[m-rev.] for review: constraints on ground types
Mark Brown
dougl at cs.mu.OZ.AU
Tue Sep 24 18:51:25 AEST 2002
Hi,
This is in response to the issue that came up recently on this list
regarding allowing typeclass constraints on ground types. This is for
review by anyone.
Cheers,
Mark.
Estimated hours taken: 3
Branches: main
Allow typeclass constraints on ground types.
compiler/prog_io_typeclass.m:
Remove the check that typeclass constraints are non-ground.
compiler/polymorphism.m:
compiler/typecheck.m:
Change tests for monomorphic calls to also test for no constraints.
The optimizations that are applied if these tests succeed assume
that there are no constraints.
Remove "sanity" checks which are no longer applicable.
tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/ground_constraint.exp:
tests/hard_coded/typeclasses/ground_constraint.m:
Test the new feature.
tests/invalid/Mmakefile:
tests/invalid/typeclass_constraint_no_var.err_exp:
tests/invalid/typeclass_constraint_no_var.m:
tests/valid/Mmakefile:
tests/valid/typeclass_constraint_no_var.m:
Move this test from invalid to valid, since it should compile
successfully now.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.228
diff -u -r1.228 polymorphism.m
--- compiler/polymorphism.m 26 Jul 2002 06:33:09 -0000 1.228
+++ compiler/polymorphism.m 23 Aug 2002 19:06:00 -0000
@@ -1879,7 +1879,9 @@
(
(
% optimize for common case of non-polymorphic call
- PredTypeVars0 = []
+ % with no constraints
+ PredTypeVars0 = [],
+ PredClassContext0 = constraints([], [])
;
% some builtins don't need the type_info
no_type_info_builtin(PredModule, PredName, PredArity)
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.25
diff -u -r1.25 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 26 Jul 2002 06:33:11 -0000 1.25
+++ compiler/prog_io_typeclass.m 23 Aug 2002 15:29:02 -0000
@@ -377,15 +377,7 @@
% constraints do not contain any info in their prog_context
% fields
list__map(convert_type, Args0, Args),
-
- % Check that the arguments contain at least one type variable.
- ( term__contains_var_list(Args, _) ->
- Result = ok(class_constraint(constraint(ClassName,
- Args)))
- ;
- Result = error("class constraint contains no variables",
- ConstraintTerm)
- )
+ Result = ok(class_constraint(constraint(ClassName, Args)))
;
Result = error("expected atom as class name or inst constraint",
ConstraintTerm)
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.324
diff -u -r1.324 typecheck.m
--- compiler/typecheck.m 29 Jul 2002 05:58:55 -0000 1.324
+++ compiler/typecheck.m 29 Aug 2002 06:23:52 -0000
@@ -1686,20 +1686,15 @@
% unify the types of the call arguments
% with the called predicates' arg types
% (optimize for the common case of
- % a non-polymorphic predicate)
+ % a non-polymorphic, non-constrained predicate)
%
- ( varset__is_empty(PredTypeVarSet) ->
+ (
+ varset__is_empty(PredTypeVarSet),
+ PredClassContext = constraints([], [])
+ ->
typecheck_var_has_type_list(Args,
PredArgTypes, 1, TypeCheckInfo0,
- TypeCheckInfo),
- (
- % sanity check
- PredClassContext \= constraints([], [])
- ->
- error("non-polymorphic pred has class context")
- ;
- true
- )
+ TypeCheckInfo)
;
typecheck_var_has_polymorphic_type_list(Args,
PredTypeVarSet, PredExistQVars, PredArgTypes,
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.47
diff -u -r1.47 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile 17 Aug 2002 13:52:18 -0000 1.47
+++ tests/hard_coded/typeclasses/Mmakefile 23 Aug 2002 15:29:02 -0000
@@ -18,6 +18,7 @@
existential_type_switch \
extra_typeinfo \
func_default_mode_bug \
+ ground_constraint \
ho_map \
implied_instance \
implied_instance_multi_constraint \
Index: tests/hard_coded/typeclasses/ground_constraint.exp
===================================================================
RCS file: tests/hard_coded/typeclasses/ground_constraint.exp
diff -N tests/hard_coded/typeclasses/ground_constraint.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/ground_constraint.exp 29 Aug 2002 06:36:58 -0000
@@ -0,0 +1,3 @@
+bar
+bar
+baz
Index: tests/hard_coded/typeclasses/ground_constraint.m
===================================================================
RCS file: tests/hard_coded/typeclasses/ground_constraint.m
diff -N tests/hard_coded/typeclasses/ground_constraint.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/typeclasses/ground_constraint.m 29 Aug 2002 06:36:20 -0000
@@ -0,0 +1,39 @@
+:- module ground_constraint.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module list.
+
+main -->
+ { S1 = f(0) },
+ io__write_string(S1),
+ io__nl,
+ { p(0, S2) },
+ io__write_string(S2),
+ io__nl,
+ { q([0], S3) },
+ io__write_string(S3),
+ io__nl.
+
+:- typeclass foo(T) where [
+ func s(T) = string
+].
+
+:- instance foo(int) where [
+ (s(_) = "bar")
+].
+
+:- func f(int) = string <= foo(int).
+f(N) = s(N).
+
+:- pred p(int::in, string::out) is det <= foo(int).
+p(N, s(N)).
+
+:- instance foo(list(T)) <= foo(T) where [
+ (s(_) = "baz")
+].
+
+:- pred q(list(int)::in, string::out) is det <= foo(list(int)).
+q(Ns, s(Ns)).
+
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.126
diff -u -r1.126 Mmakefile
--- tests/invalid/Mmakefile 20 Sep 2002 04:07:36 -0000 1.126
+++ tests/invalid/Mmakefile 23 Sep 2002 04:49:17 -0000
@@ -104,7 +104,6 @@
type_vars \
typeclass_bogus_method \
typeclass_constraint_extra_var \
- typeclass_constraint_no_var \
typeclass_mode \
typeclass_missing_det \
typeclass_missing_det_2 \
Index: tests/invalid/typeclass_constraint_no_var.err_exp
===================================================================
RCS file: tests/invalid/typeclass_constraint_no_var.err_exp
diff -N tests/invalid/typeclass_constraint_no_var.err_exp
--- tests/invalid/typeclass_constraint_no_var.err_exp 26 Jul 2002 06:33:20 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,5 +0,0 @@
-typeclass_constraint_no_var.m:015: Error: class constraint contains no variables: solver_for(list(float), float).
-typeclass_constraint_no_var.m:016: Error: mode declaration for predicate `typeclass_constraint_no_var:mg/2'
-typeclass_constraint_no_var.m:016: without preceding `pred' declaration.
-typeclass_constraint_no_var.m:016: Inferred :- pred mg(T1, T1).
-For more information, try recompiling with `-E'.
Index: tests/invalid/typeclass_constraint_no_var.m
===================================================================
RCS file: tests/invalid/typeclass_constraint_no_var.m
diff -N tests/invalid/typeclass_constraint_no_var.m
--- tests/invalid/typeclass_constraint_no_var.m 26 Jul 2002 06:33:20 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,34 +0,0 @@
-:- module typeclass_constraint_no_var.
-:- interface.
-
-:- import_module float, io.
-:- import_module list.
-
-:- typeclass solver_for(B, S) where [
- func coerce(B) = S
-].
-
-:- instance solver_for(list(T), float) where [
- coerce(_) = 42.0
-].
-
-:- pred mg(T, T) <= solver_for(list(float), float).
-:- mode mg(in, out) is det.
-
-:- pred main(io::di, io::uo) is det.
-
-:- implementation.
-:- import_module std_util.
-
-mg(S0, S) :-
- ( semidet_succeed ->
- S = S0
- ;
- S = S0
- ).
-
-
-main -->
- { mg(1.0, S) },
- io__print(S),
- io__nl.
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.112
diff -u -r1.112 Mmakefile
--- tests/valid/Mmakefile 17 Aug 2002 13:52:31 -0000 1.112
+++ tests/valid/Mmakefile 23 Aug 2002 15:29:07 -0000
@@ -24,6 +24,7 @@
instance_superclass \
instance_unconstrained_tvar \
repeated_class_constraint \
+ typeclass_constraint_no_var \
typeclass_det_warning
ADITI_PROGS= \
Index: tests/valid/typeclass_constraint_no_var.m
===================================================================
RCS file: tests/valid/typeclass_constraint_no_var.m
diff -N tests/valid/typeclass_constraint_no_var.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/typeclass_constraint_no_var.m 23 Aug 2002 15:29:07 -0000
@@ -0,0 +1,34 @@
+:- module typeclass_constraint_no_var.
+:- interface.
+
+:- import_module float, io.
+:- import_module list.
+
+:- typeclass solver_for(B, S) where [
+ func coerce(B) = S
+].
+
+:- instance solver_for(list(T), float) where [
+ coerce(_) = 42.0
+].
+
+:- pred mg(T, T) <= solver_for(list(float), float).
+:- mode mg(in, out) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module std_util.
+
+mg(S0, S) :-
+ ( semidet_succeed ->
+ S = S0
+ ;
+ S = S0
+ ).
+
+
+main -->
+ { mg(1.0, S) },
+ io__print(S),
+ io__nl.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list