ref: db23aa72a4d43083867fc28c5ec1664a3442645b
parent: 1554de912987175430a808ad1d949f0567ca44bd
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Wed Sep 16 17:09:03 EDT 2020
macro update
--- a/core.ml
+++ b/core.ml
@@ -1,7 +1,6 @@
module T = Types.Types
let base = Env.make None
-let kw_macro = T.String "macro"
let number_compare t f =
Types.proc (function
@@ -55,17 +54,17 @@
Env.set env (Types.symbol "<=") (simple_compare mk_bool ( <= ));
Env.set env (Types.symbol ">") (simple_compare mk_bool ( > ));
Env.set env (Types.symbol ">=") (simple_compare mk_bool ( >= ));
- Env.set
- env
- (Types.symbol "proc?")
- (Types.proc (function
- | [ T.Proc { T.meta = T.Map { T.value = meta } } ] ->- mk_bool
- (not
- (Types.M9map.mem kw_macro meta
- && Types.to_bool (Types.M9map.find kw_macro meta)))
- | [ T.Proc _ ] -> T.Bool true
- | _ -> T.Bool false));
+ (* Env.set
+ * env
+ * (Types.symbol "proc?")
+ * (Types.proc (function
+ * | [ T.Proc { T.meta = T.Map { T.value = meta } } ] ->+ * mk_bool
+ * (not
+ * (Types.M9map.mem kw_macro meta
+ * && Types.to_bool (Types.M9map.find kw_macro meta)))
+ * | [ T.Proc _ ] -> T.Bool true
+ * | _ -> T.Bool false)); *)
Env.set
env
(Types.symbol "number?")
--- a/eval.ml
+++ b/eval.ml
@@ -40,6 +40,7 @@
* eval foo env
* | _ -> ast)
* | _ -> ast *)
+
and eval ast env =
(* match preparse ast env with *)
match ast with
@@ -130,10 +131,10 @@
(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 = sym; meta } :: args } ->- eval (Macro.expand ast env args sym meta) env
- (* let foo = Macro.expand ast env args sym meta in
- * print_endline (":::: " ^ Printer.print foo true);- * eval foo env *)
+ (* eval (Macro.expand ast env args sym meta) env *)
+ 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")))| _ -> eval_ast ast env
--- a/macro.ml
+++ b/macro.ml
@@ -18,14 +18,16 @@
(* print_endline " LIST <-> LIST"; *)
if ph = "_" || (ph = Printer.print sym true && sym = ah)
then is_matching_pattern sym pt at matched && true
- else (
+ else
(* print_endline (" ------> " ^ ph ^ " vs " ^ Printer.print ah true); *)- is_matching_pattern sym pt at matched)
+ is_matching_pattern sym pt at matched
| ph :: pt, [] ->
- (* print_endline " LIST <-> []"; *)
+ (* print_endline " LIST <-> []";
+ * print_endline (" ph: " ^ ph);+ * print_endline (" pt: " ^ String.concat "|" pt); *)if ph = "_" || ph = Printer.print sym true
then is_matching_pattern sym pt [] matched && true
- else ph = "..."
+ else ph = "..." || List.hd pt = "..."
| [], ah :: at ->
(* print_endline " [] <-> LIST"; *)
false
@@ -33,46 +35,64 @@
;;
let rec ellipsis pattern template args =
- (* print_endline
- * ("pattern length: "- * ^ string_of_int (List.length pattern)
- * ^ " arg length: "
- * ^ string_of_int (List.length args)); *)
- let has_ellipsis = (try ignore (Str.search_forward (Str.regexp "...") (Printer.stringify pattern true) 0); true
- with Not_found -> false) in
+ let has_ellipsis =
+ try
+ ignore (Str.search_forward (Str.regexp "...") (Printer.stringify pattern true) 0);
+ true
+ with
+ | Not_found -> false
+ in
let ellipsis_substitutions = ref [] in
- let missing = List.length args - List.length pattern + (if has_ellipsis then 1 else 0) in
+ let missing = List.length args - List.length pattern + if has_ellipsis then 1 else 0 in
+ print_endline ("missing: " ^ string_of_int missing); (* print_endline (" NEED TO ADD " ^ string_of_int missing ^ " PLACEHOLDERS"); *)- if missing > 0
- then (
+ match missing with
+ | _ when (missing = 0 || missing > 0) ->
+ (* add arguments *)
+ print_endline ("ADD " ^ string_of_int missing ^ " arguments");for i = 1 to missing do
ellipsis_substitutions := !ellipsis_substitutions @ [ gen_sym "x" ]
- done);
- let pattern_str =
- Str.global_replace
- (Str.regexp "\\.\\.\\.")
- (String.concat " " !ellipsis_substitutions)
- (Printer.stringify pattern true)
- in
- let template_str =
- Str.global_replace
- (Str.regexp "\\.\\.\\.")
- (String.concat " " !ellipsis_substitutions)
- (Printer.print template true)
- in
- (* let args_str = Printer.stringify args true in *)
- (* print_endline ("ellipsis: template: " ^ template_str ^ " args: " ^ args_str); *)- "(" ^ pattern_str ^ ") " ^ template_str ^ ")"+ done;
+ let pattern_str =
+ Str.global_replace
+ (Str.regexp "\\.\\.\\.")
+ (String.concat " " !ellipsis_substitutions)
+ (Printer.stringify pattern true)
+ in
+ let template_str =
+ Str.global_replace
+ (Str.regexp "\\.\\.\\.")
+ (String.concat " " !ellipsis_substitutions)
+ (Printer.print template true)
+ in
+ (* let args_str = Printer.stringify args true in *)
+ (* print_endline ("ellipsis: template: " ^ template_str ^ " args: " ^ args_str); *)+ "(" ^ pattern_str ^ ") " ^ template_str ^ ")"+ | _ when missing < 0 ->
+ (* remove ellipsis and arg *)
+ print_endline "REMOVE arguments";
+ (* let rgx = Str.regexp "[a-zA-Z0-9]+ \\.\\.\\." in *)
+ let rgx = Str.regexp "[a-zA-Z0-9]+ \\.\\.\\." in
+ let pattern_str = Str.global_replace rgx "" (Printer.stringify pattern true) in
+ let template_str = Str.global_replace rgx "" (Printer.stringify pattern true) in
+ print_endline (" pattern: " ^ Printer.dump pattern);+ print_endline (" pattern_str: " ^ pattern_str);+ print_endline (" template: " ^ Printer.print template true);+ print_endline (" template_str: " ^ template_str);+ print_endline ("(" ^ pattern_str ^ ") " ^ template_str ^ ")");+ "(" ^ pattern_str ^ ") " ^ template_str ^ ")"+ | _ ->
+ "(" ^ Printer.dump pattern ^ ") " ^ Printer.print template true ^ ")";;
let lambdaize pattern template args =
match pattern, args with
| ph :: pt, ah :: at :: rest ->
- (* print_endline "lambdaize: list list"; *)
+ print_endline ("lambdaize: list list: args: " ^ Printer.stringify args true);Reader.read
("((lambda " ^ ellipsis pt template args ^ Printer.stringify args false ^ ")")| ph :: pt, ah :: at ->
- (* print_endline "lambdaize: list short"; *)
+ print_endline "lambdaize: list short";
Reader.read
("((lambda ("^ Printer.stringify pt true
@@ -82,7 +102,7 @@
^ Printer.stringify args true
^ ")")
| ph :: pt, [] ->
- (* print_endline "lambdaize: list empty"; *)
+ print_endline "lambdaize: list empty";
Reader.read
("((lambda ("^ Printer.stringify pt false
@@ -90,80 +110,85 @@
^ Printer.print template true
^ "))")
| _ ->
- (* print_endline "lambdaize: empty"; *)
+ 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); *)+ 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 } ->- (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); *)
- (* print_endline (" args: " ^ Printer.dump args); *)- 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?: "- * ^ (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?: "- * ^ (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
- | _ -> T.Nil)
- (* errors? *)
- | [] -> T.Nil
- in
- match_transform (Core.seq transformers)
- with
- | Not_found -> T.Nil)
- | _ -> T.Nil
+ ((* 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")
;;
--- a/notes.org
+++ b/notes.org
@@ -1,5 +1,5 @@
* First things:
-** TODO Remove kw_macro
+** DONE Remove kw_macro
We determine what's a macro based on "syntax-rules" (so we need to make sure that's always there)
** DONE (let) doesn't work at all
** Should (let) include an implicit (begin)?
@@ -9,7 +9,7 @@
** TODO implement (pair)
Pairs should be preserved, I think
Also, it should _only_ be pairs, nothing more.
-** TODO (define) needs to support function definitions
+** PROGRESSING (define) needs to support function definitions
Right now you need to use lambda
** DONE (cons) doesn't work
This appears to work, now, but not with a pair
@@ -37,3 +37,9 @@
...but what about ellipsis??
** Thoughts
Eval seems too late to handle it, so maybe try to do expansion at read?
+* Macros
+** and
+(define-syntax and (syntax-rules ()
+ ((and) #t)
+ ((and test) test) ((and test1 test2 ...)
+ (if test1 (and test2 ...) #f))))