Mercurial > urweb

comparison src/mono_print.sml @ 252:7e9bd70ad3ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Monoized and optimized initial query test
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 13:58:47 -0400
parents 326fb4686f60
children 42dfb0d61cf0
comparison
equal deleted inserted replaced
251:326fb4686f60 252:7e9bd70ad3ce
36 36
37 structure E = MonoEnv 37 structure E = MonoEnv
38 38
39 val debug = ref false 39 val debug = ref false
40 40
41 val dummyt = (TRecord [], ErrorMsg.dummySpan)
42
41 fun p_typ' par env (t, _) = 43 fun p_typ' par env (t, _) =
42 case t of 44 case t of
43 TFun (t1, t2) => parenIf par (box [p_typ' true env t1, 45 TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
44 space, 46 space,
45 string "->", 47 string "->",
131 p_list (p_exp env) es, 133 p_list (p_exp env) es,
132 string "))"] 134 string "))"]
133 | EApp (e1, e2) => parenIf par (box [p_exp env e1, 135 | EApp (e1, e2) => parenIf par (box [p_exp env e1,
134 space, 136 space,
135 p_exp' true env e2]) 137 p_exp' true env e2])
136 | EAbs (x, t, _, e) => parenIf par (box [string "fn", 138 | EAbs (x, t, _, e) => parenIf true (box [string "fn",
137 space, 139 space,
138 string x, 140 string x,
139 space, 141 space,
140 string ":", 142 string ":",
141 space, 143 space,
142 p_typ env t, 144 p_typ env t,
143 space, 145 space,
144 string "=>", 146 string "=>",
145 space, 147 space,
146 p_exp (E.pushERel env x t NONE) e]) 148 p_exp (E.pushERel env x t NONE) e])
147 149
148 | ERecord xes => box [string "{", 150 | ERecord xes => box [string "{",
149 p_list (fn (x, e, _) => 151 p_list (fn (x, e, _) =>
150 box [string x, 152 box [string x,
151 space, 153 space,
156 | EField (e, x) => 158 | EField (e, x) =>
157 box [p_exp' true env e, 159 box [p_exp' true env e,
158 string ".", 160 string ".",
159 string x] 161 string x]
160 162
161 | ECase (e, pes, _) => parenIf par (box [string "case", 163 | ECase (e, pes, _) => parenIf true (box [string "case",
162 space, 164 space,
163 p_exp env e, 165 p_exp env e,
164 space, 166 space,
165 string "of", 167 string "of",
166 space, 168 space,
167 p_list_sep (box [space, string "|", space]) 169 p_list_sep (box [space, string "|", space])
168 (fn (p, e) => box [p_pat env p, 170 (fn (p, e) => box [p_pat env p,
169 space, 171 space,
170 string "=>", 172 string "=>",
171 space, 173 space,
172 p_exp (E.patBinds env p) e]) pes]) 174 p_exp (E.patBinds env p) e]) pes])
173 175
174 | EStrcat (e1, e2) => box [p_exp' true env e1, 176 | EStrcat (e1, e2) => box [p_exp' true env e1,
175 space, 177 space,
176 string "^", 178 string "^",
177 space, 179 space,
183 185
184 | ESeq (e1, e2) => box [p_exp env e1, 186 | ESeq (e1, e2) => box [p_exp env e1,
185 string ";", 187 string ";",
186 space, 188 space,
187 p_exp env e2] 189 p_exp env e2]
188 | ELet (x, t, e1, e2) => box [string "let", 190 | ELet (x, t, e1, e2) => box [string "(let",
189 space, 191 space,
190 string x, 192 string x,
191 space, 193 space,
192 string ":", 194 string ":",
193 space, 195 space,
194 p_typ env t, 196 p_typ env t,
195 space, 197 space,
196 string "=", 198 string "=",
197 space, 199 space,
200 string "(",
198 p_exp env e1, 201 p_exp env e1,
202 string ")",
199 space, 203 space,
200 string "in", 204 string "in",
201 space, 205 space,
202 p_exp (E.pushERel env x t NONE) e2] 206 string "(",
207 p_exp (E.pushERel env x t NONE) e2,
208 string "))"]
203 209
204 | EClosure (n, es) => box [string "CLOSURE(", 210 | EClosure (n, es) => box [string "CLOSURE(",
205 p_enamed env n, 211 p_enamed env n,
206 p_list_sep (string "") (fn e => box [string ", ", 212 p_list_sep (string "") (fn e => box [string ", ",
207 p_exp env e]) es, 213 p_exp env e]) es,
208 string ")"] 214 string ")"]
215
216 | EQuery {exps, tables, state, query, body, initial} =>
217 box [string "query[",
218 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
219 string "] [",
220 p_list (fn (x, xts) => box [string x,
221 space,
222 string ":",
223 space,
224 string "{",
225 p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
226 string "}"]) tables,
227 string "] [",
228 p_typ env state,
229 string "]",
230 space,
231 p_exp env query,
232 space,
233 string "initial",
234 space,
235 p_exp env initial,
236 space,
237 string "in",
238 space,
239 p_exp (E.pushERel (E.pushERel env "r" dummyt NONE) "acc" dummyt NONE) body]
209 240
210 and p_exp env = p_exp' false env 241 and p_exp env = p_exp' false env
211 242
212 fun p_vali env (x, n, t, e, s) = 243 fun p_vali env (x, n, t, e, s) =
213 let 244 let