tools/mgen/test.ml

   1 open Match
   2 open Fuzz
   3 open Cgen
   4
   5 (* unit tests *)
   6
   7 let test_pattern_match =
   8   let pm = pattern_match
   9   and nm = fun x y -> not (pattern_match x y) in
  10   begin
  11     assert (nm (Atm Tmp) (Atm (Con 42L)));
  12     assert (pm (Atm AnyCon) (Atm (Con 42L)));
  13     assert (nm (Atm (Con 42L)) (Atm AnyCon));
  14     assert (nm (Atm (Con 42L)) (Atm Tmp));
  15   end
  16
  17 let test_peel =
  18   let o = Kw, Oadd in
  19   let p = Bnr (o, Bnr (o, Atm Tmp, Atm Tmp),
  20                   Atm (Con 42L)) in
  21   let l = peel p () in
  22   let () = assert (List.length l = 3) in
  23   let atomic_p (p, _) =
  24     match p with Atm _ -> true | _ -> false in
  25   let () = assert (List.for_all atomic_p l) in
  26   let l = List.map (fun (p, c) -> fold_cursor c p) l in
  27   let () = assert (List.for_all ((=) p) l) in
  28   ()
  29
  30 let test_fold_pairs =
  31   let l = [1; 2; 3; 4; 5] in
  32   let p = fold_pairs l l [] (fun a b -> a :: b) in
  33   let () = assert (List.length p = 25) in
  34   let p = sort_uniq compare p in
  35   let () = assert (List.length p = 25) in
  36   ()
  37
  38 (* test pattern & state *)
  39
  40 let print_sm oc =
  41   StateMap.iter (fun k s' ->
  42     match k with
  43     | K (o, sl, sr) ->
  44         let top =
  45           List.fold_left (fun top c ->
  46             match c with
  47             | Top r -> top ^ " " ^ r
  48             | _ -> top) "" s'.point
  49         in
  50         Printf.fprintf oc
  51           "  (%s %d %d) -> %d%s\n"
  52           (show_op o)
  53           sl.id sr.id s'.id top)
  54
  55 let rules =
  56   let oa = Kl, Oadd in
  57   let om = Kl, Omul in
  58   let va = Var ("a", Tmp)
  59   and vb = Var ("b", Tmp)
  60   and vc = Var ("c", Tmp)
  61   and vs = Var ("s", Tmp) in
  62   let vars = ["a"; "b"; "c"; "s"] in
  63   let rule name pattern =
  64     List.map
  65       (fun pattern -> {name; vars; pattern})
  66       (ac_equiv pattern)
  67   in
  68   match `X64Addr with
  69   (* ------------------------------- *)
  70   | `X64Addr ->
  71     (* o + b *)
  72     rule "ob" (Bnr (oa, Atm Tmp, Atm AnyCon))
  73     @ (* b + s * m *)
  74     rule "bsm" (Bnr (oa, vb, Bnr (om, Var ("m", Con 2L), vs)))
  75     @
  76     rule "bsm" (Bnr (oa, vb, Bnr (om, Var ("m", Con 4L), vs)))
  77     @
  78     rule "bsm" (Bnr (oa, vb, Bnr (om, Var ("m", Con 8L), vs)))
  79     @  (* b + s *)
  80     rule "bs1" (Bnr (oa, vb, vs))
  81     @ (* o + s * m *)
  82     (* rule "osm" (Bnr (oa, Atm AnyCon, Bnr (om, Atm (Con 4L), Atm Tmp))) *) []
  83     @ (* o + b + s *)
  84     rule "obs1" (Bnr (oa, Bnr (oa, Var ("o", AnyCon), vb), vs))
  85     @ (* o + b + s * m *)
  86     rule "obsm" (Bnr (oa, Bnr (oa, Var ("o", AnyCon), vb),
  87                           Bnr (om, Var ("m", Con 2L), vs)))
  88     @
  89     rule "obsm" (Bnr (oa, Bnr (oa, Var ("o", AnyCon), vb),
  90                           Bnr (om, Var ("m", Con 4L), vs)))
  91     @
  92     rule "obsm" (Bnr (oa, Bnr (oa, Var ("o", AnyCon), vb),
  93                           Bnr (om, Var ("m", Con 8L), vs)))
  94   (* ------------------------------- *)
  95   | `Add3 ->
  96     [ { name = "add"
  97       ; vars = []
  98       ; pattern = Bnr (oa, va, Bnr (oa, vb, vc)) } ] @
  99     [ { name = "add"
 100       ; vars = []
 101       ; pattern = Bnr (oa, Bnr (oa, va, vb), vc) } ]
 102
 103 (*
 104
 105 let sa, am, sm = generate_table rules
 106 let () =
 107   Array.iteri (fun i s ->
 108       Format.printf "@[state %d: %s@]@."
 109         i (show_pattern s.seen))
 110     sa
 111 let () = print_sm stdout sm; flush stdout
 112
 113 let matcher = lr_matcher sm sa rules "obsm" (* XXX *)
 114 let () = Format.printf "@[<v>%a@]@." Action.pp matcher
 115 let () = Format.printf "@[matcher size: %d@]@." (Action.size matcher)
 116
 117 let numbr = make_numberer sa am sm
 118
 119 let () =
 120   let opts = { pfx = ""
 121              ; static = true
 122              ; oc = stdout } in
 123   emit_c opts numbr;
 124   emit_matchers opts
 125     [ ( ["b"; "o"; "s"; "m"]
 126       , "obsm"
 127       , matcher ) ]
 128
 129 (*
 130 let tp = fuzz_numberer rules numbr
 131 let () = test_matchers tp numbr rules
 132 *)
 133
 134 *)