[svn] r6470: nemerle/trunk/ncc: hierarchy/ClassMembers.n
hierarchy/TypeBuilder.n parsing/MainParser.n test...
nazgul
svnadmin at nemerle.org
Thu Jul 27 00:07:25 CEST 2006
Log:
Add support for co/contravariant generic parameters in interfaces and delegates
Author: nazgul
Date: Thu Jul 27 00:06:59 2006
New Revision: 6470
Added:
nemerle/trunk/ncc/testsuite/negative/co-contravariant-native.n
nemerle/trunk/ncc/testsuite/positive/co-contra-variance-native.n
Modified:
nemerle/trunk/ncc/hierarchy/ClassMembers.n
nemerle/trunk/ncc/hierarchy/TypeBuilder.n
nemerle/trunk/ncc/parsing/MainParser.n
nemerle/trunk/ncc/typing/MType.n
nemerle/trunk/ncc/typing/StaticTyVar.n
nemerle/trunk/ncc/typing/TyVarEnv.n
Modified: nemerle/trunk/ncc/hierarchy/ClassMembers.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/ClassMembers.n (original)
+++ nemerle/trunk/ncc/hierarchy/ClassMembers.n Thu Jul 27 00:06:59 2006
@@ -531,7 +531,7 @@
parms =
List.Map (f.dims, fun (parm : PT.Fun_parm) {
- par.MonoBindType (parm.ty)
+ par.MonoBindType (parm.ty);
});
def process_accessor (_ : option [PT.ClassMember]) {
@@ -904,9 +904,19 @@
fun_header.body = fun_body;
+ match (fun_header.ret_type)
+ {
+ | MType.TyVarRef (tr) when tr.IsContravariant =>
+ Message.Error ($"cannot use contravariant generic parameter as method's `$name' return type");
+ | _ => ()
+ }
+
foreach (parm in parms) {
- when (parm.ty.Fix () is MType.Void)
- Message.Error ($ "method `$name' has void argument");
+ match (parm.ty.Fix()) {
+ | MType.Void => Message.Error ($ "method `$name' has void argument");
+ | MType.TyVarRef (tr) when tr.IsCovariant => Message.Error ($"cannot use covariant generic parameter as method's `$name' parameter `$(parm.name)' type");
+ | _ => ()
+ }
}
ty = MType.ConstructFunctionType (fun_header);
Modified: nemerle/trunk/ncc/hierarchy/TypeBuilder.n
==============================================================================
--- nemerle/trunk/ncc/hierarchy/TypeBuilder.n (original)
+++ nemerle/trunk/ncc/hierarchy/TypeBuilder.n Thu Jul 27 00:06:59 2006
@@ -1191,6 +1191,13 @@
this.iterate_first = iterate_first.Fold (first, fun (_, ti, acc) { ti :: acc });
foreach (x in contained_types) Util.locate (x.loc, x.bind_types ());
+
+ // check variance limitation to interface type
+ unless (IsInterface || IsDelegate)
+ foreach (t when t.IsCovariant || t.IsContravariant in typarms) {
+ Message.Error (".NET runtime allows specifying co/contravariant generic parameters only on intefaces and delegates");
+ Message.Hint ("vote here to change this miserable state: http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=94145");
+ }
}
internal construct_subtyping_map () : void
Modified: nemerle/trunk/ncc/parsing/MainParser.n
==============================================================================
--- nemerle/trunk/ncc/parsing/MainParser.n (original)
+++ nemerle/trunk/ncc/parsing/MainParser.n Thu Jul 27 00:06:59 2006
@@ -1215,7 +1215,7 @@
loop (NemerleAttributes.None)
}
- parse_tyvars () : list [Splicable] * PExpr
+ parse_tyvars () : list [PExpr] * PExpr
{
match (peek_token ()) {
| Token.SquareGroup (null) as t =>
@@ -1233,7 +1233,7 @@
| _ =>
pop_stream ();
shift (); // now we are after whole '[..]' group
- (TokenMap (group, get_splicable_id), PExpr.Void ())
+ (TokenMap (group, parse_expr), PExpr.Void ())
}
| _ => (null, null)
};
@@ -1243,7 +1243,7 @@
* if yes, it's PType.Spliced with expression describing their list
* else it's PType.Void ()
*/
- parse_where_constraints (tyvars : list [Splicable], splicing_type : PExpr)
+ parse_where_constraints (tyvars : list [PExpr], splicing_type : PExpr)
: Typarms
{
def loop (acc) {
@@ -1280,12 +1280,28 @@
else (List.Rev (acc), PExpr.Void ())
};
if (tyvars != null) {
+ def create_typarms (tyvar_exprs, mutable where_cts) {
+ mutable tyvars_spl = [];
+ foreach (e in tyvar_exprs) {
+ | <[ + $inner ]> =>
+ def tv = make_splicable (inner);
+ where_cts ::= Constraint (tv, <[ @+ ]>);
+ tyvars_spl ::= tv;
+ | <[ - $inner ]> =>
+ def tv = make_splicable (inner);
+ where_cts ::= Constraint (tv, <[ @- ]>);
+ tyvars_spl ::= tv;
+ | _ => tyvars_spl ::= make_splicable (e)
+ }
+ Typarms (tyvars_spl.Reverse (), where_cts)
+ }
+
def (where_cts, where_spl_t) = loop ([]);
match ((splicing_type, where_spl_t)) {
- | (PExpr.Void, PExpr.Void) => Typarms (tyvars, where_cts)
+ | (PExpr.Void, PExpr.Void) => create_typarms (tyvars, where_cts)
| _ =>
// we have spliced type variables
- Typarms (tyvars, Constraint (null, <[ ($splicing_type, $where_spl_t) ]>)
+ create_typarms (tyvars, Constraint (null, <[ ($splicing_type, $where_spl_t) ]>)
:: where_cts)
}
}
@@ -1457,17 +1473,19 @@
}
}
- make_operator_call (name : string, e1 : PExpr, e2 : PExpr) : PExpr
+ static make_splicable (e : PExpr) : Splicable
{
- def loc = e1.Location + e2.Location;
- def make_splicable (e) {
| PExpr.Ref (n) => Splicable.Name (e.Location, n)
| PExpr.ToComplete (n) => Splicable.HalfId (e.Location, n)
| PExpr.Spliced (s) => Splicable.Expression (e.Location, s)
| _ =>
- Message.Error (e2.Location, "expecting identifier after `.'");
+ Message.Error (e.Location, $"expecting simple identifier instead of `$e'");
null
}
+
+ make_operator_call (name : string, e1 : PExpr, e2 : PExpr) : PExpr
+ {
+ def loc = e1.Location + e2.Location;
match (name) {
| "." =>
match (e2) {
Added: nemerle/trunk/ncc/testsuite/negative/co-contravariant-native.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/negative/co-contravariant-native.n Thu Jul 27 00:06:59 2006
@@ -0,0 +1,9 @@
+
+
+interface IBuggy [+P, -M] {
+ Get (i : int) : M; // E: cannot use contravariant
+ IsEmpty : M { get; }; // E: cannot use contravariant
+
+ Set (x : P) : void; // E: cannot use covariant
+}
+
Added: nemerle/trunk/ncc/testsuite/positive/co-contra-variance-native.n
==============================================================================
--- (empty file)
+++ nemerle/trunk/ncc/testsuite/positive/co-contra-variance-native.n Thu Jul 27 00:06:59 2006
@@ -0,0 +1,84 @@
+
+public delegate DFun [-I, +O] (x : I) : O;
+
+
+public interface IList [+T] {
+ Get (i : int) : T;
+ IsEmpty : bool { get; };
+}
+
+public interface IFun [-I, +O] {
+ Apply (x : I) : O;
+}
+
+
+public class ImmutableList [T] : IList[T]
+{
+ mystore : array [T];
+
+ public this (size : int) {
+ mystore = array (size);
+ }
+
+ public Get (i : int) : T { mystore [i] }
+
+ public IsEmpty : bool { get { mystore.Length > 0 } }
+}
+
+[Record]
+public class VariantFunction [I,O] : IFun [I, O]
+{
+ myo : O;
+
+ public Apply (_x : I) : O
+ {
+ myo
+ }
+}
+
+public module Tester {
+ public LiString (_ : IList [string]) : void { }
+ public LiObject (_ : IList [object]) : void { }
+ public FuObjectString (x : IFun [object, string]) : void {
+ _ = x.Apply ("")
+ }
+ public FuStringString (x : IFun [string, string]) : void {
+ _ = x.Apply ("")
+ }
+ public FuStringObject (x : IFun [string, object]) : void {
+ _ = x.Apply ("")
+ }
+ public FuObjectObject (x : IFun [object, object]) : void {
+ _ = x.Apply ("")
+ }
+ public DeObjectString (x : DFun [object, string]) : void {
+ _ = x ("")
+ }
+ public DeStringString (x : DFun [string, string]) : void {
+ _ = x ("")
+ }
+ public DeStringObject (x : DFun [string, object]) : void {
+ _ = x ("")
+ }
+ public DeObjectObject (x : DFun [object, object]) : void {
+ _ = x ("")
+ }
+}
+
+#if !MONO_RUNTIME
+def x = ImmutableList.[string] (10);
+Tester.LiString (x);
+Tester.LiObject (x);
+
+def y = VariantFunction.[object, string] ("aaa");
+Tester.FuObjectString (y);
+Tester.FuObjectObject (y);
+Tester.FuStringString (y);
+Tester.FuStringObject (y);
+
+def z = DFun.[object, string] (o => o.ToString ());
+Tester.DeObjectString (z);
+Tester.DeObjectObject (z);
+Tester.DeStringString (z);
+Tester.DeStringObject (z);
+#endif
\ No newline at end of file
Modified: nemerle/trunk/ncc/typing/MType.n
==============================================================================
--- nemerle/trunk/ncc/typing/MType.n (original)
+++ nemerle/trunk/ncc/typing/MType.n Thu Jul 27 00:06:59 2006
@@ -251,6 +251,21 @@
{
def s = Manager.Solver;
+ def covariant_check (t, a1, a2) {
+ t.IsCovariant && a1.Require (a2) ||
+ t.IsContravariant && a2.Require (a1)
+ }
+
+ def variant_args_equality (typarms, args1, args2) {
+ | (t :: ts, a1 :: as1, a2 :: as2) =>
+ if (a1.Equals (a2) || covariant_check (t, a1, a2))
+ variant_args_equality (ts, as1, as2)
+ else false
+
+ | ([], [], []) => true
+ | _ => assert (false)
+ }
+
match ((this, t)) {
| (Void, Class) =>
SaveError (s.CurrentMessenger,
@@ -262,17 +277,24 @@
| (Class (tc1, args1), Class (tc2, args2)) =>
//Message.Debug ($"Require $this $t");
- if (tc1.Equals (tc2) && args1.Equals (args2))
+ if (tc1.Equals (tc2) && variant_args_equality (tc1.Typarms, args1, args2))
true
else
match (tc1.SuperType (tc2)) {
| Some (args) =>
//Message.Debug ($"args $args");
def subst = tc1.MakeSubst (args1);
- List.ForAll2 (args, args2,
- fun (t : MType, tv : TyVar) {
- tv.Unify (subst.Apply (t))
- })
+ def variant_args_unify (typarms, args1, args2 : list[TyVar]) {
+ | (t :: ts, a1 :: as1, a2 :: as2) =>
+ def a1' = subst.Apply (a1);
+ if (covariant_check (t, a1', a2) || a2.Unify (a1'))
+ variant_args_unify (ts, as1, as2)
+ else false
+
+ | ([], [], []) => true
+ | _ => assert (false)
+ }
+ variant_args_unify (tc2.Typarms, args, args2)
| None =>
SaveError (s.CurrentMessenger,
Modified: nemerle/trunk/ncc/typing/StaticTyVar.n
==============================================================================
--- nemerle/trunk/ncc/typing/StaticTyVar.n (original)
+++ nemerle/trunk/ncc/typing/StaticTyVar.n Thu Jul 27 00:06:59 2006
@@ -152,6 +152,19 @@
}
}
+ public IsCovariant : bool
+ {
+ get {
+ special %&& GenericParameterAttributes.Covariant
+ }
+ }
+
+ public IsContravariant : bool
+ {
+ get {
+ special %&& GenericParameterAttributes.Contravariant
+ }
+ }
[Nemerle.OverrideObjectEquals]
public Equals (o : StaticTyVar) : bool
Modified: nemerle/trunk/ncc/typing/TyVarEnv.n
==============================================================================
--- nemerle/trunk/ncc/typing/TyVarEnv.n (original)
+++ nemerle/trunk/ncc/typing/TyVarEnv.n Thu Jul 27 00:06:59 2006
@@ -398,6 +398,8 @@
| <[ @class ]> => special |= GenericParameterAttributes.ReferenceTypeConstraint;
| <[ @struct ]> => special |= GenericParameterAttributes.NotNullableValueTypeConstraint;
| <[ @new ]> => special |= GenericParameterAttributes.DefaultConstructorConstraint;
+ | <[ @+ ]> => special |= GenericParameterAttributes.Covariant;
+ | <[ @- ]> => special |= GenericParameterAttributes.Contravariant;
| <[ @enum ]> with cty = <[ System.Enum ]>
| cty =>
def ty = tenv.MonoBind (env, curtc, cty, check_parms);
More information about the svn
mailing list