ref: 264e6b67b3caa3be6c4a23fca1a81adddc9d2bac
parent: 120a0cb0fd9df6a5da5d0ba480d6eb9b8b6d66a8
author: smazga <smazga@greymanlabs.com>
date: Tue Aug 18 12:29:01 EDT 2020
slowly getting to a place where macros can be handled
--- a/env.ml
+++ b/env.ml
@@ -13,7 +13,7 @@
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)+ (* 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
@@ -41,6 +41,9 @@
try Env.get env s with
| _ -> T.Nil
with
+ | T.Macro m ->
+ print_endline "is_macro_call: true";
+ true
| 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)
@@ -54,23 +57,30 @@
let eval_macro sym args macro env =
(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 rec handle_groups groups =
- (match groups with
- | hd :: tl -> print_endline (" HD: " ^ Printer.print hd true ^ " tl: " ^ Printer.dump tl); handle_groups tl- | _ -> print_endline "<list end>") in
- handle_groups groups;
- 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);- | _ -> ());
-
+ | _ :: 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 rec handle_groups groups =
+ match groups with
+ | hd :: tl ->
+ print_endline (" HD: " ^ Printer.print hd true ^ " tl: " ^ Printer.dump tl);+ handle_groups tl
+ | _ -> print_endline "<list end>"
+ in
+ handle_groups groups;
+ 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 "(_")
@@ -88,7 +98,7 @@
(* let sub_env = Env.make (Some env) in *)
match Reader.read smacro with
| T.List { T.value = transformer } ->- print_endline (" TRANSFORMER: " ^ Printer.dump transformer)+ print_endline (" TRANSFORMER: " ^ Printer.dump transformer)| _ -> ()
;;
@@ -98,11 +108,15 @@
print_endline (" YES!: " ^ Printer.print ast true);match ast with
| T.List { T.value = s :: 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.Macro { T.value = s; meta = m } ->+ print_endline (" THIS IS A MACRO: " ^ Printer.print s true);+ print_endline (" META: " ^ Printer.print m true);+ print_endline (" ARGS: " ^ Printer.dump args);+ ast
| T.Proc { T.value = f } -> macroexpand (f args) env | T.List { T.value = macro } ->eval_macro s args macro env;
@@ -119,6 +133,9 @@
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 }+ | T.Macro { T.value = m } ->+ print_endline ("wait, what? " ^ Printer.print m true);+ T.Nil
| _ -> ast
and eval ast env =
@@ -148,19 +165,20 @@
value
| T.List
{ T.value =- [ T.Symbol { T.value = "define-syntax" }- ; keyword
- ; T.List { T.value = transformer }- ]
+ [ T.Symbol { T.value = "define-syntax" }; keyword; T.List { T.value = macro } ]} ->
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
+ (match macro with
+ | _ :: literals :: groups ->
+ let macro_entry =
+ Types.macro (Printer.print keyword true) literals (Types.list groups)
+ in
+ print_endline (" macro_entry: " ^ Printer.print macro_entry true);+ print_endline (" literals: " ^ Printer.print literals true);+ print_endline (" groups: " ^ Printer.dump groups);+ Env.set env keyword macro_entry;
+ macro_entry
+ | _ -> T.Nil)
| T.List
{ T.value = [ T.Symbol { T.value = "lambda" }; T.Vector { T.value = arg_names }; expr ]--- a/printer.ml
+++ b/printer.ml
@@ -17,12 +17,15 @@
| T.Bool false -> "#f"
| T.Char c -> "#\\" ^ Char.escaped c
| T.Nil -> "nil"
+ | T.Macro { T.value = xs } -> "#<macro>" ^ print xs r | 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 *)
+ "{"+ ^ 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>"
| T.Symbol { T.value = s } -> s@@ -49,7 +52,7 @@
"(" ^ 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>"
+ | T.Record r -> "<record unsupported>"
;;
let dump obj = String.concat " " (List.map (fun s -> print s true) obj)
--- a/types.ml
+++ b/types.ml
@@ -15,6 +15,7 @@
(* | Pair of t with_meta * t list *)
| Proc of (t list -> t) with_meta
| Symbol of string with_meta
+ | Macro of t with_meta
| Bytevector of t list
| Eof_object
| Number of float with_meta
@@ -44,6 +45,9 @@
type m9type = Value.t
+let macro_literals = Types.String "literals"
+let macro_transformers = Types.String "transformers"
+
exception M9exn of Types.t
let to_bool x =
@@ -66,3 +70,11 @@
let vector x = Types.Vector { Types.value = x; meta = Types.Nil } let record x = Types.Record { Types.value = x; meta = Types.Nil } let number x = Types.Number { Types.value = x; meta = Types.Bool (is_float x) }+
+let macro sym literals transformers =
+ let meta = ref M9map.empty in
+ meta
+ := M9map.add macro_literals literals !meta
+ |> M9map.add macro_transformers transformers;
+ Types.Macro { Types.value = symbol sym; meta = map !meta }+;;