Switched to version 1.13: Prelude.== is flexible instead of rigid (but still...

Switched to version 1.13: Prelude.== is flexible instead of rigid (but still suspends on numbers and characters)

Makefile

@@ -17,7 +17,7 @@
 # The major version numbers:
 MAJORVERSION=1
 # The minor version number:
-MINORVERSION=12
+MINORVERSION=13
 # The revision version number:
 REVISIONVERSION=0
 # The build version number:

curry2prolog/basics.pl

@@ -462,7 +462,8 @@ isIoType('TCons'('Prelude.IO',_)) :- !.
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % Union of functiontype and constructortype:
 constructorOrFunctionType(QName,Name,Arity,Type) :-
-	user:constructortype(QName,Name,Arity,_UnqualifiedName,_Index,Type), !.
+	user:constructortype(QName,Name,Arity,_UnqualifiedName,_Index,Type,_),
+	!.
 constructorOrFunctionType(QName,Name,Arity,Type) :-
 	user:functiontype(QName,Name,Arity,_PrologName,_Fixity,Type).
 

curry2prolog/compiler.pl

@@ -529,12 +529,13 @@ writeProg(Mod,Imports,MainTypes,MainFuncs,MainOps,ImpTypes,ImpFuncs,ImpOps) :-
 	writeClause((:- dynamic functiontype/6)),
 	map1partialM(compiler:writeFTypeClause(ExtFuncs,AllOps),CodeFuncsOISTotal), nl,
 	write('%%%%%%%%%%%% constructor types %%%%%%%%%%%%%%%%%%%'), nl,
-	writeClause((:- multifile constructortype/6)),
-	writeClause((:- dynamic constructortype/6)),
+	writeClause((:- multifile constructortype/7)),
+	writeClause((:- dynamic constructortype/7)),
 	(member("Prelude",Imports) -> true
 	 ; % generate type clause for partcall in the prelude:
 	   writeClause(constructortype(partcall,partcall,3,partcall,0,
-	    'FuncType'('TCons'('Int',[]),'FuncType'(_,'FuncType'('TCons'([],[_]),_)))))),
+	    'FuncType'('TCons'('Int',[]),
+		       'FuncType'(_,'FuncType'('TCons'([],[_]),_))))),[]),
 	map1M(compiler:writeDTypeClause,MainTypes), nl,
 
 	getConstructors(AllTypes,ConsList),
@@ -1561,21 +1562,31 @@ getUnqualifiedName(Name,UQName) :- atom_codes(UQName,Name).
 writeDTypeClause('Type'(TypeName,_Vis,TypeArgs,ConsExprs)) :-
 	map2M(compiler:index2tvar,TypeArgs,TypeArgExps),
 	ResultType = 'TCons'(TypeName,TypeArgExps),
-	writeDTypeClauses(ResultType,0,ConsExprs).
+	writeDTypeClauses(ResultType,0,ConsExprs,ConsExprs).
 
 index2tvar(I,'TVar'(I)). % transform tvar index into type expression
 
-writeDTypeClauses(_,_,[]).
-writeDTypeClauses(ResultType,Index,['Cons'(ConsName,Arity,Vis,ArgTypes)|Cs]) :-
+writeDTypeClauses(_,_,[],_).
+writeDTypeClauses(ResultType,Index,['Cons'(ConsName,Arity,Vis,ArgTypes)|Cs],
+		  AllConstrs) :-
 	flatName2Atom(ConsName,Cons),
 	append(ArgTypes,[ResultType],TypeL),
 	typelist2flattype(TypeL,CType),
 	replaceTVarByLVar([],CType,_,CTypeP),
 	getExternalNameFromVisibility(ConsName,Vis,EName),
 	getUnqualifiedName(ConsName,UQName),
-	writeClause(constructortype(Cons,EName,Arity,UQName,Index,CTypeP)),
+	getOtherConstructors(ConsName,AllConstrs,OtherConstrs),
+	writeClause(constructortype(Cons,EName,Arity,UQName,Index,CTypeP,
+				    OtherConstrs)),
 	Index1 is Index+1,
-	writeDTypeClauses(ResultType,Index1,Cs).
+	writeDTypeClauses(ResultType,Index1,Cs,AllConstrs).
+
+getOtherConstructors(_,[],[]).
+getOtherConstructors(ConsName,['Cons'(ConsName,_,_,_)|Cs],OCs) :- !,
+	getOtherConstructors(ConsName,Cs,OCs).
+getOtherConstructors(ConsName,['Cons'(CN,CA,_,_)|Cs],[CNA/CA|OCs]) :-
+	flatName2Atom(CN,CNA),
+	getOtherConstructors(ConsName,Cs,OCs).
 
 typelist2flattype([Type],Type) :- !.
 typelist2flattype([T1|T2L],'FuncType'(T1,T2)) :-
@@ -1832,7 +1843,7 @@ transConstrEq(Suffix) :-
 	writeClause((OccursNot_X_Y :- var(Y), !, X\==Y)),
 	OccursNotArgs_1_NY_X_Y =.. [OccursNotArgs,1,NY,X,Y],
 	writeClause((OccursNot_X_Y :- functor(Y,FY,NY),
-		                      constructortype(FY,_,NY,_,_,_),
+		                      constructortype(FY,_,NY,_,_,_,_),
 		                      !, OccursNotArgs_1_NY_X_Y)),
 	writeClause(OccursNot_X_Y),
 	nl.
@@ -1890,17 +1901,33 @@ transBoolEq(Suffix) :-
 	writeClause((BoolEq_A_B_R_E0_E :- hnf(A,HA,E0,E1),hnf(B,HB,E1,E2),
 	                                  BoolEqHnf_HA_HB_R_E2_E)),
 	nl,
-	genBlockDecl(BoolEqHnfOrg,5,[1,2,4],BoolEqHnf),
+	%genBlockDecl(BoolEqHnfOrg,5,[1,2,4],BoolEqHnf),
+	genBlockDecl(BoolEqHnfOrg,5,[4],BoolEqHnf),
+	BoolEqHnf_A_B_R_E0_E =.. [BoolEqHnf,A,B,R,E0,E],
+	BoolEqHnf_B_A_R_E0_E =.. [BoolEqHnf,B,A,R,E0,E],
+	% wait if both arguments are variables:
+	writeClause((BoolEqHnf_A_B_R_E0_E :- var(A), var(B), !,
+		       (when((nonvar(A);nonvar(B)),BoolEqHnf_A_B_R_E0_E)))),
+	writeClause((BoolEqHnf_A_B_R_E0_E :- var(A), !,
+		                             BoolEqHnf_B_A_R_E0_E)),
 	(printConsFailure(no) -> true
 	 ; BoolEqHnf_FAIL_X_E_E =.. [BoolEqHnf,'FAIL'(Src),X,'FAIL'(Src),E,E],
 	   writeClause((BoolEqHnf_FAIL_X_E_E :- !)),
 	   BoolEqHnf_X_FAIL_E_E =.. [BoolEqHnf,X,'FAIL'(Src),'FAIL'(Src),E,E],
 	   writeClause((BoolEqHnf_X_FAIL_E_E :- !))),
-	BoolEqHnf_A_B_R_E0_E =.. [BoolEqHnf,A,B,R,E0,E],
 	writeClause((BoolEqHnf_A_B_R_E0_E :-
-		       number(A), !, (A=B->R='Prelude.True';R='Prelude.False'), E0=E)),
+		% we cannot narrow numbers or characters, so we wait:
+		(number(A) ; basics:isCharCons(A)), !,
+		((A=B, R='Prelude.True', E0=E) ;
+		 when(nonvar(B),(A\=B, R='Prelude.False', E0=E))))),
 	appendAtom(genBoolEqHnfBody,Suffix,GenBoolEqHnfBody),
 	GenBoolEqHnfBody_1_NA =.. [GenBoolEqHnfBody,1,NA,A,B,SeqBody],
+	writeClause((BoolEqHnf_A_B_R_E0_E :- var(B), !, % bind variable
+	    functor(A,FA,NA),
+	    ((functor(B,FA,NA),GenBoolEqHnfBody_1_NA,hnf(SeqBody,R,E0,E))
+	     ; (constructortype(FA,_,NA,_,_,_,OtherCons),
+		member(OC/OCA,OtherCons),
+		functor(B,OC,OCA), R='Prelude.False',E0=E)))),
 	writeClause((BoolEqHnf_A_B_R_E0_E :-
 		       functor(A,FA,NA),
 		       ((functor(B,FA,NA),GenBoolEqHnfBody_1_NA)

curry2prolog/evaluator.pl

@@ -334,6 +334,10 @@ writeSuspendedGoals(Suspended) :-
 	   map1M(evaluator:tryWriteSuspGoal,Suspended).
 
 % try to format suspended goals more nicely:
+tryWriteSuspGoal(_:normalizeAndCheckNF(_,_,_)) :- !. % don't print this
+tryWriteSuspGoal(prolog:when(_,Cond,Goal)) :- !,
+	write('when('), write(Cond), write('): '),
+	tryWriteSuspGoal(Goal).
 tryWriteSuspGoal(_:G) :-
 	G =.. [Pred|Args],
 	rev(Args,[_,_,Result|RArgs]),

curry2prolog/lib_src/prim_readshowterm.pl

@@ -304,13 +304,13 @@ readIdTerm(Id,_,S,_) :-
 % (used to avoid problems readQTerm if other Curry implementations,
 % like KiCS2, write them without qualifiers):
 tryAddQualifier(Id,QId) :-
-	user:constructortype(QId,_,_,Id,_,_),
-	user:constructortype(QJ,_,_,Id,_,_),
+	user:constructortype(QId,_,_,Id,_,_,_),
+	user:constructortype(QJ,_,_,Id,_,_,_),
 	\+ QId=QJ, !,
 	writeErr('WARNING: Unqualified symbol "'), writeErr(Id),
 	writeErr('" not unique due to multiple imports.'), nlErr.
 tryAddQualifier(Id,QId) :-
-	user:constructortype(QId,_,_,Id,_,_), !.
+	user:constructortype(QId,_,_,Id,_,_,_), !.
 
 addQualifier(any,Id,QId) :-
 	constructorOrFunctionType(QId,Id,_,_),

curry2prolog/lib_src/prim_standard.pl

@@ -422,8 +422,8 @@ prim_compareHNF(X,Y,R,E0,E) :- isCharCons(X), !,
 	E0=E.
 prim_compareHNF(X,Y,R,E0,E) :-
 	functor(X,FX,NX), functor(Y,FY,NY),
-	user:constructortype(FX,_,NX,_,IX,_),
-	user:constructortype(FY,_,NY,_,IY,_), !,
+	user:constructortype(FX,_,NX,_,IX,_,_),
+	user:constructortype(FY,_,NY,_,IY,_,_), !,
 	(IX<IY -> R='Prelude.LT', E0=E ; (IX>IY -> R='Prelude.GT', E0=E
           ; prim_compareArgs(1,NX,X,Y,R,E0,E))).
 

curry2prolog/lib_src/prim_unsafe.pl

@@ -66,8 +66,8 @@ prim_compareAnyTermHNF(X,Y,R,E0,E) :- isCharCons(X), !,
 	E0=E.
 prim_compareAnyTermHNF(X,Y,R,E0,E) :-
 	functor(X,FX,NX), functor(Y,FY,NY),
-	user:constructortype(FX,_,NX,_,IX,_),
-	user:constructortype(FY,_,NY,_,IY,_), !,
+	user:constructortype(FX,_,NX,_,IX,_,_),
+	user:constructortype(FY,_,NY,_,IY,_,_), !,
 	(IX<IY -> R='Prelude.LT', E0=E ; (IX>IY -> R='Prelude.GT', E0=E
           ; prim_compareAnyTermArgs(1,NX,X,Y,R,E0,E))).
 

curry2prolog/loader.pl

@@ -36,7 +36,7 @@ costCenters(CCs) :-
 initializeBeforeLoad :-
 	retractAllFacts(dynamicPredInfo/2),
 	retractAllFacts(functiontype/6),
-	retractAllFacts(constructortype/6),
+	retractAllFacts(constructortype/7),
 	retractAllFacts(evaluation/2),
 	retractAllFacts(loadedModule/2),
 	retractAllFacts(importedModule/1),

examples/colormap.curry

@@ -4,9 +4,9 @@
 
 -- auxiliary function:
 
--- negation of ==:
+-- negation of (==) which suspends on uninstantiated arguments:
 diff :: a -> a -> Success
-diff x y = (x == y) =:= False
+diff x y = (ensureNotFree x == ensureNotFree y) =:= False
 
 {-
  This is our actual map: