Mercurial > urweb
comparison src/elab_print.sml @ 447:b77863cd0be2
Elaborating 'let'
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 01 Nov 2008 11:17:29 -0400 |
parents | dfc8c991abd0 |
children | 85819353a84f |
comparison
equal
deleted
inserted
replaced
446:86c063fedc4d | 447:b77863cd0be2 |
---|---|
376 | 376 |
377 | EError => string "<ERROR>" | 377 | EError => string "<ERROR>" |
378 | EUnif (ref (SOME e)) => p_exp env e | 378 | EUnif (ref (SOME e)) => p_exp env e |
379 | EUnif _ => string "_" | 379 | EUnif _ => string "_" |
380 | 380 |
381 | ELet (ds, e) => | |
382 let | |
383 val (dsp, env) = ListUtil.foldlMap | |
384 (fn (d, env) => | |
385 (p_edecl env d, | |
386 E.edeclBinds env d)) | |
387 env ds | |
388 in | |
389 box [string "let", | |
390 newline, | |
391 box [p_list_sep newline (fn x => x) dsp], | |
392 newline, | |
393 string "in", | |
394 newline, | |
395 box [p_exp env e], | |
396 newline, | |
397 string "end"] | |
398 end | |
399 | |
381 and p_exp env = p_exp' false env | 400 and p_exp env = p_exp' false env |
382 | 401 |
383 fun p_named x n = | 402 and p_edecl env (dAll as (d, _)) = |
384 if !debug then | 403 case d of |
385 box [string x, | 404 EDVal vi => box [string "val", |
386 string "__", | 405 space, |
387 string (Int.toString n)] | 406 p_evali env vi] |
388 else | 407 | EDValRec vis => |
389 string x | 408 let |
409 val env = E.edeclBinds env dAll | |
410 in | |
411 box [string "val", | |
412 space, | |
413 string "rec", | |
414 space, | |
415 p_list_sep (box [newline, string "and", space]) (p_evali env) vis] | |
416 end | |
417 | |
418 and p_evali env (x, t, e) = box [string x, | |
419 space, | |
420 string ":", | |
421 space, | |
422 p_con env t, | |
423 space, | |
424 string "=", | |
425 space, | |
426 p_exp env e] | |
390 | 427 |
391 fun p_datatype env (x, n, xs, cons) = | 428 fun p_datatype env (x, n, xs, cons) = |
392 let | 429 let |
393 val k = (KType, ErrorMsg.dummySpan) | 430 val k = (KType, ErrorMsg.dummySpan) |
394 val env = E.pushCNamedAs env x n k NONE | 431 val env = E.pushCNamedAs env x n k NONE |
404 p_list_sep (box [space, string "|", space]) | 441 p_list_sep (box [space, string "|", space]) |
405 (fn (x, _, NONE) => string x | 442 (fn (x, _, NONE) => string x |
406 | (x, _, SOME t) => box [string x, space, string "of", space, p_con env t]) | 443 | (x, _, SOME t) => box [string x, space, string "of", space, p_con env t]) |
407 cons] | 444 cons] |
408 end | 445 end |
446 | |
447 fun p_named x n = | |
448 if !debug then | |
449 box [string x, | |
450 string "__", | |
451 string (Int.toString n)] | |
452 else | |
453 string x | |
409 | 454 |
410 fun p_sgn_item env (sgi, _) = | 455 fun p_sgn_item env (sgi, _) = |
411 case sgi of | 456 case sgi of |
412 SgiConAbs (x, n, k) => box [string "con", | 457 SgiConAbs (x, n, k) => box [string "con", |
413 space, | 458 space, |
554 space, | 599 space, |
555 string "=", | 600 string "=", |
556 space, | 601 space, |
557 p_exp env e] | 602 p_exp env e] |
558 | 603 |
604 | |
605 | |
559 fun p_decl env (dAll as (d, _) : decl) = | 606 fun p_decl env (dAll as (d, _) : decl) = |
560 case d of | 607 case d of |
561 DCon (x, n, k, c) => box [string "con", | 608 DCon (x, n, k, c) => box [string "con", |
562 space, | 609 space, |
563 p_named x n, | 610 p_named x n, |