Mercurial > urweb

comparison src/elaborate.sml @ 2010:403f0cc65b9c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New lessSafeFfi
author Adam Chlipala <adam@chlipala.net>
date Fri, 02 May 2014 19:19:09 -0400
parents 799be3911ce3
children e762c96fffb7
comparison
equal deleted inserted replaced
2009:799be3911ce3 2010:403f0cc65b9c
2997 | 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)]
2998 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] 2998 | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)]
2999 | L'.DTask _ => [] 2999 | L'.DTask _ => []
3000 | L'.DPolicy _ => [] 3000 | L'.DPolicy _ => []
3001 | L'.DOnError _ => [] 3001 | L'.DOnError _ => []
3002 | L'.DFfi (x, n, _, t) => [(L'.SgiVal (x, n, t), loc)]
3002 3003
3003 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) = 3004 and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
3004 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), 3005 ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
3005 ("sgn2", p_sgn env sgn2)];*) 3006 ("sgn2", p_sgn env sgn2)];*)
3006 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of 3007 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of
4295 in 4296 in
4296 (unifyCons env loc t func 4297 (unifyCons env loc t func
4297 handle CUnify _ => ErrorMsg.error "onError handler has wrong type."); 4298 handle CUnify _ => ErrorMsg.error "onError handler has wrong type.");
4298 ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs)) 4299 ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs))
4299 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
4300 4315
4301 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) 4316 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
4302 in 4317 in
4303 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll), 4318 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll),
4304 ("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))];*)