ref: 89403fb391d40dee3ee3ca6b59a70d07d04de1c2
parent: a3761f1b564b3a2574fc038a352f332190a78344
author: smazga <smazga@greymanlabs.com>
date: Fri Aug 21 16:02:54 EDT 2020
stuff
--- a/core.ml
+++ b/core.ml
@@ -104,8 +104,8 @@
env
(Types.symbol "display")
(Types.proc (function xs ->
- print_string (String.concat " " (List.map (fun s -> Printer.print s false) xs));
- T.Eof_object));
+ print_string (Printer.stringify xs false);
+ T.Unspecified));
Env.set
env
(Types.symbol "string")
--- a/m9.ml
+++ b/m9.ml
@@ -32,53 +32,82 @@
| ast -> Types.list [ Types.symbol "quote"; ast ]
;;
-let eval_macro sym args env meta =
+let rec eval_ast ast env =
+ match ast with
+ | T.Symbol s -> Env.get env ast
+ | 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
+
+and eval_macro sym args env meta =
+ let sub_env = Env.make (Some env) in
+ Env.set
+ sub_env
+ (Types.symbol "_")
+ (Types.proc (function
+ | [ ast ] -> eval ast sub_env
+ | _ -> T.Nil));
match meta with
| T.Map { T.value = m } ->- (try
+ (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
+ ("--EVAL_MACRO: literals: "+ ^ Printer.print literals true
+ ^ " transformers: "
+ ^ Printer.print transformers true);
let rec match_transform transforms =
- (match transforms with
- | hd :: tl -> print_endline ("__ hd: " ^ Printer.print hd true);- print_endline ("__ arg length: " ^ string_of_int (List.length args));- let foo = T.List hd in
- print_endline ("__ transform length: " ^ string_of_int (List.length foo));- match_transform tl
- | [] -> ())
+ match transforms with
+ | hd :: tl ->
+ print_endline ("__ hd: " ^ Printer.print hd true);+ print_endline ("__ arg length: " ^ string_of_int (List.length args));+ (match hd with
+ | T.List
+ { T.value = [ T.List { T.value = pattern }; T.List { T.value = body } ] }+ ->
+ print_endline (" _ pattern: " ^ Printer.dump pattern);+ print_endline
+ ("__ pattern length: "+ ^ string_of_int (List.length pattern)
+ ^ " body: "
+ ^ Printer.dump body)
+ | T.List { T.value = [ T.List { T.value = pattern }; atom ] } ->+ print_endline (" _ pattern: " ^ Printer.dump pattern);+ print_endline
+ ("__ atomic pattern length: "+ ^ string_of_int (List.length pattern)
+ ^ " atom: "
+ ^ Printer.print atom true)
+ | _ -> ());
+ let foo = Reader.read (Printer.print hd false) in
+ print_endline (" foo: " ^ Printer.print foo true);+ (* print_endline ("__ transform length: " ^ string_of_int (List.length foo)); *)+ match_transform tl
+ | [] -> ()
in
match_transform (Core.seq transformers)
- with Not_found -> ())
+ with
+ | Not_found -> ())
| _ -> ()
-;;
-let rec preparse ast env =
- match ast with
- | T.List { T.value = s :: 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);- eval_macro s args env m; ast
- | _ -> ast)
- | _ -> ast
-;;
-
-let rec eval_ast ast env =
+and preparse ast env =
match ast with
- | T.Symbol s -> Env.get env ast
- | 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 }- | T.Macro { T.value = m } ->- print_endline ("wait, what? " ^ Printer.print m true);- T.Nil
+ | T.List { T.value = s :: 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);+ print_endline (" AST: " ^ Printer.print ast true);+ eval_macro s args env m;
+ ast
+ | _ -> ast)
| _ -> ast
and eval ast env =
@@ -94,7 +123,7 @@
eval
(Reader.read
("(lambda ("- ^ String.concat " " (List.map (fun x -> Printer.print x false) rest)
+ ^ Printer.stringify rest false
^ ") "
^ Printer.print body true
^ ")"))
--- a/notes.org
+++ b/notes.org
@@ -14,8 +14,12 @@
** DONE (cons) doesn't work
This appears to work, now, but not with a pair
* Read
+** macro "transformers" should be "clauses"
+Which themselves consist of "pattern" -> "template"
** DONE "quote" and "quasiquote" symbols not supported
The shortcuts work, but not the keywords
+** TODO switch "define-syntax" to "let-syntax" format
+I think 'let-syntax' is the better building block
* Eval
* Things to watch for
--- a/printer.ml
+++ b/printer.ml
@@ -25,12 +25,12 @@
xs
""
^ "}"
- | T.Comment -> "" (* TODO: this leaves a space in the output for block comments *)
+ | T.Unspecified -> "#unspecified"
+ | T.Eof_object -> "#eof"
(* | T.Pair ({ T.value = one }, { T.value = two }) -> "(" ^ (print one readable) ^ " . " ^ (print two readable) ^ ")" *)| T.Proc p -> "#<proc>"
| T.Symbol { T.value = s } -> s| T.Bytevector bv -> "<bytevector unsupported>"
- | T.Eof_object -> "<eof>"
| T.Number n ->
if Types.is_float n.value
then string_of_float n.value
@@ -49,10 +49,16 @@
^ "\""
else s
| T.List { T.value = xs } ->- "(|" ^ String.concat " " (List.map (fun s -> print s r) xs) ^ "|)"
+ "(" ^ stringify xs r ^ ")" | T.Vector { T.value = v } ->- "#(" ^ String.concat " " (List.map (fun s -> print s r) v) ^ ")"+ "#(" ^ stringify v r ^ ")"| T.Record r -> "<record unsupported>"
+
+and stringify obj human =
+ String.concat " " (List.filter (function
+ | T.Unspecified
+ | T.Eof_object -> human
+ | _ -> true) obj |> List.map (fun s-> print s human))
;;
let dump obj = String.concat " " (List.map (fun s -> print s true) obj)
--- a/reader.ml
+++ b/reader.ml
@@ -116,7 +116,7 @@
| "#" -> read_vector tokens
| "#|" ->
let list_reader = read_list "|#" { list_form = []; tokens } in- { form = T.Comment; tokens = list_reader.tokens }+ { 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 }--- a/types.ml
+++ b/types.ml
@@ -11,13 +11,13 @@
| Bool of bool
| Char of char
| Nil
- | Comment
+ | Unspecified
+ | Eof_object
(* | 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
| Port of bool (* not sure how to represent this *)
| String of string