Mercurial > urweb

comparison src/expl_print.sml @ 146:80ac94b54e41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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