shithub: martian9

Download patch

ref: 64583452c2d9c394432b2490c67ea17875ea65aa
parent: df79e7e4c7f40d06925385e94365b5cba554f1fe
author: smazga <smazga@greymanlabs.com>
date: Fri Aug 28 06:38:59 EDT 2020

macro

--- a/eval.ml
+++ b/eval.ml
@@ -35,7 +35,7 @@
      with
      | T.Macro { T.value = sym; meta = meta } ->
         let foo = Macro.expand ast env args sym meta in
-        print_endline ("PREPARSE: " ^ (Printer.print foo true)); eval foo env
+        print_endline ("PREPARSE: " ^ (Printer.print foo true)); foo (* eval foo env *)
     | _ -> ast)
   | _ -> ast
 
@@ -68,7 +68,6 @@
       { T.value =
           [ T.Symbol { T.value = "define-syntax" }; keyword; T.List { T.value = macro } ]
       } ->
-    print_endline ("define-syntax: " ^ Printer.print keyword true);
     (match macro with
     | _ :: literals :: groups ->
       let macro_entry =
--- a/macro.ml
+++ b/macro.ml
@@ -1,14 +1,31 @@
 module T = Types.Types
 
+(* let gen_sym root =
+ *   let gen() = match Random.int(26+26+10) with
+ *       n when n < 26 -> int_of_char 'a' + n
+ *     | n when n < 26 + 26 -> int_of_char 'A' + n - 26
+ *     | n -> int_of_char '0' + n - 26 - 26 in
+ *   let gen _ = String.make 1 (char_of_int(gen())) in
+ *   root ^ (String.concat "" (Array.to_list (Array.init 5 gen))) *)
+
 let rec is_matching_pattern sym pattern args matched =
   match pattern, args with
   (* literals not handled, yet *)
   | ph :: pt, ah :: at -> print_endline "    LIST <-> LIST";
-                          if (ph = "_" || (ph = (Printer.print sym true) && ph = (Printer.print ah true))) then is_matching_pattern sym pt at matched && true else is_matching_pattern sym pt at matched
+                          if (ph = "_" || (ph = (Printer.print sym true) && ph = (Printer.print ah true))) then is_matching_pattern sym pt at matched && true else (print_endline " ------> foo"; is_matching_pattern sym pt at matched)
    | ph :: pt, [] -> print_endline "    LIST <-> []";
                      if (ph = "_" || ph = (Printer.print sym true)) then is_matching_pattern sym pt [] matched && true else false
+   | [], ah :: at -> print_endline "    [] <-> LIST"; false
    | _, _ -> matched
 
+let lambdaize pattern template args =
+  match pattern, args with
+  | ph :: pt, ah :: at ->
+     Reader.read ("(lambda (" ^ (Printer.stringify pt false) ^ ") (" ^ (Printer.print template true) ^ ")" ^ (Printer.stringify args false) ^ ")")
+  | ph :: pt, [] ->
+     Reader.read ("((lambda (" ^ (Printer.stringify pt false) ^ ") " ^ (Printer.print template true) ^ "))")
+  | _ -> Reader.read ("((lambda () " ^ (Printer.print template true) ^ "))")
+
 let rec expand ast env args sym meta =
   print_endline ("\n\nTHIS IS A MACRO: " ^ Printer.print sym true);
   print_endline ("   META: " ^ Printer.print meta true);
@@ -15,15 +32,6 @@
   print_endline ("   ARGS: " ^ Printer.dump args);
   print_endline ("  AST:   " ^ Printer.print ast true);
 
-    (* and expand args env sym meta = *)
-  (* let sub_env = Env.make (Some env) in
-   * Env.set
-   *   sub_env
-   *   (Types.symbol "_")
-   *   (Types.proc (function
-   *       | [ ast ] -> eval ast sub_env
-   *       | _ -> T.Nil)); *)
-  
   match meta with
   | T.Map { T.value = m } ->
     (try
@@ -34,11 +42,11 @@
          ^ Printer.print literals true
          ^ "     transformers: "
          ^ Printer.print transformers true);
+       print_endline ("    args: " ^ Printer.dump args);
        let rec match_transform transforms =
          match transforms with
          | hd :: tl ->
-           print_endline ("   __ hd: " ^ Printer.print hd true);
-           print_endline ("   __ args: " ^ Printer.dump args);
+           print_endline ("      transform: " ^ Printer.print hd true);
            (match hd with
            | T.List
                { T.value = [ T.List { T.value = pattern }; T.List { T.value = template } ] }
@@ -47,11 +55,13 @@
            | T.List { T.value = [ T.List { T.value = pattern }; atom ] } ->
               print_endline ("     _ single pattern: " ^ Printer.dump pattern);
               print_endline ("matched?: " ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) args true then "yes" else "no"));
-              if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) args true then atom else match_transform tl
-           | _ -> ast)
-         | [] -> ast
+              if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) args true
+              then atom else match_transform tl
+              (* then lambdaize pattern atom args else match_transform tl *)
+           | _ -> T.Nil) (* errors? *)
+         | [] -> T.Nil
        in
        match_transform (Core.seq transformers)
      with
-    | Not_found -> ast)
-  | _ -> ast
+    | Not_found -> T.Nil)
+  | _ -> T.Nil