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