[svn] r5873: nemerle/trunk/ncc: CompilationOptions.n Makefile
external/InternalTypes.n generation/Decision...
nazgul
svnadmin at nemerle.org
Wed Nov 2 22:15:08 CET 2005
Log:
New matching engine by Marcin Grzeskowiak
Author: nazgul
Date: Wed Nov 2 22:15:06 2005
New Revision: 5873
Added:
nemerle/trunk/ncc/generation/DecisionTreeCompiler.n
nemerle/trunk/ncc/testsuite/positive/new-matching-as.n
nemerle/trunk/ncc/testsuite/positive/new-matching-enums.n
nemerle/trunk/ncc/testsuite/positive/new-matching-null.n
nemerle/trunk/ncc/testsuite/positive/new-matching-shared.n
Modified:
nemerle/trunk/ncc/CompilationOptions.n
nemerle/trunk/ncc/Makefile
nemerle/trunk/ncc/external/InternalTypes.n
nemerle/trunk/ncc/generation/Typer3.n
nemerle/trunk/ncc/misc/PrettyPrint.n
nemerle/trunk/ncc/testsuite/Makefile
nemerle/trunk/ncc/testsuite/frommcs/test-234.n
nemerle/trunk/ncc/testsuite/positive/matching.n
nemerle/trunk/ncc/testsuite/test.n
nemerle/trunk/ncc/typing/DecisionTreeBuilder.n
nemerle/trunk/ncc/typing/TypedTree.n
nemerle/trunk/ncc/typing/Typer.n
Modified: nemerle/trunk/ncc/CompilationOptions.n
==============================================================================
--- nemerle/trunk/ncc/CompilationOptions.n (original)
+++ nemerle/trunk/ncc/CompilationOptions.n Wed Nov 2 22:15:06 2005
@@ -38,6 +38,9 @@
public mutable XmlDoc : bool;
public mutable DumpTypedTree : bool;
public mutable DumpNamedMethod : string;
+ public mutable DumpDecisionTree : bool;
+ public mutable NewMatchingCompiler : bool;
+ public mutable BuildDecisionDAG : bool;
public mutable AdditionalDebug : bool;
public mutable TargetIsLibrary : bool;
public mutable TargetIsWinexe : bool;
@@ -99,8 +102,10 @@
DumpNamedMethod = "";
AdditionalDebug = false;
PersistentLibraries = false;
+ NewMatchingCompiler = false;
+ BuildDecisionDAG = true;
+ DumpDecisionTree = false;
IndentationSyntax = false;
-
LinkedResources = [];
EmbeddedResources = [];
ReferencedLibraries = [];
@@ -428,6 +433,16 @@
help = "Enable general tail call optimization (programs are slower on MS.NET, but faster on Mono)",
handler = fun () { Options.GeneralTailCallOpt = true }),
+ Getopt.CliOption.Flag (name = "-new-matching",
+ aliases = [],
+ help = "NOHELP",
+ handler = fun () { Options.NewMatchingCompiler = true }),
+
+ Getopt.CliOption.Flag (name = "-disable-decision-dag-opt",
+ aliases = ["-no-dag"],
+ help = "NOHELP",
+ handler = fun () { Options.BuildDecisionDAG = false }),
+
Getopt.CliOption.String (name = "-disable-keyword",
aliases = ["-no-keyword"],
help = "Prevent given identifiers from being reserved as keywords"
@@ -491,6 +506,13 @@
Options.DumpNamedMethod = s;
}),
+ Getopt.CliOption.Flag (name = "-dump-decision-trees",
+ aliases = ["-dd"],
+ help = "NOHELP",
+ handler = fun () {
+ Options.DumpDecisionTree = true;
+ }),
+
Getopt.CliOption.Flag (name = "-boolean-constant-matching-opt",
aliases = ["-Obcm"],
help = "NOHELP",
Modified: nemerle/trunk/ncc/Makefile
==============================================================================
--- nemerle/trunk/ncc/Makefile (original)
+++ nemerle/trunk/ncc/Makefile Wed Nov 2 22:15:06 2005
@@ -83,6 +83,7 @@
generation/ILEmitter.n \
generation/ImplementsWrapperMaker.n \
generation/MatchingCompiler.n \
+ generation/DecisionTreeCompiler.n \
generation/Typer3.n \
generation/Typer4.n \
hierarchy/BuiltinMethod.n \
Modified: nemerle/trunk/ncc/external/InternalTypes.n
==============================================================================
--- nemerle/trunk/ncc/external/InternalTypes.n (original)
+++ nemerle/trunk/ncc/external/InternalTypes.n Wed Nov 2 22:15:06 2005
@@ -254,6 +254,13 @@
static name = ["Nemerle", "Builtins", "Tuple"] : list [string];
+ public static IsTupleMember (ty : IMember) : bool
+ {
+ def dt = ty.DeclaringType;
+ def typarms = dt.TyparmsCount;
+ typarms > 1 && dt.Equals (InternalType.GetTupleType (typarms).tycon)
+ }
+
internal this (size : int)
{
tycon = NamespaceTree.LookupInternalType (name, size);
Added: nemerle/trunk/ncc/generation/DecisionTreeCompiler.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/generation/DecisionTreeCompiler.n Wed Nov 2 22:15:06 2005
@@ -0,0 +1,358 @@
+/*
+ * Copyright (c) 2005 The University of Wroclaw.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. The name of the University may not be used to endorse or promote
+ * products derived from this software without specific prior
+ * written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+ * NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+ * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+using Nemerle.Compiler.Typedtree;
+using Nemerle.Collections;
+
+namespace Nemerle.Compiler
+{
+ class DecisionTreeCompiler
+ {
+ type Path = DecisionTreeBuilder.Path;
+ type Decision = DecisionTreeBuilder.Decision;
+
+ // DAGs created by DecisionTreeBuilder can still contain
+ // repeated nodes since DTB ignores or-patterns
+ // this class is used to ensure that all shared effects
+ // are discovered
+ class SharedEffect
+ {
+ body : TExpr;
+ mutable label_id : option [int];
+
+ public this (body : TExpr)
+ {
+ this.body = body;
+ this.label_id = None ();
+ }
+
+ public GetExpr () : TExpr
+ {
+ match (label_id) {
+ | Some (id) => TExpr.Goto (id, 1);
+ | None =>
+ def id = Util.next_id ();
+ label_id = Some (id);
+ TExpr.Label (body.loc, body.Type, id, body);
+ }
+ }
+
+ public GetExpr (assigns : list [LocalValue * TExpr]) : TExpr
+ {
+ def effect_expr = GetExpr ();
+ if (assigns.IsEmpty) effect_expr
+ else
+ assigns.FoldRight (effect_expr, fun (assign, acc) {
+ def (name, value) = assign;
+ Util.locate (value.loc,
+ TExpr.Sequence (effect_expr.Type,
+ TExpr.Assign (InternalType.Void,
+ TExpr.LocalRef (name.Type, name),
+ value),
+ acc))
+ })
+ }
+ }
+
+ tyvar : TyVar;
+ val : TExpr;
+ cases : list [Match_case];
+
+ decision : Decision;
+
+ mutable effects : array [void -> TExpr];
+ mutable guards : array [TExpr];
+
+ public this (t : TyVar, val : TExpr, mcs : list [Match_case])
+ {
+ this.tyvar = t;
+ this.val = val;
+ this.cases = mcs;
+
+ def builder = DecisionTreeBuilder (mcs);
+
+ def disable_warnings = mcs.Exists (fun (mc) { mc.disable_warnings == true });
+
+ when (!disable_warnings && Passes.Solver.CurrentMessenger.NeedMessage)
+ builder.CheckMatching();
+
+ List.Iter (mcs, Typer.FixupMatchCase);
+
+ decision = builder.GetDecision ();
+
+ when (Options.DumpDecisionTree)
+ Message.Debug ($ "decision tree"
+ "$(dag_to_string (decision))\n"
+ "$(get_stats (decision))\n");
+
+ collect_effects_and_guards ()
+ }
+
+ collect_effects_and_guards () : void
+ {
+ def walk_cases (i, cases)
+ {
+ match (cases) {
+ | case0 :: rest =>
+ def effect = SharedEffect (case0.body);
+ walk_patterns (i, effect, case0.patterns, rest)
+ | _ =>
+ effects = array (i);
+ guards = array (i)
+ }
+ }
+ and walk_patterns (i, effect, patterns, cases)
+ {
+ match (patterns) {
+ | (_, guard, assigns) :: rest =>
+ walk_patterns (i+1, effect, rest, cases);
+ effects[i] = fun () { effect.GetExpr (assigns) };
+ guards[i] = guard
+ | _ => walk_cases (i, cases)
+ }
+ }
+ assert (cases is _ :: _);
+ walk_cases (0, cases)
+ }
+
+ /** Generate TExpr tree for decision tree stored in this matching compiler. */
+ public Run() : TExpr
+ {
+ compile (decision)
+ }
+
+ /** Build and compile decision tree for the given matching instance. */
+ public static Run (t : TyVar, val : TExpr,
+ mcs : list [Match_case]) : TExpr
+ {
+ def compiler = DecisionTreeCompiler (t, val, mcs);
+ compiler.Run ()
+ }
+
+ // check if node has already been compiled and either reuse
+ // memoized TExpr or call compile2() to generate a new one
+ compile (decision : Decision) : TExpr
+ {
+ // for effects SharedEffect class is used to detect reusable nodes
+ | Decision.Success => compile2 (decision)
+
+ | _ when decision.IsShared =>
+ match (decision.LabelId) {
+ | None =>
+ def label_id = Util.next_id ();
+ decision.LabelId = Some (label_id);
+ def expr = compile2 (decision);
+ TExpr.Label (expr.loc, expr.Type, label_id, expr)
+ | Some (id) =>
+ TExpr.Goto (id, 1)
+ }
+
+ | _ => compile2 (decision)
+ }
+
+
+ compile2 (decision : Decision) : TExpr
+ {
+ | Success (res_id) => effects [res_id] ()
+
+ | Failure => MatchingCompiler.ThrowMatchFailure ()
+
+ | Assign (path, decl, dtree) =>
+ def path_expr = get_path_expression (path);
+ def assign_expr = TExpr.Assign (TExpr.LocalRef (decl.Type, decl),
+ MatchingCompiler.Cast (path_expr, decl.Type));
+ def expr = compile (dtree);
+ MatchingCompiler.Sequence (assign_expr, expr)
+
+ | IfEq (_, DecisionTreeBuilder.Con.Guard,
+ Decision.Success (res_id) as if_true, if_false) =>
+ def true_expr = compile (if_true);
+ def false_expr = compile (if_false);
+ MatchingCompiler.If (guards [res_id], true_expr, false_expr)
+
+ | IfEq (path, con, if_true, if_false) =>
+ def path_expr = get_path_expression (path);
+ def true_expr = compile (if_true);
+ def false_expr = compile (if_false);
+ match (con)
+ {
+ | Variant (ti) =>
+ def constant_object =
+ if (ti.GetConstantObject () != null)
+ MatchingCompiler.get_constant_object (ti, path_expr.Type)
+ else
+ None ();
+
+ match (constant_object) {
+ | Some ((from, field)) =>
+ def sref = TExpr.StaticRef (from, from, field, []);
+ def cond = TExpr.Call (InternalType.Boolean, TExpr.OpCode ("==.ref"),
+ [Parm (path_expr), Parm (sref)], false);
+ MatchingCompiler.If (cond, true_expr, false_expr)
+
+ | None =>
+ def has_type_expr = MatchingCompiler.HasType (path_expr, ti);
+ MatchingCompiler.If (has_type_expr, true_expr, false_expr)
+ }
+
+ | Lit (lit) =>
+ def cmp_expr = MatchingCompiler.emit_compare_with (path_expr, lit);
+ MatchingCompiler.If (cmp_expr, true_expr, false_expr)
+
+ | Type (ti) =>
+ def has_type_expr = MatchingCompiler.HasType (path_expr, ti);
+ MatchingCompiler.If (has_type_expr, true_expr, false_expr)
+
+ | _ => assert (false);
+ }
+ }
+
+ // memoize calls to build_path_expression ()
+ get_path_expression (path : Path) : TExpr
+ {
+ when (path.AccessExpr == null)
+ path.AccessExpr = build_path_expression (path);
+ path.AccessExpr
+ }
+
+ // construct TExpr that will load object referenced by path on
+ // the VM stack
+ build_path_expression (path : Path) : TExpr
+ {
+ | Here => val
+
+ | Field (f, p) =>
+ def p_expr = get_path_expression (p);
+
+ def val =
+ if (f.DeclaringType.GetTydecl () is TypeDeclaration.VariantOption) {
+ def ty = f.DeclaringType.GetFreshType ();
+ p_expr.Type.ForceProvide (ty);
+ MatchingCompiler.Cast (p_expr, ty)
+ } else p_expr;
+
+ if (TupleType.IsTupleMember (f)) {
+ def len = f.DeclaringType.TyparmsCount;
+ mutable pos = int ();
+ Nemerle.IO.sscanf (f.Name, "field%i", pos);
+ TExpr.TupleIndexer (path.Type, val, pos, len)
+ } else MatchingCompiler.build_record_field_ref (path.Type, val, f)
+ }
+
+ static get_stats (decision : Decision) : string
+ {
+ mutable num_nodes = 0;
+ mutable num_shared = 0;
+ def shared_nodes = Hashtable ();
+ mutable all_paths_length = 0;
+ mutable num_paths = 0;
+ mutable longest_path = 0;
+
+ def make_stats (decision : Decision, path_len,
+ mutable was_here_before)
+ {
+ when (! was_here_before)
+ if (! shared_nodes.Contains (decision)) {
+ ++ num_nodes;
+ when (decision.IsShared) {
+ ++ num_shared;
+ shared_nodes.Add (decision, decision)
+ }
+ } else was_here_before = true;
+
+ match (decision) {
+ | IfEq (_, _, tr, fl) =>
+ make_stats (tr, path_len + 1, was_here_before);
+ make_stats (fl, path_len + 1, was_here_before)
+ | Assign (_, _, dtree) =>
+ make_stats (dtree, path_len + 1, was_here_before)
+ | _ => // leaf
+ all_paths_length += path_len;
+ ++ num_paths;
+ when (path_len > longest_path)
+ longest_path = path_len
+ }
+ }
+
+ make_stats (decision, 1, false);
+ $ "Number of nodes: $(num_nodes)\n"
+ "Number of shared nodes: $(num_shared)\n"
+ "Number of paths: $(num_paths)\n"
+ "Length of the longest path: $(longest_path)\n"
+ "Average length of a path: $(all_paths_length / num_paths)"
+ }
+
+ // pretty-print a decision dag
+ // this function recognizes shared nodes in dag and prints each such
+ // node only once (in contrast to decision.ToString ())
+ static dag_to_string (decision : Decision) : string
+ {
+ def shared_nodes = Hashtable ();
+ mutable id = 0;
+
+ def to_string (decision : Decision, indent)
+ {
+ match (shared_nodes.Get (decision)) {
+ | Some (id) =>
+ if (Options.ColorMessages)
+ $"$(indent)\e[01;34m-> *$(id)*\e[0m\n"
+ else $"$(indent)-> *$(id)*\n"
+
+ | None =>
+ def ids =
+ if (decision.IsShared) {
+ ++ id;
+ shared_nodes.Add (decision, id);
+ if (Options.ColorMessages)
+ $" \e[01;34m(*$(id)*)\e[0m\n"
+ else
+ $" (*$(id)*)\n"
+ } else "\n";
+
+ match (decision) {
+ | Success (res) =>
+ $"$(indent)success $res $ids"
+ | Failure =>
+ $"$(indent)failure $ids"
+ | Assign (path, decl, dtree) =>
+ def i2 = indent + " ";
+ $"$(indent)def $(decl.Name) = $path $ids"
+ "$(to_string (dtree, i2))"
+ | IfEq (path, con, tr, fl) =>
+ def i2 = indent + " ";
+ $"$(indent)if $path = $con: $ids"
+ "$(to_string(tr, i2))"
+ "$(indent)else:\n"
+ "$(to_string(fl, i2))"
+ }
+ }
+ }
+ "\n" + to_string (decision, "")
+ }
+ }
+}
Modified: nemerle/trunk/ncc/generation/Typer3.n
==============================================================================
--- nemerle/trunk/ncc/generation/Typer3.n (original)
+++ nemerle/trunk/ncc/generation/Typer3.n Wed Nov 2 22:15:06 2005
@@ -1305,16 +1305,22 @@
| _ => false
}
+ def match_comp =
+ if (Options.NewMatchingCompiler)
+ DecisionTreeCompiler.Run (m.Type, _, m.cases)
+ else
+ MatchingCompiler.Run (m.Type, _, m.cases);
+
def expr =
match (m.cases) {
- | [([(p1, TExpr.Literal (Bool (true)), [])], _),
- ([(p2, TExpr.Literal (Bool (true)), [])], _)]
+ | [([(p1, TExpr.Literal (Bool (true)), [])], _, _),
+ ([(p2, TExpr.Literal (Bool (true)), [])], _, _)]
when is_bool_pattern (p1) && is_bool_pattern (p2) =>
// don't cache
- MatchingCompiler.Run (m.Type, m.expr, m.cases)
+ match_comp (m.expr)
| _ =>
WithCached (m.expr, fun (e) {
- MatchingCompiler.Run (m.Type, e, m.cases)
+ match_comp (e)
});
}
Modified: nemerle/trunk/ncc/misc/PrettyPrint.n
==============================================================================
--- nemerle/trunk/ncc/misc/PrettyPrint.n (original)
+++ nemerle/trunk/ncc/misc/PrettyPrint.n Wed Nov 2 22:15:06 2005
@@ -575,7 +575,7 @@
def print_match_cases (cases : list [TT.Match_case])
{
- | TT.Match_case where (patterns, body) :: rest =>
+ | TT.Match_case where (patterns, body, _) :: rest =>
print_patterns (patterns);
recurse_and_indent (body);
append ("\n");
Modified: nemerle/trunk/ncc/testsuite/Makefile
==============================================================================
--- nemerle/trunk/ncc/testsuite/Makefile (original)
+++ nemerle/trunk/ncc/testsuite/Makefile Wed Nov 2 22:15:06 2005
@@ -59,7 +59,7 @@
rm -f *.dll *.mdb *.pdb *.exe xml-*.xml *.netmodule ext_test.out test_out.txt
test: test.exe $(NEM_DLLS)
- $(EXECUTE) ./test.exe -s -r "$(EXECUTE)" -p "$(NEM_FLAGS) $(ADDITIONAL_FLAGS)" \
+ $(EXECUTE) ./test.exe -s -r "$(NET_ENGINE)" -rp " $(NET_FLAGS)" -p "$(NEM_FLAGS) $(ADDITIONAL_FLAGS)" \
-verify "$(VERIFY)" $(TEST_FILES)
test.exe: test.n
Modified: nemerle/trunk/ncc/testsuite/frommcs/test-234.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/frommcs/test-234.n (original)
+++ nemerle/trunk/ncc/testsuite/frommcs/test-234.n Wed Nov 2 22:15:06 2005
@@ -73,7 +73,7 @@
| E.E29=> s = "case 29"; ();
| E.E30=> s = "case 30"; ();
| E.E31=> s = "case 31"; ();
- | _ => () // W: this match clause is unused
+ | _ => ()
}
System.Console.WriteLine (s);
}
Modified: nemerle/trunk/ncc/testsuite/positive/matching.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/positive/matching.n (original)
+++ nemerle/trunk/ncc/testsuite/positive/matching.n Wed Nov 2 22:15:06 2005
@@ -1159,13 +1159,13 @@
| _x is RedBlackTree.Red => printf ("good1\n")
| _x is RedBlackTree.Black => printf ("bad1a\n")
| RedBlackTree.Leaf => printf ("bad1b\n")
- | _ => printf ("bad1c\n")// W: unused
+ | _ => printf ("bad1c\n")
}
match (RedBlackTree.Leaf (0) : RedBlackTree) {
| _x is RedBlackTree.Red => ()
| _x is RedBlackTree.Black => ()
| RedBlackTree.Leaf => System.Console.WriteLine ("good2")
- | _ => ()// W: unused
+ | _ => ()
}
match (MyVari.B() : MyVari) {
| _x is MyVari.B => printf ("good3\n")
Added: nemerle/trunk/ncc/testsuite/positive/new-matching-as.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/new-matching-as.n Wed Nov 2 22:15:06 2005
@@ -0,0 +1,60 @@
+
+variant V {
+ | Keyword { name : string; }
+ | SquareGroup { mutable child : V; }
+
+ public override ToString () : string
+ {
+ match (this) {
+ | Keyword (name) => "Keyword(" + name + ")"
+ | SquareGroup (child) => "SquareGroup[" + child.ToString () + "]"
+ }
+ }
+}
+
+variant W {
+ | Method { f_implements : list [string] }
+ | Constructor
+}
+
+
+public module M
+{
+ /* Simplified version of code from Nemerle.Compiler.MainParser.ParseTopLevel ()
+ that disclosed a rather subtle bug in DecisionTreeBuilder.n modified for
+ new matching compiler.
+ The problem was with Decision.As () generated for 'as' in second case, which
+ throught Failure paths got propagated to the third case resulting in
+ an invalid cast ('v' to SquareGroup before assignment) whenever 'v' was
+ not a SquareGroup. */
+ voo (v : V) : string
+ {
+ | SquareGroup (null) => "null " + v.ToString ()
+ | SquareGroup as square => square.ToString ()
+ | _ => "some V"
+ }
+
+ /* First solution to the problem described above also didn't work -- testcase
+ is a simplified version of code from Nemerle.Compiler.MethodBuilder.this ()
+ (ncc/hierarchy/ClassMembers.n) */
+ goo (w : W, name : string) : string
+ {
+ | (W.Method ([]), _) when false => "1"
+ | (W.Method (_ :: _ as _impl), _) => "2"
+ | (_x, _) => "3"
+ }
+
+ public Main () : void
+ {
+ System.Console.WriteLine (voo (V.Keyword ("public")));
+ System.Console.WriteLine (goo (W.Method ([]), "goo"));
+ }
+}
+
+
+/*
+BEGIN-OUTPUT
+some V
+3
+END-OUTPUT
+*/
Added: nemerle/trunk/ncc/testsuite/positive/new-matching-enums.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/new-matching-enums.n Wed Nov 2 22:15:06 2005
@@ -0,0 +1,103 @@
+
+enum E1
+{
+ | Red = 0xFF0000
+ | Green = 0x00FF00
+ | Blue = 0x0000FF
+}
+
+[System.Flags]
+enum E2
+{
+ | Red = 0xFF0000
+ | Green = 0x00FF00
+ | Blue = 0x0000FF
+}
+
+module M
+{
+ // When span of E1 is defined as 3 (number of named constants) in
+ // DecisionTreeBuilder.n then the decision tree generated for foo
+ // doesn't contain Decision.Failure node. Then foo(E1.Red | E1.Blue)
+ // returns ``Blue'' instead of throwing MatchFailureException.
+ foo (e : E1) : string
+ {
+ try {
+ match (e) { // OK
+ | Red => "Red"
+ | Green => "Green"
+ | Blue => "Blue"
+ }
+ } catch {
+ | _ is MatchFailureException => "exception"
+ }
+ }
+
+ // This shows why span of E1 can't be 4 (number of named constants + 1)
+ // and must be infinite (or -1). Althought 4 would work for foo () here
+ // it would still make Decision.Failure missing in the tree.
+ voo (e : E1) : string
+ {
+ try {
+ match (e) { // OK
+ | Red => "Red"
+ | Green => "Green"
+ | Blue => "Blue"
+ | E1.Red %| E1.Green => "Yellow"
+ }
+ } catch {
+ | _ is MatchFailureException => "exception"
+ }
+ }
+
+ // This is for comparison that we get same results for enums with and
+ // without System.Flags attribute.
+ goo (e : E2) : string
+ {
+ try {
+ match (e) { // W: matching is not exhaustive
+ | Red => "Red"
+ | Green => "Green"
+ | Blue => "Blue"
+ }
+ } catch {
+ | _ is MatchFailureException => "exception"
+ }
+ }
+
+ public Main () : void
+ {
+ match (E1.Red : E1) { // W: matching is not exhaustive, example unmatched value: Blue
+ | Green => System.Console.WriteLine ("Green")
+ | Red => System.Console.WriteLine ("Red")
+ }
+
+ System.Console.WriteLine (foo (E1.Red));
+ System.Console.WriteLine (foo (E1.Blue));
+ System.Console.WriteLine (foo (E1.Red | E1.Blue));
+
+ System.Console.WriteLine (voo (E1.Green));
+ System.Console.WriteLine (voo (E1.Red | E1.Green));
+ System.Console.WriteLine (voo (E1.Green | E1.Blue));
+
+ System.Console.WriteLine (goo (E2.Red));
+ System.Console.WriteLine (goo (E2.Green));
+ System.Console.WriteLine (goo (E2.Red | E2.Green));
+ }
+}
+
+/*
+BEGIN-OUTPUT
+Red
+Red
+Blue
+exception
+Green
+Yellow
+exception
+Red
+Green
+exception
+END-OUTPUT
+*/
+
Added: nemerle/trunk/ncc/testsuite/positive/new-matching-null.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/new-matching-null.n Wed Nov 2 22:15:06 2005
@@ -0,0 +1,212 @@
+using System;
+
+variant V
+{
+ | A { a : V; b : V; }
+ | B
+
+ public override ToString () : string
+ {
+ match (this) {
+ | A (a, b) => "A(" + a.ToString () + ", " + b.ToString () + ")"
+ | B => "B"
+ }
+ }
+}
+
+public variant Color
+{
+ | R
+ | G
+ | B
+
+ [Nemerle.OverrideObjectEquals]
+ public Equals (c : Color) : bool
+ {
+ match ((this, c)) {
+ | (R, R)
+ | (G, G)
+ | (B, B) => true
+ | _ => false
+ }
+ }
+}
+
+class K
+{
+ public Prop : Color {
+ get { Color.R() }
+ }
+
+ public PropNull : Color {
+ get { null }
+ }
+}
+
+
+public module NewMatchingWithNulls
+{
+ /* no warnings here that matching is not exhaustive (all counter-examples must
+ contain null values) */
+ public foo (ccc : Color * Color * Color) : string // OK
+ {
+ | (R, _, _) => "1" // OK
+ | (_, R, _) => "2" // OK
+ | (_, _, R) => "3" // OK
+ | (B, B, B) => "4" // OK
+ | (_, _, G) => "5" // OK
+ | (G, _, _) => "6" // OK
+ | (_, G, _) => "7" // OK
+ }
+
+ public Main () : void
+ {
+ def print_exception (e : Exception, ids) {
+ match (e) {
+ | _ is MatchFailureException =>
+ System.Console.WriteLine (ids + ": match failure")
+ | _ is NullReferenceException =>
+ System.Console.WriteLine (ids + ": null reference")
+ | _ => System.Console.WriteLine (ids + ": unknown exception")
+ }
+ }
+
+ def x : V = null;
+
+ match (x) {
+ | A => {} // OK
+ | _ => {} // OK
+ | null => {} // W: this match clause is unused
+ }
+
+ match (x) {
+ | A => {} // OK
+ | B => {} // OK
+ | null => {} // OK
+ | _ => {} // W: this match clause is unused
+ }
+
+ match (x) { // OK
+ | null => {} // OK
+ | A => {} // OK
+ | null => {} // W: this match clause is unused
+ | B => {} // OK
+ }
+
+ try {
+ match (V.A (null, V.B ()) : V) { // W: matching is not exhaustive
+ | B => {} // OK
+ | A (B, _) => {} // OK
+ | A (A, A) => {} // OK
+ | A (null, A) => {} // OK
+ }
+ } catch {
+ // expected "match failure"
+ | e => print_exception (e, "1")
+ }
+
+ match (x) { // OK
+ | A => Console.WriteLine ("A")
+ | _ => Console.WriteLine ("other than A")
+ }
+
+ try {
+ match (x) { // OK
+ | A => Console.WriteLine ("A")
+ | x => Console.WriteLine (x.ToString ())
+ }
+ } catch {
+ // expected "null reference"
+ | e => print_exception (e, "2")
+ }
+
+ try {
+ match (x) { // OK
+ | A => {}
+ | B => {}
+ }
+ } catch {
+ // expected "match failure"
+ | e => print_exception (e, "3")
+ }
+
+ try {
+ match ((V.A (V.B (), V.B ()), null) : V * V) { // OK
+ | (A, A) => {} // OK
+ | (A, B) => {} // OK
+ | (B, null) => {} // OK
+ | (B, _) => {} // OK
+ }
+ } catch {
+ // expected "match failure"
+ | e => print_exception (e, "4")
+ }
+
+ def k : K = null;
+
+ try {
+ match (k) { // OK
+ | _ : K => {} // OK
+ }
+ } catch {
+ // expected -- no exception
+ | e => print_exception (e, "5")
+ }
+
+ try {
+ match (k) { // OK
+ | K where (Prop = Color.R ()) => {}
+ | _ => {}
+ }
+ } catch {
+ // expected "null reference"
+ | e => print_exception (e, "6")
+ }
+
+ def k = K ();
+
+ try {
+ match (k) { // OK
+ | K where (PropNull = null) => {}
+ | _ => {}
+ }
+ } catch {
+ // expected -- no exception
+ | e => print_exception (e, "7")
+ }
+
+ System.Console.WriteLine (foo ((Color.R (), null, Color.G ())));
+ System.Console.WriteLine (foo ((null, null, Color.G ())));
+
+ try {
+ System.Console.WriteLine (foo ((null, null, Color.B ())))
+ } catch {
+ // expected "match failure"
+ | e => print_exception (e, "8")
+ }
+
+ try {
+ System.Console.WriteLine (foo ((null, null, null)))
+ } catch {
+ // expected "match failure"
+ | e => print_exception (e, "9")
+ }
+
+ }
+}
+
+
+/*
+BEGIN-OUTPUT
+1: match failure
+other than A
+2: null reference
+3: match failure
+4: match failure
+6: null reference
+1
+5
+8: match failure
+9: match failure
+END-OUTPUT
+*/
Added: nemerle/trunk/ncc/testsuite/positive/new-matching-shared.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/new-matching-shared.n Wed Nov 2 22:15:06 2005
@@ -0,0 +1,67 @@
+/* some test cases for algorithm that turns decision tree into decision DAG */
+
+module M
+{
+ foo (a : int, b : int) : void
+ {
+ def n =
+ match ((a, b))
+ {
+ | (1, 1) => 1
+ | (1, 2) with y = 2
+ | (2, 1) with y = 4 => y
+ | (a, b) when (a < b) => a + b
+ | (2, 2) with x = 8
+ | (a, b) when (a > b) with x = 16 => x
+ | _ => 3
+ };
+ System.Console.WriteLine (n.ToString ())
+ }
+
+ goo (x : list [int] * list [int]) : void
+ {
+ def n =
+ match (x) {
+ | ([1,2], _) => 0
+ | (_, [1,2]) => 1
+ | _ => 2
+ };
+ System.Console.WriteLine (n.ToString ())
+ }
+
+ public Main () : void
+ {
+ foo (1, 1);
+ foo (1, 2);
+ foo (2, 1);
+ foo (2, 2);
+ foo (0, 1);
+ foo (1, 0);
+ foo (3, 3);
+ goo (([1,2], [1,2]));
+ goo (([1,3], [1,2]));
+ goo (([1,2,3], [1,2]));
+ goo (([], []));
+ goo (([], [1,2]));
+ goo (([], [1,2,3]));
+ }
+}
+
+/*
+BEGIN-OUTPUT
+1
+2
+4
+8
+1
+16
+3
+0
+1
+1
+2
+1
+2
+END-OUTPUT
+*/
+
Modified: nemerle/trunk/ncc/testsuite/test.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/test.n (original)
+++ nemerle/trunk/ncc/testsuite/test.n Wed Nov 2 22:15:06 2005
@@ -52,6 +52,7 @@
public static mutable peverify : string = "";
private dnet_runtime : string;
+ private runtime_parms : list [string];
private parameters : list [string];
private dlls : list [string];
private nem_runtime : string;
@@ -80,12 +81,14 @@
private mutable no_verify : bool;
mutable final_message : string;
- public this (dnet_runtime : string, parms : list [string],
- dlls : list [string], nem_comp : string, verbose : int,
+ public this (dnet_runtime : string, runtime_parms : list [string],
+ parms : list [string], dlls : list [string],
+ nem_comp : string, verbose : int,
external_compiler : bool)
{
this.dnet_runtime = dnet_runtime;
+ this.runtime_parms = runtime_parms;
this.parameters = parms;
this.dlls = dlls;
this.nem_runtime = nem_comp;
@@ -251,7 +254,7 @@
nem_compile = Process ();
if (dnet_runtime.Length > 0) {
nem_compile.StartInfo.FileName = dnet_runtime;
- args = nem_runtime :: args;
+ args = nem_runtime :: (runtime_parms + args);
} else {
nem_compile.StartInfo.FileName = nem_runtime;
}
@@ -279,7 +282,7 @@
// gotta read output *first*, and then wait for process to exit
// otherwise pipe buffer overflows
nem_output = read_output ([]);
- unless (nem_compile.WaitForExit (20000))
+ unless (nem_compile.WaitForExit (20000) || nem_compile.HasExited)
nem_compile.Kill ();
exit_code = nem_compile.ExitCode;
} else {
@@ -397,7 +400,7 @@
def _ = verifier.Start ();
def _stdout = verifier.StandardOutput.ReadToEnd ();
def _stderr = verifier.StandardError.ReadToEnd ();
- unless (verifier.WaitForExit (20000))
+ unless (verifier.WaitForExit (20000) || verifier.HasExited)
verifier.Kill ();
when (verifier.ExitCode != 0) {
print (_stdout);
@@ -451,7 +454,7 @@
// gotta read output *first*, and then wait for process to exit
// otherwise pipe buffer overflows
def out_list = read_output ([]);
- unless (runtime.WaitForExit (20000))
+ unless (runtime.WaitForExit (20000) || runtime.HasExited)
runtime.Kill ();
def CheckOutput (in_list : list [string], out_list : list [string], is_ok : bool) : bool
@@ -642,6 +645,7 @@
public static Main () : int
{
mutable dnet_env = "";
+ mutable runtime_parms = [];
mutable nem_comp = "ncc.exe";
mutable dlls = [];
mutable verbose = 0;
@@ -684,6 +688,11 @@
aliases = ["-runtime"],
help = "use this .Net runtime engine (default : none) ",
handler = fun (s) { dnet_env = (s : String).Trim (); }),
+ Getopt.CliOption.String (name = "-rp",
+ aliases = ["-runtime-params"],
+ help = "parameters passed to the .Net runtime (default : none)",
+ handler =
+ fun (s) { runtime_parms = runtime_parms + split_opt (s) }),
Getopt.CliOption.Flag (name = "-v",
aliases = ["-verbose"],
help = "prints all Nemerle output (default : off) ",
@@ -702,7 +711,8 @@
];
Getopt.Parse (opts);
- def tester = Tester (dnet_env, parms, dlls, nem_comp, verbose, external_compiler);
+ def tester = Tester (dnet_env, runtime_parms, parms, dlls, nem_comp,
+ verbose, external_compiler);
if (List.IsEmpty (test_files))
{
def str = Directory.GetFiles (Directory.GetCurrentDirectory (), "*.n");
Modified: nemerle/trunk/ncc/typing/DecisionTreeBuilder.n
==============================================================================
--- nemerle/trunk/ncc/typing/DecisionTreeBuilder.n (original)
+++ nemerle/trunk/ncc/typing/DecisionTreeBuilder.n Wed Nov 2 22:15:06 2005
@@ -69,6 +69,7 @@
using Nemerle.Collections;
using Nemerle.IO;
+using Nemerle.Utility;
using Nemerle.Compiler;
using Nemerle.Compiler.Typedtree;
@@ -79,7 +80,22 @@
{
class DecisionTreeBuilder
{
- variant Con
+
+ // this is used internally to tell CheckMatching to renounce
+ // the counter example being constructed and try to find
+ // another one
+ // a counter example is rejected in two cases:
+ // 1) when it contains 'null'
+ // 2) when it contains a numerical constant for an enum
+ // that wasn't declared with System.Flags attribute
+ class IgnoreCounterExample : System.Exception
+ {
+ public this ()
+ {
+ }
+ }
+
+ internal variant Con
{
| Variant { ti : TypeInfo; }
| Lit { lit : Nemerle.Compiler.Literal; }
@@ -106,20 +122,49 @@
}
/** Return a string representation of a value of the same kind
- as values in [cons], but different than any of them. */
- static FindValueExcept (cons : list [Con]) : string
+ as values in [cons], but different than any of them.
+
+ throw_ignore == true tells the function to throw
+ IgnoreCounterExample whenever it is unable to find
+ such value; otherwise (throw_ignore == false) the
+ compiler bails out with ``internal error''
+ */
+ static FindValueExcept (cons : list [Con], throw_ignore = false) : string
{
+ match (cons) {
| [] => "_"
| Lit (Literal.Bool (true)) :: _ => "false"
| Lit (Literal.Bool (false)) :: _ => "true"
| (Lit (Literal.Enum (_, tc)) :: _) as lits
when ! tc.HasAttribute (InternalType.FlagsAttribute_tc) =>
+
+ // seems that both cases are possible (Enum & Integer; the latter
+ // for example when enumeration is defined in different assembly
+ // than the code that uses it)
+ def get_cmpf (val)
+ {
+ if (val is Literal.Enum)
+ fun (l) {
+ | Lit (v) => val.Equals (v)
+ | _ => false
+ }
+ else {
+ assert (val is Literal.Integer);
+ fun (l) {
+ | Lit (Literal.Enum (v, _)) => val.Equals (v)
+ | _ => false
+ }
+ }
+ }
+
mutable res = null;
foreach (fld is IField in tc.GetMembers ())
when (fld.IsLiteral && fld.DeclaringType.Equals (tc) &&
- !lits.Contains (Lit (fld.GetValue ())))
+ !lits.Exists (get_cmpf (fld.GetValue ())))
res = fld.Name;
+ when (res == null && throw_ignore)
+ throw IgnoreCounterExample ();
assert (res != null);
res
@@ -130,6 +175,11 @@
foreach (opt in opts)
when (!variants.Contains (Variant (opt)))
res = opt.Name;
+ when (res == null && variants.ForAll (fun (x) { ! (x is Con.Lit (Literal.Null)) }))
+ if (throw_ignore)
+ throw IgnoreCounterExample ();
+ else
+ res = "null";
assert (res != null);
res
| _ => assert (false)
@@ -137,8 +187,9 @@
| vals => $ "(anything except $vals)"
}
+ }
- public override ToString () : string
+ public ToString (throw_ignore : bool) : string
{
match (this) {
| Variant (ti) => ti.ToString ()
@@ -146,28 +197,49 @@
| Type (ti) => $ "is $ti"
| Guard => "GUARD"
| Unspecified => "UNSPECIFIED"
- | Not (x) => FindValueExcept (x)
+ | Not (x) => FindValueExcept (x, throw_ignore)
// + $ "NOT($x)"
}
}
+ public override ToString () : string
+ {
+ ToString (false);
+ }
+
+ public override GetHashCode () : int
+ {
+ match (this) {
+ | Variant (ti) => ti.GetHashCode ()
+ | Type (ti) => ti.GetHashCode ()
+ | Lit (lit) => lit.GetHashCode ()
+ | Guard => 4
+ | Unspecified
+ | Not => 0
+ }
+ }
+
/** Return number of possible constructors of given type.
-1 means infinity. */
public Span : int
{
get {
match (this) {
- | Lit (Literal.Enum (_, tc))
- when ! tc.HasAttribute (InternalType.FlagsAttribute_tc) =>
- mutable cnt = 0;
- foreach (fld is IField in tc.GetMembers ())
- when (fld.IsLiteral && fld.DeclaringType.Equals (tc))
- ++cnt;
- cnt
+// this case is ok for CheckMatching () but doesn't work when a decision
+// tree is compiled (examples in new-matching-enums.n testcase)
+// | Lit (Literal.Enum (_, tc))
+// when ! tc.HasAttribute (InternalType.FlagsAttribute_tc) =>
+// mutable cnt = 0;
+// foreach (fld is IField in tc.GetMembers ())
+// when (fld.IsLiteral && fld.DeclaringType.Equals (tc))
+// ++cnt;
+// cnt
| Variant (ti) =>
match (Option.UnSome (ti.SuperClass ()).GetTydecl ()) {
- | TypeDeclaration.Variant (opts) => opts.Length
+ | TypeDeclaration.Variant (opts) =>
+ // + 1 for null value
+ opts.Length + 1
| _ => assert (false)
}
@@ -219,13 +291,21 @@
public IsIt (con : Con) : bool
{
if (is_con == null)
- if (is_not.Length + 1 == con.Span &&
- ! is_not.Contains (con)) {
- // normalize
+ if (is_not is [] || is_not.Contains (con))
+ false
+ else {
+ def span =
+ if (con is Con.Lit (Nemerle.Compiler.Literal.Null))
+ is_not.Head.Span;
+ else
+ con.Span;
+ if (is_not.Length + 1 == span) {
AddPositive (con);
true
} else false
- else is_con.Equals (con)
+ }
+ else
+ is_con.Equals (con)
}
@@ -297,10 +377,36 @@
/** Represent an access path to a subterm. */
- variant Path {
+ internal variant Path {
| Here
| Field { field : IMember; path : Path; }
+ // TyVar of Pattern that this Path node was created for
+ // necessary to compute access_expr
+ ty : TyVar;
+
+ // TExpr that loads object this path points to on the VM stack
+ // field used by DecisionTreeCompiler to memoize computed TExprs
+ [Accessor (flags = WantSetter)]
+ mutable access_expr : TExpr;
+
+ public this (ty : TyVar)
+ {
+ this.ty = ty;
+ this.access_expr = null;
+ }
+
+ public this ()
+ {
+ this.ty = null;
+ this.access_expr = null;
+ }
+
+ public Type : TyVar
+ {
+ get { ty }
+ }
+
public override ToString () : string
{
match (this) {
@@ -308,13 +414,38 @@
| Field (f, p) => $ "($p : $(f.DeclaringType)).$(f.Name)"
}
}
+
+ [OverrideObjectEquals]
+ public Equals (path : Path) : bool
+ {
+ match ((this, path)) {
+ | (Here, Here) => true
+ | (Field (f1, p1), Field (f2, p2)) => f1.Equals (f2) && p1.Equals (p2)
+ | _ => false
+ }
+ }
+
+ [Memoize]
+ public override GetHashCode () : int
+ {
+ match (this)
+ {
+ | Here => 0
+ | Field (f, p) => f.GetHashCode () + p.GetHashCode ()
+ }
+ }
}
/** Represent a decision tree. */
- variant Decision {
+ internal variant Decision {
| Success { res : int; }
| Failure
+ | Assign {
+ path : Path;
+ decl : LocalValue;
+ dtree : Decision;
+ }
| IfEq {
path : Path;
con : Con;
@@ -329,6 +460,10 @@
$"$(indent)success $res\n"
| Failure =>
$"$(indent)failure\n"
+ | Assign (path, decl, dtree) =>
+ def i2 = indent + " ";
+ $"$(indent)def $(decl.Name) = $path\n"
+ "$(dtree.ToString (i2))"
| IfEq (path, con, tr, fl) =>
def i2 = indent + " ";
$"$(indent)if $path = $con:\n"
@@ -342,6 +477,63 @@
{
"\n" + ToString ("")
}
+
+ // in-degree of this node in decision dag
+ [Accessor (flags = WantSetter)]
+ mutable in_deg : int;
+
+ public IsShared : bool
+ {
+ get { in_deg > 1 }
+ }
+
+ // DecisionTreeCompiler labels shared nodes so they can
+ // be reused in IL (goto label_id)
+ [Accessor (flags = WantSetter)]
+ mutable label_id : option [int];
+
+ public this ()
+ {
+ in_deg = 0;
+ label_id = None ()
+ }
+
+ // this equality test is used for bottom-up detection of shared
+ // nodes and that's why it compares subtrees by their references
+ [OverrideObjectEquals]
+ public Equals (other : Decision) : bool
+ {
+ match ((this, other)) {
+ | (IfEq (path1, con1, if_true1, if_false1),
+ IfEq (path2, con2, if_true2, if_false2)) =>
+ (if_true1 : object) == if_true2 &&
+ (if_false1 : object) == if_false2 &&
+ con1.Equals (con2) && path1.Equals (path2)
+
+ | (Assign (path1, decl1, dtree1),
+ Assign (path2, decl2, dtree2)) =>
+ (dtree1 : object) == dtree2 && decl1.Equals (decl2) &&
+ path1.Equals (path2)
+
+ | (Success (res_id1), Success (res_id2)) =>
+ res_id1 == res_id2
+
+ | (Failure, Failure) => true
+
+ | _ => false
+ }
+ }
+
+ public override GetHashCode () : int
+ {
+ match (this) {
+ | IfEq (path, con, _, _) => path.GetHashCode () + con.GetHashCode ()
+ | Assign (path, decl, _) => path.GetHashCode () + decl.GetHashCode ()
+ | Success (res_id) => 1 + res_id
+ | Failure => 0
+ }
+ }
+
}
@@ -352,6 +544,10 @@
res_id : int;
continuation : list [Pattern * bool * int];
skel : Skeleton;
+ // used to detect shared nodes
+ // TODO: don't need a dictionary here (but don't have any
+ // meaningful comparator for a Set)
+ nodes : Hashtable [Decision, Decision];
/** Called when we have failed to match the current pattern. */
BuildFailure () : Decision
@@ -359,8 +555,8 @@
match (continuation) {
| [] => Decision.Failure ()
| (pat, has_guard, res_id) :: rest =>
- def p = TopLevelPattern (has_guard, res_id, rest, skel);
- p.Build ([(Path.Here (), skel, pat)])
+ def p = TopLevelPattern (has_guard, res_id, rest, skel, nodes);
+ p.Build ([(Path.Here (pat.Type), skel, pat)])
}
}
@@ -423,12 +619,44 @@
}
}
+ def dtree =
match (pat) {
| Pattern.Wildcard
| Pattern.Error => Build (rest)
- | Pattern.As (pat, _) =>
- Build ((path, skel, pat) :: rest)
+ | Pattern.As (pat, decl) =>
+
+ // Check if by always choosing if_true branch in decision subtree we
+ // eventually stop at either Failure or Success with res_id equal
+ // to the current one.
+ // This check is needed for Decision.Assign, because `if_true' path
+ // in tree can cross TopLevelPatterns (see new-matching-as.n test case)
+ // and assignment would be placed in wrong match effect (resulting in
+ // InvalidCastException).
+ def check_resid (decision) {
+ | Decision.Success (res) => res == res_id
+ | Decision.IfEq (_, _, if_true, _) => check_resid (if_true)
+ | Decision.Assign (_, _, dtree) => check_resid (dtree)
+ | Decision.Failure => true
+ }
+
+ def dtree = Build ((path, skel, pat) :: rest);
+
+ if (check_resid (dtree))
+ match (dtree)
+ {
+ | Decision.IfEq (_, Con.Guard, _, _) => Decision.Assign (path, decl, dtree)
+
+ | Decision.IfEq (p, con, if_true, if_false) =>
+ def assign = Decision.Assign (path, decl, if_true);
+ Decision.IfEq (p, con, assign, if_false);
+
+ | Decision.Success
+ | Decision.Assign => Decision.Assign (path, decl, dtree)
+
+ | Decision.Failure => dtree
+ }
+ else dtree
// change tuple to record
| Pattern.Tuple (pats) =>
@@ -444,8 +672,8 @@
check_if (Con.Lit (lit), rest)
| Pattern.Record (pats) =>
- def actions = pats.Map (fun (fld, pat) {
- (Path.Field (fld, path), skel.Select (fld), pat)
+ def actions = pats.Map (fun (fld, p) {
+ (Path.Field (p.Type, fld, path), skel.Select (fld), p)
});
Build (actions + rest)
@@ -465,6 +693,32 @@
}
check_if (Con.Lit (lit), rest)
}
+
+ if (Options.BuildDecisionDAG)
+ match (nodes.Get (dtree)) {
+ | None =>
+ nodes.Add (dtree, dtree);
+ match (dtree) {
+ | IfEq (_, _, tr, fl) =>
+ ++ tr.InDeg;
+ ++ fl.InDeg
+ | Assign (_, _, tree) =>
+ ++ tree.InDeg
+ | _ => {}
+ }
+ dtree
+ | Some (dtree) =>
+ dtree
+ }
+ else {
+ // ensure that leaves are shared even when DAG option is disabled
+ match (dtree) {
+ | Decision.Failure
+ | Decision.Success => dtree.InDeg = 2
+ | _ => {}
+ }
+ dtree
+ }
}
}
}
@@ -477,8 +731,9 @@
match (patterns) {
| (pat, has_guard, res_id) :: rest =>
def skel = Skeleton.Empty ();
- def p = TopLevelPattern (has_guard, res_id, rest, skel);
- p.Build ([(Path.Here (), skel, pat)])
+ def nodes = Hashtable ();
+ def p = TopLevelPattern (has_guard, res_id, rest, skel, nodes);
+ p.Build ([(Path.Here (pat.Type), skel, pat)])
| _ => assert (false)
}
}
@@ -535,7 +790,7 @@
static FieldToString (mem : IMember, example : CounterExample) : string
{
- if (mem.DeclaringType.FullName.StartsWith ("Nemerle.Internal.Tuple"))
+ if (TupleType.IsTupleMember (mem))
example.ToString ()
else
mem.Name + " = " + example.ToString ()
@@ -546,7 +801,7 @@
match (this) {
| Anything => "_"
| Exactly (null, []) => "_"
- | Exactly (con, []) => con.ToString ()
+ | Exactly (con, []) => con.ToString (true)
| Exactly (null, lst) =>
"(" + lst.Map (FieldToString).ToString (", ") + ")"
| Exactly (con, lst) =>
@@ -571,11 +826,11 @@
}
- /** Give warnings about ``pattern matching not exhaustive'' and
- ``unused match clause''. */
- public static CheckMatching (cases : list [Match_case]) : void
+ mutable patterns : list [Pattern * bool * int] = [];
+ decision : Decision;
+
+ public this (cases : list [Match_case])
{
- mutable patterns = [];
mutable no = 0;
foreach (case in cases)
@@ -587,10 +842,20 @@
patterns = patterns.Rev ();
- def tree = Build (patterns);
+ decision = Build (patterns)
+ }
+
+ internal GetDecision () : Decision
+ {
+ decision
+ }
+ /** Give warnings about ``pattern matching not exhaustive'' and
+ ``unused match clause''. */
+ public CheckMatching () : void
+ {
// Message.Debug ($ "tree for $patterns: $tree");
- def pat_arr = array (no);
+ def pat_arr = array (patterns.Length);
foreach ((pat, _, k) in patterns)
pat_arr [k] = pat;
@@ -603,24 +868,41 @@
| Decision.Failure =>
if (non_exhaustive_shown) {}
- else {
- non_exhaustive_shown = true;
+ else
+ try {
def example = BuildCounterExample (path);
+ non_exhaustive_shown = true;
Message.Warning ($ "matching is not exhaustive, example "
"unmatched value: $example")
+ } catch {
+ | _ is IgnoreCounterExample => {}
}
+ | Decision.Assign (_, _, dtree) =>
+ traverse (path, dtree)
+
| Decision.IfEq (access, con, n1, n2) =>
traverse ((access, con) :: path, n1);
traverse ((access, Con.Not ([con])) :: path, n2);
}
}
- traverse ([], tree);
+ traverse ([], decision);
foreach (pat in pat_arr)
when (pat != null)
Message.Warning (pat.loc, "this match clause is unused");
}
+
+ /** Construct a Decision tree and call CheckMatching () on it. */
+ public static CheckMatching (cases : list [Match_case]) : void
+ {
+ def builder = DecisionTreeBuilder (cases);
+ builder.CheckMatching ();
}
+
+
+ }
+
+
}
Modified: nemerle/trunk/ncc/typing/TypedTree.n
==============================================================================
--- nemerle/trunk/ncc/typing/TypedTree.n (original)
+++ nemerle/trunk/ncc/typing/TypedTree.n Wed Nov 2 22:15:06 2005
@@ -374,6 +374,7 @@
{
public mutable patterns : list [Pattern * TExpr * list [LocalValue * TExpr]];
public mutable body : TExpr;
+ public mutable disable_warnings : bool;
}
public variant ConversionKind
Modified: nemerle/trunk/ncc/typing/Typer.n
==============================================================================
--- nemerle/trunk/ncc/typing/Typer.n (original)
+++ nemerle/trunk/ncc/typing/Typer.n Wed Nov 2 22:15:06 2005
@@ -598,7 +598,7 @@
public static ImplicitCast (expr : TExpr, ty : TyVar) : TExpr
{
- TExpr.TypeConversion (ty, expr, ty, ConversionKind.Implicit ())
+ TExpr.TypeConversion (expr.loc, ty, expr, ty, ConversionKind.Implicit ())
}
@@ -1511,11 +1511,13 @@
def res = FreshTyVar ();
def matched_value = TypeExpr (value, res);
def pats = TypePatterns (res, [pattern]);
- def case = Match_case (pats, null);
+ def case = Match_case (pats, null, true);
+ when (! Options.NewMatchingCompiler || messenger.SeenError) {
when (messenger.NeedMessage)
DecisionTreeBuilder.CheckMatching ([case]);
- FixupMatchCase (case);
+ FixupMatchCase (case)
+ }
TExpr.Match (matched_value, [case])
}
@@ -2806,7 +2808,7 @@
}
- static FixupMatchCase (case : Match_case) : void
+ static internal FixupMatchCase (case : Match_case) : void
{
case.patterns =
case.patterns.Map (fun (p, e, a) { (p.StripEnums (), e, a) });
@@ -2845,7 +2847,7 @@
messenger.CleanLocalError ();
PopLocals ();
- res = Match_case (pats, body) :: res;
+ res = Match_case (pats, body, disable_warnings) :: res;
}
if (res.IsEmpty) {
@@ -2854,9 +2856,11 @@
} else {
res = List.Rev (res);
- when (!disable_warnings && messenger.NeedMessage)
+ when (! Options.NewMatchingCompiler || messenger.SeenError) {
+ when (! disable_warnings && messenger.NeedMessage)
DecisionTreeBuilder.CheckMatching (res);
- List.Iter (res, FixupMatchCase);
+ List.Iter (res, FixupMatchCase)
+ }
TExpr.Match (matched_value, res)
}
More information about the svn
mailing list