summaryrefslogtreecommitdiff
path: root/src/elaborate.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2010-09-07 08:28:07 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2010-09-07 08:28:07 -0400
commit5545969f485ef2fb944db8e7b0237acbabeb8d4c (patch)
treeab4a39c6f88b3e8719c9e41dfcd7f147126ef790 /src/elaborate.sml
parentee175ea1f9151123e47d9cbfee0c6329b2e5d934 (diff)
Server-side 'onError'
Diffstat (limited to 'src/elaborate.sml')
-rw-r--r--src/elaborate.sml27
1 files changed, 27 insertions, 0 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 505699bd..e7848f21 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2679,6 +2679,7 @@ and sgiOfDecl (d, loc) =
| L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)]
| L'.DTask _ => []
| L'.DPolicy _ => []
+ | L'.DOnError _ => []
and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) =
((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
@@ -3858,6 +3859,32 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
([(L'.DPolicy e1', loc)], (env, denv, gs1 @ gs))
end
+ | L.DOnError (m1, ms, s) =>
+ (case E.lookupStr env m1 of
+ NONE => (expError env (UnboundStrInExp (loc, m1));
+ ([], (env, denv, [])))
+ | SOME (n, sgn) =>
+ let
+ val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+ case E.projectStr env {sgn = sgn, str = str, field = m} of
+ NONE => (conError env (UnboundStrInCon (loc, m));
+ (strerror, sgnerror))
+ | SOME sgn => ((L'.StrProj (str, m), loc), sgn))
+ ((L'.StrVar n, loc), sgn) ms
+
+ val t = case E.projectVal env {sgn = sgn, str = str, field = s} of
+ NONE => (expError env (UnboundExp (loc, s));
+ cerror)
+ | SOME t => t
+
+ val page = (L'.CModProj (!basis_r, [], "page"), loc)
+ val xpage = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), page), loc)
+ val func = (L'.TFun ((L'.CModProj (!basis_r, [], "xbody"), loc), xpage), loc)
+ in
+ unifyCons env loc t func;
+ ([(L'.DOnError (n, ms, s), loc)], (env, denv, gs))
+ end)
+
(*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
in
(*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll)];*)