[svn] r5964: nemerle/trunk/ncc: testsuite/negative/cyclic-type.n testsuite/positive/delayed-indexers.n typ...

malekith svnadmin at nemerle.org
Wed Nov 23 15:38:34 CET 2005


Log:
Don't mark arrays, tupels and functions as separated types. Resolves #571.

Author: malekith
Date: Wed Nov 23 15:38:33 2005
New Revision: 5964

Modified:
   nemerle/trunk/ncc/testsuite/negative/cyclic-type.n
   nemerle/trunk/ncc/testsuite/positive/delayed-indexers.n
   nemerle/trunk/ncc/typing/MType.n
   nemerle/trunk/ncc/typing/Solver.n
   nemerle/trunk/ncc/typing/TyVar.n
   nemerle/trunk/ncc/typing/Typer-CallTyper.n

Modified: nemerle/trunk/ncc/testsuite/negative/cyclic-type.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/negative/cyclic-type.n	(original)
+++ nemerle/trunk/ncc/testsuite/negative/cyclic-type.n	Wed Nov 23 15:38:33 2005
@@ -4,6 +4,6 @@
    public static Main () : void
    {
      def f (x) { x (x) }
-     f (3) // E: cyclic type found
+     f (3) // E: typing error in call
    }
 }

Modified: nemerle/trunk/ncc/testsuite/positive/delayed-indexers.n
==============================================================================
--- nemerle/trunk/ncc/testsuite/positive/delayed-indexers.n	(original)
+++ nemerle/trunk/ncc/testsuite/positive/delayed-indexers.n	Wed Nov 23 15:38:33 2005
@@ -2,6 +2,13 @@
 
 module M { public set42 (x : ref int) : void { x = 42; } }
 
+[Record]
+class Element {
+  public Value : object;
+  public Foo : int;
+}
+
+
 def f (s) { s [0] == 's' }
 _ = f ("foo");
 
@@ -28,6 +35,14 @@
 operations.Add ("+", fun (arr) { assert (arr.Length == 2); arr[0] + arr[1] });
 System.Console.WriteLine ( operations ["+"] (array [1,2]));
 
+// bug #571
+def f (node) {
+  _ = node.Foo + 1;
+  _ = node.Value :> array[int];
+}
+
+f (Element (array[1,2], 1));
+
 /*
 BEGIN-OUTPUT
 12

Modified: nemerle/trunk/ncc/typing/MType.n
==============================================================================
--- nemerle/trunk/ncc/typing/MType.n	(original)
+++ nemerle/trunk/ncc/typing/MType.n	Wed Nov 23 15:38:33 2005
@@ -228,6 +228,19 @@
             failed
           } else false
 
+        | (Fun (f1, t1), Fun (f2, t2)) =>
+          f1.Unify (f2) && t1.Unify (t2)
+          
+        | (Tuple (l1), Tuple (l2)) 
+          when List.Length (l1) == List.Length (l2) =>
+          List.ForAll2 (l1, l2, fun (x : TyVar, y : TyVar) { x.Unify (y) })
+
+        | (Array (t1, rank1), Array (t2, rank2)) when rank1 == rank2 =>
+          t1.Unify (t2)
+        
+        | (TyVarRef (tv1), TyVarRef (tv2)) =>
+          tv1.Equals (tv2)
+          
         | _ => false
       }
     }
@@ -324,29 +337,20 @@
     public override Unify (t : MType) : bool
     {
       match ((this, t)) {
-        | (Intersection, Intersection) when TryEnforcingEquality (t)
-        | (Class, Class) when TryEnforcingEquality (t) => true
-        
-        | (Fun (f1, t1), Fun (f2, t2)) =>
-          f1.Unify (f2) && t1.Unify (t2)
-          
-        | (Tuple (l1), Tuple (l2)) 
-          when List.Length (l1) == List.Length (l2) =>
-          List.ForAll2 (l1, l2, fun (x : TyVar, y : TyVar) { x.Unify (y) })
+        | (Class, Class) when TryEnforcingEquality (t)
+        | (TyVarRef, TyVarRef) when TryEnforcingEquality (t)
+        | (Fun, Fun) when TryEnforcingEquality (t)
+        | (Array, Array) when TryEnforcingEquality (t)
+        | (Tuple, Tuple) when TryEnforcingEquality (t)
+        | (Intersection, Intersection) when TryEnforcingEquality (t) =>
+          true
 
         | (Ref (t1), Ref (t2))
-        | (Out (t1), Out (t2))
-        | (Array (t1, rank1), Array (t2, rank2)) when rank1 == rank2 =>
+        | (Out (t1), Out (t2)) =>
           t1.Unify (t2)
         
-        // XXX shouldn't be needed
-        // | (Void, Class (tc, _)) when tc.Equals (InternalType.Void_tc)
-        // | (Class (tc, _), Void) when tc.Equals (InternalType.Void_tc)
         | (Void, Void) => true
 
-        | (TyVarRef (tv1), TyVarRef (tv2))
-          when tv1.Equals (tv2) => true
-
         | _ =>
           SaveError (Passes.Solver.CurrentMessenger,
                      $ "the types $(this) and $t are not compatible "
@@ -408,12 +412,13 @@
         match (this) {
           | Class => false
 
-          | Ref
-          | Out
           | TyVarRef
           | Fun
           | Tuple
-          | Array
+          | Array => false
+
+          | Ref
+          | Out
           | Void => true
           
           | Intersection (lst) =>

Modified: nemerle/trunk/ncc/typing/Solver.n
==============================================================================
--- nemerle/trunk/ncc/typing/Solver.n	(original)
+++ nemerle/trunk/ncc/typing/Solver.n	Wed Nov 23 15:38:33 2005
@@ -256,6 +256,10 @@
             | (t, MType.Class (tc, [])) when tc.Equals (InternalType.Object_tc) =>
               [t]
 
+            | (Class (tc, []), Array as t) when tc.Equals (InternalType.Array_tc)
+            | (Array as t, Class (tc, [])) when tc.Equals (InternalType.Array_tc) =>
+              [t]
+
             | ((MType.TyVarRef (tv)) as tvr, (MType.Class (tc, _)) as t)
             | ((MType.Class (tc, _)) as t, (MType.TyVarRef (tv)) as tvr) =>
               mutable res = true;
@@ -322,9 +326,9 @@
         mutable supertypes = null;
         mutable seen_object = false;
         mutable seen_value_type = false;
+        mutable seen_non_class_type = false;
 
         foreach (t in lst) {
-          match (t) {
             | MType.Class (tc, _) =>
               when (tc.Equals (InternalType.Object_tc))
                 seen_object = true;
@@ -344,8 +348,27 @@
                 supertypes = s
               else
                 supertypes = supertypes.Intersect (s);
-            | _ => assert (false, $ "wrong type in Sum: $t")
+
+          | _ =>
+            seen_non_class_type = true;
+        }
+
+        when (seen_non_class_type)
+          if (seen_object)
+            Nemerle.Imperative.Return (InternalType.Object)
+          else
+            match (lst) {
+              | x :: xs =>
+                if (xs.ForAll (_.Unify (x)))
+                  Nemerle.Imperative.Return (x)
+                else {
+                  SaveError (messenger, 
+                               $ "common super type of types $lst is just "
+                                 "`object', please upcast one of the types to "
+                                 "`object' if this is desired");
+                  Nemerle.Imperative.Return (InternalType.Object)
           }
+              | [] => Util.ice ()
         }
 
         assert (!supertypes.IsEmpty);

Modified: nemerle/trunk/ncc/typing/TyVar.n
==============================================================================
--- nemerle/trunk/ncc/typing/TyVar.n	(original)
+++ nemerle/trunk/ncc/typing/TyVar.n	Wed Nov 23 15:38:33 2005
@@ -93,6 +93,9 @@
         variable.  Return [true] iff it's possible.  */
     public virtual Require (t : MType) : bool
     {
+      if (IsFixed)
+        Self.Require (t)
+      else
       AddRelation (t, this, rev = false)
     }
 
@@ -135,6 +138,9 @@
         [this]. Dual to [Require]. */
     public virtual Provide (t : MType) : bool
     {
+      if (IsFixed)
+        Self.Provide (t)
+      else
       AddRelation (t, this, rev = true)
     }
 
@@ -790,10 +796,12 @@
 
       if (low.IsSeparated && high.IsFree)
         match (low) {
+        /*
           | MType.Fun
           | MType.Array
           | MType.TyVarRef
           | MType.Tuple
+          */
           | MType.Void => high.Unify (low)
 
           /*
@@ -838,6 +846,9 @@
         if (rev) {
           def new_bound = Passes.Solver.Sum (high.upper_bound, low);
           def high = high.Self;
+          if (high.IsFixed)
+            _ = high.Provide (new_bound);
+          else {
           high.WillWrite ();
           // Message.Debug ($"new bound $new_bound");
           when (high.upper_bound == null || 
@@ -845,13 +856,17 @@
             high.upper_bound = new_bound;
             high.SetUpperBound (low);
           }
+          }
         } else {
           def new_bound = Passes.Solver.Intersect (high.lower_bound, low);
           def high = high.Self;
+          if (high.IsFixed)
+            _ = high.Require (new_bound);
+          else {
           high.WillWrite ();
           whenlogging (SOLVER) {
             def tv = if (high.lower_bound == null) "(null)" else high.lower_bound.ToString ();
-            Message.Debug ($"new bound $tv * $low  = $new_bound");
+              //Message.Debug ($"new bound $tv * $low  = $new_bound");
           }
           when (high.lower_bound == null || 
                 !new_bound.Equals (high.lower_bound)) {
@@ -859,7 +874,9 @@
             high.SetLowerBound (low);
           }
         }
+        }
 
+        unless (high.IsFixed) {
         def high = high.Self;
         when (high.upper_bound != null &&
               high.lower_bound != null)
@@ -872,6 +889,7 @@
               high.lower_bound != null &&
               high.upper_bound.TryEnforcingEquality (high.lower_bound))
           _ = high.Unify (high.lower_bound);
+        }
 
 
         // Message.Debug ($"error=$(LocalError)");

Modified: nemerle/trunk/ncc/typing/Typer-CallTyper.n
==============================================================================
--- nemerle/trunk/ncc/typing/Typer-CallTyper.n	(original)
+++ nemerle/trunk/ncc/typing/Typer-CallTyper.n	Wed Nov 23 15:38:33 2005
@@ -271,7 +271,7 @@
           | ([], [], []) when !is_var_args => {}
 
           | ((fparm : Fun_parm) :: fparms, ftype :: ftypes, (aparm : Parm) :: aparms) =>
-            //Message.Debug ($"loop with header: $ftype $(aparm.expr.Type)");
+            log (TYPING, $"loop with header: $ftype $(aparm.expr.Type)");
             if (fparm.kind == aparm.kind) {
               RequireType (fparm, StripRefOut (ftype), aparm);
               ++argument_number;
@@ -298,6 +298,7 @@
 
           | (ftype :: ftypes, (aparm : Parm) :: aparms) =>
             if (aparm.kind == ParmKind.Normal) {
+              log (TYPING, $"loop without header: $ftype $(aparm.expr.Type)");
               RequireType (null, ftype, aparm);
               ++argument_number;
               unless (messenger.LocalError)



More information about the svn mailing list