ref: 271c7847be7a17ea20b84720a4b740255877da6c
parent: 6cec07e20602ff1a19e3179c48ad11203c61c274
author: McKay Marston <[email protected]>
date: Tue Oct 20 14:08:36 EDT 2020
macro
--- a/eval.ml
+++ b/eval.ml
@@ -62,7 +62,6 @@
* | _ -> ast)
* | _ -> ast *)
and eval ast env =
- print_endline ("AST: " ^ Printer.print ast true);match ast with
| T.List { T.value = [] } -> ast(* Can this be replaced with a define-syntax thing? *)
--- a/macro.ml
+++ b/macro.ml
@@ -50,7 +50,7 @@
(* add arguments *)
print_endline ("ADD " ^ string_of_int missing ^ " arguments");for i = 1 to missing do
- ellipsis_substitutions := !ellipsis_substitutions @ [ (Printer.print (gen_sym "x") true) ]
+ ellipsis_substitutions := !ellipsis_substitutions @ [ Printer.print (gen_sym "x") true ]
done;
let pattern_str =
Str.global_replace
@@ -214,7 +214,6 @@
* 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 *)
@@ -228,17 +227,17 @@
* | _ -> raise (Utils.Runtime_error ("wayward variant of " ^ sym ^ ": " ^ variant)) *)let generate_variants sym literals patterns =
- let symbol = (Printer.print sym true) in
+ let symbol = Printer.print sym true in
let variants = ref Types.M9map.empty in
let rec register_variants clauses =
let new_sym = gen_sym symbol in
match clauses with
| [ pattern ] ->
- variants := Types.M9map.add new_sym pattern !variants;
- !variants
+ variants := Types.M9map.add new_sym pattern !variants;
+ !variants
| pattern :: rest ->
- variants := Types.M9map.add new_sym pattern !variants;
- register_variants rest
+ variants := Types.M9map.add new_sym pattern !variants;
+ register_variants rest
| _ -> raise (Utils.Syntax_error "macro pattern registration botch")
in
register_variants patterns
@@ -247,20 +246,28 @@
let match_variant macro args =
match macro with
| T.Map { T.value = meta } ->- (match Types.M9map.find Types.macro_variants meta with
- | T.Map { T.value = variant_list } ->- Types.M9map.iter
- (fun k v ->
- print_endline (Printer.print k true ^ ": " ^ Printer.print v true);
- match v with
- | T.List { T.value = T.List { T.value = x } :: z } -> print_endline (" !!! [" ^ string_of_int (List.length args) ^ "](" ^ string_of_int (List.length x) ^ ") " ^ Printer.dump x ^ " :: " ^ Printer.dump z);- if List.length args = List.length x
- then print_endline "MATCH!"
- else print_endline "no match"
- | _ -> ())
- variant_list
- | _ -> ())
+ (match Types.M9map.find Types.macro_variants meta with
+ | T.Map { T.value = variant_list } ->+ Types.M9map.iter
+ (fun k v ->
+ print_endline (Printer.print k true ^ ": " ^ Printer.print v true);
+ match v with
+ | T.List { T.value = T.List { T.value = x } :: z } ->+ print_endline
+ (" !!! ["+ ^ string_of_int (List.length args)
+ ^ "]("+ ^ string_of_int (List.length x)
+ ^ ") "
+ ^ Printer.dump x
+ ^ " :: "
+ ^ Printer.dump z);
+ if List.length args = List.length x then print_endline "MATCH!" else print_endline "no match"
+ | _ -> ())
+ variant_list
+ | _ -> ())
| _ -> ()
+;;
(* match meta with
* | T.Map { T.value = m } ->--- a/reader.ml
+++ b/reader.ml
@@ -47,12 +47,14 @@
let new_pattern = ref [] in
let rec replace_token tokens =
match tokens with
- | token :: [] -> let t = if token = "_" then (Printer.print sym true) else token in
- new_pattern := !new_pattern @ [t];
- !new_pattern
- | token :: rest -> let t = if token = "_" then (Printer.print sym true) else token in
- new_pattern := !new_pattern @ [t];
- replace_token rest
+ | [ token ] ->
+ let t = if token = "_" then Printer.print sym true else token in
+ new_pattern := !new_pattern @ [ t ];
+ !new_pattern
+ | token :: rest ->
+ let t = if token = "_" then Printer.print sym true else token in
+ new_pattern := !new_pattern @ [ t ];
+ replace_token rest
| _ -> raise (Utils.Syntax_error "unable to fix pattern")
in
replace_token tokenized_pattern
@@ -82,25 +84,24 @@
;;
let rec read_list eol list_reader =
- if (List.length list_reader.tokens > 1) && (List.hd list_reader.tokens) = "("- then
- (match
- try Env.get registered_macros (Types.symbol (List.nth list_reader.tokens 1)) with
- | _ -> T.Nil
- with
- | T.Macro { T.value = sym; meta } ->- print_endline("\nFOUND A MACRO! " ^ Printer.print sym true);- print_endline(" tokens: " ^ String.concat " " list_reader.tokens);- let rec collect_args tokens args =
- match tokens with
- | t :: [] -> args @ [t]
- | t :: ts -> if t = eol then args else collect_args ts args @ [t]
- | _ -> []
- in
- let args = collect_args (List.tl list_reader.tokens) [] in
- print_endline(" ### " ^ String.concat " " args);- Macro.match_variant meta args
- | _ -> ());
+ if List.length list_reader.tokens > 1 && List.hd list_reader.tokens = "("+ then (
+ match
+ try Env.get registered_macros (Types.symbol (List.nth list_reader.tokens 1)) with
+ | _ -> T.Nil
+ with
+ | T.Macro { T.value = sym; meta } ->+ (* print_endline ("\nFOUND A MACRO! " ^ Printer.print sym true);+ * print_endline (" tokens: " ^ String.concat " " list_reader.tokens); *)+ let rec collect_args tokens args =
+ match tokens with
+ | [ t ] -> args @ [ t ]
+ | t :: ts -> if t = eol then args else collect_args ts args @ [ t ]
+ | _ -> []
+ in
+ let args = collect_args (List.tl list_reader.tokens) [] in
+ Macro.match_variant meta args
+ | _ -> ());
match list_reader.tokens with
| [] -> raise (Utils.Syntax_error ("unterminated '" ^ eol ^ "'"))| token :: tokens ->
@@ -132,17 +133,16 @@
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 variants = Macro.generate_variants sym literals clauses in
- print_endline (" variants: " ^ (Printer.print (Types.map variants) true));- let macro_entry = Types.macro sym literals (Types.list clauses) variants in
- Env.set registered_macros sym macro_entry;
- Types.M9map.iter (fun k v ->
- print_endline (" >>> " ^ String.concat " " (fix_pattern k (Printer.print v true)));- print_endline (" >> " ^ Printer.print k true ^ ": " ^ Printer.print v true))- variants;
- print_endline(" >>>>>> MACRO: " ^ Printer.print macro_entry true)- | _ -> raise (Utils.Syntax_error "read_macro botch"))
+ | [ T.List { T.value = T.Symbol { T.value = "syntax-rules" } :: literals :: clauses } ] ->+ let variants = Macro.generate_variants sym literals clauses in
+ let macro_entry = Types.macro sym literals (Types.list clauses) variants in
+ Env.set registered_macros sym macro_entry;
+ Types.M9map.iter
+ (fun k v ->
+ print_endline (" >>> " ^ String.concat " " (fix_pattern k (Printer.print v true)));+ print_endline (" >> " ^ Printer.print k true ^ ": " ^ Printer.print v true))+ variants
+ | _ -> raise (Utils.Syntax_error "read_macro botch"))
| _ as x -> print_endline (" rest: " ^ Printer.dump x)); { form = Types.list list_reader.list_form; tokens = list_reader.tokens }