ref: 8b4ebe50739d76ce9591716e394ca68194f22245
parent: dc596842d658ab664a025d4e98c89b50cac465c4
author: McKay Marston <mckay.marston@greymanlabs.com>
date: Wed Nov 25 15:25:35 EST 2020
about to make big changes
--- a/macro.ml
+++ b/macro.ml
@@ -1,3 +1,13 @@
+(* The ⟨pattern⟩ in a ⟨syntax rule⟩ is a list ⟨pattern⟩ whose first element is an identifier.
+ * A ⟨pattern⟩ is either an identifier, a constant, or one of the following
+ * (⟨pattern⟩ ...)
+ * ((_) #t) => ⟨pattern⟩: (_), ...: #t
+ * (⟨pattern⟩ ⟨pattern⟩ ... . ⟨pattern⟩)
+ * (⟨pattern⟩ ... ⟨pattern⟩ ⟨ellipsis⟩ ⟨pattern⟩ ...) (⟨pattern⟩ ... ⟨pattern⟩ ⟨ellipsis⟩ ⟨pattern⟩ ... . ⟨pattern⟩)
+ * #(⟨pattern⟩ ...) => same, only vector
+ * #(⟨pattern⟩ ... ⟨pattern⟩ ⟨ellipsis⟩ ⟨pattern⟩ ...)
+ *)
+
module T = Types.Types
let gen_sym root =
@@ -27,13 +37,13 @@
if ph = "_" || ph = Printer.print sym true
then is_matching_pattern sym pt [] matched && true
else ph = "..." || List.hd pt = "..."
- | [], ah :: at ->
+ | [], _ :: _ ->
(* print_endline " [] <-> LIST"; *)
false
| _, _ -> matched
;;
-let rec ellipsis pattern template args =
+let ellipsis pattern template args =
let has_ellipsis =
try
ignore (Str.search_forward (Str.regexp "...") (Printer.stringify pattern true) 0);
@@ -43,6 +53,7 @@
in
let ellipsis_substitutions = ref [] in
let missing = List.length args - List.length pattern + if has_ellipsis then 1 else 0 in
+ print_endline ("args: " ^ String.concat " " (List.map (fun x -> Printer.print x true) args)); print_endline ("missing: " ^ string_of_int missing); (* print_endline (" NEED TO ADD " ^ string_of_int missing ^ " PLACEHOLDERS"); *)match missing with
@@ -49,7 +60,7 @@
| _ when missing = 0 || missing > 0 ->
(* add arguments *)
print_endline ("ADD " ^ string_of_int missing ^ " arguments");- for i = 1 to missing do
+ for _ = 1 to missing do
ellipsis_substitutions := !ellipsis_substitutions @ [ Printer.print (gen_sym "x") true ]
done;
let pattern_str =
@@ -62,35 +73,102 @@
Str.global_replace
(Str.regexp "\\.\\.\\.")
(String.concat " " !ellipsis_substitutions)
- (Printer.print template true)
+ (Printer.stringify 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 ^ ")");+ (* | _ 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.dump template);+ * print_endline (" template_str: " ^ template_str);+ * print_endline ("(" ^ pattern_str ^ ") " ^ template_str ^ ")");+ * "(" ^ pattern_str ^ ") " ^ template_str ^ ")" *)+ | _ -> "(" ^ Printer.dump pattern ^ ") " ^ Printer.dump template ^ ")"+;;
+
+let sanitize_macro pattern template =
+ try
+ ignore (Str.search_forward (Str.regexp "...") (Printer.stringify pattern true) 0);
+ let substitution = Printer.print (gen_sym "x") true in
+ let pattern_str =
+ Str.global_replace
+ (Str.regexp "\\.\\.\\.")
+ substitution
+ (Printer.stringify pattern true)
+ in
+ let template_str =
+ Str.global_replace
+ (Str.regexp "\\.\\.\\.")
+ substitution
+ (Printer.stringify template true)
+ in
+ (* let args_str = Printer.stringify args true in *)
+ (* print_endline ("ellipsis: template: " ^ template_str ^ " args: " ^ args_str); *) "(" ^ pattern_str ^ ") " ^ template_str ^ ")"- | _ -> "(" ^ Printer.dump pattern ^ ") " ^ Printer.print template true ^ ")"+ with
+ | Not_found -> "(" ^ Printer.dump pattern ^ ") " ^ Printer.dump template ^ ")";;
-let rec parse ast macros =
+let parse ast _ =
print_endline ("\n\nREADING MACRO: " ^ String.concat " " ast);match ast with
| [] -> raise End_of_file
- | macro :: tokens -> print_endline (" macro: " ^ macro)+ | macro :: _ -> print_endline (" macro: " ^ macro);;
-let generate_variants sym literals patterns =
+let hack_ellipsis prefix clause =
+ let clauses = ref [] in
+ (match clause with
+ (* ((_ test1 test2 ...) (if test1 (_ test2 ...) #f)) *)
+ (* | T.List { T.value = [ T.List { T.value = pattern; meta = _ }; T.List {T.value = [ transform ]; meta = _ } ]; meta = _ } -> *)+ | T.List { T.value = [ T.List { T.value = pattern; meta = _ }; T.List { T.value = transform; meta = _ } ]; meta = _ }+ ->
+ let args = ref [] in
+ for _ = 1 to 5 do
+ args := !args @ [ gen_sym prefix ];
+ print_endline ("HAXXOR: " ^ prefix ^ ":: " ^ Printer.dump pattern ^ " :: " ^ Printer.dump transform);+ clauses := !clauses @ [ sanitize_macro pattern transform !args ]
+ done
+ (* needs to match ((_) #t) : LIST(LIST() ATOM) *)
+ | T.List { T.value = [ T.List { T.value = pattern; meta = _ }; atom ]; meta = _ } ->+ print_endline ("FOUND CLAUSE WITH ATOM: " ^ Printer.print atom true ^ " pattern: " ^ Printer.dump pattern)+ | _ as x -> print_endline ("nope: " ^ Printer.print x true));+ !clauses
+;;
+
+(* print_endline (" head: " ^ Printer.print (List.hd clause) true);+ * print_endline (" tail: " ^ Printer.dump (List.tl clause)); *)+(* print_endline ("H4CK3LL!P5!5: " ^ Printer.print (gen_sym prefix) true ^ ": " ^ Printer.dump clause); *)+(* print_endline ("H4CK3LL!P5!5: " ^ Printer.print (gen_sym prefix) true ^ ": " ^ Printer.print clause true); *)+(* clause *)
+
+(* this is a dirty hack *)
+let generate_patterns sym clauses =
+ let prefix = Printer.print sym true in
+ let sanitized = ref [] in
+ let rec sanitize_clauses unsanitized =
+ match unsanitized with
+ | [ clause ] ->
+ print_endline ("CLAUSE: " ^ Printer.print clause true);+ sanitized := !sanitized @ [ hack_ellipsis prefix clause ];
+ !sanitized
+ | clause :: rest ->
+ sanitized := !sanitized @ [ hack_ellipsis prefix clause ];
+ sanitize_clauses rest
+ | [] -> !sanitized
+ in
+ sanitize_clauses clauses
+;;
+
+let generate_variants sym _ patterns =
let symbol = Printer.print sym true in
let variants = ref Types.M9map.empty in
let rec register_variants clauses =
@@ -110,14 +188,14 @@
let match_variant macro args =
let vmatch = ref "" in
(match macro with
- | T.Map { T.value = meta } ->+ | T.Map { T.value = meta; meta = _ } ->(match Types.M9map.find Types.macro_variants meta with
- | T.Map { T.value = variant_list } ->+ | T.Map { T.value = variant_list; meta = _ } ->Types.M9map.iter
(fun k v ->
print_endline (Printer.print k true ^ ": " ^ Printer.print v true);
match v with
- | T.List { T.value = T.List { T.value = x } :: z } ->+ | T.List { T.value = T.List { T.value = x; meta = _ } :: z; meta = _ } ->print_endline
(" >>>> ["^ string_of_int (List.length args)
--- a/reader.ml
+++ b/reader.ml
@@ -18,11 +18,11 @@
List.map
(function
| Str.Delim x -> String.trim x (* move trim to regex for speed? *)
- | Str.Text x -> "tokenize botch")
+ | Str.Text _ -> "tokenize botch")
(List.filter
(function
- | Str.Delim x -> true
- | Str.Text x -> false)
+ | Str.Delim _ -> true
+ | Str.Text _ -> false)
(Str.full_split token_re str))
;;
@@ -87,7 +87,7 @@
try Env.get registered_macros (Types.symbol (List.nth list_reader.tokens 1)) with
| _ -> T.Nil
with
- | T.List { T.value = xs; T.meta } ->+ | T.List { T.value = _; T.meta } ->print_endline "XXXX MACRO FOUND";
let rec collect_args tokens args =
match tokens with
@@ -103,7 +103,7 @@
| [] ->
print_endline ("ERROR: " ^ Printer.dump list_reader.list_form); raise (Utils.Syntax_error ("unterminated '" ^ eol ^ "'"))- | [ token ] -> { list_form = list_reader.list_form; tokens = [ ")" ] }+ | [ _ ] -> { 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 }@@ -134,8 +134,10 @@
print_endline (" sym: " ^ Printer.print sym true); print_endline (" rest: " ^ Printer.dump rest);(match rest with
- | [ T.List { T.value = T.Symbol { T.value = "syntax-rules" } :: literals :: clauses } ] ->- let variants = Macro.generate_variants sym literals clauses in
+ | [ T.List { T.value = T.Symbol { T.value = "syntax-rules"; meta = _ } :: literals :: clauses; meta = _ } ] ->+ let sanitized_clauses = Macro.generate_patterns sym clauses in
+ print_endline ("sanitized: " ^ String.concat " " (List.map (fun x -> String.concat " " x) sanitized_clauses));+ let variants = Macro.generate_variants sym literals sanitized_clauses in
let macro_entry = Types.macro sym literals (Types.list clauses) variants in
Env.set registered_macros sym macro_entry;
Types.M9map.iter