Mercurial > urweb
comparison src/expl_print.sml @ 449:89f766f19d5b
Explify 'let'
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 01 Nov 2008 16:08:39 -0400 |
parents | dfc8c991abd0 |
children | 787d4931fb07 |
comparison
equal
deleted
inserted
replaced
448:85819353a84f | 449:89f766f19d5b |
---|---|
81 string "}"] | 81 string "}"] |
82 | TRecord c => box [string "$", | 82 | TRecord c => box [string "$", |
83 p_con' true env c] | 83 p_con' true env c] |
84 | 84 |
85 | CRel n => | 85 | CRel n => |
86 if !debug then | 86 ((if !debug then |
87 string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n) | 87 string (#1 (E.lookupCRel env n) ^ "_" ^ Int.toString n) |
88 else | 88 else |
89 string (#1 (E.lookupCRel env n)) | 89 string (#1 (E.lookupCRel env n))) |
90 handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n)) | |
90 | CNamed n => | 91 | CNamed n => |
91 ((if !debug then | 92 ((if !debug then |
92 string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n) | 93 string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n) |
93 else | 94 else |
94 string (#1 (E.lookupCNamed env n))) | 95 string (#1 (E.lookupCNamed env n))) |
170 PConVar n => | 171 PConVar n => |
171 ((if !debug then | 172 ((if !debug then |
172 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) | 173 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) |
173 else | 174 else |
174 string (#1 (E.lookupENamed env n))) | 175 string (#1 (E.lookupENamed env n))) |
175 handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n)) | 176 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n)) |
176 | PConProj (m1, ms, x) => | 177 | PConProj (m1, ms, x) => |
177 let | 178 let |
178 val m1x = #1 (E.lookupStrNamed env m1) | 179 val m1x = #1 (E.lookupStrNamed env m1) |
179 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1 | 180 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1 |
180 | 181 |
209 | 210 |
210 fun p_exp' par env (e, loc) = | 211 fun p_exp' par env (e, loc) = |
211 case e of | 212 case e of |
212 EPrim p => Prim.p_t p | 213 EPrim p => Prim.p_t p |
213 | ERel n => | 214 | ERel n => |
214 if !debug then | 215 ((if !debug then |
215 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) | 216 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) |
216 else | 217 else |
217 string (#1 (E.lookupERel env n)) | 218 string (#1 (E.lookupERel env n))) |
219 handle E.UnboundRel _ => string ("UNBOUND_REL" ^ Int.toString n)) | |
218 | ENamed n => | 220 | ENamed n => |
219 if !debug then | 221 ((if !debug then |
220 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) | 222 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) |
221 else | 223 else |
222 string (#1 (E.lookupENamed env n)) | 224 string (#1 (E.lookupENamed env n))) |
225 handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n)) | |
223 | EModProj (m1, ms, x) => | 226 | EModProj (m1, ms, x) => |
224 let | 227 let |
225 val (m1x, sgn) = E.lookupStrNamed env m1 | 228 val (m1x, sgn) = E.lookupStrNamed env m1 |
226 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) | 229 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) |
227 | 230 |
359 (fn (p, e) => box [p_pat env p, | 362 (fn (p, e) => box [p_pat env p, |
360 space, | 363 space, |
361 string "=>", | 364 string "=>", |
362 space, | 365 space, |
363 p_exp env e]) pes]) | 366 p_exp env e]) pes]) |
367 | |
368 | ELet (x, t, e1, e2) => box [string "let", | |
369 space, | |
370 string x, | |
371 space, | |
372 string ":", | |
373 p_con env t, | |
374 space, | |
375 string "=", | |
376 space, | |
377 p_exp env e1, | |
378 space, | |
379 string "in", | |
380 newline, | |
381 p_exp (E.pushERel env x t) e2] | |
382 | |
383 | |
364 | 384 |
365 and p_exp env = p_exp' false env | 385 and p_exp env = p_exp' false env |
366 | 386 |
367 fun p_named x n = | 387 fun p_named x n = |
368 if !debug then | 388 if !debug then |