ref: ad64b64a877a8ade76ab155b61931aa2f18a3ee5
parent: 64583452c2d9c394432b2490c67ea17875ea65aa
author: smazga <[email protected]>
date: Fri Aug 28 10:21:40 EDT 2020
closer on the macro question
--- a/eval.ml
+++ b/eval.ml
@@ -26,21 +26,23 @@
T.Vector { T.value = List.map (fun x -> eval x env) xs; T.meta }| _ -> ast
-and preparse ast env =
- match ast with
- | T.List { T.value = s :: args } ->- (match
- try Env.get env s with
- | _ -> T.Nil
- 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)); foo (* eval foo env *)- | _ -> ast)
- | _ -> ast
-
+(* and preparse ast env =
+ * print_endline ("preparse: " ^ Printer.print ast true);+ * match ast with
+ * | T.List { T.value = s :: args } ->+ * (match
+ * try Env.get env s with
+ * | _ -> T.Nil
+ * with
+ * | T.Macro { T.value = sym; meta } ->+ * let foo = Macro.expand ast env args sym meta in
+ * print_endline (" expanded: " ^ Printer.print foo true);+ * eval foo env
+ * | _ -> ast)
+ * | _ -> ast *)
and eval ast env =
- match preparse ast env with
+ (* match preparse ast env with *)
+ match ast with
| T.List { T.value = [] } -> ast(* Can this be replaced with a define-syntax thing? *)
| T.List
@@ -123,10 +125,15 @@
if Types.to_bool (eval cond env) then eval then_expr env else T.Nil
| T.List { T.value = [ T.Symbol { T.value = "quote" }; ast ] } -> ast | T.List { T.value = [ T.Symbol { T.value = "quasiquote" }; ast ] } ->- eval (quasiquote ast) env
+ eval (quasiquote ast) env
| T.List _ ->
(match eval_ast ast env with
| T.List { T.value = T.Proc { T.value = f } :: args } -> f args+ | T.List { T.value = T.Macro { T.value = sym; meta } :: args } ->+ (* eval (Macro.expand ast env args sym meta) env *)
+ let foo = Macro.expand ast env args sym meta in
+ print_endline (":::: " ^ Printer.print foo true);+ eval foo env
| _ as x ->
raise (Reader.Syntax_error ("'" ^ Printer.print x true ^ "' not a function")))| _ -> eval_ast ast env
--- a/m9.ml
+++ b/m9.ml
@@ -13,7 +13,6 @@
module T = Types.Types
let repl_env = Env.make (Some Core.base)
-
let nameplate = "Martian9 Scheme v0.1"
let read str = Reader.read str
let print exp = Printer.print exp true
--- a/macro.ml
+++ b/macro.ml
@@ -10,21 +10,54 @@
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 (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
+ (* literals and ellipses not handled, yet *)
+ | ph :: pt, ah :: at ->
+ print_endline " LIST <-> LIST";
+ if ph = "_" || (ph = Printer.print sym true && sym = ah)
+ then is_matching_pattern sym pt at matched && true
+ else (
+ print_endline (" ------> " ^ ph ^ " vs " ^ Printer.print ah true);+ 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 (List.hd pt = "...")
+ | [], ah :: at ->
+ print_endline " [] <-> LIST";
+ false
+ | _, _ -> matched
+;;
let lambdaize pattern template args =
match pattern, args with
+ | ph :: pt, ah :: at :: rest ->
+ print_endline "lambdaize: list list";
+ Reader.read
+ ("((lambda ("+ ^ Printer.stringify pt false
+ ^ ") ("+ ^ Printer.print template true
+ ^ ")"
+ ^ Printer.stringify args false
+ ^ "))")
| ph :: pt, ah :: at ->
- Reader.read ("(lambda (" ^ (Printer.stringify pt false) ^ ") (" ^ (Printer.print template true) ^ ")" ^ (Printer.stringify args false) ^ ")")+ print_endline "lambdaize: list short";
+ Reader.read ("((lambda (" ^ Printer.stringify pt true ^ ")"+ ^ Printer.print template true ^ ")"
+ ^ Printer.stringify args true ^ ")")
| ph :: pt, [] ->
- Reader.read ("((lambda (" ^ (Printer.stringify pt false) ^ ") " ^ (Printer.print template true) ^ "))")- | _ -> Reader.read ("((lambda () " ^ (Printer.print template true) ^ "))")+ print_endline "lambdaize: list empty";
+ Reader.read
+ ("((lambda ("+ ^ Printer.stringify pt false
+ ^ ") "
+ ^ Printer.print template true
+ ^ "))")
+ | _ ->
+ print_endline "lambdaize: empty";
+ 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);@@ -31,7 +64,6 @@
print_endline (" META: " ^ Printer.print meta true); print_endline (" ARGS: " ^ Printer.dump args); print_endline (" AST: " ^ Printer.print ast true);-
match meta with
| T.Map { T.value = m } ->(try
@@ -49,16 +81,48 @@
print_endline (" transform: " ^ Printer.print hd true);(match hd with
| T.List
- { T.value = [ T.List { T.value = pattern }; T.List { T.value = template } ] }- ->
- print_endline (" _ multi pattern: " ^ Printer.dump pattern); match_transform tl+ { T.value = [ T.List { T.value = pattern }; T.List { T.value = template } ]+ } ->
+ print_endline (" _ multi pattern: " ^ Printer.dump pattern);+ print_endline (" - template: " ^ Printer.dump template);+ print_endline
+ ("matched?: "+ ^
+ if is_matching_pattern
+ sym
+ (List.map (fun x -> Printer.print x true) pattern)
+ (Core.seq ast)
+ true
+ then "yes"
+ else "no");
+ if is_matching_pattern
+ sym
+ (List.map (fun x -> Printer.print x true) pattern)
+ (Core.seq ast)
+ true
+ then lambdaize pattern (Types.list template) args
+ else match_transform tl
| 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
- (* then lambdaize pattern atom args else match_transform tl *)
- | _ -> T.Nil) (* errors? *)
+ print_endline (" _ single pattern: " ^ Printer.dump pattern);+ print_endline
+ ("matched?: "+ ^
+ if is_matching_pattern
+ sym
+ (List.map (fun x -> Printer.print x true) pattern)
+ (Core.seq ast)
+ true
+ then "yes"
+ else "no");
+ if is_matching_pattern
+ sym
+ (List.map (fun x -> Printer.print x true) pattern)
+ (Core.seq ast)
+ true
+ then lambdaize pattern atom args
+ else match_transform tl
+ | _ -> T.Nil)
+ (* errors? *)
| [] -> T.Nil
in
match_transform (Core.seq transformers)
@@ -65,3 +129,4 @@
with
| Not_found -> T.Nil)
| _ -> T.Nil
+;;
--- a/notes.org
+++ b/notes.org
@@ -35,3 +35,5 @@
- substitute args for non-literals (in order)
- compare result with ast - if it's a match, return a lamba with the matching args and the transformer
...but what about ellipsis??
+** Thoughts
+Eval seems too late to handle it, so maybe try to do expansion at read?