ref: 925c0021a3447cc63a8ad07846e55e34fc277877
parent: cee3c78840d9cde8172fb8f167a75f20ecf6451c
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Tue Oct 13 05:25:09 EDT 2020
macro
--- a/eval.ml
+++ b/eval.ml
@@ -19,8 +19,8 @@
(* | T.Symbol s -> let foo = Env.get env ast in(\* (match Env.get env ast with *\)
* print_endline ("EVAL_AST: " ^ Printer.print foo true);* (match foo with
- * | T.Macro { T.value = sym; meta } -> raise (Reader.Syntax_error ("EVAL_AST MACRO: ast: " ^ Printer.print ast true))- * | T.List { T.value = xs; meta } -> raise (Reader.Syntax_error "EVAL_AST LIST")+ * | T.Macro { T.value = sym; meta } -> raise (Utils.Syntax_error ("EVAL_AST MACRO: ast: " ^ Printer.print ast true))+ * | T.List { T.value = xs; meta } -> raise (Utils.Syntax_error "EVAL_AST LIST") * | _ as x -> print_endline ("EVAL_AST UNKNOWN: " ^ Printer.print ast true ^ ":" ^ Printer.print x true); foo)*)
| T.List { T.value = xs; T.meta } ->@@ -28,17 +28,23 @@
try Env.get env (List.hd xs) with
| _ -> T.Nil
with
- | T.Macro { T.value = sym; meta } as om ->- print_endline (" EVAL_AST: the rest: " ^ Printer.dump (List.tl xs));- print_endline (" EVAL_AST: AST: " ^ Printer.print ast true);- let foo = Macro.expand ast env (List.tl xs) sym meta in
- print_endline (" expanded: " ^ Printer.print foo true);- T.List { T.value = [ om; foo ]; T.meta }- (* T.List { T.value = [foo]; T.meta } *)+ (* disabled for macro_read development *)
+
+ (* | T.Macro { T.value = sym; meta } as om ->+ * print_endline (" EVAL_AST: the rest: " ^ Printer.dump (List.tl xs));+ * print_endline (" EVAL_AST: AST: " ^ Printer.print ast true);+ * let foo = Macro.expand ast env (List.tl xs) sym meta in
+ * 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 *)
- (* raise (Reader.Syntax_error ("EVAL_AST MACRO: ast: " ^ Printer.print ast true)) *)+ (* 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 }@@ -94,7 +100,7 @@
Env.set sub_env name arg;
bind_args names args
| [], [] -> ()
- | _ -> raise (Reader.Syntax_error "wrong parameter count for lambda")
+ | _ -> raise (Utils.Syntax_error "wrong parameter count for lambda")
in
bind_args arg_names args;
eval expr sub_env)
@@ -130,6 +136,6 @@
* 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")))+ | _ as x -> raise (Utils.Syntax_error ("'" ^ Printer.print x true ^ "' not a function")))| _ -> eval_ast ast env
;;
--- a/macro.ml
+++ b/macro.ml
@@ -83,88 +83,88 @@
| _ -> "(" ^ Printer.dump pattern ^ ") " ^ Printer.print template true ^ ")";;
-let lambdaize pattern template args =
- match pattern, args with
- | ph :: pt, ah :: at :: rest ->
- let expr = "((lambda " ^ ellipsis pt template args ^ Printer.stringify args false ^ ")" in
- print_endline (" lambdaize list list: " ^ expr);- Reader.read expr
- | ph :: pt, ah :: at ->
- let expr =
- "((lambda ("- ^ Printer.stringify pt true
- ^ ")"
- ^ Printer.print template true
- ^ ")"
- ^ Printer.stringify args true
- ^ ")"
- in
- print_endline (" lambdaize short list: " ^ expr);- Reader.read expr
- | ph :: pt, [] ->
- let expr = "((lambda (" ^ Printer.stringify pt false ^ ") " ^ Printer.print template false ^ "))" in- print_endline (" lambdaize empty list: " ^ expr);- Reader.read expr
- | _ ->
- print_endline "lambdaize: empty";
- Reader.read ("((lambda () " ^ Printer.print template true ^ "))")-;;
+(* let lambdaize pattern template args =
+ * match pattern, args with
+ * | ph :: pt, ah :: at :: rest ->
+ * let expr = "((lambda " ^ ellipsis pt template args ^ Printer.stringify args false ^ ")" in
+ * print_endline (" lambdaize list list: " ^ expr);+ * Reader.read expr
+ * | ph :: pt, ah :: at ->
+ * let expr =
+ * "((lambda ("+ * ^ Printer.stringify pt true
+ * ^ ")"
+ * ^ Printer.print template true
+ * ^ ")"
+ * ^ Printer.stringify args true
+ * ^ ")"
+ * in
+ * print_endline (" lambdaize short list: " ^ expr);+ * Reader.read expr
+ * | ph :: pt, [] ->
+ * let expr = "((lambda (" ^ Printer.stringify pt false ^ ") " ^ Printer.print template false ^ "))" in+ * print_endline (" lambdaize empty list: " ^ expr);+ * Reader.read expr
+ * | _ ->
+ * 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);- 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 } ->- ((* let literals = Types.M9map.find Types.macro_literals m in *)
- try
- 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 (" 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";
- * print_endline (" - template: " ^ Printer.dump template); *)- print_endline
- (" matched (m)?: "- ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) (Core.seq ast) true
- then "yes"
- else "no")
- ^ " ::> "
- ^ Printer.dump pattern);
- 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"; *)
- print_endline
- (" matched (s)?: "- ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) (Core.seq ast) true
- then "yes"
- else "no")
- ^ " ::> "
- ^ Printer.dump pattern);
- 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
- | _ -> raise (Reader.Syntax_error "Unknown"))
- (* errors? *)
- | [] -> raise (Reader.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))- in
- match_transform (Core.seq transformers)
- with
- | Not_found -> raise (Reader.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))- | _ -> raise (Reader.Syntax_error "syntax error with defined macro")
-;;
+(* let rec expand ast env args sym meta =
+ * print_endline ("\n\nTHIS 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);+ * match meta with
+ * | T.Map { T.value = m } ->+ * ((\* let literals = Types.M9map.find Types.macro_literals m in *\)
+ * try
+ * 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 (" 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";
+ * * print_endline (" - template: " ^ Printer.dump template); *\)+ * print_endline
+ * (" matched (m)?: "+ * ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) (Core.seq ast) true
+ * then "yes"
+ * else "no")
+ * ^ " ::> "
+ * ^ Printer.dump pattern);
+ * 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"; *\)
+ * print_endline
+ * (" matched (s)?: "+ * ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) (Core.seq ast) true
+ * then "yes"
+ * else "no")
+ * ^ " ::> "
+ * ^ Printer.dump pattern);
+ * 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
+ * | _ -> raise (Utils.Syntax_error "Unknown"))
+ * (\* errors? *\)
+ * | [] -> raise (Utils.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))+ * in
+ * match_transform (Core.seq transformers)
+ * with
+ * | Not_found -> raise (Utils.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))+ * | _ -> raise (Utils.Syntax_error "syntax error with defined macro")
+ * ;; *)
(* let rec parse ast env args sym meta =
* print_endline("\n\nREADING MACRO: " ^ Printer.print sym true);@@ -184,13 +184,13 @@
* 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
- * | _ -> raise (Reader.Syntax_error "no transform match"))
- * | [] -> raise (Reader.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))+ * | _ -> raise (Utils.Syntax_error "no transform match"))
+ * | [] -> raise (Utils.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))* in
* match_transform (Core.seq transformers)
* with
- * | Not_found -> raise (Reader.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))- * | _ -> raise (Reader.Syntax_error "syntax error with defined macro") *)
+ * | Not_found -> raise (Utils.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))+ * | _ -> raise (Utils.Syntax_error "syntax error with defined macro") *)
let rec parse ast macros =
print_endline ("\n\nREADING MACRO: " ^ String.concat " " ast);@@ -199,6 +199,41 @@
| macro :: tokens -> print_endline (" macro: " ^ macro);;
+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)) *)+
+let register_macro macro sym literals patterns env =
+ let rec register_variants clauses =
+ match clauses with
+ | pattern :: [] ->
+ print_endline (" " ^ sym ^ ": pattern: " ^ pattern)+ | pattern :: rest ->
+ print_endline (" " ^ sym ^ ": rest: " ^ String.concat " " rest);+ 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
+ | _ -> ());
+ register_variants patterns
+;;
+
(* match meta with
* | T.Map { T.value = m } ->* (try
@@ -215,10 +250,10 @@
* 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
- * | _ -> raise (Reader.Syntax_error "no transform match"))
- * | [] -> raise (Reader.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))+ * | _ -> raise (Utils.Syntax_error "no transform match"))
+ * | [] -> raise (Utils.Syntax_error ("No matching transform for macro: '" ^ Printer.print sym true))* in
* match_transform (Core.seq transformers)
* with
- * | Not_found -> raise (Reader.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))- * | _ -> raise (Reader.Syntax_error "syntax error with defined macro") *)
+ * | Not_found -> raise (Utils.Syntax_error ("'" ^ Printer.print sym true ^ "' is not a known macro")))+ * | _ -> raise (Utils.Syntax_error "syntax error with defined macro") *)
--- a/mkfile
+++ b/mkfile
@@ -7,9 +7,9 @@
types.ml\
env.ml\
printer.ml\
+ macro.ml\
reader.ml\
core.ml\
- macro.ml\
eval.ml
$BIN:
--- a/reader.ml
+++ b/reader.ml
@@ -1,10 +1,8 @@
module T = Types.Types
-exception Syntax_error of string
-
let token_re = Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"?\\|;.*\\$\\|[^][ \n{}('\"`,;)]*"let string_re = Str.regexp "\"\\(\\\\.\\|[^\\\\\"]\\)*\""
-let macros = Env.make None
+let registered_macros = Env.make None
type reader =
{ form : Types.m9type@@ -69,7 +67,7 @@
let rec read_list eol list_reader =
match list_reader.tokens with
- | [] -> raise (Syntax_error ("unterminated '" ^ eol ^ "'"))+ | [] -> raise (Utils.Syntax_error ("unterminated '" ^ eol ^ "'"))| token :: tokens ->
if Str.string_match (Str.regexp eol) token 0
then { list_form = list_reader.list_form; tokens }@@ -100,9 +98,12 @@
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" } :: _ :: clauses } :: [] ->- print_endline (" clauses: " ^ Printer.dump clauses)- | _ as y -> print_endline ("xxxxxxxx: " ^ Printer.dump y))+ | 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
--- a/types.ml
+++ b/types.ml
@@ -47,6 +47,7 @@
let macro_literals = Types.String "literals"
let macro_transformers = Types.String "transformers"
+let macro_variants = Types.String "variants"
exception M9exn of Types.t
--- a/utils.ml
+++ b/utils.ml
@@ -1,3 +1,6 @@
+exception Syntax_error of string
+exception Runtime_error of string
+
(* copied verbatim - must needs grok *)
let gsub re f str =
String.concat