ref: 689862826175d1b783f98018c1484c78396a33aa
parent: 925c0021a3447cc63a8ad07846e55e34fc277877
author: McKay Marston <[email protected]>
date: Wed Oct 14 15:47:37 EDT 2020
about to refactor macro creation
--- a/eval.ml
+++ b/eval.ml
@@ -28,7 +28,7 @@
try Env.get env (List.hd xs) with
| _ -> T.Nil
with
- (* disabled for macro_read development *)
+ (* disabled for macro_read development *)
(* | T.Macro { T.value = sym; meta } as om -> * print_endline (" EVAL_AST: the rest: " ^ Printer.dump (List.tl xs));@@ -37,14 +37,11 @@
* print_endline (" expanded: " ^ Printer.print foo true); * T.List { T.value = [ om; foo ]; T.meta } *)-
(* T.List { T.value = [foo]; T.meta } *)- (* T.List { T.value = [ Types.symbol (Printer.print sym true); foo; T.List { T.value = (List.tl xs); T.meta } ]; T.meta } *)- (* T.List { T.value = [eval foo env]; T.meta } *)- (* eval foo env *)
+ (* T.List { T.value = [ Types.symbol (Printer.print sym true); foo; T.List { T.value = (List.tl xs); T.meta } ]; T.meta } *)+ (* T.List { T.value = [eval foo env]; T.meta } *)+ (* eval foo env *)
(* raise (Utils.Syntax_error ("EVAL_AST MACRO: ast: " ^ Printer.print ast true)) *)-
-
| _ -> T.List { T.value = List.map (fun x -> eval x env) xs; T.meta }) (* | T.List { T.value = xs; T.meta } -> T.List { T.value = List.map (fun x -> eval x env) xs; T.meta } *) | T.Vector { T.value = xs; T.meta } -> T.Vector { T.value = List.map (fun x -> eval x env) xs; T.meta }@@ -64,7 +61,6 @@
* eval foo env
* | _ -> ast)
* | _ -> ast *)
-
and eval ast env =
print_endline ("AST: " ^ Printer.print ast true);match ast with
--- a/macro.ml
+++ b/macro.ml
@@ -201,36 +201,53 @@
let add_variant sym variant env =
let new_variant = gen_sym sym in
- let macro = Env.get env (Types.symbol sym) in
- let variants = Types.M9map.find Types.macro_variants macro.meta
- (* match
- * try Env.get env (Types.symbol sym) with
- * | _ -> T.Nil
- * with
- * | T.Macro { T.value = sym; meta } ->- * let variants = Types.M9map.find Types.macro_variants meta in
- * Types.M9map.add Types.macro_variants (new_variant :: variants) meta
- * | _ -> raise (Utils.Runtime_error ("wayward variant of " ^ sym ^ ": " ^ variant)) *)+ match
+ try Env.get env (Types.symbol sym) with
+ | _ -> T.Nil
+ with
+ | T.Macro { T.value = sym; meta } ->+ (match meta with
+ | T.Map { T.value = m } ->+ let variants = ref (Types.M9map.find Types.macro_variants m) in
+ Types.M9map.add (Types.symbol new_variant) variant !variants;
+ print_endline ("ADD_VARIANT: " ^ new_variant ^ ": " ^ Printer.print meta true);+ print_endline (" variants: " ^ Printer.print !variants true)+ | _ -> raise (Utils.Runtime_error ("macro " ^ (Printer.print sym true) ^ " is missing its variants")))+ | _ -> raise (Utils.Syntax_error "add_variant botch")
+;;
+(* let macro = Env.get env (Types.symbol sym) in
+ * let variants = Types.M9map.find Types.macro_variants macro.meta *)
+(* match
+ * try Env.get env (Types.symbol sym) with
+ * | _ -> T.Nil
+ * with
+ * | T.Macro { T.value = sym; meta } ->+ * let variants = Types.M9map.find Types.macro_variants meta in
+ * Types.M9map.add Types.macro_variants (new_variant :: variants) meta
+ * | _ -> raise (Utils.Runtime_error ("wayward variant of " ^ sym ^ ": " ^ variant)) *)+
let register_macro macro sym literals patterns env =
let rec register_variants clauses =
match clauses with
- | pattern :: [] ->
- print_endline (" " ^ sym ^ ": pattern: " ^ pattern)+ | [ pattern ] ->
+ print_endline (" " ^ sym ^ ": -> pattern: " ^ pattern);+ add_variant sym pattern env
| pattern :: rest ->
- print_endline (" " ^ sym ^ ": rest: " ^ String.concat " " rest);- register_variants rest
- | _ -> raise (Utils.Syntax_error("macro pattern registration botch"))+ print_endline (" " ^ sym ^ ": pattern: " ^ pattern);+ print_endline (" " ^ sym ^ ": rest: " ^ String.concat " " rest);+ (* add_variant sym pattern env; *)
+ register_variants rest
+ | _ -> raise (Utils.Syntax_error "macro pattern registration botch")
in
(match
try Env.get env (Types.symbol sym) with
| _ -> T.Nil
with
- (* | T.Macro { T.value = sym; meta } -> *)- | T.Nil ->
- print_endline ("new macro: " ^ sym);- Env.set env (Types.symbol sym) macro
- | _ -> ());
+ | T.Nil ->
+ print_endline ("new macro: " ^ sym);+ Env.set env (Types.symbol sym) macro
+ | _ -> ());
register_variants patterns
;;
--- a/reader.ml
+++ b/reader.ml
@@ -93,18 +93,23 @@
let list_reader = read_list ")" { list_form = []; tokens } in print_endline ("MACRO: " ^ Printer.dump list_reader.list_form);(match list_reader.list_form with
- (* | sym :: T.List { T.value = [ T.Symbol { T.value = "syntax-rules" }; clause ] } -> *)- | sym :: rest ->
- print_endline (" sym: " ^ Printer.print sym true);- print_endline (" rest: " ^ Printer.dump rest);- (match rest with
- | T.List { T.value = T.Symbol { T.value = "syntax-rules" } :: literals :: clauses } :: [] ->- let symbol = Printer.print sym true in
- print_endline (" clauses: " ^ Printer.dump clauses);- let macro_entry = Types.macro symbol literals (Types.list clauses) in
- Macro.register_macro macro_entry symbol literals (List.map (fun x -> Printer.print x true) clauses) registered_macros
- | _ -> raise (Utils.Syntax_error "read_macro botch"))
- | _ as x -> print_endline (" rest: " ^ Printer.dump x));+ (* | sym :: T.List { T.value = [ T.Symbol { T.value = "syntax-rules" }; clause ] } -> *)+ | sym :: rest ->
+ print_endline (" sym: " ^ Printer.print sym true);+ print_endline (" rest: " ^ Printer.dump rest);+ (match rest with
+ | [ T.List { T.value = T.Symbol { T.value = "syntax-rules" } :: literals :: clauses } ] ->+ let symbol = Printer.print sym true in
+ print_endline (" clauses: " ^ Printer.dump clauses);+ let macro_entry = Types.macro symbol literals (Types.list clauses) in
+ Macro.register_macro
+ macro_entry
+ symbol
+ literals
+ (List.map (fun x -> Printer.print x true) clauses)
+ registered_macros
+ | _ -> raise (Utils.Syntax_error "read_macro botch"))
+ | _ as x -> print_endline (" rest: " ^ Printer.dump x)); (* | T.List { T.value = [ T.Symbol { T.value = "define-syntax" }; keyword; T.List { T.value = macro } ] } ->* (match macro with
* | _ :: literals :: groups ->
--- a/types.ml
+++ b/types.ml
@@ -74,6 +74,9 @@
let macro sym literals transformers =
let meta = ref M9map.empty in
- meta := M9map.add macro_literals literals !meta |> M9map.add macro_transformers transformers;
+ meta
+ := M9map.add macro_literals literals !meta
+ |> M9map.add macro_transformers transformers
+ |> M9map.add macro_variants (map M9map.empty);
Types.Macro { Types.value = symbol sym; meta = map !meta };;