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,