1 files changed, 102 insertions, 0 deletions
diff --git a/tools/match_test.ml b/tools/match_test.ml
new file mode 100644
index 0000000..75e2005
--- /dev/null
+++ b/tools/match_test.ml
@@ -0,0 +1,102 @@
+#use "match.ml"
+
+let test_pattern_match =
+  let pm = pattern_match
+  and nm = fun x y -> not (pattern_match x y) in
+  begin
+    assert (nm (Atm Tmp) (Atm (Con 42L)));
+    assert (pm (Atm AnyCon) (Atm (Con 42L)));
+    assert (nm (Atm (Con 42L)) (Atm AnyCon));
+    assert (nm (Atm (Con 42L)) (Atm Tmp));
+  end
+
+let test_peel =
+  let o = Kw, Oadd in
+  let p = Bnr (o, Bnr (o, Atm Tmp, Atm Tmp),
+                  Atm (Con 42L)) in
+  let l = peel p () in
+  let () = assert (List.length l = 3) in
+  let atomic_p (p, _) =
+    match p with Atm _ -> true | _ -> false in
+  let () = assert (List.for_all atomic_p l) in
+  let l = List.map (fun (p, c) -> fold_cursor c p) l in
+  let () = assert (List.for_all ((=) p) l) in
+  ()
+
+let test_fold_pairs =
+  let l = [1; 2; 3; 4; 5] in
+  let p = fold_pairs l l [] (fun a b -> a :: b) in
+  let () = assert (List.length p = 25) in
+  let p = sort_uniq compare p in
+  let () = assert (List.length p = 25) in
+  ()
+
+(* test pattern & state *)
+let tp =
+  let o = Kw, Oadd in
+  Bnr (o, Bnr (o, Atm Tmp, Atm Tmp),
+                  Atm (Con 0L))
+let ts =
+  { id = 0
+  ; seen = Atm Tmp
+  ; point =
+    List.map snd
+      (List.filter (fun (p, _) -> p = Atm Tmp)
+        (peel tp ()))
+  }
+
+let print_sm =
+  let op_str (k, o) =
+    Printf.sprintf "%s%s"
+      (match o with
+       | Oadd -> "add"
+       | Osub -> "sub"
+       | Omul -> "mul")
+      (match k with
+       | Kw -> "w"
+       | Kl -> "l"
+       | Ks -> "s"
+       | Kd -> "d")
+  in
+  StateMap.iter (fun k s' ->
+    match k with
+    | K (o, sl, sr) ->
+        Printf.printf
+          "(%s %d %d) -> %d\n"
+          (op_str o)
+          sl.id sr.id s'.id
+  )
+
+let address_rules =
+  let oa = Kl, Oadd in
+  let om = Kl, Omul in
+  let rule name pattern = { name; pattern; } in
+  (* o + b *)
+  [ rule "ob1" (Bnr (oa, Atm Tmp, Atm AnyCon))
+  ; rule "ob2" (Bnr (oa, Atm AnyCon, Atm Tmp))
+
+  (* b + s * i *)
+  ; rule "bs1" (Bnr (oa, Atm Tmp, Bnr (om, Atm AnyCon, Atm Tmp)))
+  ; rule "bs2" (Bnr (oa, Atm Tmp, Bnr (om, Atm Tmp, Atm AnyCon)))
+  ; rule "bs3" (Bnr (oa, Bnr (om, Atm AnyCon, Atm Tmp), Atm Tmp))
+  ; rule "bs4" (Bnr (oa, Bnr (om, Atm Tmp, Atm AnyCon), Atm Tmp))
+
+  (* o + s * i *)
+  ; rule "os1" (Bnr (oa, Atm AnyCon, Bnr (om, Atm AnyCon, Atm Tmp)))
+  ; rule "os2" (Bnr (oa, Atm AnyCon, Bnr (om, Atm Tmp, Atm AnyCon)))
+  ; rule "os3" (Bnr (oa, Bnr (om, Atm AnyCon, Atm Tmp), Atm AnyCon))
+  ; rule "os4" (Bnr (oa, Bnr (om, Atm Tmp, Atm AnyCon), Atm AnyCon))
+  ]
+
+(*
+let sl, sm = generate_table address_rules
+let s n = List.find (fun {id; _} -> id = n) sl
+let () = print_sm sm
+*)
+
+let tp0 =
+  let o = Kw, Oadd in
+  Bnr (o, Atm Tmp, Atm (Con 0L))
+let tp1 =
+  let o = Kw, Oadd in
+  Bnr (o, tp0, Atm (Con 1L))