ref: 083121b7a0857569d6562aa563055c19c9e2cece
parent: ae95184e6aa4685bbd13ed4b58df2fcc3e1f625c
author: smazga <[email protected]>
date: Fri Aug 14 12:41:49 EDT 2020
working on macros
--- a/env.ml
+++ b/env.ml
@@ -12,7 +12,8 @@
let set env sym value =
match sym with
- | T.Symbol { T.value = key } -> (* print_endline ("Env.set: " ^ key); *) env.data := Data.add key value !(env.data)+ | T.Symbol { T.value = key } ->+ (* print_endline ("Env.set: " ^ key); *) env.data := Data.add key value !(env.data)| _ -> raise (Invalid_argument "set: not a symbol")
;;
--- a/m9.ml
+++ b/m9.ml
@@ -14,6 +14,8 @@
module T = Types.Types
let repl_env = Env.make (Some Core.base)
+let synext_literals = T.String "syntax literals"
+let synext_transformers = T.String "syntax transformers"
let rec quasiquote ast =
match ast with
@@ -42,25 +44,50 @@
| T.Proc { T.meta = T.Map { T.value = meta } } ->Types.M9map.mem Core.kw_macro meta
&& Types.to_bool (Types.M9map.find Core.kw_macro meta)
- | T.List { T.value = macro } -> (match macro with- | kw :: _ -> kw = Types.symbol "syntax-rules"
- | _ -> false)
+ | T.List { T.value = macro } ->+ (match macro with
+ | kw :: _ -> kw = Types.symbol "syntax-rules"
+ | _ -> false)
| _ -> false)
| _ -> false
;;
+
let eval_macro sym args macro env =
- let parsed = Str.global_replace (Str.regexp "(_") ("(" ^ Printer.print sym true) (Printer.dump macro) in- print_endline ("eval_macro: sym:" ^ Printer.print sym true ^ " args:" ^ Printer.dump args ^ " macro:" ^ Printer.dump macro);- print_endline (" parsed: " ^ parsed)-(* let sub_env = Env.make (Some env) in
- * match macro with
- * | _ :: literals :: cases ->
- * (match cases with
- * | hd :: tl ->
- * (\* TODO: handle literals *\)
- * )
- * | _ -> () *)
+ (match macro with
+ | _ :: literals :: groups ->
+ let sgroups = Str.global_replace
+ (Str.regexp "(_")
+ ("(" ^ Printer.print sym true)+ (Printer.dump groups) in
+ print_endline ("BLARGH: " ^ sgroups);+ print_endline ("TOKENIZED: " ^ String.concat " " (Reader.tokenize ("(" ^ sgroups ^ ")")));+ let list_reader = Reader.read_list ")" {list_form = []; tokens = (Reader.tokenize (sgroups ^ ")")) } in+ let slist = Types.list list_reader.list_form in
+ print_endline ("BLAAAARGH: " ^ Printer.print slist true)+ | _ -> ());
+ let smacro =
+ Str.global_replace
+ (Str.regexp "(_")
+ ("(" ^ Printer.print sym true)+ (Printer.dump macro)
+ in
+ print_endline
+ ("eval_macro: sym:"+ ^ Printer.print sym true
+ ^ " args:"
+ ^ Printer.dump args
+ ^ " straight macro: "
+ ^ Printer.dump macro
+ ^ " subbed macro:"
+ ^ smacro);
+ (* let sub_env = Env.make (Some env) in *)
+ match Reader.read smacro with
+ | T.List { T.value = transformer } ->+ print_endline (" TRANSFORMER: " ^ Printer.dump transformer)+ | _ -> ()
+;;
+
let rec macroexpand ast env =
if is_macro_call ast env
then (
@@ -67,17 +94,18 @@
print_endline (" YES!: " ^ Printer.print ast true);match ast with
| T.List { T.value = s :: args } ->- print_endline ("one: s: " ^ Printer.print s true ^ " args: " ^ Printer.dump args);+ print_endline ("macroexpand macro symbol: " ^ Printer.print s true ^ " args: " ^ Printer.dump args);(match
try Env.get env s with
| _ -> T.Nil
with
- | T.Proc { T.value = f } -> macroexpand (f args) env- | T.List { T.value = macro } -> eval_macro s args macro env; ast+ | T.Proc { T.value = f } -> macroexpand (f args) env+ | T.List { T.value = macro } ->+ eval_macro s args macro env;
+ ast
| _ -> ast)
| _ -> ast)
- else
- ast
+ else ast
;;
let rec eval_ast ast env =
@@ -121,33 +149,14 @@
; T.List { T.value = transformer }]
} ->
- print_endline ("define-syntax: " ^ Printer.print keyword true);- print_endline (" transformer: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) transformer));- let macro = T.List { T.value = transformer; meta = Core.link [ Core.kw_macro; T.Bool true ] } in- Env.set env keyword macro; macro
- (* print_endline ("define-syntax: " ^ Printer.print keyword true);- * print_endline
- * (" transformer: "- * ^ String.concat " " (List.map (fun xs -> Printer.print xs true) transformer));
- * (match transformer with
- * | T.Symbol { T.value = "syntax-rules" } :: literals :: rest ->- * print_endline (" literals (unsupported!): " ^ Printer.print literals true);- * print_endline (" -- rest: " ^ String.concat ":" (List.map (fun x -> Printer.print x true) rest));- * let proc = T.Proc { - * T.Nil *)
-
-
- (* print_endline (" literals: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) literals)); *)- (* print_endline (" body: " ^ String.concat " " (List.map (fun xs -> Printer.print xs true) body)); *)- (* (match eval transformer env with
- * | T.Proc { T.value = p; T.meta } ->- * let proc =
- * T.Proc { T.value = p; meta = Core.link [ meta; Core.kw_macro; T.Bool true ] }- * in
- * Env.set env keyword proc;
- * proc
- * | _ -> raise (Reader.Syntax_error "malformed syntax-rules")) *)
- (* | _ -> raise (Reader.Syntax_error "missing syntax-rules")) *)
+ print_endline ("define-syntax: " ^ Printer.print keyword true);+ print_endline
+ (" transformer: " ^ Printer.dump transformer);+ let macro =
+ Types.list transformer
+ in
+ Env.set env keyword macro;
+ macro
| T.List
{ T.value = [ T.Symbol { T.value = "lambda" }; T.Vector { T.value = arg_names }; expr ]--- a/notes.org
+++ b/notes.org
@@ -1,5 +1,7 @@
* First things:
-** PROGRESSING (let) doesn't work at all
+** TODO 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)?
s9fes seems to do it
** TODO need an "unspecified" type?
--- a/printer.ml
+++ b/printer.ml
@@ -17,7 +17,11 @@
| T.Bool false -> "#f"
| T.Char c -> "#\\" ^ Char.escaped c
| T.Nil -> "nil"
- | T.Map _ | T.Comment ->
+ | T.Map { T.value = xs } ->+ "{" ^ (Types.M9map.fold (fun k v s -> s ^ (if s = "" then "" else " ") ^ (print k r)+ ^ " " ^ (print v r)) xs "")
+ ^ "}"
+ | T.Comment ->
"" (* TODO: this leaves a space in the output for block comments *)
(* | T.Pair ({ T.value = one }, { T.value = two }) -> "(" ^ (print one readable) ^ " . " ^ (print two readable) ^ ")" *)| T.Proc p -> "#<proc>"
@@ -42,11 +46,10 @@
^ "\""
else s
| T.List { T.value = xs } ->- "(" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ ")"+ "~(" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ ")" | T.Vector { T.value = v } -> "#(" ^ String.concat " " (List.map (fun s -> print s r) v) ^ ")"| T.Record r -> "<record supported>"
;;
-let dump obj =
- String.concat " " (List.map (fun s -> print s true) obj)
+let dump obj = String.concat " " (List.map (fun s -> print s true) obj)