Mercurial > urweb

comparison src/cjr_env.sml @ 109:813e5a52063d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Jul 2008 10:17:06 -0400
parents 717b6f8d8505
children 91027db5a07c
comparison
equal deleted inserted replaced
108:f59553dc1b6a 109:813e5a52063d
42 42
43 numRelE : int, 43 numRelE : int,
44 relE : (string * typ) list, 44 relE : (string * typ) list,
45 namedE : (string * typ) IM.map, 45 namedE : (string * typ) IM.map,
46 46
47 F : (string * typ * typ) IM.map,
48 structs : (string * typ) list IM.map 47 structs : (string * typ) list IM.map
49 } 48 }
50 49
51 val empty = { 50 val empty = {
52 namedT = IM.empty, 51 namedT = IM.empty,
53 52
54 numRelE = 0, 53 numRelE = 0,
55 relE = [], 54 relE = [],
56 namedE = IM.empty, 55 namedE = IM.empty,
57 56
58 F = IM.empty,
59 structs = IM.empty 57 structs = IM.empty
60 } 58 }
61 59
62 fun pushTNamed (env : env) x n co = 60 fun pushTNamed (env : env) x n co =
63 {namedT = IM.insert (#namedT env, n, (x, co)), 61 {namedT = IM.insert (#namedT env, n, (x, co)),
64 62
65 numRelE = #numRelE env, 63 numRelE = #numRelE env,
66 relE = #relE env, 64 relE = #relE env,
67 namedE = #namedE env, 65 namedE = #namedE env,
68 66
69 F = #F env,
70 structs = #structs env} 67 structs = #structs env}
71 68
72 fun lookupTNamed (env : env) n = 69 fun lookupTNamed (env : env) n =
73 case IM.find (#namedT env, n) of 70 case IM.find (#namedT env, n) of
74 NONE => raise UnboundNamed n 71 NONE => raise UnboundNamed n
79 76
80 numRelE = #numRelE env + 1, 77 numRelE = #numRelE env + 1,
81 relE = (x, t) :: #relE env, 78 relE = (x, t) :: #relE env,
82 namedE = #namedE env, 79 namedE = #namedE env,
83 80
84 F = #F env,
85 structs = #structs env} 81 structs = #structs env}
86 82
87 fun lookupERel (env : env) n = 83 fun lookupERel (env : env) n =
88 (List.nth (#relE env, n)) 84 (List.nth (#relE env, n))
89 handle Subscript => raise UnboundRel n 85 handle Subscript => raise UnboundRel n
97 93
98 numRelE = #numRelE env, 94 numRelE = #numRelE env,
99 relE = #relE env, 95 relE = #relE env,
100 namedE = IM.insert (#namedE env, n, (x, t)), 96 namedE = IM.insert (#namedE env, n, (x, t)),
101 97
102 F = #F env,
103 structs = #structs env} 98 structs = #structs env}
104 99
105 fun lookupENamed (env : env) n = 100 fun lookupENamed (env : env) n =
106 case IM.find (#namedE env, n) of 101 case IM.find (#namedE env, n) of
107 NONE => raise UnboundNamed n 102 NONE => raise UnboundNamed n
108 | SOME x => x
109
110 fun pushF (env : env) n x dom ran =
111 {namedT = #namedT env,
112
113 numRelE = #numRelE env,
114 relE = #relE env,
115 namedE = #namedE env,
116
117 F = IM.insert (#F env, n, (x, dom, ran)),
118 structs = #structs env}
119
120 fun lookupF (env : env) n =
121 case IM.find (#F env, n) of
122 NONE => raise UnboundF n
123 | SOME x => x 103 | SOME x => x
124 104
125 fun pushStruct (env : env) n xts = 105 fun pushStruct (env : env) n xts =
126 {namedT = #namedT env, 106 {namedT = #namedT env,
127 107
128 numRelE = #numRelE env, 108 numRelE = #numRelE env,
129 relE = #relE env, 109 relE = #relE env,
130 namedE = #namedE env, 110 namedE = #namedE env,
131 111
132 F = #F env,
133 structs = IM.insert (#structs env, n, xts)} 112 structs = IM.insert (#structs env, n, xts)}
134 113
135 fun lookupStruct (env : env) n = 114 fun lookupStruct (env : env) n =
136 case IM.find (#structs env, n) of 115 case IM.find (#structs env, n) of
137 NONE => raise UnboundStruct n 116 NONE => raise UnboundStruct n
138 | SOME x => x 117 | SOME x => x
139 118
140 fun declBinds env (d, _) = 119 fun declBinds env (d, loc) =
141 case d of 120 case d of
142 DVal (x, n, t, _) => pushENamed env x n t 121 DVal (x, n, t, _) => pushENamed env x n t
143 | DFun (n, x, dom, ran, _) => pushF env n x dom ran 122 | DFun (fx, n, _, dom, ran, _) => pushENamed env fx n (TFun (dom, ran), loc)
144 | DStruct (n, xts) => pushStruct env n xts 123 | DStruct (n, xts) => pushStruct env n xts
145 124
146 end 125 end