-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathAbstractInfixop.sml
44 lines (43 loc) · 1.5 KB
/
AbstractInfixop.sml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
signature Infixop =
sig
type infixop
type exp
val rep_comb : exp -> infixop -> infixop
val rep_exp : exp -> infixop
val prt_infixop : (exp -> 'a) ->
(exp -> infixop -> 'a) ->
infixop -> 'a
val deconstruct_infixop : ('a -> 'b) -> ('c -> 'b) ->
(('c -> string * string * 'b list) ->
('c -> 'a -> string * string * 'b list) -> 'd) -> 'd
val construct_infixop :
('a -> infixop) -> ('a -> exp) ->
(infixop -> 'b) ->
string * 'a list -> 'b
end
functor AbstractInfixop
(type infixop
type exp
val rep_comb : exp -> infixop -> infixop
val rep_exp : exp -> infixop
val prt_infixop : (exp -> 'a) ->
(exp -> infixop -> 'a) ->
infixop -> 'a
) :> Infixop
where type infixop = infixop
and type exp = exp =
struct
type infixop = infixop
type exp = exp
val rep_comb = rep_comb
val rep_exp = rep_exp
val prt_infixop = prt_infixop
fun deconstruct_infixop infixop exp =
fn f => f (fn e => ("infixop","exp", [exp e]))
(fn e => fn es => ("infixop","comb",[exp e, infixop es]))
fun construct_infixop infixop exp rep_infixop =
fn arg => rep_infixop
(case arg of ("exp",[e]) => rep_exp (exp e)
| ("comb",[e,es]) => rep_comb (exp e) (infixop es)
| (c,l) => raise Fail "infixop: no case")
end