shithub: martian9

Info  •  Files  •  Log  •  Branches

ready for step 8

--- a/core.ml

+++ b/core.ml

@@ -77,7 +77,8 @@

     env

     (Types.symbol "display")

     (Types.proc (function xs ->

-         T.String (String.concat " " (List.map (fun s -> Printer.print s false) xs))));

+         print_string (String.concat " " (List.map (fun s -> Printer.print s false) xs));

+         T.Eof_object));

   Env.set

     env

     (Types.symbol "string")

@@ -95,9 +96,12 @@

     (Types.proc (function

         | [ T.String x ] -> T.String (Reader.slurp x)

         | _ -> T.Nil));

-  Env.set env (Types.symbol "cons") (Types.proc (function xs -> Types.list xs));

-  (* | x :: xs -> Types.pair x xs

-   * | _ -> T.Nil)); *)

+  Env.set

+    env

+    (Types.symbol "cons")

+    (Types.proc (function

+        | [ x; xs ] -> Types.list [ x; xs ]

+        | _ -> T.Nil));

   Env.set

     env

     (Types.symbol "concat")

--- a/m9.ml

+++ b/m9.ml

@@ -58,7 +58,7 @@

       | sym :: expr :: more ->

         Env.set sub_env sym (eval expr sub_env);

         bind_pairs more

-      | [ _ ] -> raise (Invalid_argument "let missing body")

+      | [ _ ] -> raise (Invalid_argument "missing 'let' body")

       | [] -> ()

     in

     bind_pairs bindings;

@@ -81,7 +81,7 @@

             Env.set sub_env name arg;

             bind_args names args

           | [], [] -> ()

-          | _ -> raise (Invalid_argument "wrong parameter count")

+          | _ -> raise (Invalid_argument "wrong parameter count for lambda")

         in

         bind_args arg_names args;

         eval expr sub_env)

@@ -97,7 +97,8 @@

   | T.List _ ->

     (match eval_ast ast env with

     | T.List { T.value = T.Proc { T.value = f } :: args } -> f args

-    | _ -> raise (Invalid_argument "not a function"))

+    | _ as x ->

+      raise (Invalid_argument ("\"" ^ Printer.print x true ^ "\" not a function")))

   | _ -> eval_ast ast env

 ;;

--- a/mkfile

+++ b/mkfile

@@ -1,3 +1,5 @@

+# -*- makefile -*-

+

 BIN=m9

 FILES=\

@@ -8,7 +10,7 @@

 	core.ml

 $BIN:

-	ocamlc str.cma -o $target $FILES m9.ml

+	ocamlc str.cma -g -o $target $FILES m9.ml

 %.cmx : %.ml

 	ocamlopt -c $stem.ml

--- a/notes.org

+++ b/notes.org

@@ -1,13 +1,15 @@

 * First things:

 ** TODO need an "unspecified" type?

 ** TODO (display) should return unspecified

-** TODO implement (cons)

+** TODO implement (pair)

 Pairs should be preserved, I think

 Also, it should _only_ be pairs, nothing more.

 ** TODO (define) needs to support function definitions

 Right now you need to use lambda

+** DONE (cons) doesn't work

+This appears to work, now, but not with a pair

 * Read

-** TODO quote and quasiquote symbols not supported

+** DONE "quote" and "quasiquote" symbols not supported

 The shortcuts work, but not the keywords

 * Eval

 * Print

--- a/printer.ml

+++ b/printer.ml

@@ -15,7 +15,7 @@

   match obj with

   | T.Bool true -> "#t"

   | T.Bool false -> "#f"

-  | T.Char c -> Char.escaped c

+  | T.Char c -> "#\\" ^ Char.escaped c

   | T.Nil -> "nil"

   | T.Comment -> "" (* TODO: this leaves a space in the output for block comments *)

   (* | T.Pair ({ T.value = one }, { T.value = two }) -> "(" ^ (print one readable) ^ " . " ^ (print two readable) ^ ")" *)

--- a/reader.ml

+++ b/reader.ml

@@ -63,6 +63,10 @@

   | _ ->

     (match token.[0] with

     | '0' .. '9' -> Types.number (float_of_string token)

+    | '#' ->

+      (match token.[1], token.[2] with

+      | '\\', '0' .. '9' | '\\', 'a' .. 'z' | '\\', 'A' .. 'Z' -> T.Char token.[2]

+      | _ -> Types.symbol token)

     | '-' ->

       (match String.length token with

       | 1 -> Types.symbol token

@@ -92,6 +96,19 @@

   let reader = read_form tokens in

   { form = Types.list [ Types.symbol sym; reader.form ]; tokens = reader.tokens }

+and read_hash all_tokens =

+  print_endline "read_hash";

+  match all_tokens with

+  | [] -> raise End_of_file

+  | token :: tokens ->

+    (match token with

+    | "(" ->

+      let list_reader = read_list ")" { list_form = []; tokens } in

+      { form = Types.vector list_reader.list_form; tokens = list_reader.tokens }

+    | _ as x ->

+      print_endline ("subtoken: " ^ x);

+      read_form tokens)

+

 and read_form all_tokens =

   match all_tokens with

   | [] -> raise End_of_file

@@ -99,12 +116,16 @@

     (match token with

     | "'" -> read_quote "quote" tokens

     | "`" -> read_quote "quasiquote" tokens

-    | "(" ->

-      let list_reader = read_list ")" { list_form = []; tokens } in

-      { form = Types.list list_reader.list_form; tokens = list_reader.tokens }

+    | "#" ->

+      print_endline ("read_form:token: " ^ token);

+      read_hash tokens

     | "#|" ->

       let list_reader = read_list "|#" { list_form = []; tokens } in

       { form = T.Comment; tokens = list_reader.tokens }

+    | "(" ->

+      let list_reader = read_list ")" { list_form = []; tokens } in

+      { form = Types.list list_reader.list_form; tokens = list_reader.tokens }

+    | "" | "\t" | "\n" -> read_form tokens

     | _ ->

       if token.[0] = ';' then read_form tokens else { form = read_atom token; tokens })

 ;;