-
Notifications
You must be signed in to change notification settings - Fork 6
/
expr.sml
118 lines (97 loc) · 4.09 KB
/
expr.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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
structure Expr = IdxTypeExprFn (type v = int
structure UVarI = UVar
structure UVarT = UVar
type ptrn_constr_tag = int * int
)
structure LongIdHasEqual = struct
open LongId
fun eq_id ((x, _), (x', _)) = x = x'
fun eq_var a = eq_long_id eq_id a
end
structure HasEqual = struct
open UVar
open Expr
open LongIdHasEqual
fun eq_name ((s, _) : name, (s', _)) = s = s'
end
structure Equal = EqualFn (structure IdxType = struct
structure Idx = Expr.Idx
structure Type = Expr.Type
end
structure HasEqual = HasEqual
)
structure IntLongIdCanToString = struct
open LongId
open Gctx
fun str_raw_v x = str_int x
fun str_raw_var a = str_raw_long_id str_raw_v a
fun str_v ctx x : string =
(* sprintf "%$" [str_int x] *)
case nth_error ctx x of
SOME name => name
| NONE => "unbound_" ^ str_int x
fun str_id ctx (x, _) =
str_v ctx x
fun lookup_module gctx m =
case nth_error2 gctx m of
SOME (name, ctx) => (name, ctx)
| NONE => ("unbound_module_" ^ m, ([], [], [], []))
fun str_var sel gctx ctx id =
case id of
QID ((m, _), x) =>
let
val (name, ctx) = lookup_module gctx m
val ctx = sel ctx
in
name ^ "." ^ str_id ctx x
end
| ID x => str_id ctx x
end
structure CanToString = struct
open UVar
open Expr
open IntLongIdCanToString
end
structure ToString = ToStringFn (structure Expr = Expr
structure CanToString = CanToString
)
structure ToStringRaw = ToStringRawFn (structure Expr = Expr
open CanToString
)
structure Subst = SubstFn (structure IdxType = struct
structure Idx = Expr.Idx
structure Type = Expr.Type
end
structure SubstableVar = LongIdSubst
)
structure ExprVisitor = ExprVisitorFn (structure S = Expr
structure T = Expr)
structure ExprShift = ExprShiftFn (structure Expr = Expr
structure ShiftableVar = LongIdSubst
open Subst
)
structure ExprSubst = ExprSubstFn (structure Expr = Expr
open Subst)
structure Simp = SimpFn (structure Idx = Expr
val get_region_i = Expr.get_region_i
val get_region_p = Expr.get_region_p
val eq_i = Equal.eq_i
val eq_p = Equal.eq_p
val shift_i_i = Subst.shift_i_i
val forget_i_i = Subst.forget_i_i
val forget_i_p = Subst.forget_i_p
val subst_i_i = Subst.subst_i_i
val subst_i_s = Subst.subst_i_s
val substx_i_p = Subst.substx_i_p
)
structure SimpType = SimpTypeFn (structure Type = Expr
val simp_i = Simp.simp_i
val simp_s = Simp.simp_s
val subst_i_mt = Subst.subst_i_mt
)
structure VC = VCFn (structure Idx = Expr
val get_region_p = Expr.get_region_p
val str_bs = ToString.str_bs
val str_p = ToString.str_p
val simp_p = Simp.simp_p
)