ref: b2beb0311ec840da0eafa95888d816af0353436e
parent: 24cf0e8cd6799c80652dd2f7ecf41e0209dfe159
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Thu Dec 3 16:08:18 EST 2020
macros are _almost_ there
--- a/env.ml
+++ b/env.ml
@@ -10,7 +10,7 @@
let set env sym value =
match sym with
| T.Symbol {T.value= key; T.meta= _} ->- 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")
let rec find env sym =
@@ -26,6 +26,11 @@
| Some found_env -> Data.find key !(found_env.data)
| None -> raise (Runtime_error ("unknown symbol '" ^ key ^ "'")) )| _ -> raise (Invalid_argument "get: not a symbol")
+
+let dump env =
+ let str = ref "" in
+ Data.iter (fun k v -> str := !str ^ k ^ ": " ^ Printer.to_string v) !(env.data) ;
+ !str
(* let string_of_env env =
* let string = ref "" in
--- a/m9.ml
+++ b/m9.ml
@@ -13,7 +13,7 @@
module T = Types.Types
let repl_env = Env.make (Some Core.base)
-let nameplate = "Martian9 Scheme v0.2"
+let nameplate = "Martian9 Scheme v0.3"
let read str = Reader.read str
let print exp = Printer.print exp true
let rep str env = print (Eval.eval (read str) env)
--- a/macro.ml
+++ b/macro.ml
@@ -158,14 +158,13 @@
register_variants clauses
let rec collect_args tokens args =
- match tokens with
- | [t] -> args @ [t]
- | t :: ts -> if t = ")" then args else collect_args ts args @ [t]
- | _ -> []
+ match tokens with [t] -> args @ [t] | t :: ts -> if t = ")" then args else collect_args ts args @ [t] | _ -> []
-let match_variant macro args =
+let match_variant original_sym macro args =
+ let args = if List.hd args = original_sym then List.tl args else args in
let vmatch = ref "" in
- print_endline ("match_variant: " ^ Printer.to_string macro);+ (* print_endline (" >>>> match_variant: " ^ Printer.to_string macro) ; *)+ print_endline (" >>>> match_variant with args: " ^ String.concat " " args);( match macro with
| T.Map {T.value= meta; meta= _} -> (match Types.M9map.find Types.macro_variants meta with
@@ -172,22 +171,28 @@
| T.Map {T.value= variant_list; meta= _} ->Types.M9map.iter
(fun k v ->
- print_endline (" >>> " ^ Printer.to_string k ^ ": " ^ Printer.to_string v) ;+ print_endline (" >>> " ^ Printer.to_string k ^ ": " ^ Printer.to_string v) ;let wrong = Utils.tokenize (Printer.to_string v) in
- print_endline ("->->-> " ^ String.concat "*" wrong);- (match wrong with
- | "(" :: "define" :: sym :: "(":: "lambda" :: rest ->- print_endline ("SYM: " ^ sym ^ " REST: " ^ String.concat " " rest);+ ( match wrong with
+ | "(" :: "define" :: sym :: "(" :: "lambda" :: rest ->+ print_endline (" SYM: " ^ sym ^ " REST: " ^ String.concat " " rest) ;let new_args = collect_args (List.tl rest) [] in
- print_endline (" ARGS: " ^ String.concat " " new_args ^ " [" ^ string_of_int (List.length new_args) ^ "] args:[" ^ string_of_int (List.length args - 1) ^ "]");- if List.length new_args = List.length args - 1 then vmatch := sym
- | _ -> print_endline "no rest");
- (* match v with
- * | T.List { T.value = [T.Symbol { T.value = "define"; meta = _ }; T.Symbol { T.value = sym; meta = _ } ]; meta = _ } -> *)- print_endline ( " >>>> sym: " ^ Printer.to_string k);
- print_endline ( " >>>> args: " ^ String.concat " " args);
- print_endline ( " >>>> v: " ^ Printer.to_string v))
- (* | _ -> () ) *)
+ print_endline
+ ( " ARGS: " ^ String.concat " " new_args ^ " ["
+ ^ string_of_int (List.length new_args)
+ ^ "] args: " ^ String.concat " " args ^ " ["
+ ^ string_of_int (List.length args)
+ ^ "]" ) ;
+ (match (List.length new_args, List.length args) with
+ | 0, 0
+ | 1, 1 -> vmatch := sym
+ | x, y when x = y -> vmatch := sym
+ | _, _ -> ())
+ (* if List.length new_args = List.length args - 1 then vmatch := sym *)
+ | _ -> print_endline "no rest" ) ;
+ print_endline (" >>>> sym: " ^ Printer.to_string k) ;+ print_endline (" >>>> args: " ^ String.concat " " args) ;+ print_endline (" >>>> v: " ^ Printer.to_string v) )variant_list
| _ -> () )
| _ -> () ) ;
--- a/reader.ml
+++ b/reader.ml
@@ -27,13 +27,14 @@
| _ -> String.concat " " !block
and fix_clause original sym clause =
- print_endline (">>>>> fix_clause: incoming: " ^ Printer.print clause true) ;+ print_endline (">>>>> fix_clause: incoming: " ^ Printer.to_string clause) ;match clause with
| T.List {T.value= [T.List {T.value= pattern; meta= _}; T.List {T.value= transform; meta= _}]; meta= _} ->let pattern = Utils.tokenize (Printer.dump pattern) in
let fixed_pattern = replace_token (List.tl pattern) (Printer.to_string sym) (ref []) in
- let fixed_transform = replace_token (Utils.tokenize (Printer.dump transform)) (Printer.to_string original) (ref []) in
- [ "("; "define"; Printer.print sym true; "("; "lambda"; "("; fixed_pattern; ")"; "("; fixed_transform; ")"; ")"; ")" ]+ let fixed_transform =
+ replace_token (Utils.tokenize (Printer.dump transform)) (Printer.to_string original) (ref []) in
+ ["("; "define"; Printer.to_string sym; "("; "lambda"; "("; fixed_pattern; ")"; "("; fixed_transform; ")"; ")"; ")"] | T.List {T.value= [T.List {T.value= pattern; meta= _}; atom]; meta= _} ->let pattern = Utils.tokenize (Printer.dump pattern) in
let fixed_pattern = replace_token (List.tl pattern) (Printer.to_string sym) (ref []) in
@@ -63,32 +64,32 @@
(* we need to replace macro calls with their variant symbols *)
let tweaked_tokens =
if List.length list_reader.tokens > 1 && List.hd list_reader.tokens = "(" then- let symbol = Types.symbol (List.nth list_reader.tokens 1) in
+ let symbol_str = List.nth list_reader.tokens 1 in
+ let symbol = Types.symbol symbol_str in
match try Env.get registered_macros symbol with _ -> T.Nil with
| T.Macro {T.value= m; meta} ->- print_endline "XXXX MACRO FOUND" ;
+ (* print_endline "XXXX MACRO FOUND" ; *)
print_endline ("XXXX MACRO: " ^ Printer.to_string m) ;- print_endline ("XXXX META: " ^ Printer.to_string meta);- print_endline ("XXXX TOKENS: " ^ String.concat " " list_reader.tokens);+ (* print_endline ("XXXX META: " ^ Printer.to_string meta); *)+ (* print_endline ("XXXX TOKENS: " ^ String.concat " " list_reader.tokens) ; *)let args = Macro.collect_args (List.tl list_reader.tokens) [] in
- print_endline ("<><><> args: " ^ String.concat " " args) ;- let variant = Macro.match_variant meta args in
+ (* print_endline ("<><><> args: " ^ String.concat " " args) ; *)+ let variant = Macro.match_variant symbol_str meta args in
print_endline ("<><><><>: " ^ variant) ;- List.map (fun s -> if s = Printer.to_string symbol then variant else s) list_reader.tokens
+ (* List.map (fun s -> if s = Printer.to_string symbol then variant else s) (trim_end list_reader.tokens) *)
+ List.map (fun s -> if s = symbol_str then variant else s) (trim_end list_reader.tokens)
| _ -> list_reader.tokens
else list_reader.tokens in
- (* print_endline ("TWEAKED_TOKENS: [" ^ String.concat " " tweaked_tokens ^ "]"); *)+ (* print_endline ("TWEAKED_TOKENS: [" ^ String.concat " " tweaked_tokens ^ "]") ; *)match tweaked_tokens with
- | [] ->
- raise (Utils.Syntax_error ("read_list botch: '" ^ Printer.dump list_reader.list_form ^ "' eol: '" ^ eol ^ "'"))+ | [] -> raise (Utils.Syntax_error ("read_list botch: '" ^ Printer.dump list_reader.list_form ^ "' eol: '" ^ eol ^ "'")) | [_] -> {list_form= list_reader.list_form; tokens= [")"]}| token :: tokens ->
- if Str.string_match (Str.regexp eol) token 0
- then {list_form= list_reader.list_form; tokens}- else
- let reader = read_form tweaked_tokens in
- print_endline ("token: " ^ token ^ " tokens: " ^ String.concat " " tokens);- read_list eol {list_form= list_reader.list_form @ [reader.form]; tokens= reader.tokens}+ if Str.string_match (Str.regexp eol) token 0 then {list_form= list_reader.list_form; tokens}+ else
+ let reader = read_form tweaked_tokens in
+ (* print_endline ("token: " ^ token ^ " tokens: " ^ String.concat " " tokens); *)+ read_list eol {list_form= list_reader.list_form @ [reader.form]; tokens= reader.tokens}and read_quote sym tokens =
let reader = read_form tokens in
@@ -119,39 +120,32 @@
let variants = Macro.generate_variants sym literals sanitized_clauses in
let fixed_variants = ref Types.M9map.empty in
let transforms = ref Types.M9map.empty in
- Types.M9map.iter
- (fun k v -> transforms := Types.M9map.add k (Utils.tokenize v) !transforms)
- variants ;
-
+ Types.M9map.iter (fun k v -> transforms := Types.M9map.add k (Utils.tokenize v) !transforms) variants ;
let fixed_clauses = ref [] in
Types.M9map.iter
(fun k v ->
let fixed_clause = fix_clause sym k (read_form (Utils.tokenize v)).form in
+ (* TODO: is this even used? *)
print_endline
(">>>> registering variant: " ^ Printer.print k true ^ ": " ^ String.concat " " fixed_clause) ;- macro := !macro @ fixed_clause;
+ macro := !macro @ fixed_clause ;
let parsed = (read_form fixed_clause).form in
- fixed_clauses := !fixed_clauses @ [ parsed ];
- fixed_variants := Types.M9map.add k parsed !fixed_variants;
- Env.set registered_macros k parsed)
- variants;
- print_endline ("trying to parse macro: " ^ String.concat " " !macro);- let macro_entry =
- Types.macro sym literals
- T.Nil
- !fixed_variants in
- Env.set registered_macros sym macro_entry;
- print_endline ("finished")+ fixed_clauses := !fixed_clauses @ [parsed] ;
+ fixed_variants := Types.M9map.add k parsed !fixed_variants ;
+ Env.set registered_macros k parsed )
+ variants ;
+ print_endline ("trying to parse macro: " ^ String.concat " " !macro) ;+ let macro_entry = Types.macro sym literals T.Nil !fixed_variants in
+ Env.set registered_macros sym macro_entry ;
+ print_endline "finished"
| _ -> raise (Utils.Syntax_error "read_macro botch") )
| _ -> raise (Utils.Syntax_error "read_macro last rest botch") ) ;
print_endline ("SO HERE ARE THE MACRO VARIANTS: " ^ String.concat " " !macro) ;-
- (* the first and last () because the parser makes the whole thing a bogus list *)
let trimmed_macro = List.tl !macro in
let trimmed_tokens = trim_end list_reader.tokens in
print_endline ("TRIMMED_MACRO: " ^ String.concat " " trimmed_macro) ; print_endline ("TRIMMED_TOKENS: " ^ String.concat " " trimmed_tokens) ;- print_endline ("TRIMMED_MACRO: " ^ String.concat " " (trimmed_macro @ trimmed_tokens));+ print_endline ("TRIMMED_MACRO: " ^ String.concat " " (trimmed_macro @ trimmed_tokens)) ;trimmed_macro @ trimmed_tokens
and read_form all_tokens =
@@ -171,11 +165,7 @@
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
- (* | "define-syntax" -> read_form (read_macro tokens) *)
- | "define-syntax" ->
- let list_reader = read_list ")" {list_form= []; tokens= read_macro tokens} in- print_endline ("macro: " ^ Printer.dump list_reader.list_form) ;- {form= T.Unspecified; tokens= list_reader.tokens}+ | "define-syntax" -> read_form (read_macro tokens)
| _ ->
if token.[0] = ';' then (
let list_reader = read_list "\\n" {list_form= []; tokens} in@@ -195,5 +185,8 @@
let tokenized = Utils.tokenize str in
print_endline ("TOKENIZED: " ^ String.concat " " tokenized) ;let form = (read_form tokenized).form in
- print_endline ("FORM: " ^ Printer.to_string form) ;- form
+ let retoken = Utils.tokenize (Printer.to_string form) in
+ print_endline ("\nRETOKENIZED: " ^ String.concat " " retoken ^ "\n") ;+ let reform = (read_form retoken).form in
+ print_endline ("\nFORM: " ^ Printer.to_string form) ;+ reform
--- a/utils.ml
+++ b/utils.ml
@@ -11,4 +11,3 @@
List.map
(function Str.Delim x -> String.trim x (* move trim to regex for speed? *) | Str.Text _ -> "tokenize botch")
(List.filter (function Str.Delim _ -> true | Str.Text _ -> false) (Str.full_split token_re str))
-