ref: 9c051022720fb7ac3ba0e899550654d348462c63
parent: 89403fb391d40dee3ee3ca6b59a70d07d04de1c2
author: smazga <smazga@greymanlabs.com>
date: Mon Aug 24 11:50:41 EDT 2020
added macro.ml
--- a/core.ml
+++ b/core.ml
@@ -104,7 +104,7 @@
env
(Types.symbol "display")
(Types.proc (function xs ->
- print_string (Printer.stringify xs false);
+ print_string (Printer.stringify xs false);
T.Unspecified));
Env.set
env
--- a/m9.ml
+++ b/m9.ml
@@ -41,58 +41,6 @@
T.Vector { T.value = List.map (fun x -> eval x env) xs; T.meta }| _ -> ast
-and eval_macro sym args env 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
- 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));- (match hd with
- | T.List
- { T.value = [ T.List { T.value = pattern }; T.List { T.value = body } ] }- ->
- print_endline (" _ pattern: " ^ Printer.dump pattern);- print_endline
- ("__ pattern length: "- ^ string_of_int (List.length pattern)
- ^ " body: "
- ^ Printer.dump body)
- | T.List { T.value = [ T.List { T.value = pattern }; atom ] } ->- print_endline (" _ pattern: " ^ Printer.dump pattern);- print_endline
- ("__ atomic pattern length: "- ^ string_of_int (List.length pattern)
- ^ " atom: "
- ^ Printer.print atom true)
- | _ -> ());
- let foo = Reader.read (Printer.print hd false) in
- print_endline (" foo: " ^ Printer.print foo true);- (* print_endline ("__ transform length: " ^ string_of_int (List.length foo)); *)- match_transform tl
- | [] -> ()
- in
- match_transform (Core.seq transformers)
- with
- | Not_found -> ())
- | _ -> ()
-
and preparse ast env =
match ast with
| T.List { T.value = s :: args } ->@@ -100,13 +48,8 @@
try Env.get env s with
| _ -> T.Nil
with
- | T.Macro { T.value = s; meta = m } ->- print_endline (" THIS IS A MACRO: " ^ Printer.print s true);- print_endline (" META: " ^ Printer.print m true);- print_endline (" ARGS: " ^ Printer.dump args);- print_endline (" AST: " ^ Printer.print ast true);- eval_macro s args env m;
- ast
+ | T.Macro { T.value = sym; meta = meta } ->+ Macro.expand ast env args sym meta; ast
| _ -> ast)
| _ -> ast
--- /dev/null
+++ b/macro.ml
@@ -1,0 +1,60 @@
+module T = Types.Types
+
+let rec expand ast env args sym meta =
+ print_endline (" THIS IS A MACRO: " ^ Printer.print sym true);+ print_endline (" META: " ^ Printer.print meta true);+ 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
+ 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));+ (match hd with
+ | T.List
+ { T.value = [ T.List { T.value = pattern }; T.List { T.value = body } ] }+ ->
+ print_endline (" _ pattern: " ^ Printer.dump pattern);+ print_endline
+ ("__ pattern length: "+ ^ string_of_int (List.length pattern)
+ ^ " body: "
+ ^ Printer.dump body)
+ | T.List { T.value = [ T.List { T.value = pattern }; atom ] } ->+ print_endline (" _ pattern: " ^ Printer.dump pattern);+ print_endline
+ ("__ atomic pattern length: "+ ^ string_of_int (List.length pattern)
+ ^ " atom: "
+ ^ Printer.print atom true)
+ | _ -> ());
+ let foo = Reader.read (Printer.print hd false) in
+ print_endline (" foo: " ^ Printer.print foo true);+ (* print_endline ("__ transform length: " ^ string_of_int (List.length foo)); *)+ match_transform tl
+ | [] -> ()
+ in
+ match_transform (Core.seq transformers)
+ with
+ | Not_found -> ())
+ | _ -> ()
--- a/mkfile
+++ b/mkfile
@@ -7,7 +7,8 @@
env.ml\
reader.ml\
printer.ml\
- core.ml
+ core.ml\
+ macro.ml
$BIN:
ocamlc str.cma -g -o $target $FILES m9.ml
--- a/printer.ml
+++ b/printer.ml
@@ -48,17 +48,19 @@
s
^ "\""
else s
- | T.List { T.value = xs } ->- "(" ^ stringify xs r ^ ")"- | T.Vector { T.value = v } ->- "#(" ^ stringify v r ^ ")"+ | T.List { T.value = xs } -> "(" ^ stringify xs r ^ ")"+ | T.Vector { T.value = v } -> "#(" ^ stringify v r ^ ")"| T.Record r -> "<record unsupported>"
and stringify obj human =
- String.concat " " (List.filter (function
- | T.Unspecified
- | T.Eof_object -> human
- | _ -> true) obj |> List.map (fun s-> print s human))
+ String.concat
+ " "
+ (List.filter
+ (function
+ | T.Unspecified | T.Eof_object -> human
+ | _ -> true)
+ obj
+ |> List.map (fun s -> print s human))
;;
let dump obj = String.concat " " (List.map (fun s -> print s true) obj)