[chatter] r11802 - in trunk/fundev/sources: dfmc/modeling dylan

[agent at mccarthy.opendylan.org]

Author: agent
Date: Fri May  9 10:59:07 2008
New Revision: 11802

Modified:
   trunk/fundev/sources/dfmc/modeling/types.dylan
   trunk/fundev/sources/dylan/type.dylan
Log:
Job: fd
Fixed subtype? so limited collections can be tested against type-unions.


Modified: trunk/fundev/sources/dfmc/modeling/types.dylan
==============================================================================
--- trunk/fundev/sources/dfmc/modeling/types.dylan	(original)
+++ trunk/fundev/sources/dfmc/modeling/types.dylan	Fri May  9 10:59:07 2008
@@ -190,9 +190,9 @@
   ^instance?(^singleton-object(s), t)
 end method;
 
-define method ^subtype? 
-    (t :: <&limited-collection-type>, c :: <&class>) => (result :: <boolean>)
-  ^subtype?(^limited-collection-concrete-class(t) | ^limited-collection-class(t), c)
+define method ^subtype?
+    (u :: <&union>, t :: <&limited-collection-type>) => (well? :: <boolean>)
+  ^subtype?(u.^union-type1, t) & ^subtype?(u.^union-type2, t)
 end method;
 
 define method ^subtype? 
@@ -200,6 +200,16 @@
   #f
 end method;
 
+define method ^subtype? 
+    (t :: <&limited-collection-type>, c :: <&class>) => (result :: <boolean>)
+  ^subtype?(^limited-collection-concrete-class(t) | ^limited-collection-class(t), c)
+end method;
+
+define method ^subtype?
+    (t :: <&limited-collection-type>, u :: <&union>) => (well? :: <boolean>)
+  ^subtype?(t, u.^union-type1) | ^subtype?(t, u.^union-type2)
+end method;
+
 define method ^instance? (object :: <model-value>, t :: <&limited-collection-type>)
     => (instance? :: <boolean>)
   let lc-size       = ^limited-collection-size(t);

Modified: trunk/fundev/sources/dylan/type.dylan
==============================================================================
--- trunk/fundev/sources/dylan/type.dylan	(original)
+++ trunk/fundev/sources/dylan/type.dylan	Fri May  9 10:59:07 2008
@@ -508,7 +508,7 @@
 end method;
 
 define method subjunctive-subtype? (t1 :: <type>, t2 :: <limited-collection-type>,
-				    scu :: <subjunctive-class-universe>)
+                                 scu :: <subjunctive-class-universe>)
  => (result == #f)
   #f
 end method;
@@ -530,11 +530,35 @@
 end method;
 
 define method subjunctive-subtype? (t1 :: <limited-collection-type>, t2 :: <type>,
-				    scu :: <subjunctive-class-universe>)
+                                 scu :: <subjunctive-class-universe>)
  => (result == #f)
   #f
 end method;
 
+// With union types
+
+define method subtype? (u :: <union>, t :: <limited-collection-type>)
+ => (result :: <boolean>)
+  subtype?(u.union-type1, t) & subtype?(u.union-type2, t)
+end method;
+
+define method subtype? (t :: <limited-collection-type>, u :: <union>)
+ => (result :: <boolean>)
+  subtype?(t, u.union-type1) | subtype?(t, u.union-type2)
+end method;
+
+define method subjunctive-subtype? (u :: <union>, t :: <limited-collection-type>,
+				    scu :: <subjunctive-class-universe>) 
+ => (result :: <boolean>)
+  subjunctive-subtype?(u.union-type1, t, scu) & subjunctive-subtype?(u.union-type2, t, scu)
+end method;
+
+define method subjunctive-subtype? (t :: <limited-collection-type>, u :: <union>,
+				    scu :: <subjunctive-class-universe>)
+ => (result :: <boolean>)
+  subjunctive-subtype?(t, u.union-type1, scu) | subjunctive-subtype?(t, u.union-type2, scu)
+end method;
+
 define method subtype? 
     (t1 :: <limited-collection-type>, t2 :: <class>) => (result == #f)
   subtype?(limited-collection-class(t1), t2)