ref: a3761f1b564b3a2574fc038a352f332190a78344
parent: 264e6b67b3caa3be6c4a23fca1a81adddc9d2bac
author: smazga <[email protected]>
date: Wed Aug 19 07:09:01 EDT 2020
more macro stuff...again
--- a/m9.ml
+++ b/m9.ml
@@ -14,8 +14,6 @@
module T = Types.Types
let repl_env = Env.make (Some Core.base)
-let synext_literals = T.String "syntax literals"
-let synext_transformers = T.String "syntax transformers"
let rec quasiquote ast =
match ast with
@@ -34,78 +32,28 @@
| ast -> Types.list [ Types.symbol "quote"; ast ]
;;
-let is_macro_call ast env =
- match ast with
- | T.List { T.value = s :: args } ->- (match
- try Env.get env s with
- | _ -> T.Nil
- with
- | T.Macro m ->
- print_endline "is_macro_call: true";
- true
- | 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 = macro } ->- (match macro with
- | kw :: _ -> kw = Types.symbol "syntax-rules"
- | _ -> false)
- | _ -> false)
- | _ -> false
-;;
-
-let eval_macro sym args macro env =
- (match macro with
- | _ :: literals :: groups ->
- let sgroups =
- Str.global_replace
- (Str.regexp "(_")
- ("(" ^ Printer.print sym true)- (Printer.dump groups)
- in
- print_endline ("BLARGH: " ^ sgroups);- print_endline
- ("TOKENIZED: " ^ String.concat " " (Reader.tokenize ("(" ^ sgroups ^ ")")));- let rec handle_groups groups =
- match groups with
- | hd :: tl ->
- print_endline (" HD: " ^ Printer.print hd true ^ " tl: " ^ Printer.dump tl);- handle_groups tl
- | _ -> print_endline "<list end>"
- in
- handle_groups groups;
- let list_reader =
- Reader.read_list ")" { list_form = []; tokens = Reader.tokenize (sgroups ^ ")") }- in
- let slist = Types.list list_reader.list_form in
- print_endline ("BLAAAARGH: " ^ Printer.print slist true)- | _ -> ());
- let smacro =
- Str.global_replace
- (Str.regexp "(_")
- ("(" ^ Printer.print sym true)- (Printer.dump macro)
- in
- print_endline
- ("eval_macro: sym:"- ^ Printer.print sym true
- ^ " args:"
- ^ Printer.dump args
- ^ " straight macro: "
- ^ Printer.dump macro);
- print_endline (" subbed macro:" ^ smacro);- (* let sub_env = Env.make (Some env) in *)
- match Reader.read smacro with
- | T.List { T.value = transformer } ->- print_endline (" TRANSFORMER: " ^ Printer.dump transformer)+let eval_macro sym args env meta =
+ match meta with
+ | T.Map { T.value = m } ->+ (try
+ let literals = Types.M9map.find Types.macro_literals m in
+ let transformers = Types.M9map.find Types.macro_transformers m in
+ print_endline ("--EVAL_MACRO: literals: " ^ Printer.print literals true ^ " transformers: " ^ Printer.print transformers true);+ let rec match_transform transforms =
+ (match transforms with
+ | hd :: tl -> print_endline ("__ hd: " ^ Printer.print hd true);+ print_endline ("__ arg length: " ^ string_of_int (List.length args));+ let foo = T.List hd in
+ print_endline ("__ transform length: " ^ string_of_int (List.length foo));+ match_transform tl
+ | [] -> ())
+ in
+ match_transform (Core.seq transformers)
+ with Not_found -> ())
| _ -> ()
;;
-let rec macroexpand ast env =
- if is_macro_call ast env
- then (
- print_endline (" YES!: " ^ Printer.print ast true);+let rec preparse ast env =
match ast with
| T.List { T.value = s :: args } ->(match
@@ -116,14 +64,9 @@
print_endline (" THIS IS A MACRO: " ^ Printer.print s true); print_endline (" META: " ^ Printer.print m true); print_endline (" ARGS: " ^ Printer.dump args);- ast
- | T.Proc { T.value = f } -> macroexpand (f args) env- | T.List { T.value = macro } ->- eval_macro s args macro env;
- ast
- | _ -> ast)
- | _ -> ast)
- else ast
+ eval_macro s args env m; ast
+ | _ -> ast)
+ | _ -> ast
;;
let rec eval_ast ast env =
@@ -139,7 +82,7 @@
| _ -> ast
and eval ast env =
- match macroexpand ast env with
+ match preparse ast env with
| T.List { T.value = [] } -> ast(* Can this be replaced with a define-syntax thing? *)
| T.List
--- a/printer.ml
+++ b/printer.ml
@@ -49,7 +49,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 unsupported>"