Commit 55397909 authored by Michael Hanus 's avatar Michael Hanus
Browse files

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)
parent 62cd4342
......@@ -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:
......
......@@ -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).
......
......@@ -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)
......
......@@ -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]),
......
......@@ -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,_,_),
......
......@@ -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))).
......
......@@ -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))).
......
......@@ -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),
......
......@@ -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:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment