shithub: martian9

Info  •  Files  •  Log  •  Branches

more macro work

--- a/env.ml

+++ b/env.ml

@@ -12,7 +12,7 @@

 let set env sym value =

   match sym with

-  | T.Symbol { T.value = key } -> env.data := Data.add key value !(env.data)

+  | T.Symbol { T.value = key } -> (* print_endline ("Env.set: " ^ key); *) env.data := Data.add key value !(env.data)

   | _ -> raise (Invalid_argument "set: not a symbol")

 ;;

--- a/m9.ml

+++ b/m9.ml

@@ -35,6 +35,7 @@

 let is_macro_call ast env =

   match ast with

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

+     print_endline ("is_macro_call: sym: " ^ Printer.print s true ^ "  args: " ^ Printer.dump args);

     (match

        try Env.get env s with

        | _ -> T.Nil

@@ -42,6 +43,8 @@

     | T.Proc { T.meta = T.Map { T.value = meta } } ->

       Types.M9map.mem Core.kw_macro meta

       && Types.to_bool (Types.M9map.find Core.kw_macro meta)

+    (* | T.List { T.value = foo } -> print_endline ("foo: " ^ Printer.dump foo); false *)

+    | T.List { T.value = [ T.Symbol { T.value = "syntax-rules" }; args ] }-> true

     | _ -> false)

   | _ -> false

 ;;

@@ -49,6 +52,7 @@

 let rec macroexpand ast env =

   if is_macro_call ast env

   then (

+    print_endline ("  YES!: " ^ Printer.print ast true);

     match ast with

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

       (match

@@ -58,7 +62,9 @@

       | T.Proc { T.value = f } -> macroexpand (f args) env

       | _ -> ast)

     | _ -> ast)

-  else ast

+  else

+    (print_endline ("  no: " ^ Printer.print ast true);

+     ast)

 ;;

 let rec eval_ast ast env =

@@ -71,7 +77,7 @@

   | _ -> ast

 and eval ast env =

-  match ast with

+  match macroexpand ast env with

   | T.List { T.value = [] } -> ast

   (* Can this be replaced with a define-syntax thing? *)

   | T.List

@@ -102,18 +108,23 @@

           ; 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 ("define-syntax: " ^ Printer.print keyword true);

+     print_endline ("  transformer: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) transformer));

+     let macro = T.List { T.value = transformer; meta = Core.link [ Core.kw_macro; T.Bool true ] } in

+     Env.set env keyword macro; macro

+    (* 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 (unsupported!): " ^ Printer.print literals true);

+     *     print_endline ("   -- rest: " ^ String.concat ":" (List.map (fun x -> Printer.print x true) rest));

+     *     let proc = T.Proc { 

+     *     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 } ->

@@ -123,7 +134,7 @@

        *   Env.set env keyword proc;

        *   proc

        * | _ -> raise (Reader.Syntax_error "malformed syntax-rules")) *)

-    | _ -> raise (Reader.Syntax_error "missing 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 ]

@@ -176,7 +187,7 @@

     (match eval_ast ast env with

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

     | _ as x ->

-      raise (Reader.Syntax_error ("\"" ^ Printer.print x true ^ "\" not a function")))

+      raise (Reader.Syntax_error ("'" ^ Printer.print x true ^ "' not a function")))

   | _ -> eval_ast ast env

 ;;

--- a/printer.ml

+++ b/printer.ml

@@ -42,8 +42,11 @@

       ^ "\""

     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>"

 ;;

+

+let dump obj =

+  String.concat " " (List.map (fun s -> print s true) obj)

-- 

⑨