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

PAKCS 1.14.0: type Success is now a type synonym for Bool

parent 40686528
......@@ -17,9 +17,9 @@
# The major version numbers:
MAJORVERSION=1
# The minor version number:
MINORVERSION=13
MINORVERSION=14
# The revision version number:
REVISIONVERSION=1
REVISIONVERSION=0
# The build version number:
BUILDVERSION=1
# Complete version:
......
PAKCS: Release Notes
====================
Release notes for PAKCS Version 1.13.1 (September 6, 2015)
----------------------------------------------------------
Release notes for PAKCS Version 1.14.0 (October 12, 2015)
---------------------------------------------------------
Changes to version 1.13.0:
* Type `Success` is now a type synonym for `Bool` and
`success` is defined as `True` in the prelude.
Release notes for PAKCS Version 1.13.1 (October 2, 2015)
--------------------------------------------------------
Changes to version 1.13.0:
......
......@@ -659,7 +659,7 @@ getConstructors([],Cs) :-
(includePrelude
-> Cs=[partcall/3,'$stream'/1] % all standard constructors defined in prelude
; Cs=[partcall/3,'Prelude.True'/0,'Prelude.False'/0,
'Prelude.success'/0,[]/0,'.'/2|TupleCons]).
[]/0,'.'/2|TupleCons]).
getConstructors(['Type'(_,_,_,DataCons)|Types],AllCons) :-
getDataCons(DataCons,DCs),
getConstructors(Types,TCs),
......@@ -1446,7 +1446,7 @@ genDerefCalls(_,[],[],LastGoal,LastGoal).
% derefRoot for primitive types and derefAll for other types
type2derefPred('TCons'(Name,_),derefRoot) :-
member(Name,["Prelude.Int","Prelude.Float","Prelude.Char","Prelude.Bool",
"Prelude.Success","Prelude.Ordering",
"Prelude.Ordering",
"IO.Handle","IO.IOMode","IO.SeekMode",
"PlProfileData.ProfileSelection","Ports.Port","Socket.Socket"]), !.
type2derefPred('FuncType'(_,_),derefRoot) :-
......@@ -1647,18 +1647,16 @@ genVariableShareHnfClause(HNF,Suffix) :-
appendAtom(propagateShare,Suffix,PropShare),
PropShare_HV_R =.. [PropShare,HV,R],
HnfLHS =.. [HNF,Share_M,R,E0,E],
ShareGoal = (PropShare_HV_R, update_mutable('$eval'(R),M)),
(printConsFailure(no)
-> NoSharingCheck = functor(HV,'Prelude.success',0)
; NoSharingCheck =
(functor(HV,'Prelude.success',0);functor(HV,'FAIL',_))),
-> ShareHNF = ShareGoal
; ShareHNF = % no sharing for FAIL:
((nonvar(HV), functor(HV,'FAIL',_)) -> R=HV ; ShareGoal)),
writeClause((HnfLHS :- !, get_mutable(V,M),
(V='$eval'(Expr)
-> R=Expr, E0=E
; hnf(V,HV,E0,E1),
((nonvar(HV),NoSharingCheck)
-> R=HV % no sharing for constraints
; PropShare_HV_R,
update_mutable('$eval'(R),M)),
ShareHNF,
E1=E))).
genFunctionShareHnfClause(HNF,Suffix) :-
......@@ -1673,11 +1671,6 @@ genFunctionShareHnfClause(HNF,Suffix) :-
E1=E))).
% generate hnf clause for a function:
genHnfClause(_,('Prelude.success'/0,_)) :- !. % success is treated as a constructor
genHnfClause(HNF,(FName/0,'Prelude.success')) :- !,
% if somebody defines FName as (External Prelude.success)
HnfLHS =.. [HNF,FName,'Prelude.success',E,E],
writeClause((HnfLHS :- !)).
genHnfClause(HNF,(FName/FArity,PredName)) :-
length(Args,FArity),
LHS =.. [FName|Args],
......@@ -1713,7 +1706,7 @@ transConstrEq(Suffix) :-
hnf(A,HA,E0,E1), hnf(B,HB,E1,E2),
ConstrEqHnf_HA_HB_R_E2_E,
traceExit('Prelude.=:='(A,B),
'Prelude.success',
'Prelude.True',
E,Skip)))
; writeClause((ConstrEq_A_B_R_E0_E :- hnf(A,HA,E0,E1),hnf(B,HB,E1,E2),
ConstrEqHnf_HA_HB_R_E2_E))),
......@@ -1725,7 +1718,7 @@ transConstrEq(Suffix) :-
BindTryNf_X_H_R_E0_E =.. [BindTryNf,X,H,R,E0,E],
writeClause((ConstrEqHnf_X_H_R_E0_E :- var(X),!,BindTryNf_X_H_R_E0_E)),
writeClause((ConstrEqHnf_H_X_R_E0_E :- var(X),!,BindTryNf_X_H_R_E0_E)),
ConstrEqHnf_T1_T2_E0_E =.. [ConstrEqHnf,T1,T2,'Prelude.success',E0,E],
ConstrEqHnf_T1_T2_E0_E =.. [ConstrEqHnf,T1,T2,'Prelude.True',E0,E],
ConstrEqHnf_A_B_R_E0_E =.. [ConstrEqHnf,A,B,R,E0,E],
(printConsFailure(no)
-> writeClause((ConstrEqHnf_T1_T2_E0_E :- number(T1),!,T1=T2,E0=E))
......@@ -1736,7 +1729,7 @@ transConstrEq(Suffix) :-
'FAIL'(Src),E,E],
writeClause((ConstrEqHnf_X_FAIL_E_E :- !)),
writeClause((ConstrEqHnf_A_B_R_E0_E :- number(A), !,
(A=B -> R='Prelude.success', E0=E
(A=B -> R='Prelude.True', E0=E
; prim_failure(partcall(2,'Prelude.=:=',[]),[A,B],R,E0,E))))),
appendAtom(genConstrEqHnfBody,Suffix,GenConstrEqHnfBody),
GenConstrEqHnfBody_1_NA =.. [GenConstrEqHnfBody,1,NA,A,B,EqBody],
......@@ -1750,7 +1743,7 @@ transConstrEq(Suffix) :-
prim_failure(partcall(2,'Prelude.=:=',[]),[A,B],R,E0,E)))),
nl,
GenConstrEqHnfBody_N_NA_Succ =..
[GenConstrEqHnfBody,N,NA,_,_,'Prelude.success'],
[GenConstrEqHnfBody,N,NA,_,_,'Prelude.True'],
writeClause((GenConstrEqHnfBody_N_NA_Succ :- N>NA,!)),
appendAtom('Prelude.=:=',Suffix,Eq),
Eq_ArgA_ArgB =.. [Eq,ArgA,ArgB],
......@@ -1780,19 +1773,19 @@ transConstrEq(Suffix) :-
appendAtom(occursNot,Suffix,OccursNot),
OccursNot_X_T =.. [OccursNot,X,T],
writeClause((BindDirect_X_T_R_E0_E :- var(T), !, X=T,
R='Prelude.success', E0=E)),
R='Prelude.True', E0=E)),
(printConsFailure(no)
-> writeClause((BindDirect_X_T_R_E0_E :-
OccursNot_X_T, X=T, R='Prelude.success', E0=E))
OccursNot_X_T, X=T, R='Prelude.True', E0=E))
; BindDirect_X_FAIL_E_E =..
[BindDirect,X,'FAIL'(Src),'FAIL'(Src),E,E],
writeClause((BindDirect_X_FAIL_E_E :- !)),
writeClause((BindDirect_X_T_R_E0_E :-
OccursNot_X_T, !, X=T, R='Prelude.success', E0=E)),
OccursNot_X_T, !, X=T, R='Prelude.True', E0=E)),
writeClause((BindDirect_X_T_R_E0_E :-
prim_failure(partcall(2,'Prelude.=:=',[]),[X,T],R,E0,E)))),
nl,
Bind_X_T_E0_E =.. [Bind,X,T,'Prelude.success',E0,E],
Bind_X_T_E0_E =.. [Bind,X,T,'Prelude.True',E0,E],
writeClause((Bind_X_T_E0_E :- var(T), !, X=T, E0=E)),
writeClause((Bind_X_T_E0_E :- number(T), !, X=T, E0=E)),
(printConsFailure(no) -> true
......@@ -1821,7 +1814,7 @@ transConstrEq(Suffix) :-
OccursNot_A_ArgB,
N1 is N+1, OccursNotArgs_N1_NA_A_B)),
nl,
BindArgs_N_NA_A_B_E0_E =.. [BindArgs,N,NA,A,B,'Prelude.success',E0,E],
BindArgs_N_NA_A_B_E0_E =.. [BindArgs,N,NA,A,B,'Prelude.True',E0,E],
BindArgs_N_NA_A_B_R_E0_E =.. [BindArgs,N,NA,A,B,R,E0,E],
Bind_ArgA_HArgB_R_E1_E2 =.. [Bind,ArgA,HArgB,R,E1,E2],
Bind_ArgA_HArgB_R0_E1_E2 =.. [Bind,ArgA,HArgB,R0,E1,E2],
......@@ -2203,8 +2196,6 @@ transExp(FName,_Aux,Patterns,Vars,Cut,Exp) :-
TPCall =.. [TP|TArgsH],
writeClauseWithInitGoals(LHS,CutUShares,TPCall) )).
localFunCall(_,'Comb'('FuncCall',"Prelude.success",_)) :-
!. % since we implement "success" as a constructor, thus we don't need hnf for it
localFunCall(DefFuncName,'Comb'('FuncCall',FName,_)) :-
atom_codes(DefFuncName,DefFuncNameS),
fromSameModule(DefFuncNameS,FName), !.
......@@ -2217,8 +2208,6 @@ fromSameModule(F1,F2) :-
isConstructorRooted('Lit'(_)).
isConstructorRooted('Comb'('ConsCall',_,_)).
% we implement "success" as a constructor of type "Success":
isConstructorRooted('Comb'('FuncCall',"Prelude.success",[])).
isConstructorRooted('Free'(_,Exp)) :- % since we ignore Constr in the code:
isConstructorRooted(Exp).
......
......@@ -14,8 +14,8 @@ warnSuspendedConstraints(ShowAll,R) :-
find_chr_constraint(C), !,
write(user_error,'WARNING: residual CHR constraints:'),
writeSuspendedCHRConstraints(ShowAll),
R='Prelude.success'.
warnSuspendedConstraints(_,'Prelude.success').
R='Prelude.True'.
warnSuspendedConstraints(_,'Prelude.True').
writeSuspendedCHRConstraints(ShowAll) :-
find_chr_constraint(C), write(user_error,' '), write(user_error,C),
......
......@@ -19,9 +19,9 @@ clpb_card(Ns,Bs,B) :- =(B,card(Ns,Bs)).
clpb_exists(V,B,R) :- =(V^B,R).
clpb_sat(B,C) :- sat(B), C='Prelude.success'.
clpb_sat(B,C) :- sat(B), C='Prelude.True'.
clpb_check(B,R) :- taut(B,R).
clpb_labeling(Bs,C) :- labeling(Bs), C='Prelude.success'.
clpb_labeling(Bs,C) :- labeling(Bs), C='Prelude.True'.
......@@ -9,25 +9,25 @@
prim_FD_domain(L,A,B,R) :-
(prolog(sicstus) -> domain(L,A,B) ; ins(L,'..'(A,B))),
R='Prelude.success'.
R='Prelude.True'.
prim_FD_sum(Vs,RelCall,V,R) :-
checkSICStusAndWarn('CLPFD.sum'),
RelCall=partcall(2,FD_Rel,[]),
translateFD_Rel(FD_Rel,Rel),
sum(Vs,Rel,V), R='Prelude.success'.
sum(Vs,Rel,V), R='Prelude.True'.
prim_FD_scalar_product(Cs,Vs,RelCall,V,R) :-
checkSICStusAndWarn('CLPFD.scalar_product'),
RelCall=partcall(2,FD_Rel,[]),
translateFD_Rel(FD_Rel,Rel),
scalar_product(Cs,Vs,Rel,V), R='Prelude.success'.
scalar_product(Cs,Vs,Rel,V), R='Prelude.True'.
prim_FD_count(Val,Vs,RelCall,C,R) :-
checkSICStusAndWarn('CLPFD.count'),
RelCall=partcall(2,FD_Rel,[]),
translateFD_Rel(FD_Rel,Rel),
count(Val,Vs,Rel,C), R='Prelude.success'.
count(Val,Vs,Rel,C), R='Prelude.True'.
translateFD_Rel('CLPFD.=#',#=) :- !.
translateFD_Rel('CLPFD./=#',#\=) :- !.
......@@ -38,16 +38,16 @@ translateFD_Rel('CLPFD.>=#',#>=) :- !.
translateFD_Rel(FD_Rel,_) :- writeErr('ERROR: Illegal FD constraint: '),
writeErr(FD_Rel), nlErr, !, fail.
prim_FD_all_different(L,R) :- all_different(L), R='Prelude.success'.
prim_FD_all_different(L,R) :- all_different(L), R='Prelude.True'.
prim_FD_indomain(Var,R) :-
(prolog(sicstus) -> indomain(Var) ; label([Var])),
R='Prelude.success'.
R='Prelude.True'.
prim_FD_labeling(Options,L,R) :-
map2M(user:translateLabelingOption,Options,PlOptions),
labeling(PlOptions,L),
R='Prelude.success'.
R='Prelude.True'.
translateLabelingOption('CLPFD.LeftMost',leftmost).
translateLabelingOption('CLPFD.FirstFail',ff).
......@@ -72,22 +72,22 @@ prim_FD_minus(Y,X,R) :- #=(R,X-Y).
prim_FD_times(Y,X,R) :- #=(R,X*Y).
prim_FD_equal(Y,X,'Prelude.success') :- #=(X,Y).
prim_FD_equal(Y,X,'Prelude.True') :- #=(X,Y).
prim_FD_notequal(Y,X,'Prelude.success') :- #\=(X,Y).
prim_FD_notequal(Y,X,'Prelude.True') :- #\=(X,Y).
prim_FD_le(Y,X,'Prelude.success') :- #<(X,Y).
prim_FD_le(Y,X,'Prelude.True') :- #<(X,Y).
prim_FD_leq(Y,X,'Prelude.success') :- #=<(X,Y).
prim_FD_leq(Y,X,'Prelude.True') :- #=<(X,Y).
prim_FD_ge(Y,X,'Prelude.success') :- #>(X,Y).
prim_FD_ge(Y,X,'Prelude.True') :- #>(X,Y).
prim_FD_geq(Y,X,'Prelude.success') :- #>=(X,Y).
prim_FD_geq(Y,X,'Prelude.True') :- #>=(X,Y).
prim_FD_solve_reify(Constraint,R) :-
translateConstraint(Constraint,PrologConstraint),
call(PrologConstraint),
R='Prelude.success'.
R='Prelude.True'.
translateConstraint(V,V) :- var(V), !.
translateConstraint(X,X) :- integer(X), !.
......
......@@ -15,13 +15,13 @@ prim_CLPR_times(Y,X,R) :- {R = X*Y}.
prim_CLPR_div(Y,X,R) :- {R = X/Y}.
prim_CLPR_le(Y,X,'Prelude.success') :- {X < Y}.
prim_CLPR_le(Y,X,'Prelude.True') :- {X < Y}.
prim_CLPR_ge(Y,X,'Prelude.success') :- {X > Y}.
prim_CLPR_ge(Y,X,'Prelude.True') :- {X > Y}.
prim_CLPR_leq(Y,X,'Prelude.success') :- {X =< Y}.
prim_CLPR_leq(Y,X,'Prelude.True') :- {X =< Y}.
prim_CLPR_geq(Y,X,'Prelude.success') :- {X >= Y}.
prim_CLPR_geq(Y,X,'Prelude.True') :- {X >= Y}.
% transform an integer into a float:
prim_CLPR_i2f(X,R) :- R is X*1.0.
......@@ -33,7 +33,7 @@ prim_minimumFor(Guard,Fun,X,E0,E) :-
?- block exec_minimum(?,?,?,-,?).
exec_minimum(Guard,Fun,X,E,E3) :-
prim_apply(Guard,X,'Prelude.success',E,E1),
prim_apply(Guard,X,'Prelude.True',E,E1),
prim_apply(Fun,X,Z,E1,E2),
minimize(Z), E2=E3.
......@@ -44,6 +44,6 @@ prim_maximumFor(Guard,Fun,X,E0,E) :-
?- block exec_maximum(?,?,?,-,?).
exec_maximum(Guard,Fun,X,E,E3) :-
prim_apply(Guard,X,'Prelude.success',E,E1),
prim_apply(Guard,X,'Prelude.True',E,E1),
prim_apply(Fun,X,Z,E1,E2),
maximize(Z), E2=E3.
......@@ -58,7 +58,7 @@ prim_getDynamicKnowledge(IsKnownAtTime) :-
-> makeShare(IsKnownAtTime,Result)
; Result = IsKnownAtTime).
prim_isKnownAtTime(DT,'Dynamic.Dynamic'(P),'Prelude.success') :-
prim_isKnownAtTime(DT,'Dynamic.Dynamic'(P),'Prelude.True') :-
P =.. [Pred,_,_,_|Args],
NP =.. [Pred,Start,Stop|Args],
call(user:NP),
......@@ -309,7 +309,6 @@ translateDynFactArg('Left','Prelude.Left') :- !.
translateDynFactArg('Right','Prelude.Right') :- !.
translateDynFactArg('Nothing','Prelude.Nothing') :- !.
translateDynFactArg('Just','Prelude.Just') :- !.
translateDynFactArg('success','Prelude.success') :- !.
translateDynFactArg('LT','Prelude.LT') :- !.
translateDynFactArg('GT','Prelude.GT') :- !.
translateDynFactArg('EQ','Prelude.EQ') :- !.
......
......@@ -148,7 +148,7 @@ prim_openPort(_,S,_) :-
nonvar(S), !,
writeErr('ERROR: openPort: stream is not a free variable'), nlErr,
fail.
prim_openPort('Ports.internalPort'([],0,0,S),S,'Prelude.success').
prim_openPort('Ports.internalPort'([],0,0,S),S,'Prelude.True').
prim_openPortOnSocket(NewSocketNr,NewPortNr,Result) :-
......@@ -370,12 +370,12 @@ prim_sendPort(RMsg,RPort,R,E0,E) :-
prim_sendPortExec(Msg,Port,R,E0,E).
prim_sendPortExec(Msg,'Ports.internalPort'(_,0,_,Stream),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to internal port
!,
add2Stream(Stream,Msg), E0=E.
prim_sendPortExec('Ports.SP_Put'(Str),'Ports.internalPort'(_,-1,_,WIn),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to stream port
!,
user:waitUntilGround(Str,E0,E), % wait for string to become bound
......@@ -384,7 +384,7 @@ prim_sendPortExec('Ports.SP_Put'(Str),'Ports.internalPort'(_,-1,_,WIn),
writeChars(user_error,Str),
nlErr)).
prim_sendPortExec('Ports.SP_GetLine'(Str),'Ports.internalPort'(WOut,-1,_,_),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to stream port
!,
readStreamLine(WOut,WOLine),
......@@ -394,7 +394,7 @@ prim_sendPortExec('Ports.SP_GetLine'(Str),'Ports.internalPort'(WOut,-1,_,_),
nlErr)),
user:constrEq(SPOutLine,Str,_,E0,E). % unify SP_Get-Arg with read line
prim_sendPortExec('Ports.SP_GetChar'(Chr),'Ports.internalPort'(WOut,-1,_,_),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to stream port
!,
get_code(WOut,NC), char_int(NC,C),
......@@ -403,7 +403,7 @@ prim_sendPortExec('Ports.SP_GetChar'(Chr),'Ports.internalPort'(WOut,-1,_,_),
nlErr)),
user:constrEq(C,Chr,_,E0,E). % unify SP_GetChar-Arg with read character
prim_sendPortExec('Ports.SP_EOF'(Bool),'Ports.internalPort'(WOut,-1,_,_),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to stream port
!,
(atEndOfStream(WOut) -> EOF='Prelude.True' ; EOF='Prelude.False'),
......@@ -412,17 +412,17 @@ prim_sendPortExec('Ports.SP_EOF'(Bool),'Ports.internalPort'(WOut,-1,_,_),
nlErr)),
user:constrEq(Bool,EOF,_,E0,E). % unify SP_EOF-Arg with current value
prim_sendPortExec('Ports.SP_Close','Ports.internalPort'(WOut,-1,_,WIn),
'Prelude.success',E0,E) :-
'Prelude.True',E0,E) :-
% send to stream port
!,
close(WIn), close(WOut), % close input and output streams
E0=E.
prim_sendPortExec(Msg,'Ports.internalPort'(_,-1,_,_),'Prelude.success',E0,E) :-
prim_sendPortExec(Msg,'Ports.internalPort'(_,-1,_,_),'Prelude.True',E0,E) :-
% send to stream port
!,
writeErr('ERROR: wrong message received by stream port: '),
writeErr(Msg), nlErr, E0=E.
prim_sendPortExec(Msg,'Ports.internalPort'(Host,SNr,PNr,_),'Prelude.success',E0,E) :-
prim_sendPortExec(Msg,'Ports.internalPort'(Host,SNr,PNr,_),'Prelude.True',E0,E) :-
% send to external port
% catch connection errors:
string2Atom(Host,AHost),
......
......@@ -77,7 +77,7 @@ prim_concurrent_and(C1,C2,R,E0,E) :-
% The always satisfiable primitive constraint:
prim_success('Prelude.success').
prim_success('Prelude.True').
% primitive for conditional rules:
?- block prim_cond(?,?,?,-,?).
......@@ -85,14 +85,14 @@ prim_cond(Cond,RHS,R,E0,E) :-
user:hnf(Cond,S,E0,E1), prim_checkcond(S,Cond,RHS,R,E1,E).
?- block prim_checkcond(-,?,?,?,?,?), prim_checkcond(?,?,?,?,-,?).
prim_checkcond('Prelude.success',_,RHS,R,E0,E) :- user:hnf(RHS,R,E0,E).
prim_checkcond('Prelude.True',_,RHS,R,E0,E) :- user:hnf(RHS,R,E0,E).
prim_checkcond('FAIL'(Src),Cond,RHS,'FAIL'(['Prelude.cond'(Cond,RHS)|Src]),E,E).
% primitive for implementing letrec:
?- block prim_letrec(?,?,?,-,?).
prim_letrec(X,XE,'Prelude.success',E0,E) :- var(XE), !, X=XE, E0=E.
prim_letrec(X,XE,'Prelude.success',E0,E) :- create_mutable(XE,MX), X=share(MX), E0=E.
prim_letrec(X,XE,'Prelude.True',E0,E) :- var(XE), !, X=XE, E0=E.
prim_letrec(X,XE,'Prelude.True',E0,E) :- create_mutable(XE,MX), X=share(MX), E0=E.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
......@@ -460,10 +460,10 @@ prim_findall(RSG,Sols,E0,E) :-
:- block prim_findall_exec(?,?,-,?).
prim_findall_exec(SG,Sols,E0,E) :-
hasPrintedFailure
-> findall((X,E1),prim_apply(SG,X,'Prelude.success',E0,E1),SolEs),
-> findall((X,E1),prim_apply(SG,X,'Prelude.True',E0,E1),SolEs),
extractSolutions(SolEs,Sols,E0,E)
; asserta(hasPrintedFailure),
findall((X,E1),prim_apply(SG,X,'Prelude.success',E0,E1),SolEs),
findall((X,E1),prim_apply(SG,X,'Prelude.True',E0,E1),SolEs),
retract(hasPrintedFailure),
extractSolutions(SolEs,Sols,E0,E).
......@@ -508,10 +508,10 @@ prim_findfirst_exec(SG,Sol,E0,E) :-
prim_findfirstWithoutPF(SG,Sol,E0,E).
prim_findfirstWithPF(SG,Sol,E0,E) :-
prim_apply(SG,X,'Prelude.success',E0,E1), !, Sol=X, E1=E.
prim_apply(SG,X,'Prelude.True',E0,E1), !, Sol=X, E1=E.
prim_findfirstWithoutPF(SG,Sol,E0,E) :-
prim_apply(SG,X,'Prelude.success',E0,E1),
prim_apply(SG,X,'Prelude.True',E0,E1),
retract(hasPrintedFailure), !, Sol=X, E1=E.
prim_findfirstWithoutPF(_,_,_,_) :-
retract(hasPrintedFailure), fail.
......@@ -536,12 +536,12 @@ prim_getOneSol_exec(SG,Sol,E0,E) :-
prim_getOneSolWithoutPF(SG,Sol,E0,E).
prim_getOneSolWithPF(SG,Sol,E0,E) :-
prim_apply(SG,X,'Prelude.success',E0,E1), !,
prim_apply(SG,X,'Prelude.True',E0,E1), !,
Sol='$io'('Prelude.Just'(X)), E1=E.
prim_getOneSolWithPF(_,'$io'('Prelude.Nothing'),E,E).
prim_getOneSolWithoutPF(SG,Sol,E0,E) :-
prim_apply(SG,X,'Prelude.success',E0,E1), retract(hasPrintedFailure), !,
prim_apply(SG,X,'Prelude.True',E0,E1), retract(hasPrintedFailure), !,
Sol='$io'('Prelude.Just'(X)), E1=E.
prim_getOneSolWithoutPF(_,'$io'('Prelude.Nothing'),E0,E) :-
retract(hasPrintedFailure), E0=E.
......@@ -655,7 +655,7 @@ unifEq(A,B,R,E0,E):- user:hnf(A,HA,E0,E1), unifEq1(HA,B,R,E1,E).
% a non-constructor term is not problematic since the functional pattern
% variable is a logical variable that is not enclosed
% by a sharing structure (compare definition of makeShare).
unifEq1(FPat,ActArg,'Prelude.success',E0,E) :-
unifEq1(FPat,ActArg,'Prelude.True',E0,E) :-
var(FPat), !,
user:occursNot(FPat,ActArg),
%FPat=ActArg, % this would implement run-time choice
......@@ -677,7 +677,7 @@ unifEq1(A,B,R,E0,E) :-
unifEq2(EqR,LinConstraints,R,E0,E) :-
isFail(EqR)
-> R=EqR, E0=E
; %(LinConstraints='Prelude.success' -> true
; %(LinConstraints='Prelude.True' -> true
% ; writeErr('Linearity constraints: '),
% writeErr(LinConstraints), nlErr),
user:hnf(LinConstraints,R,E0,E).
......@@ -715,12 +715,12 @@ getControlVar(X,Below,[control(Y,YBelow,NewVar,NewConstraint)|_],NewX) :- X==Y,
'Prelude.=:='(ShareVar,'Prelude.()'),
'Prelude.=:='(CtrlVar,'Prelude.()')),X),
NewConstraint = 'Prelude.ifVar'(CtrlVar,
'Prelude.success',
'Prelude.True',
'Prelude.=:='(X,X))
; true)).
getControlVar(X,Below,[_|L],NewVar) :- getControlVar(X,Below,L,NewVar).
getSEqConstraints(L,'Prelude.success') :- var(L), !, L=[].
getSEqConstraints(L,'Prelude.True') :- var(L), !, L=[].
getSEqConstraints([control(X,_,NewVar,NewConstraint)|L],Constraints) :-
var(NewConstraint), !, % occurred only once
X=NewVar,
......@@ -753,7 +753,7 @@ unifEqHnf(A,B,Success,E0,E) :- var(B),!,
unifEqHnf(_,'FAIL'(Src),'FAIL'(Src),E,E) :- !.
unifEqHnf(A,B,R,E0,E) :-
number(A), !,
(A=B -> R='Prelude.success', E0=E
(A=B -> R='Prelude.True', E0=E
; prim_failure(partcall(2,'Prelude.=:<=',[]),[A,B],R,E0,E)).
unifEqHnf(A,B,R,E0,E) :-
functor(A,FuncA,ArA), functor(B,FuncB,ArB), FuncA==FuncB, ArA==ArB, !,
......@@ -761,7 +761,7 @@ unifEqHnf(A,B,R,E0,E) :-
unifEqHnf(A,B,R,E0,E) :-
prim_failure(partcall(2,'Prelude.=:<=',[]),[A,B],R,E0,E).
genUnifEqHnfBody(N,Arity,_,_,'Prelude.success') :- N>Arity, !.
genUnifEqHnfBody(N,Arity,_,_,'Prelude.True') :- N>Arity, !.
genUnifEqHnfBody(N,Arity,A,B,'Prelude.=:<='(ArgA,ArgB)):-
N=Arity, !,
arg(N,A,ArgA), arg(N,B,ArgB).
......@@ -784,7 +784,7 @@ unifEqLinear(A,B,R,E0,E):-
% a non-constructor term is not problematic since the functional pattern
% variable is a logical variable that is not enclosed
% by a sharing structure (compare definition of makeShare).
unifEqLinear1(FPat,ActArg,'Prelude.success',E0,E):-
unifEqLinear1(FPat,ActArg,'Prelude.True',E0,E):-
var(FPat), !,
%FPat=ActArg, % this would implement run-time choice
% in order to implement call-time choice for pattern variables,
......@@ -801,11 +801,11 @@ unifEqLinear1(A,B,R,E0,E):-
:- block unifEqLinearHnf(?,?,?,-,?).
unifEqLinearHnf(A,B,R,E0,E) :- var(B), !,
user:nf(A,NA,E0,E1),
freeze(E1,(isFail(NA) -> R=NA, E1=E ; B=NA, R='Prelude.success', E1=E)).
freeze(E1,(isFail(NA) -> R=NA, E1=E ; B=NA, R='Prelude.True', E1=E)).
unifEqLinearHnf(_,'FAIL'(Src),'FAIL'(Src),E,E) :- !.
unifEqLinearHnf(A,B,R,E0,E) :-
number(A), !,
(A=B -> R='Prelude.success', E0=E
(A=B -> R='Prelude.True', E0=E
; prim_failure(partcall(2,'Prelude.=:<<=',[]),[A,B],R,E0,E)).
unifEqLinearHnf(A,B,R,E0,E) :-
functor(A,FuncA,ArA), functor(B,FuncB,ArB), FuncA==FuncB, ArA==ArB, !,
......@@ -813,7 +813,7 @@ unifEqLinearHnf(A,B,R,E0,E) :-
unifEqLinearHnf(A,B,R,E0,E) :-
prim_failure(partcall(2,'Prelude.=:<<=',[]),[A,B],R,E0,E).
genUnifEqLinearHnfBody(N,Arity,_,_,'Prelude.success') :- N>Arity, !.
genUnifEqLinearHnfBody(N,Arity,_,_,'Prelude.True') :- N>Arity, !.
genUnifEqLinearHnfBody(N,Arity,A,B,'Prelude.=:<<='(ArgA,ArgB)):-
N=Arity, !,
arg(N,A,ArgA), arg(N,B,ArgB).
......
......@@ -14,7 +14,7 @@
?- block 'prim_spawnConstraint'(?,?,?,-,?).
'prim_spawnConstraint'(Guard,Exp,H,E0,E) :-
user:hnf(Guard,S,E0,_), % S='Prelude.success',
user:hnf(Guard,S,E0,_), % S='Prelude.True',
user:hnf(Exp,H,E0,E).
prim_isVar(Term,H) :- var(Term), !, H='Prelude.True'.
......
......@@ -231,15 +231,15 @@ waitConcurrentConjunction(S1,S2,R,E1,E2,E) :- % E2 must be nonvar
reduceConcurrentConjunction(S2,S1,R,E2,E1,E).
% reduce a concurrent conjunction where the first argument is already evaluated
reduceConcurrentConjunction('Prelude.success',S2,R,_,E2,E) :-
reduceConcurrentConjunction('Prelude.True',S2,R,_,E2,E) :-
!, % first constraint is successful
waitForEval(S2,R,E2,E).
waitForEval(S2,R,E2,E3), R='Prelude.True', E3=E.
reduceConcurrentConjunction('FAIL'(X),_,R,E1,_,E) :-
!, % first constraint is a failure
R='FAIL'(X), E=E1.
reduceConcurrentConjunction(_,_,_,_,_,_) :-
write(user_error,'Internal error in waitConcurrentConjunction'),
nl(user_error).
%reduceConcurrentConjunction(_,_,_,_,_,_) :-
% write(user_error,'Internal error in waitConcurrentConjunction'),
% nl(user_error).
?- block waitForEval(?,?,-,?).
waitForEval(R,R,E,E).
......
......@@ -118,15 +118,15 @@ waitConcurrentConjunctionBlocked(S1,S2,R,E1,E2,E) :- % E2 must be nonvar
reduceConcurrentConjunction(S2,S1,R,E2,E1,E).
% reduce a concurrent conjunction where the first argument is already evaluated
reduceConcurrentConjunction('Prelude.success',S2,R,_<