Mercurial > urweb
comparison src/expl_print.sml @ 146:80ac94b54e41
Fix opening and corifying of functors
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 22 Jul 2008 18:20:13 -0400 |
parents | 541282b81454 |
children | 7420fa18d657 |
comparison
equal
deleted
inserted
replaced
145:b1b33f7cf555 | 146:80ac94b54e41 |
---|---|
98 val m1s = if !debug then | 98 val m1s = if !debug then |
99 m1x ^ "__" ^ Int.toString m1 | 99 m1x ^ "__" ^ Int.toString m1 |
100 else | 100 else |
101 m1x | 101 m1x |
102 in | 102 in |
103 p_list_sep (string ".") string (m1x :: ms @ [x]) | 103 p_list_sep (string ".") string (m1s :: ms @ [x]) |
104 end | 104 end |
105 | 105 |
106 | CApp (c1, c2) => parenIf par (box [p_con env c1, | 106 | CApp (c1, c2) => parenIf par (box [p_con env c1, |
107 space, | 107 space, |
108 p_con' true env c2]) | 108 p_con' true env c2]) |
153 and p_name env (all as (c, _)) = | 153 and p_name env (all as (c, _)) = |
154 case c of | 154 case c of |
155 CName s => string s | 155 CName s => string s |
156 | _ => p_con env all | 156 | _ => p_con env all |
157 | 157 |
158 fun p_exp' par env (e, _) = | 158 fun p_exp' par env (e, loc) = |
159 case e of | 159 case e of |
160 EPrim p => Prim.p_t p | 160 EPrim p => Prim.p_t p |
161 | ERel n => | 161 | ERel n => |
162 if !debug then | 162 if !debug then |
163 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) | 163 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) |
169 else | 169 else |
170 string (#1 (E.lookupENamed env n)) | 170 string (#1 (E.lookupENamed env n)) |
171 | EModProj (m1, ms, x) => | 171 | EModProj (m1, ms, x) => |
172 let | 172 let |
173 val (m1x, sgn) = E.lookupStrNamed env m1 | 173 val (m1x, sgn) = E.lookupStrNamed env m1 |
174 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) | |
174 | 175 |
175 val m1s = if !debug then | 176 val m1s = if !debug then |
176 m1x ^ "__" ^ Int.toString m1 | 177 m1x ^ "__" ^ Int.toString m1 |
177 else | 178 else |
178 m1x | 179 m1x |
179 in | 180 in |
180 p_list_sep (string ".") string (m1x :: ms @ [x]) | 181 p_list_sep (string ".") string (m1s :: ms @ [x]) |
181 end | 182 end |
182 | 183 |
183 | EApp (e1, e2) => parenIf par (box [p_exp env e1, | 184 | EApp (e1, e2) => parenIf par (box [p_exp env e1, |
184 space, | 185 space, |
185 p_exp' true env e2]) | 186 p_exp' true env e2]) |
292 space, | 293 space, |
293 string "=", | 294 string "=", |
294 space, | 295 space, |
295 p_sgn env sgn] | 296 p_sgn env sgn] |
296 | 297 |
297 and p_sgn env (sgn, _) = | 298 and p_sgn env (sgn, loc) = |
298 case sgn of | 299 case sgn of |
299 SgnConst sgis => box [string "sig", | 300 SgnConst sgis => box [string "sig", |
300 newline, | 301 newline, |
301 let | 302 let |
302 val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) => | 303 val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) => |
306 in | 307 in |
307 p_list_sep newline (fn x => x) psgis | 308 p_list_sep newline (fn x => x) psgis |
308 end, | 309 end, |
309 newline, | 310 newline, |
310 string "end"] | 311 string "end"] |
311 | SgnVar n => string (#1 (E.lookupSgnNamed env n)) | 312 | SgnVar n => string ((#1 (E.lookupSgnNamed env n)) |
313 handle E.UnboundNamed _ => "UNBOUND") | |
312 | SgnFun (x, n, sgn, sgn') => box [string "functor", | 314 | SgnFun (x, n, sgn, sgn') => box [string "functor", |
313 space, | 315 space, |
314 string "(", | 316 string "(", |
315 string x, | 317 string x, |
316 space, | 318 space, |
334 space, | 336 space, |
335 p_con env c] | 337 p_con env c] |
336 | SgnProj (m1, ms, x) => | 338 | SgnProj (m1, ms, x) => |
337 let | 339 let |
338 val (m1x, sgn) = E.lookupStrNamed env m1 | 340 val (m1x, sgn) = E.lookupStrNamed env m1 |
341 handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc)) | |
339 | 342 |
340 val m1s = if !debug then | 343 val m1s = if !debug then |
341 m1x ^ "__" ^ Int.toString m1 | 344 m1x ^ "__" ^ Int.toString m1 |
342 else | 345 else |
343 m1x | 346 m1x |
422 StrConst ds => box [string "struct", | 425 StrConst ds => box [string "struct", |
423 newline, | 426 newline, |
424 p_file env ds, | 427 p_file env ds, |
425 newline, | 428 newline, |
426 string "end"] | 429 string "end"] |
427 | StrVar n => string (#1 (E.lookupStrNamed env n)) | 430 | StrVar n => |
431 let | |
432 val x = #1 (E.lookupStrNamed env n) | |
433 handle E.UnboundNamed _ => "UNBOUND" | |
434 | |
435 val s = if !debug then | |
436 x ^ "__" ^ Int.toString n | |
437 else | |
438 x | |
439 in | |
440 string s | |
441 end | |
428 | StrProj (str, s) => box [p_str env str, | 442 | StrProj (str, s) => box [p_str env str, |
429 string ".", | 443 string ".", |
430 string s] | 444 string s] |
431 | StrFun (x, n, sgn, sgn', str) => | 445 | StrFun (x, n, sgn, sgn', str) => |
432 let | 446 let |