package TestMatchGen =
pkg
local
package map_raw_syntax = adl_rewrite_raw_syntax_parsetree
package mg
=
match_gen_g ( # See src/lib/compiler/back/low/tools/match-compiler/match-gen-g.pkg package rsu = raw_syntax_unparser # "rsu" == "raw_syntax_unparser"
package rsj = raw_syntax_junk # "rsj" == "raw_syntax_junk"
package map_raw_syntax = map_raw_syntax
)
package mc = mg::MC
use raw_syntax_unparser raw_syntax_junk raw_syntax_unparser::raw_syntax
fun newSumtype (id, cbs) = SUMTYPE (id,[], cbs)
fun type id = IDTY (IDENT([], id))
footy = type "foo"
defs =
[newSumtype("foo",[CONS("A", THE (TUPLETY[footy, footy])),
CONS("B", NULL),
CONS("C", NULL),
CONS("D", THE (RECORDTY[("x", footy), ("y", footy)]))
]
)
]
info = mg::compileTypes defs
fun test root rules =
let clauses = map (\\ (p, g, x) => CLAUSE([p], g, INT_CONSTANT_IN_EXPRESSION (x))) rules
print (pp::lit (raw_syntax_unparser::expression (CASE_EXPRESSION (root, clauses)))$"\n")
dfa = mg::compile info clauses
# print (mc::to_string dfa)
fun fail () = RAISE_EXPRESSION (ID "MATCH")
code = mg::coder { root=root, dfa=dfa, fail=fail }
in print (pp::lit (raw_syntax_unparser::expression code)$"\n")
end except mc::MATCH_COMPILER msg => print msg
fun cons_fn (x,[]) = CONSPAT (IDENT([], x), NULL)
| cons_fn (x,[a]) = CONSPAT (IDENT([], x), THE a)
| cons_fn (x, xs) = CONSPAT (IDENT([], x), THE (TUPLEPAT xs))
wild = WILDCARD_PATTERN
in
fun rule1 () =
test
(ID "B")
[ (cons_fn("A",[wild, wild]), NULL, 0)
]
fun rule2 () =
test
(ID "B")
[ (cons_fn("A",[wild, wild]), NULL, 0),
(cons_fn("B",[]), NULL, 1)
]
fun rule3 () =
test
(ID "B")
[ (cons_fn("A",[wild, cons_fn("B",[])]), NULL, 0),
(cons_fn("A",[cons_fn("B",[]), wild]), NULL, 1)
]
fun rule4 () =
test
(ID "B")
[ (cons_fn("A",[cons_fn("B",[]), cons_fn("B",[])]), NULL, 0),
(cons_fn("A",[IDPAT "a", IDPAT "b"]), NULL, 1)
]
fun rule5 () =
test
(ID "B")
[ (cons_fn("A",[cons_fn("B",[]), cons_fn("B",[])]), NULL, 0),
(cons_fn("A",[IDPAT "c", cons_fn("B",[])]), NULL, 1),
(cons_fn("A",[IDPAT "a", IDPAT "b"]), NULL, 2),
(ASPAT("u", cons_fn("B",[])), NULL, 3)
]
fun rule6 () =
test
(TUPLE_IN_EXPRESSION [ID "B", ID "C"])
[ (TUPLEPAT[cons_fn("A",[wild, wild]), cons_fn("B",[])], NULL, 0),
(TUPLEPAT[wild, wild], NULL, 1)
]
fun rule7 () =
test
(ID "B")
[ (cons_fn("D",[RECORD_PATTERN([("x", IDPAT "x"),
("y", cons_fn("B",[]))], FALSE)]), NULL, 0)
]
fun rule8 () =
test
(ID "B")
[ (cons_fn("D",[RECORD_PATTERN([("x", IDPAT "x"), ("y", cons_fn("B",[]))], FALSE)]),
THE (APPLY("=", TUPLE_IN_EXPRESSION [ID "x", ID "C"])), 0)
]
fun rule9 () =
test
(ID "B")
[ (cons_fn("A",[IDPAT "x", cons_fn("B",[])]),
THE (APPLY("=", TUPLE_IN_EXPRESSION [ID "x", ID "C"])), 0),
(cons_fn("A",[cons_fn("B",[]), ASPAT("z", cons_fn("C",[]))]),
THE (APPLY("=", TUPLE_IN_EXPRESSION [ID "z", ID "C"])), 1),
(cons_fn("A",[cons_fn("B",[]), cons_fn("C",[])]), NULL, 2),
(cons_fn("A",[cons_fn("B",[]), cons_fn("B",[])]), NULL, 3),
(IDPAT "z", NULL, 4)
]
end
end