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))];*)