Mercurial > urweb
comparison src/elaborate.sml @ 2206:c1a62ce47083
Merge.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Tue, 27 May 2014 21:38:01 -0400 |
parents | 403f0cc65b9c |
children | e762c96fffb7 |
comparison
equal
deleted
inserted
replaced
2205:cdea39473c78 | 2206:c1a62ce47083 |
---|---|
2181 val gs2 = D.prove env denv (c1, c2, loc) | 2181 val gs2 = D.prove env denv (c1, c2, loc) |
2182 in | 2182 in |
2183 (e', (#1 (chaseUnifs t'), loc), enD gs2 @ gs1) | 2183 (e', (#1 (chaseUnifs t'), loc), enD gs2 @ gs1) |
2184 end | 2184 end |
2185 | 2185 |
2186 | L.ERecord xes => | 2186 | L.ERecord (xes, flex) => |
2187 let | 2187 let |
2188 val () = if flex then | |
2189 expError env (IllegalFlex eAll) | |
2190 else | |
2191 () | |
2192 | |
2188 val (xes', gs) = ListUtil.foldlMap (fn ((x, e), gs) => | 2193 val (xes', gs) = ListUtil.foldlMap (fn ((x, e), gs) => |
2189 let | 2194 let |
2190 val (x', xk, gs1) = elabCon (env, denv) x | 2195 val (x', xk, gs1) = elabCon (env, denv) x |
2191 val (e', et, gs2) = elabExp (env, denv) e | 2196 val (e', et, gs2) = elabExp (env, denv) e |
2192 in | 2197 in |
2992 | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)] | 2997 | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)] |
2993 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] | 2998 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] |
2994 | L'.DTask _ => [] | 2999 | L'.DTask _ => [] |
2995 | L'.DPolicy _ => [] | 3000 | L'.DPolicy _ => [] |
2996 | L'.DOnError _ => [] | 3001 | L'.DOnError _ => [] |
3002 | L'.DFfi (x, n, _, t) => [(L'.SgiVal (x, n, t), loc)] | |
2997 | 3003 |
2998 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) = | 3004 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) = |
2999 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), | 3005 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), |
3000 ("sgn2", p_sgn env sgn2)];*) | 3006 ("sgn2", p_sgn env sgn2)];*) |
3001 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of | 3007 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of |
4290 in | 4296 in |
4291 (unifyCons env loc t func | 4297 (unifyCons env loc t func |
4292 handle CUnify _ => ErrorMsg.error "onError handler has wrong type."); | 4298 handle CUnify _ => ErrorMsg.error "onError handler has wrong type."); |
4293 ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs)) | 4299 ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs)) |
4294 end) | 4300 end) |
4301 | |
4302 | L.DFfi (x, modes, t) => | |
4303 let | |
4304 val () = if Settings.getLessSafeFfi () then | |
4305 () | |
4306 else | |
4307 ErrorMsg.errorAt loc "To enable 'ffi' declarations, the .urp directive 'lessSafeFfi' is mandatory." | |
4308 | |
4309 val (t', _, gs1) = elabCon (env, denv) t | |
4310 val t' = normClassConstraint env t' | |
4311 val (env', n) = E.pushENamed env x t' | |
4312 in | |
4313 ([(L'.DFfi (x, n, modes, t'), loc)], (env', denv, enD gs1 @ gs)) | |
4314 end | |
4295 | 4315 |
4296 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) | 4316 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) |
4297 in | 4317 in |
4298 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll), | 4318 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll), |
4299 ("d'", p_list_sep PD.newline (ElabPrint.p_decl env) (#1 r))];*) | 4319 ("d'", p_list_sep PD.newline (ElabPrint.p_decl env) (#1 r))];*) |