shithub: martian9

Download patch

ref: fa52cb29fed5ef678dadecb9b14302ac03f4d399
parent: 78448532a8c1c72d3220a9289cf1bb9f872a8886
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Wed Aug 12 19:02:44 EDT 2020 

getting there with macros


--- a/m9.ml
+++ b/m9.ml
@@ -73,27 +73,59 @@
 and eval ast env =
   match ast with
   | T.List { T.value = [] } -> ast
-  | T.List { T.value = [ T.Symbol { T.value = "define" }; T.List { T.value = arg_list }; body ] } ->
-     let sym = List.hd arg_list in
-     let rest = List.tl arg_list in
-     let func = eval (Reader.read ("(lambda (" ^ String.concat " " (List.map (fun x -> Printer.print x false) rest) ^ ") " ^ Printer.print body true ^ ")")) env in
-     Env.set env sym func; func
+  (* Can this be replaced with a define-syntax thing? *)
+  | T.List
+      { T.value = [ T.Symbol { T.value = "define" }; T.List { T.value = arg_list }; body ]
+      } ->
+    let sym = List.hd arg_list in
+    let rest = List.tl arg_list in
+    let func =
+      eval
+        (Reader.read
+           ("(lambda ("
+           ^ String.concat " " (List.map (fun x -> Printer.print x false) rest)
+           ^ ") "
+           ^ Printer.print body true
+           ^ ")"))
+        env
+    in
+    Env.set env sym func;
+    func
   | T.List { T.value = [ T.Symbol { T.value = "define" }; key; expr ] } ->
     let value = eval expr env in
     Env.set env key value;
     value
-  | T.List { T.value = [ T.Symbol { T.value = "define-syntax" }; keyword; transformer ] }
-    ->
-    (match eval transformer env with
-    | T.Proc { T.value = p; T.meta } ->
-      let proc =
-        T.Proc { T.value = p; meta = Core.link [ meta; Core.kw_macro; T.Bool true ] }
-      in
-      Env.set env keyword proc;
-      proc
-    | _ -> raise (Reader.Syntax_error "transformer value must be syntax-rules"))
   | T.List
       { T.value =
+          [ T.Symbol { T.value = "define-syntax" }
+          ; keyword
+          ; T.List { T.value = transformer }
+          ]
+      } ->
+    print_endline ("define-syntax: " ^ Printer.print keyword true);
+    print_endline
+      ("  transformer: "
+      ^ String.concat " " (List.map (fun xs -> Printer.print xs true) transformer));
+    (match transformer with
+     | T.Symbol { T.value = "syntax-rules" } :: literals :: rest ->
+        print_endline ("  literals: " ^ Printer.print literals true);
+        let lits = Core.seq literals in
+        print_endline ("   -- lits: " ^ String.concat ":" (List.map (fun x -> Printer.print x true) lits));
+        print_endline ("   -- rest: " ^ String.concat ":" (List.map (fun x -> Printer.print x true) rest));
+        T.Nil
+      (* print_endline ("  literals: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) literals)); *)
+      (* print_endline ("    body: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) body)); *)
+      (* (match eval transformer env with
+       * | T.Proc { T.value = p; T.meta } ->
+       *   let proc =
+       *     T.Proc { T.value = p; meta = Core.link [ meta; Core.kw_macro; T.Bool true ] }
+       *   in
+       *   Env.set env keyword proc;
+       *   proc
+       * | _ -> raise (Reader.Syntax_error "malformed syntax-rules")) *)
+    | _ -> raise (Reader.Syntax_error "missing syntax-rules"))
+  | T.List
+      { T.value =
           [ T.Symbol { T.value = "lambda" }; T.Vector { T.value = arg_names }; expr ]
       }
   | T.List
@@ -114,6 +146,7 @@
         in
         bind_args arg_names args;
         eval expr sub_env)
+  (* Can these be replace with define-syntax stuff? *)
   | T.List
       { T.value = [ T.Symbol { T.value = "let" }; T.Vector { T.value = bindings }; body ]
       }
--- a/printer.ml
+++ b/printer.ml
@@ -42,7 +42,7 @@
       ^ "\""
     else s
   | T.List { T.value = xs } ->
-    "(" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ ")"
+    "~(" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ ")"
   | T.Vector { T.value = v } ->
     "#(" ^ String.concat " " (List.map (fun s -> print s r) v) ^ ")"
   | T.Record r -> "<record supported>"