comparison src/elab_env.sml @ 203:dd82457fda82

Parsing and elaborating 'table'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 Aug 2008 13:20:29 -0400
parents aa54250f58ac
children cb8f69556975
comparison
equal deleted inserted replaced
202:af5bd54cbbd7 203:dd82457fda82
402 | SgiVal (x, n, t) => pushENamedAs env x n t 402 | SgiVal (x, n, t) => pushENamedAs env x n t
403 | SgiStr (x, n, sgn) => pushStrNamedAs env x n sgn 403 | SgiStr (x, n, sgn) => pushStrNamedAs env x n sgn
404 | SgiSgn (x, n, sgn) => pushSgnNamedAs env x n sgn 404 | SgiSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
405 | SgiConstraint _ => env 405 | SgiConstraint _ => env
406 406
407 | SgiTable (x, n, c) =>
408 (case lookupStr env "Basis" of
409 NONE => raise Fail "ElabEnv.sgiBinds: Can't find Basis"
410 | SOME (n, _) =>
411 let
412 val t = (CApp ((CModProj (n, [], "table"), loc), c), loc)
413 in
414 pushENamedAs env x n t
415 end)
416
407 fun sgnSeek f sgis = 417 fun sgnSeek f sgis =
408 let 418 let
409 fun seek (sgis, sgns, strs, cons) = 419 fun seek (sgis, sgns, strs, cons) =
410 case sgis of 420 case sgis of
411 [] => NONE 421 [] => NONE
429 | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x)) 439 | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x))
430 | SgiVal _ => seek (sgis, sgns, strs, cons) 440 | SgiVal _ => seek (sgis, sgns, strs, cons)
431 | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons) 441 | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons)
432 | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons) 442 | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons)
433 | SgiConstraint _ => seek (sgis, sgns, strs, cons) 443 | SgiConstraint _ => seek (sgis, sgns, strs, cons)
444 | SgiTable _ => seek (sgis, sgns, strs, cons)
434 in 445 in
435 seek (sgis, IM.empty, IM.empty, IM.empty) 446 seek (sgis, IM.empty, IM.empty, IM.empty)
436 end 447 end
437 448
438 fun id x = x 449 fun id x = x
664 | SgiDatatype (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc) 675 | SgiDatatype (x, n, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
665 | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc) 676 | SgiDatatypeImp (x, n, _, _, _, _, _) => seek (sgis, sgns, strs, IM.insert (cons, n, x), acc)
666 | SgiVal _ => seek (sgis, sgns, strs, cons, acc) 677 | SgiVal _ => seek (sgis, sgns, strs, cons, acc)
667 | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons, acc) 678 | SgiSgn (x, n, _) => seek (sgis, IM.insert (sgns, n, x), strs, cons, acc)
668 | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons, acc) 679 | SgiStr (x, n, _) => seek (sgis, sgns, IM.insert (strs, n, x), cons, acc)
680 | SgiTable _ => seek (sgis, sgns, strs, cons, acc)
669 in 681 in
670 seek (sgis, IM.empty, IM.empty, IM.empty, []) 682 seek (sgis, IM.empty, IM.empty, IM.empty, [])
671 end 683 end
672 684
673 fun projectConstraints env {sgn, str} = 685 fun projectConstraints env {sgn, str} =
723 | DSgn (x, n, sgn) => pushSgnNamedAs env x n sgn 735 | DSgn (x, n, sgn) => pushSgnNamedAs env x n sgn
724 | DStr (x, n, sgn, _) => pushStrNamedAs env x n sgn 736 | DStr (x, n, sgn, _) => pushStrNamedAs env x n sgn
725 | DFfiStr (x, n, sgn) => pushStrNamedAs env x n sgn 737 | DFfiStr (x, n, sgn) => pushStrNamedAs env x n sgn
726 | DConstraint _ => env 738 | DConstraint _ => env
727 | DExport _ => env 739 | DExport _ => env
740 | DTable (x, n, c) =>
741 (case lookupStr env "Basis" of
742 NONE => raise Fail "ElabEnv.declBinds: Can't find Basis"
743 | SOME (n, _) =>
744 let
745 val t = (CApp ((CModProj (n, [], "table"), loc), c), loc)
746 in
747 pushENamedAs env x n t
748 end)
728 749
729 end 750 end