ref: efd8060bae1542dd17556dcdc182b18b5bc35d36
parent: bfe18062adfcad6af73f1b5ab204763df12649a6
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Mon Oct 12 06:25:01 EDT 2020
extra macro work
--- a/eval.ml
+++ b/eval.ml
@@ -23,21 +23,23 @@
* | T.List { T.value = xs; meta } -> raise (Reader.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 } -> (match- 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 } *)- (* 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)) *)- | _ -> T.List { T.value = List.map (fun x -> eval x env) xs; T.meta })+ | T.List { T.value = xs; T.meta } ->+ (match
+ 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 } *)+ (* 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)) *)+ | _ -> 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 }| _ -> ast
@@ -119,8 +121,10 @@
| T.List { T.value = [ T.Symbol { T.value = "quasiquote" }; ast ] } -> eval (quasiquote ast) env| T.List _ ->
(match eval_ast ast env with
- | T.List { T.value = T.Proc { T.value = f } :: args } -> f args- | T.List { T.value = T.Macro { T.value = _ } :: macro :: _ } -> print_endline "MACRO EVALUATION"; eval macro env+ | T.List { T.value = T.Proc { T.value = f } :: args } -> f args+ | T.List { T.value = T.Macro { T.value = _ } :: macro :: _ } ->+ print_endline "MACRO EVALUATION";
+ eval macro env
(* | T.List { T.value = T.Macro { T.value = sym; meta } :: args } ->* (\* eval (Macro.expand ast env args sym meta) env *\)
* let foo = Macro.expand ast env args sym meta in
--- a/macro.ml
+++ b/macro.ml
@@ -165,3 +165,60 @@
| 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 parse ast env args sym meta =
+ * print_endline("\n\nREADING MACRO: " ^ Printer.print sym true);+ * match meta with
+ * | T.Map { T.value = m } ->+ * (try
+ * let transformers = Types.M9map.find Types.macro_transformers m in
+ * let rec match_transform transforms =
+ * match transforms with
+ * | hd :: tl ->
+ * (match hd with
+ * | T.List { T.value = [ T.List { T.value = pattern }; T.List {T.value = template } ] } ->+ * 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 ] } ->+ * 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))+ * 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 parse ast macros =
+ print_endline ("\n\nREADING MACRO: " ^ String.concat " " ast);+ match ast with
+ | [] -> raise End_of_file
+ | macro :: tokens -> print_endline (" macro: " ^ macro)+;;
+
+(* match meta with
+ * | T.Map { T.value = m } ->+ * (try
+ * let transformers = Types.M9map.find Types.macro_transformers m in
+ * let rec match_transform transforms =
+ * match transforms with
+ * | hd :: tl ->
+ * (match hd with
+ * | T.List { T.value = [ T.List { T.value = pattern }; T.List {T.value = template } ] } ->+ * 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 ] } ->+ * 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))+ * 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") *)
--- a/reader.ml
+++ b/reader.ml
@@ -4,6 +4,7 @@
let token_re = Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"?\\|;.*\\$\\|[^][ \n{}('\"`,;)]*"let string_re = Str.regexp "\"\\(\\\\.\\|[^\\\\\"]\\)*\""
+let macros = Env.make None
type reader =
{ form : Types.m9type@@ -90,6 +91,32 @@
{ form = Types.vector list_reader.list_form; tokens = list_reader.tokens }| _ -> read_form tokens)
+and read_macro tokens =
+ 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" }; foo ] } ->+ print_endline (" foo: " ^ foo)+ | _ -> print_endline ("xxxxxxxx"))+ | _ 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 ->
+ * let macro_entry = Types.macro (Printer.print keyword true) literals (Types.list groups) in
+ * Env.set env keyword macro_entry;
+ * macro_entry) *)
+ { form = Types.list list_reader.list_form; tokens = list_reader.tokens }+
+(* (match ast with
+ * | [] -> raise End_of_file
+ * | hd :: tl -> print_endline (" macro: " ^ String.concat " " tl));+ * raise (Syntax_error ("macro botch"))+ * | _ -> raise (Syntax_error "bad macro read") *)
and read_form all_tokens =
(* print_endline ("READ_FORM: " ^ String.concat " " all_tokens); *)match all_tokens with
@@ -100,18 +127,21 @@
| "`" -> read_quote "quasiquote" tokens
| "#" -> read_vector tokens
| "#|" ->
- let list_reader = read_list "|#" { list_form = []; tokens } in- print_endline ("block comment: " ^ Printer.dump list_reader.list_form);+ let list_reader = read_list "|#" { list_form = []; tokens } in+ print_endline ("block comment: " ^ Printer.dump list_reader.list_form); { form = T.Unspecified; tokens = list_reader.tokens } | "(" -> let list_reader = read_list ")" { list_form = []; tokens } in { form = Types.list list_reader.list_form; tokens = list_reader.tokens }| "" | "\t" | "\n" -> read_form tokens
- | _ -> if token.[0] = ';' then
- let list_reader = read_list "\\n" { list_form = []; tokens } in- print_endline ("line comment: " ^ (String.concat " " list_reader.tokens));- { form = T.Unspecified; tokens = list_reader.tokens }- else { form = read_atom token; tokens })+ | "define-syntax" -> read_macro tokens
+ | _ ->
+ if token.[0] = ';'
+ then (
+ let list_reader = read_list "\\n" { list_form = []; tokens } in+ print_endline ("line comment: " ^ String.concat " " list_reader.tokens);+ { form = T.Unspecified; tokens = list_reader.tokens })+ else { form = read_atom token; tokens });;
let slurp filename =