Mercurial > urweb

comparison src/elaborate.sml @ 1075:0657e5adc938

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Convert to task syntax
author Adam Chlipala <adamc@hcoop.net>
date Tue, 15 Dec 2009 10:19:05 -0500
parents d89f98f0b4bb
children 8d3aa6c7cee0
comparison
equal deleted inserted replaced
1074:d89f98f0b4bb 1075:0657e5adc938
2546 [(L'.SgiVal (x, n, (L'.CApp (viewOf (), c), loc)), loc)] 2546 [(L'.SgiVal (x, n, (L'.CApp (viewOf (), c), loc)), loc)]
2547 | L'.DClass (x, n, k, c) => [(L'.SgiClass (x, n, k, c), loc)] 2547 | L'.DClass (x, n, k, c) => [(L'.SgiClass (x, n, k, c), loc)]
2548 | L'.DDatabase _ => [] 2548 | L'.DDatabase _ => []
2549 | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)] 2549 | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)]
2550 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] 2550 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)]
2551 | L'.DInitializer _ => [] 2551 | L'.DTask _ => []
2552 2552
2553 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) = 2553 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
2554 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), 2554 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
2555 ("sgn2", p_sgn env sgn2)];*) 2555 ("sgn2", p_sgn env sgn2)];*)
2556 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of 2556 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of
3667 let 3667 let
3668 val (env, n) = E.pushENamed env x (styleOf ()) 3668 val (env, n) = E.pushENamed env x (styleOf ())
3669 in 3669 in
3670 ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs)) 3670 ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs))
3671 end 3671 end
3672 | L.DInitializer e => 3672 | L.DTask (e1, e2) =>
3673 let 3673 let
3674 val (e', t, gs') = elabExp (env, denv) e 3674 val (e1', t1, gs1) = elabExp (env, denv) e1
3675 val t' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), 3675 val (e2', t2, gs2) = elabExp (env, denv) e2
3676 (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc) 3676
3677 val t1' = (L'.CModProj (!basis_r, [], "task_kind"), loc)
3678 val t2' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc),
3679 (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc)
3677 in 3680 in
3678 checkCon env e' t t'; 3681 checkCon env e1' t1 t1';
3679 ([(L'.DInitializer e', loc)], (env, denv, gs' @ gs)) 3682 checkCon env e2' t2 t2';
3683 ([(L'.DTask (e1', e2'), loc)], (env, denv, gs2 @ gs1 @ gs))
3680 end 3684 end
3681 3685
3682 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) 3686 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
3683 in 3687 in
3684 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll)];*) 3688 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll)];*)