[svn] r6478: nemerle/trunk: macros/Late.n
ncc/generation/ILEmitter.n ncc/generation/Typer3.n ncc/generatio...
dragonfox
svnadmin at nemerle.org
Tue Aug 1 20:09:57 CEST 2006
Log:
fix exception handling (bug 695); add exception filters feature ('when' with condition)
Author: dragonfox
Date: Tue Aug 1 20:09:44 2006
New Revision: 6478
Modified:
nemerle/trunk/macros/Late.n
nemerle/trunk/ncc/generation/ILEmitter.n
nemerle/trunk/ncc/generation/Typer3.n
nemerle/trunk/ncc/generation/Typer4.n
nemerle/trunk/ncc/misc/PrettyPrint.n
nemerle/trunk/ncc/parsing/MainParser.n
nemerle/trunk/ncc/parsing/ParseTree.n
nemerle/trunk/ncc/typing/Macros.n
nemerle/trunk/ncc/typing/TypedTree.n
nemerle/trunk/ncc/typing/Typer.n
nemerle/trunk/ncc/typing/Typer2.n
nemerle/trunk/tools/contracts/Nemerle.Contracts.n
Modified: nemerle/trunk/macros/Late.n
==============================================================================
--- nemerle/trunk/macros/Late.n (original)
+++ nemerle/trunk/macros/Late.n Tue Aug 1 20:09:44 2006
@@ -307,9 +307,18 @@
| PExpr.Throw(expr) =>
PExpr.Throw(loc, recurse(expr))
| PExpr.TryWith(body, ex, ty, handler) =>
- PExpr.TryWith(loc, recurse(body), ex, ty, recurse(handler))
+ PExpr.Try(loc, recurse(body), [TryCase.Catch(ex, ty, recurse(handler))])
| PExpr.TryFinally(body, handler) =>
PExpr.TryFinally(loc, recurse(body), recurse(handler))
+ | PExpr.Try(body, cases) =>
+ def recurse_case(case)
+ | TryCase.Catch(ex, ty, handler) =>
+ TryCase.Catch(ex, ty, recurse(handler))
+ | TryCase.Filter(ex, ty, filter, handler) =>
+ TryCase.Filter(ex, ty, recurse(filter), recurse(handler))
+ | TryCase.Ellipsis(e) =>
+ TryCase.Ellipsis(recurse(e))
+ PExpr.Try(loc, recurse(body), cases.Map(recurse_case))
| PExpr.Literal \
| PExpr.This \
| PExpr.Base \
Modified: nemerle/trunk/ncc/generation/ILEmitter.n
==============================================================================
--- nemerle/trunk/ncc/generation/ILEmitter.n (original)
+++ nemerle/trunk/ncc/generation/ILEmitter.n Tue Aug 1 20:09:44 2006
@@ -1235,6 +1235,79 @@
_ilg.Emit (OpCodes.Ldloc, try_result);
+ | Try (try_expr, try_cases) =>
+ def type_of_try_expr = expr.SystemType;
+
+ def ignore_try_result = is_void (try_expr.Type);
+ mutable try_result = null;
+
+ unless (ignore_try_result)
+ try_result = _ilg.DeclareLocal (type_of_try_expr);
+
+ _ = _ilg.BeginExceptionBlock ();
+
+ emit (try_expr);
+
+ unless (try_expr.Throws || ignore_try_result)
+ _ilg.Emit (OpCodes.Stloc, try_result);
+
+ def walk_case (case) {
+ | Try_case.Catch (catch_val, catch_expr) =>
+ _ilg.BeginCatchBlock (catch_val.Type.SystemType);
+
+ def catch_val_local_slot = declare_val_local_slot (catch_val);
+ _ilg.Emit (OpCodes.Stloc, catch_val_local_slot);
+
+ emit (catch_expr);
+ // close scope opened by declare_val_local_slot
+ when (_debug_doc != null) _ilg.EndScope ();
+
+ unless (catch_expr.Throws || ignore_try_result)
+ _ilg.Emit (OpCodes.Stloc, try_result);
+
+ | Try_case.Filter (catch_val, filter_expr, catch_expr) =>
+ def label_badclass = _ilg.DefineLabel ();
+ def label_endfilter = _ilg.DefineLabel ();
+
+ // emit filter preamble
+ _ilg.BeginExceptFilterBlock ();
+ _ilg.Emit (OpCodes.Isinst, catch_val.Type.SystemType);
+ _ilg.Emit (OpCodes.Dup);
+ _ilg.Emit (OpCodes.Brfalse, label_badclass);
+
+ // emit filter block
+ def catch_val_local_slot = declare_val_local_slot (catch_val);
+ _ilg.Emit (OpCodes.Stloc, catch_val_local_slot);
+ emit (filter_expr);
+ _ilg.Emit (OpCodes.Br, label_endfilter);
+
+ // when bad class return 0
+ _ilg.MarkLabel (label_badclass);
+ _ilg.Emit (OpCodes.Pop);
+ _ilg.Emit (OpCodes.Ldc_I4_0);
+
+ // mark end of filter
+ _ilg.MarkLabel (label_endfilter);
+
+ // emit catch block
+ _ilg.BeginCatchBlock (null);
+ _ilg.Emit (OpCodes.Pop); // ignore value on stack, it's already local
+ emit (catch_expr);
+ when (_debug_doc != null) _ilg.EndScope ();
+
+ unless (catch_expr.Throws || ignore_try_result)
+ _ilg.Emit (OpCodes.Stloc, try_result);
+ }
+
+ foreach (try_case in try_cases)
+ walk_case (try_case);
+
+ _ilg.EndExceptionBlock ();
+
+ unless (ignore_try_result)
+ _ilg.Emit (OpCodes.Ldloc, try_result);
+
+
/* -- TUPLES -------------------------------------------------------- */
| Tuple (vals) =>
foreach (v in vals) emit (v);
Modified: nemerle/trunk/ncc/generation/Typer3.n
==============================================================================
--- nemerle/trunk/ncc/generation/Typer3.n (original)
+++ nemerle/trunk/ncc/generation/Typer3.n Tue Aug 1 20:09:44 2006
@@ -803,6 +803,18 @@
_ = handler.Walk (look_for_invalid_yield);
expr
+ | Try (body, cases) as expr =>
+ _ = body.Walk (look_for_invalid_yield);
+ def walk_case(case) {
+ | Try_case.Catch (_, handler) =>
+ _ = handler.Walk (look_for_invalid_yield);
+ | Try_case.Filter (_, filter, handler) =>
+ _ = filter.Walk (look_for_invalid_yield);
+ _ = handler.Walk (look_for_invalid_yield);
+ }
+ foreach (case in cases)
+ walk_case (case);
+ expr
| _ => null
}
@@ -1724,8 +1736,48 @@
val.UseFrom (current_local_fun);
def handler =
TExpr.DefValIn (handler.Type, orig, PlainRef (val), handler);
- TExpr.TryWith (Walk (body), val, Walk (handler))
+ TExpr.Try (Walk (body), [Try_case.Catch (val, Walk (handler))])
} else null
+ | TExpr.Try (body, cases) =>
+ mutable change_happened = false;
+ def need_walk (cases) {
+ | [] => false
+ | Try_case.Catch (orig, _) :: _ when (orig.InClosure) => true
+ | Try_case.Filter (orig, _, _) :: _ when (orig.InClosure) => true
+ | _ :: cases => need_walk (cases)
+ }
+ def walk_case (case) {
+ | Try_case.Catch (orig, handler) when (orig.InClosure) =>
+ def val =
+ LocalValue (current_local_fun, orig.Name,
+ orig.Type, LocalValue.Kind.ExceptionValue (),
+ is_mutable = false);
+ val.Register ();
+ val.UseFrom (current_local_fun);
+ def handler =
+ TExpr.DefValIn (handler.Type, orig, PlainRef (val), handler);
+ change_happened = true;
+ Try_case.Catch (val, Walk (handler))
+ | Try_case.Filter (orig, filter, handler) when (orig.InClosure) =>
+ def val =
+ LocalValue (current_local_fun, orig.Name,
+ orig.Type, LocalValue.Kind.ExceptionValue (),
+ is_mutable = false);
+ val.Register ();
+ val.UseFrom (current_local_fun);
+ def filter =
+ TExpr.DefValIn (filter.Type, orig, PlainRef (val), filter);
+ def handler =
+ TExpr.DefValIn (handler.Type, orig, PlainRef (val), handler);
+ change_happened = true;
+ Try_case.Filter (val, Walk (filter), Walk (handler))
+ | Try_case.Catch => case
+ | Try_case.Filter => case
+ }
+ if (need_walk (cases))
+ TExpr.Try (Walk (body), cases.Map (walk_case))
+ else
+ null
// optimize ifs
@@ -1795,6 +1847,17 @@
name.SetType (SubstType (name.Type));
null
+ | Try (_, cases) =>
+ def walk_case (case) {
+ | Try_case.Catch (name, _)
+ | Try_case.Filter (name, _, _) =>
+ name.SetType (SubstType (name.Type));
+ | _ => ()
+ }
+ foreach (case in cases)
+ walk_case (case);
+ null
+
| LocalRef
| ImplicitValueTypeCtor
| FieldMember
Modified: nemerle/trunk/ncc/generation/Typer4.n
==============================================================================
--- nemerle/trunk/ncc/generation/Typer4.n (original)
+++ nemerle/trunk/ncc/generation/Typer4.n Tue Aug 1 20:09:44 2006
@@ -223,7 +223,18 @@
log (STV, expr.loc, $ "( name($(name)) : $(name.Type)");
CheckSTV (name.Type);
log (STV, expr.loc, $ "done )");
- | _ => {}
+ | Try (_, cases) =>
+ def walk_case (case) {
+ | Try_case.Catch (name, _)
+ | Try_case.Filter (name, _, _) =>
+ log (STV, expr.loc, $ "( name($(name)) : $(name.Type)");
+ CheckSTV (name.Type);
+ log (STV, expr.loc, $ "done )");
+ | _ => ()
+ }
+ foreach (case in cases)
+ walk_case (case);
+ | _ => ()
}
#endif
def res =
@@ -389,6 +400,24 @@
_ = Throws (handler, true);
false
+ | Try (body, cases) =>
+ when (! allow_try)
+ // use ice here?
+ Message.Error (expr.loc,
+ "try-blocks cannot be used inside expressions, "
+ "this message shouldn't happen though");
+ def walk_case (case) {
+ | Try_case.Catch (_, handler) =>
+ _ = Throws (handler, true);
+ | Try_case.Filter (_, filter, handler) =>
+ _ = Throws (filter, true);
+ _ = Throws (handler, true);
+ }
+ _ = Throws (body, true);
+ foreach (case in cases)
+ walk_case (case);
+ false
+
| StaticRef (_t, meth is IMethod, tp) =>
Util.cassert (meth.GetHeader ().typarms.Length == tp.Length,
$ "typarms check failed for $meth "
@@ -641,7 +670,7 @@
TExpr.Array (res.Rev (), dimensions)
| TryWith (body, exn, handler) =>
- TExpr.TryWith (WalkTry (body), exn, WalkTry (handler))
+ TExpr.Try (WalkTry (body), [Try_case.Catch (exn, WalkTry (handler))])
| TryFinally (body, handler) =>
TExpr.TryFinally (WalkTry (body), Walk (handler))
@@ -649,6 +678,15 @@
| TryFault (body, handler) =>
TExpr.TryFault (WalkTry (body), Walk (handler))
+ | Try (body, cases) =>
+ def walk_case (case) {
+ | Try_case.Catch (exn, handler) =>
+ Try_case.Catch (exn, WalkTry (handler))
+ | Try_case.Filter (exn, filter, handler) =>
+ Try_case.Filter (exn, WalkTry (filter), WalkTry (handler))
+ }
+ TExpr.Try (WalkTry (body), cases.Map (walk_case))
+
| Goto as g =>
g.try_block = current_try_block;
null
Modified: nemerle/trunk/ncc/misc/PrettyPrint.n
==============================================================================
--- nemerle/trunk/ncc/misc/PrettyPrint.n (original)
+++ nemerle/trunk/ncc/misc/PrettyPrint.n Tue Aug 1 20:09:44 2006
@@ -206,7 +206,7 @@
| <[ throw $exc ]> =>
add ("throw "); SprintExpr (ctx, exc, indentation, acc);
- | <[ try $body catch { $exn is $exn_ty => $handler } ]> =>
+ | PExpr.TryWith (body, exn, exn_ty, handler) =>
add (sprintf ("try {\n%s ", indentation));
SprintExpr (ctx, body, indentation + " ", acc);
add (sprintf ("\n%s}\n%scatch {\n%s", indentation, indentation, indentation + " "));
@@ -216,13 +216,41 @@
SprintExpr (ctx, handler, indentation + " ", acc);
add (sprintf ("\n%s}", indentation));
- | <[ try $body finally $handler ]> =>
+ | PExpr.TryFinally (body, handler) =>
add (sprintf ("try {\n%s ", indentation));
SprintExpr (ctx, body, indentation + " ", acc);
add (sprintf ("\n%s}\n%sfinally {\n%s ", indentation, indentation, indentation));
SprintExpr (ctx, handler, indentation + " ", acc);
add (sprintf ("\n%s}", indentation));
+ | PExpr.Try (body, cases) =>
+ add (sprintf ("try {\n%s ", indentation));
+ SprintExpr (ctx, body, indentation + " ", acc);
+ add (sprintf ("\n%s}\n%scatch {", indentation, indentation));
+ def print_case (case) {
+ | TryCase.Catch (exn, exn_ty, handler) =>
+ add (sprintf ("\n%s", indentation + " "));
+ sprint_ss (exn); add (" is ");
+ SprintExpr (ctx, exn_ty, indentation, acc);
+ add (sprintf ("=>\n%s", indentation + " "));
+ SprintExpr (ctx, handler, indentation + " ", acc);
+ | TryCase.Filter (exn, exn_ty, filter, handler) =>
+ add (sprintf ("\n%s", indentation + " "));
+ sprint_ss (exn); add (" is ");
+ SprintExpr (ctx, exn_ty, indentation, acc);
+ add (" when (");
+ SprintExpr (ctx, filter, indentation, acc);
+ add (") ");
+ add (sprintf ("=>\n%s", indentation + " "));
+ SprintExpr (ctx, handler, indentation + " ", acc);
+ | TryCase.Ellipsis (e) =>
+ add (sprintf ("\n%s", indentation + " "));
+ SprintExpr (ctx, e, indentation + " ", acc);
+ }
+ foreach (case in cases)
+ print_case (case);
+ add (sprintf ("\n%s}", indentation));
+
| PExpr.Literal (lit) => add (lit.ToString ())
| <[ this ]> => add ("this")
@@ -1118,6 +1146,27 @@
recurse_and_indent (handler);
append ("\n" + indentation + "}")
+ | TT.TExpr.Try (body, cases) =>
+ append ("try {\n");
+ recurse_and_indent (body);
+ append ("\n" + indentation + "} catch {");
+ def print_case (case) {
+ | TT.Try_case.Catch (exn, handler) =>
+ append ("\n " + indentation + "| " + exn.Name + " is ");
+ print_type (exn.Type);
+ append (" =>\n");
+ recurse_and_indent (handler);
+ | TT.Try_case.Filter (exn, filter, handler) =>
+ append ("\n " + indentation + "| " + exn.Name + " is ");
+ print_type (exn.Type);
+ append (" when (");
+ recurse (filter);
+ append (") =>\n");
+ recurse_and_indent (handler);
+ }
+ foreach (case in cases)
+ print_case (case);
+ append ("\n" + indentation + "}");
// 'this' and 'base' objects
| TT.TExpr.This =>
Modified: nemerle/trunk/ncc/parsing/MainParser.n
==============================================================================
--- nemerle/trunk/ncc/parsing/MainParser.n (original)
+++ nemerle/trunk/ncc/parsing/MainParser.n Tue Aug 1 20:09:44 2006
@@ -1992,65 +1992,87 @@
// exception handlers
when (flag_sibling_keyword ("catch")) {
- def mktry (h : MatchCase, body) {
+ def mktry (h : MatchCase, cases) {
match (h.patterns) {
| [PExpr.TypeEnforcement (PExpr.Wildcard, t)] =>
Message.Warning (602, loc, "using ``:'' as a type tests is "
"deprecated, please use ``is'' instead");
- PExpr.TryWith (loc, body, Splicable.Name (loc, mkname (Util.tmpname ("u"))), t, h.body)
+ TryCase.Catch (Splicable.Name (loc, mkname (Util.tmpname ("u"))), t, h.body) :: cases
| [PExpr.Is (PExpr.Wildcard, t)] =>
- PExpr.TryWith (loc, body, Splicable.Name (loc, mkname (Util.tmpname ("u"))), t, h.body)
+ TryCase.Catch (Splicable.Name (loc, mkname (Util.tmpname ("u"))), t, h.body) :: cases
+
+ | [<[ _ is $t when $cond ]>] =>
+ TryCase.Filter (Splicable.Name (loc, mkname (Util.tmpname ("u"))), t, cond, h.body) :: cases
| [PExpr.TypeEnforcement (PExpr.Ref (id), t)] =>
Message.Warning (602, loc, "using ``:'' as a type tests is "
"deprecated, please use ``is'' instead");
- PExpr.TryWith (loc, body, Splicable.Name (id), t, h.body)
+ TryCase.Catch (Splicable.Name (id), t, h.body) :: cases
| [PExpr.Is (PExpr.Ref (id), t)] =>
- PExpr.TryWith (loc, body, Splicable.Name (loc, id), t, h.body)
+ TryCase.Catch (Splicable.Name (loc, id), t, h.body) :: cases
+
+ | [<[ $(PExpr.Ref(id)) is $t when $cond ]>] =>
+ TryCase.Filter (Splicable.Name (loc, id), t, cond, h.body) :: cases
| [PExpr.Ref (id)] =>
- PExpr.TryWith (loc, body, Splicable.Name (loc, id), <[ System.Exception ]>, h.body)
+ TryCase.Catch (Splicable.Name (loc, id), <[ System.Exception ]>, h.body) :: cases
+
+ | [<[ $(PExpr.Ref(id)) when $cond ]>] =>
+ TryCase.Filter (Splicable.Name (loc, id), <[ System.Exception ]>, cond, h.body) :: cases
| [PExpr.Wildcard] =>
- PExpr.TryWith (loc, body, Splicable.Name (loc, mkname (Util.tmpname ("u"))),
- <[ System.Exception ]>, h.body)
+ TryCase.Catch (Splicable.Name (loc, mkname (Util.tmpname ("u"))),
+ <[ System.Exception ]>, h.body) :: cases
+
+ | [<[ _ when $cond ]>] =>
+ TryCase.Filter (Splicable.Name (loc, mkname (Util.tmpname ("u"))),
+ <[ System.Exception ]>, cond, h.body) :: cases
| [PExpr.TypeEnforcement (PExpr.Spliced (id), t)] =>
Message.Warning (602, loc, "using ``:'' as a type tests is "
"deprecated, please use ``is'' instead");
- PExpr.TryWith (loc, body, Splicable.Expression (id), t, h.body)
+ TryCase.Catch (Splicable.Expression (id), t, h.body) :: cases
| [PExpr.Is (PExpr.Spliced (id), t)] =>
- PExpr.TryWith (loc, body, Splicable.Expression (loc, id), t, h.body)
+ TryCase.Catch (Splicable.Expression (loc, id), t, h.body) :: cases
+
+ | [<[ $(PExpr.Spliced(id)) is $t when $cond ]>] =>
+ TryCase.Filter (Splicable.Expression (loc, id), t, cond, h.body) :: cases
| _ =>
Message.Error (h.body.Location, "exception catch pattern must"
" be in form of `| e is ExceptionType => handler' or"
- "`| e => handler' for System.Exception"); body
+ "`| e => handler' for System.Exception");
+ cases
}
};
match (get_token ()) {
+ | Token.BracesGroup (Token.LooseGroup (Token.Operator ("..")) as group) =>
+ push_stream (group);
+ match (maybe_parse_ellipsis ()) {
+ | Some (e) =>
+ pop_stream ("catch body");
+ body = PExpr.Try (loc, body, [TryCase.Ellipsis (e)]);
+ | _ => Util.ice ()
+ }
| Token.BracesGroup (group) =>
- body = List.FoldLeft (process_groups (group, "exception handlers", parse_match_case),
- try_body, mktry);
+ def cases = List.FoldLeft (process_groups (group, "exception handlers", parse_match_case),
+ [], mktry);
+ body = PExpr.Try (loc, body, cases.Rev ());
| x => Error (x, "expecting handlers of exceptions")
}
}
- if (flag_sibling_keyword ("finally")) {
+ when (flag_sibling_keyword ("finally")) {
def handler = parse_block ([]);
- PExpr.TryFinally (loc, body, handler)
+ body = PExpr.TryFinally (loc, body, handler);
}
- else {
- if (body == (try_body : object)) {
+ when (body == (try_body : object))
Message.Error (loc, "expecting `catch' or `finally'");
- try_body
- }
- else body
- }
+ body
| Token.Keyword ("def") =>
def parse_define () {
Modified: nemerle/trunk/ncc/parsing/ParseTree.n
==============================================================================
--- nemerle/trunk/ncc/parsing/ParseTree.n (original)
+++ nemerle/trunk/ncc/parsing/ParseTree.n Tue Aug 1 20:09:44 2006
@@ -273,6 +273,7 @@
| DefFunctions { funs : list [Function_decl]; }
| Lambda { decl : Function_decl; }
| Throw { exn : PExpr; }
+ | Try { body : PExpr; cases : list [TryCase]; }
| TryWith { body : PExpr; exn : Splicable; exn_ty : PExpr;
handler : PExpr; }
| TryFinally { body : PExpr; handler : PExpr; }
@@ -441,6 +442,12 @@
public mutable disable_warnings : bool;
}
+ [Record]
+ public variant TryCase {
+ | Catch { exn : Splicable; exn_ty : PExpr; handler : PExpr; }
+ | Filter { exn : Splicable; exn_ty : PExpr; filter : PExpr; handler : PExpr; }
+ | Ellipsis { body : PExpr; }
+ }
public variant SyntaxElement {
| Expression { body : PExpr; }
Modified: nemerle/trunk/ncc/typing/Macros.n
==============================================================================
--- nemerle/trunk/ncc/typing/Macros.n (original)
+++ nemerle/trunk/ncc/typing/Macros.n Tue Aug 1 20:09:44 2006
@@ -614,18 +614,44 @@
| <[ out $e ]> =>
<[ PExpr.ParmOut ($(quoted_expr (e))) ]>
- | <[ try $body catch { $exn is $exn_ty => $handler } ]> =>
+ | PExpr.TryWith (body, exn, exn_ty, handler) =>
def qbody = quoted_expr (body);
- <[ PExpr.TryWith ($qbody, $(quoted_sstring (exn)),
+ <[ PExpr.Try ($qbody, [
+ TryCase.Catch ($(quoted_sstring (exn)),
$(quoted_expr (exn_ty)),
- $(quoted_expr (handler))) ]>
+ $(quoted_expr (handler)))]) ]>
- | <[ try $body finally $handler ]> =>
+ | PExpr.TryFinally (body, handler) =>
assert (body != null);
assert (handler != null);
<[ PExpr.TryFinally ($(quoted_expr (body)),
$(quoted_expr (handler))) ]>
+ | PExpr.Try (body, cases) =>
+ def quoted_case (case) {
+ | TryCase.Catch (exn, exn_ty, handler) =>
+ <[ TryCase.Catch ($(quoted_sstring (exn)),
+ $(quoted_expr (exn_ty)),
+ $(quoted_expr (handler))) ]>
+ | TryCase.Filter (exn, exn_ty, filter, handler) =>
+ <[ TryCase.Filter ($(quoted_sstring (exn)),
+ $(quoted_expr (exn_ty)),
+ $(quoted_expr (filter)),
+ $(quoted_expr (handler))) ]>
+ | TryCase.Ellipsis => Util.ice ("you can have either none or only TryCase.Ellipsis")
+ }
+ def qbody = quoted_expr (body);
+ match (cases) {
+ | [TryCase.Ellipsis (e)] =>
+ match (e) {
+ | PExpr.Ellipsis (e) =>
+ <[ PExpr.Try ($qbody, $(quoted_expr (e))) ]>
+ | _ => Util.ice ("parser generated strange try_case")
+ }
+ | _ =>
+ <[ PExpr.Try ($qbody, [.. $(cases.Map (quoted_case))]) ]>
+ }
+
| PExpr.Literal (lit) => <[ PExpr.Literal ($(quoted_literal (lit))) ]>
| <[ this ]> => <[ PExpr.This () ]>
@@ -928,13 +954,22 @@
| <[ throw $exc ]> =>
<[ throw $(traverse (exc)) ]>
- | <[ try $body catch { $exn is $exn_ty => $handler } ]> =>
- <[ try $(traverse (body)) catch {
- $exn is $exn_ty => $(traverse (handler))
- } ]>
+ | PExpr.TryWith (body, exn, exn_ty, handler) =>
+ PExpr.Try (traverse (body), [TryCase.Catch (exn, exn_ty, traverse (handler))])
- | <[ try $body finally $handler ]> =>
- <[ try $(traverse (body)) finally $(traverse (handler)) ]>
+ | PExpr.TryFinally (body, handler) =>
+ PExpr.TryFinally (traverse (body), traverse (handler))
+
+ | PExpr.Try (body, cases) =>
+ def walk_case (case) {
+ | TryCase.Catch (exn, exn_ty, handler) =>
+ TryCase.Catch (exn, exn_ty, traverse (handler))
+ | TryCase.Filter (exn, exn_ty, filter, handler) =>
+ TryCase.Filter (exn, exn_ty, traverse (filter), traverse (handler))
+ | TryCase.Ellipsis (e) =>
+ TryCase.Ellipsis (traverse (e))
+ }
+ PExpr.Try (traverse (body), cases.Map (walk_case))
| PExpr.Literal => expr
@@ -1057,7 +1092,28 @@
| PExpr.TryWith (body, Splicable.Name (exn), exn_ty, handler)
when exn.Equals (from) =>
- PExpr.TryWith (body, Splicable.Name (to), exn_ty, handler)
+ PExpr.Try (body, [TryCase.Catch (Splicable.Name (to), exn_ty, handler)])
+
+ | PExpr.Try (body, cases) =>
+ mutable changed = false;
+ def walk_case (case) {
+ | TryCase.Catch (Splicable.Name (exn), exn_ty, handler)
+ when exn.Equals (from) =>
+ changed = true;
+ TryCase.Catch (Splicable.Name (to), exn_ty, handler)
+ | TryCase.Filter (Splicable.Name (exn), exn_ty, filter, handler)
+ when exn.Equals (from) =>
+ changed = true;
+ TryCase.Filter (Splicable.Name (to), exn_ty, filter, handler)
+ | TryCase.Catch
+ | TryCase.Filter
+ | TryCase.Ellipsis => case
+ }
+ def cases = cases.Map (walk_case);
+ if (changed)
+ PExpr.Try (body, cases)
+ else
+ e
| _ => e
}
else e
Modified: nemerle/trunk/ncc/typing/TypedTree.n
==============================================================================
--- nemerle/trunk/ncc/typing/TypedTree.n (original)
+++ nemerle/trunk/ncc/typing/TypedTree.n Tue Aug 1 20:09:44 2006
@@ -426,6 +426,13 @@
}
[Record]
+ public variant Try_case
+ {
+ | Catch { exn : LocalValue; handler : TExpr; }
+ | Filter { exn : LocalValue; filter : TExpr; handler : TExpr; }
+ }
+
+ [Record]
public class Match_case
{
public mutable patterns : list [Pattern * TExpr * list [LocalValue * TExpr]];
@@ -489,6 +496,7 @@
| TryFault { body : TExpr; handler : TExpr; }
| TryWith { body : TExpr; exn : LocalValue; handler : TExpr; }
| TryFinally { body : TExpr; handler : TExpr; }
+ | Try { body : TExpr; mutable cases : list [Try_case]; }
| Literal { val : Nemerle.Compiler.Literal; }
| This
| Base { base_ctor : IMethod; }
@@ -931,7 +939,7 @@
null
| TryWith (body, exn, handler) =>
- TryWith (walk (f, body), exn, walk (f, handler))
+ Try (walk (f, body), [Try_case.Catch (exn, walk (f, handler))])
| TryFinally (body, handler) =>
@@ -941,6 +949,12 @@
| TryFault (body, handler) =>
TryFault (walk (f, body), walk (f, handler))
+ | Try (body, cases) =>
+ def walk_case(case) {
+ | Try_case.Catch (exn, handler) => Try_case.Catch (exn, walk (f, handler))
+ | Try_case.Filter (exn, filter, handler) => Try_case.Filter (exn, walk (f, filter), walk (f, handler))
+ }
+ Try (walk (f, body), cases.Map (walk_case))
| TypeConversion (expr, t, kind) =>
def expr = null_walk (f, expr);
Modified: nemerle/trunk/ncc/typing/Typer.n
==============================================================================
--- nemerle/trunk/ncc/typing/Typer.n (original)
+++ nemerle/trunk/ncc/typing/Typer.n Tue Aug 1 20:09:44 2006
@@ -1253,8 +1253,9 @@
}
_ = ExpectSubtyping (expected, handler.Type, "catch body");
- TExpr.TryWith (ImplicitCast (body, expected), decl,
- ImplicitCast (handler, expected))
+ TExpr.Try (ImplicitCast (body, expected), [
+ Try_case.Catch (decl,
+ ImplicitCast (handler, expected))])
| _ =>
ReportFatal (messenger,
@@ -1270,6 +1271,70 @@
TExpr.TryFinally (body, handler)
+ | PT.PExpr.Try as x =>
+ def body = TypeExpr (x.body);
+ if (ExpectSubtyping (expected, body.Type, "try body")) {
+ def type_trycases(cases, acc = []) {
+ match (cases) {
+ | [] => Some (acc.Rev ())
+ | case :: cases =>
+ match (case) {
+ | PT.TryCase.Catch as y =>
+ match(y.exn) {
+ | PT.Splicable.Name (exn) =>
+ def decl = DefineLocal (exn, BindType (y.exn_ty),
+ LocalValue.Kind.ExceptionValue (), false);
+ PushLocals ();
+ def handler =
+ try {
+ AddLocal (exn, decl);
+ TypeExpr (y.handler);
+ } finally {
+ PopLocals ();
+ }
+
+ _ = ExpectSubtyping (expected, handler.Type, "catch body");
+ type_trycases (cases,
+ Try_case.Catch (decl, ImplicitCast (handler, expected)) :: acc)
+ | _ => None ()
+ }
+ | PT.TryCase.Filter as y =>
+ match(y.exn) {
+ | PT.Splicable.Name (exn) =>
+ def decl = DefineLocal (exn, BindType (y.exn_ty),
+ LocalValue.Kind.ExceptionValue (), false);
+ PushLocals();
+ def (filter, handler) =
+ try {
+ AddLocal (exn, decl);
+ (TypeExpr (y.filter), TypeExpr (y.handler));
+ } finally {
+ PopLocals ();
+ }
+
+ def bool_tv = BindType (<[ bool ]>);
+ _ = ExpectSubtyping (bool_tv, filter.Type, "catch filter");
+ _ = ExpectSubtyping (expected, handler.Type, "catch body");
+ type_trycases (cases,
+ Try_case.Filter (decl, ImplicitCast (filter, bool_tv),
+ ImplicitCast (handler, expected)) :: acc)
+ | _ => None ()
+ }
+ | PT.TryCase.Ellipsis =>
+ Util.ice ("List of expression parameters out of quotation")
+ }
+ }
+ }
+ match (type_trycases (x.cases)) {
+ | Some (cases) => TExpr.Try (body, cases) : TExpr
+ | None =>
+ ReportFatal (messenger,
+ "$ operator used outside quotation <[ ... ]> context");
+
+ }
+ } else TExpr.Error ()
+
+
| PT.PExpr.Typeof (t) =>
_ = Expect (expected, InternalType.Type, "typeof result");
TExpr.TypeOf (BindType (t))
@@ -3317,6 +3382,7 @@
| TExpr.Throw => "a throw expression"
| TExpr.TryWith => "a try...with expression"
| TExpr.TryFinally => "a try...finally expression"
+ | TExpr.Try => "a try expression"
| TExpr.Literal => "a literal value"
| TExpr.This => "a this pointer reference"
| TExpr.Base => "a base class reference"
Modified: nemerle/trunk/ncc/typing/Typer2.n
==============================================================================
--- nemerle/trunk/ncc/typing/Typer2.n (original)
+++ nemerle/trunk/ncc/typing/Typer2.n Tue Aug 1 20:09:44 2006
@@ -1159,9 +1159,9 @@
exn.Register ();
current_fun.uses_try_block = true;
- TExpr.TryWith (Walk (Context.AllowGotoAndSuch, body), exn,
- Walk (Context.AllowGotoAndSuch, handler))
-
+ TExpr.Try (Walk (Context.AllowGotoAndSuch, body),
+ [Try_case.Catch (exn,
+ Walk (Context.AllowGotoAndSuch, handler))])
| TExpr.TryFinally (body, handler) =>
unless (ctx %&& Context.AllowTry)
@@ -1173,6 +1173,27 @@
TExpr.TryFinally (Walk (Context.AllowGotoAndSuch, body),
IgnoreExpr (Walk (Context.AllowTry, handler)))
+ | TExpr.Try (body, cases) =>
+ unless (ctx %&& Context.AllowTry)
+ ReportError (messenger,
+ "try block is not allowed inside expressions");
+ def register_case(case) {
+ | Try_case.Catch (exn, _)
+ | Try_case.Filter (exn, _, _) =>
+ exn.Register ();
+ }
+ foreach (case in cases)
+ register_case (case);
+ current_fun.uses_try_block = true;
+
+ def walk_case(case) {
+ | Try_case.Catch (exn, handler) =>
+ Try_case.Catch (exn, Walk (Context.AllowGotoAndSuch, handler))
+ | Try_case.Filter (exn, filter, handler) =>
+ Try_case.Filter (exn, Walk (Context.AllowGotoAndSuch, filter),
+ Walk (Context.AllowGotoAndSuch, handler))
+ }
+ TExpr.Try (Walk (Context.AllowGotoAndSuch, body), cases.Map (walk_case))
| TExpr.Literal (Literal.Integer as i) =>
def t = expr.Type.Fix ();
Modified: nemerle/trunk/tools/contracts/Nemerle.Contracts.n
==============================================================================
--- nemerle/trunk/tools/contracts/Nemerle.Contracts.n (original)
+++ nemerle/trunk/tools/contracts/Nemerle.Contracts.n Tue Aug 1 20:09:44 2006
@@ -1918,7 +1918,7 @@
append ("try {\n");
recurse_and_indent (body);
append ("\n" + indentation + "} catch {\n " + indentation + exn.Name + " : ");
- append (exn.Type.ToString () );
+ append (exn.Type.ToString ());
append (" =>\n");
recurse_and_indent (handler);
append ("\n" + indentation + "}")
@@ -1930,6 +1930,27 @@
recurse_and_indent (handler);
append ("\n" + indentation + "}")
+ | TT.TExpr.Try (body, cases) =>
+ append ("try {\n");
+ recurse_and_indent (body);
+ append ("\n" + indentation + "} catch {");
+ def print_case (case) {
+ | TT.Try_case.Catch (exn, handler) =>
+ append ("\n " + indentation + "| " + exn.Name + " is ");
+ append (exn.Type.ToString ());
+ append (" =>\n");
+ recurse_and_indent (handler);
+ | TT.Try_case.Filter (exn, filter, handler) =>
+ append ("\n " + indentation + "| " + exn.Name + " is ");
+ append (exn.Type.ToString ());
+ append (" when (");
+ recurse (filter);
+ append (") =>\n");
+ recurse_and_indent (handler);
+ }
+ foreach (case in cases)
+ print_case (case);
+ append ("\n" + indentation + "}");
// 'this' and 'base' objects
| TT.TExpr.This =>
More information about the svn
mailing list