Commit 59bc14e1 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Examples and libs updated, suspension information added to run-time system

parent d2a3be6d
......@@ -10,8 +10,10 @@
compileWithDebug/0, compileWithFailPrint/0,
hasPrintedFailure/0, printConsFailure/1,
evalToken/1, worldToken/1,
writeNQ/1, nlNQ/0, writeErr/1, nlErr/0,
writeErrNQ/1, nlErrNQ/0, writeBlanks/1,
writeNQ/1, nlNQ/0, writeLnNQ/1,
writeErr/1, nlErr/0, writeLnErr/1,
writeErrNQ/1, nlErrNQ/0, writeLnErrNQ/1,
writeBlanks/1,
onlySICStusMessage/1, checkSICStusAndWarn/1,
putChars/2, writeChars/2,
assertPakcsrc/1, writeRCvalues/0,
......@@ -140,14 +142,17 @@ verbosityDetailed :- verbosity(N), N>2.
% write on standard out if not in quiet mode:
writeNQ(T) :- quietmode(no) -> write(T); true.
nlNQ :- quietmode(no) -> nl; true.
writeLnNQ(T) :- writeNQ(T), nlNQ.
% write on user error:
writeErr(T) :- write(user_error,T).
nlErr :- nl(user_error), flush_output(user_error).
writeLnErr(T) :- writeErr(T), nlErr.
% write on user error if not in quiet mode:
writeErrNQ(T) :- quietmode(no) -> write(user_error,T); true.
nlErrNQ :- quietmode(no) -> nl(user_error); true.
writeLnErrNQ(T) :- writeErrNQ(T), nlErrNQ.
% write n blanks on standard out:
......
......@@ -131,7 +131,7 @@ processArgs([Arg|Args]) :-
processArgs(['-c',Prog|Args]) :- !,
(Args=[] -> true
; writeErr('ERROR: Illegal arguments after "-c": '),
writeErr(Args), nlErr, fail),
writeLnErr(Args), fail),
processCompileOption(Prog).
processArgs([Arg|Args]) :- % command option as in KiCS2
atom_codes(Arg,[58|CmdS]), !, % 58=':'
......@@ -142,8 +142,8 @@ processArgs([Arg|Args]) :- % command option as in KiCS2
processArgs([Arg|Args]) :-
atom_codes(Arg,[45|_]), !, % 45='-'
writeErr('ERROR: Illegal or no longer supported option: '),
writeErr([Arg|Args]), nlErr,
writeErr('Hint: use command options (like "pakcs :load rev")'), nlErr,
writeErrLn([Arg|Args]),
writeErrLn('Hint: use command options (like "pakcs :load rev")'),
halt(1).
processArgs([Arg|Args]) :-
retract(rtArgs(RTA)),
......@@ -191,14 +191,14 @@ combine2cmd([X1,X2|Xs],CmdS) :-
% Show the main options of calling pakcs:
writeMainHelp :-
nlErr,
writeErr('Usage: pakcs <options>'), nlErr,
writeLnErr('Usage: pakcs <options>'),
nlErr,
writeErr('Options:'), nlErr,
writeErr('-h|--help|-? : show this message and quit'), nlErr,
writeErr('-q|--quiet : work silently'), nlErr,
writeErr('--noreadline : do not use input line editing via command "rlwrap"'), nlErr,
writeErr('-Dname=val : define pakcsrc property "name" as "val"'), nlErr,
writeErr(':<cmd> <args> : command of the PAKCS environment'), nlErr.
writeLnErr('Options:'),
writeLnErr('-h|--help|-? : show this message and quit'),
writeLnErr('-q|--quiet : work silently'),
writeLnErr('--noreadline : do not use input line editing via command "rlwrap"'),
writeLnErr('-Dname=val : define pakcsrc property "name" as "val"'),
writeLnErr(':<cmd> <args> : command of the PAKCS environment').
% Compute the prompt of the interactive loop:
......@@ -243,11 +243,11 @@ expandCommand(AShortCmd,Cmd) :-
(FullCmds=[Cmd] -> true ;
(FullCmds=[]
-> writeErr('ERROR: unknown command: ":'),
atom_codes(ASC,AShortCmd), writeErr(ASC), writeErr('"'),
nlErr, fail
atom_codes(ASC,AShortCmd), writeErr(ASC), writeLnErr('"'),
fail
; writeErr('ERROR: ambiguous command: ":'),
atom_codes(ASC,AShortCmd), writeErr(ASC), writeErr('"'),
nlErr, fail)).
atom_codes(ASC,AShortCmd), writeErr(ASC), writeLnErr('"'),
fail)).
prefixOf(Prefix,[Full|_],Full) :- append(Prefix,_,Full).
prefixOf(Prefix,[_|FullS],Full) :- prefixOf(Prefix,FullS,Full).
......@@ -268,11 +268,11 @@ expandOption(ShortOpt,FullOpt) :-
; append(Opt,[32|OptRest],FullOpt))
; (FullOpts=[]
-> writeErr('ERROR: unknown option: '),
atom_codes(OF,OptFirst), writeErr(OF), nlErr,
writeErr('Type :set for help'), nlErr, fail
atom_codes(OF,OptFirst), writeLnErr(OF),
writeLnErr('Type :set for help'), fail
; writeErr('ERROR: option not unique: '),
atom_codes(OF,OptFirst), writeErr(OF), nlErr,
writeErr('Type :set for help'), nlErr, fail)).
atom_codes(OF,OptFirst), writeLnErr(OF),
writeLnErr('Type :set for help'), fail)).
% all possible options:
allOptions(["+allfails","-allfails",
......@@ -424,13 +424,13 @@ getMainProgPath(CurrMod,MainPath) :-
(verbosityQuiet -> true ;
lastload(LoadProgS), atom_codes(LoadProg,LoadProgS),
writeErr('*** Warning: module loaded from : '),
writeErr(LoadProg), nlErr,
writeLnErr(LoadProg),
writeErr(' main expression parsed w.r.t. source module: '),
writeErr(CurrMod), nlErr).
writeLnErr(CurrMod)).
getMainProgPath(_,_) :-
lastload(MainProgS), atom_codes(MainProg,MainProgS),
writeErr('Source program for module "'), writeErr(MainProg),
writeErr('" not found!'), nlErr,
writeLnErr('" not found!'),
!, fail.
% delete all auxiliary files for storing main expression:
......@@ -540,16 +540,16 @@ flatExp2MainExp(Vs,'Comb'(CType,FNameS,FArgs),Vs1,Exp) :-
flatExp2MainExp(Vs,'Free'(_,FExp),Vs1,Exp) :-
flatExp2MainExp(Vs,FExp,Vs1,Exp).
flatExp2MainExp(_,'Let'(_,_),_,_) :-
writeErr('ERROR: Let not allowed in main expressions!'), nlErr,
writeLnErr('ERROR: Let not allowed in main expressions!'),
!, fail.
flatExp2MainExp(_,'Or'(_,_),_,_) :-
writeErr('ERROR: Or not allowed in main expressions!'), nlErr,
writeLnErr('ERROR: Or not allowed in main expressions!'),
!, fail.
flatExp2MainExp(_,'Typed'(_,_),_,_) :-
writeErr('ERROR: Typed not allowed in main expressions!'), nlErr,
writeLnErr('ERROR: Typed not allowed in main expressions!'),
!, fail.
flatExp2MainExp(_,'Case'(_,_,_),_,_) :-
writeErr('ERROR: Case not allowed in main expressions!'), nlErr,
writeLnErr('ERROR: Case not allowed in main expressions!'),
!, fail.
flatExps2MainExps(Vs,[],Vs,[]).
......@@ -744,8 +744,8 @@ processCommand("load",Arg) :- !,
processCommand("reload",[]) :- !,
lastload(Prog),
(Prog="" -> writeErr('ERROR: no load command to repeat'),
nlErr, !, fail
(Prog="" -> writeLnErr('ERROR: no load command to repeat'),
!, fail
; true),
processCompile(Prog,PrologFile),
!,
......@@ -843,12 +843,12 @@ processCommand("coosy",[]) :- !,
appendAtoms(['"',CoosyHome,'/CoosyGUI" ',CoosyHome,' &'],GuiCmd),
shellCmdWithCurryPathWithReport(GuiCmd),
(waitForFile('COOSYLOGS/READY',3) -> true
; writeErr('ERROR: COOSy startup failed'), nlErr, fail),
; writeLnErr('ERROR: COOSy startup failed'), fail),
printCurrentLoadPath.
processCommand("xml",[]) :- !,
lastload(Prog),
(Prog="" -> write('ERROR: no program loaded for XML translation'), nl,
(Prog="" -> writeLnErr('ERROR: no program loaded for XML translation'),
!, fail
; true),
atom_codes(ProgA,Prog),
......@@ -858,8 +858,7 @@ processCommand("xml",[]) :- !,
processCommand("peval",[]) :- !,
lastload(Prog),
(Prog="" -> write('ERROR: no program loaded for partial evaluation'),
nl,
(Prog="" -> writeLnErr('ERROR: no program loaded for partial evaluation'),
!, fail
; true),
atom_codes(ProgA,Prog),
......@@ -922,7 +921,7 @@ processCommand("show",ShTail) :- % show source of a module
shellCmdWithReport(Cmd).
processCommand("show",_) :- !,
writeErr('ERROR: Source file not found'), nlErr.
writeLnErr('ERROR: Source file not found').
processCommand("source",Arg) :-
append(PModS,[46|FunS],Arg), !, % show source code of function in module
......@@ -934,23 +933,21 @@ processCommand("source",ExprInput) :- !, % show source code of a function
showSourceCode(Term).
processCommand("cd",DirString) :- !,
(DirString="" -> writeErr('ERROR: missing argument'), nlErr, fail
(DirString="" -> writeLnErr('ERROR: missing argument'), fail
; true),
atom_codes(Dir,DirString),
(existsDirectory(Dir)
-> (setWorkingDirectory(Dir) -> true
; writeErr('ERROR: cd command failed!'), nlErr)
; writeLnErr('ERROR: cd command failed!'))
; writeErr('ERROR: directory \''),
writeErr(Dir),
writeErr('\' does not exist!'),
nlErr).
writeLnErr('\' does not exist!')).
processCommand("save",Exp) :- !,
(Exp=[] -> MainGoal="main" ; MainGoal=Exp),
currentprogram(Prog),
atom_codes(ProgName,Prog),
(Prog="Prelude" -> writeErr('ERROR: no program loaded'),
nlErr, fail
(Prog="Prelude" -> writeLnErr('ERROR: no program loaded'), fail
; true),
appendAtom(ProgName,'.state',ProgStName),
initializationsInProg(ProgInits),
......@@ -1009,7 +1006,7 @@ addImportModule(Arg) :-
addImportModule(Arg) :-
writeErr('ERROR: Source file of module "'),
atomCodes(ArgA,Arg), writeErr(ArgA),
writeErr('" not found!'), nlErr.
writeLnErr('" not found!').
% show the Curry programs in a given directory:
showProgramsInDirectory(Dir) :-
......@@ -1061,8 +1058,7 @@ processCompile(ProgS,PrologFile) :-
-> true
; writeErr('ERROR: FlatCurry file for program "'),
writeErr(Prog),
writeErr('" not found!'),
nlErr,
writeLnErr('" not found!'),
deletePrologTarget(LocalPrologFile),!, failWithExitCode),
prog2PrologFile(PathProgName,PrologFile),
checkProgramHeader(PrologFile),
......@@ -1079,8 +1075,8 @@ reloadMainProgram :-
-> true
; writeErr('ERROR: FlatCurry file for program "'),
writeErr(Prog),
writeErr('" not found!'),
nlErr, !, fail),
writeLnErr('" not found!'),
!, fail),
prog2PrologFile(PathProgName,PrologFile),
loadMain(PrologFile),
!.
......@@ -1088,8 +1084,7 @@ reloadMainProgram :-
% create a saved state for an already compiled Curry program:
createSavedState(ProgPl,ProgState,InitialGoal) :-
writeErrNQ('>>> Creating saved state without interactive environment...'),
nlErrNQ,
writeLnErrNQ('>>> Creating saved state without interactive environment...'),
findall(assertz(prologbasics:pakcsrc(Tag,Value)),pakcsrc(Tag,Value),Pakcsrcs),
foldr(',',true,Pakcsrcs,AssertPakcsrcs),
generateMainPlFile(ProgPl,MainPrologFile),
......@@ -1116,9 +1111,9 @@ createSavedState(ProgPl,ProgState,InitialGoal) :-
% process the various options of the ":set" command:
processSetOption("+error") :- !,
writeErr('WARNING: option "error" no longer supported!'), nlErr.
writeLnErr('WARNING: option "error" no longer supported!').
processSetOption("-error") :- !,
writeErr('WARNING: option "error" no longer supported!'), nlErr.
writeLnErr('WARNING: option "error" no longer supported!').
processSetOption("+free") :- !,
retract(freeVarsUndeclared(_)),
asserta(freeVarsUndeclared(yes)).
......@@ -1209,7 +1204,7 @@ processSetOption(Option) :-
append("file:",FileS,OptTail)
-> atom_codes(File,FileS), asserta(printConsFailure(file(File)))
; asserta(printConsFailure(Old)),
writeErr('ERROR: illegal option for +consfail!'), nlErr),
writeLnErr('ERROR: illegal option for +consfail!')),
(Old=no -> reloadMainProgram ; true).
processSetOption("+debug") :- compileWithDebug, !.
......@@ -1282,7 +1277,7 @@ processSetOption(Option) :-
atom_codes(PN,P),
spypoint(PN).
processSetOption(_) :- !,
writeErr('ERROR: unknown option. Type :set for help'), nlErr.
writeLnErr('ERROR: unknown option. Type :set for help').
printCurrentLoadPath :-
loadPath('.',LP),
......@@ -1313,8 +1308,7 @@ checkFreeVars(FreeVars,Vs) :-
!,
writeErr('ERROR: Expression contains unknown symbols: '),
writeVar(user_error,V), writeVars(user_error,RVs), nlErr,
writeErr('(Note: free variables should be declared with "where...free" in initial goals)'),
nlErr,
writeLnErr('(Note: free variables should be declared with "where...free" in initial goals)'),
failWithExitCode.
checkFreeVars(_,_).
......@@ -1427,7 +1421,7 @@ parseProgram(ProgS,Verbosity,Warnings) :-
setWorkingDirectory(ProgPath),
appendAtoms([CM6,' ',POpts,' ',ProgName],LoadCmd),
(shellCmdWithReport(LoadCmd) -> Parse=ok
; writeErr('ERROR occurred during parsing!'), nlErr, Parse=failed),
; writeLnErr('ERROR occurred during parsing!'), Parse=failed),
setWorkingDirectory(CurDir),
!, Parse=ok, % proceed only in case of successful parsing
% finally, we apply the FlatCury preprocessor:
......@@ -1441,7 +1435,7 @@ parseProgram(ProgS,Verbosity,Warnings) :-
stripSuffix(PPSA,ProgNameA),
appendAtoms([PP2,CWCA,' ',ProgNameA],PPCmd),
(shellCmdWithReport(PPCmd) -> true
; writeErr('ERROR occurred during FlatCurry preprocessing!'), nlErr,
; writeLnErr('ERROR occurred during FlatCurry preprocessing!'),
fail).
parseProgram(_,_,_). % do not parse if source program does not exist
......@@ -1679,7 +1673,7 @@ transDefinedFunc(F,_) :-
constructorOrFunctionType(FI,F,_,_), constructorOrFunctionType(FJ,F,_,_),
\+ FI=FJ, !,
writeErr('ERROR: Symbol "'), writeErr(F),
writeErr('" not unique due to multiple imports.'), nlErr, fail.
writeLnErr('" not unique due to multiple imports.'), fail.
transDefinedFunc(F,FI) :-
constructorOrFunctionType(FI,F,_,_).
% allow access to non-exported qualified names in the interpreter shell:
......@@ -1945,7 +1939,7 @@ isValidProgramName(ProgString) :-
isValidModuleName(ModString) :-
(isValidModuleString(ModString) -> true
; writeErr('ERROR: Illegal module name: '),
atom_codes(ModName,ModString), writeErr(ModName), nlErr,
atom_codes(ModName,ModString), writeLnErr(ModName),
fail).
isValidModuleString([]).
......@@ -2142,7 +2136,7 @@ updateProperty(N,Ns,Vs,[_|Ps],NL) :- updateProperty(N,Ns,Vs,Ps,NL).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% show source code of a function call:
showSourceCode(F) :- var(F),
writeErr('Cannot show source code of a variable!'), nlErr.
writeLnErr('Cannot show source code of a variable!').
showSourceCode(partcall(_,QF,_)) :- !,
atom_codes(QF,QFS),
append(ModS,[46|FS],QFS), !,
......
This diff is collapsed.
......@@ -4,6 +4,7 @@
:- module(evaluator,
[currentprogram/1, numberOfCalls/1, numberOfExits/1,
singlestep/0, tracemode/0, spymode/0, spypoints/1,
addSuspensionReason/1,
printDepth/1, printAllFailures/0,
profiling/1, suspendmode/1, interactiveMode/1,
firstSolutionMode/1, timemode/1,
......@@ -48,6 +49,32 @@ interactiveMode(no). % interactive mode?
firstSolutionMode(no). % first solution printing mode?
timemode(no). % yes if execution times should be shown
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliaries for showing suspension reasons:
% The reasons for suspensions will be collected during run-time
% and will be shown at the end, if the main expression is suspended.
:- dynamic suspensionReasons/1.
suspensionReasons([]).
resetSuspensionReasons :-
retract(suspensionReasons(_)),
asserta(suspensionReasons([])), !.
% add a potential reason why a computation is suspended
addSuspensionReason(Reason) :-
suspensionReasons(Reasons),
\+ member(Reason,Reasons), !,
retract(suspensionReasons(Reasons)),
asserta(suspensionReasons([Reason|Reasons])), !.
addSuspensionReason(_).
showSuspensionReasons :- suspensionReasons([]), !.
showSuspensionReasons :-
suspensionReasons(Reasons),
writeLnErr('*** Possible reasons for the suspension:'),
map1M(basics:writeLnErr,Reasons).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% evaluate a goal and exit (used in saved states):
......@@ -59,6 +86,7 @@ evaluateGoalAndExit(Goal) :-
% evaluate an expression with a given type and a given list of free variables:
evaluateMainExpression(Exp,Type,Vs) :-
setExitCode(2), % exit code = 2 if value cannot be computed
resetSuspensionReasons,
retract(allsolutionmode(_)),
((interactiveMode(no), firstSolutionMode(no))
-> asserta(allsolutionmode(yes))
......@@ -106,8 +134,7 @@ evaluateMainExp(E,Vs,RTime1,ETime1) :-
; ((nonvar(V), V='$io'(_))
-> (nextIOproof
-> retract(nextIOproof),
writeErr('ERROR: non-determinism in I/O actions occurred!'),
nlErr,
writeLnErr('ERROR: non-determinism in I/O actions occurred!'),
showProfileData,
!, fail
; (profiling(yes) % no IO ND checking during profiling
......@@ -136,7 +163,7 @@ evaluateMainExp(_,_,RTime1,ETime1) :- % ignore proof attempt for IO ND
!, fail.
evaluateMainExp(_,_,_,_) :-
exitCode(2), % we still try to find the first value
writeErr('*** No value found!'), nlErr,
writeLnErr('*** No value found!'),
!, fail.
evaluateMainExp(_,_,RTime1,ETime1) :-
(interactiveMode(yes)
......@@ -159,7 +186,7 @@ showStatistics(RTime1,ETime1) :-
; true).
writeMainResult(Done,_,_,_) :- var(Done), !, % goal suspended
writeErr('*** Goal suspended!'), nlErr.
writeLnErr('*** Goal suspended!').
writeMainResult(_,Suspended,Vs,Value) :- var(Value), !,
((verbosemode(yes), verbosityNotQuiet) -> write('Result: ') ; true),
writeCurryTermWithFreeVarNames(Suspended,Vs,Value), nl.
......@@ -328,8 +355,8 @@ writeFunctionFailureList(Stream,FTLen,[FCall|FailSrc]) :- !,
% Write suspended goals if necessary:
writeSuspendedGoals(Suspended) :-
suspendmode(no)
-> writeErr('*** Warning: there are suspended constraints (for details: ":set +suspend")'),
nlErr
-> writeLnErr('*** Warning: there are suspended constraints (for details: ":set +suspend")'),
showSuspensionReasons
; write('Suspended goals (in internal representation):'), nl,
map1M(evaluator:tryWriteSuspGoal,Suspended).
......
......@@ -26,6 +26,7 @@
:- use_module('../prologbasics').
:- use_module('../basics').
:- use_module('../evaluator').
% dereference a function's argument, i.e., remove all top-level sharing structures:
%derefRoot(R,V) :- var(R), !, V=R.
......@@ -374,8 +375,10 @@ prim_ensureNotFree(Arg,Result,E0,E) :-
?- block prim_ensureNotFreeHNF(?,?,-,?).
prim_ensureNotFreeHNF(Val,Result,E0,E) :-
isFail(Val) -> Result=Val, E0=E
; prim_ensureHnfNotFree(Val,Result,E0,E).
isFail(Val)
-> Result=Val, E0=E
; (var(Val) -> addSuspensionReason('Applying a primitive (rigid) operation to a free variable') ; true),
prim_ensureHnfNotFree(Val,Result,E0,E).
?- block prim_ensureHnfNotFree(-,?,?,?), prim_ensureHnfNotFree(?,?,-,?).
prim_ensureHnfNotFree(Val,Val,E,E).
......@@ -409,9 +412,9 @@ prim_compare(X,Y,R,E0,E) :-
user:hnf(Y,HY,E1,E2),
prim_compareHNF(HX,HY,R,E2,E).
?- block %prim_compareHNF(-,?,?,?,?), prim_compareHNF(?,-,?,?,?),
prim_compareHNF(?,?,?,-,?).
?- block prim_compareHNF(?,?,?,-,?).
prim_compareHNF(X,Y,R,E0,E) :- var(X), var(Y), !,
addSuspensionReason('Comparing (with <, >,...) two free variables'),
when((nonvar(X);nonvar(Y)), prim_compareHNF(X,Y,R,E0,E)).
prim_compareHNF(X,Y,R,E0,E) :- var(X), !,
prim_compareHNF(Y,X,R0,E0,E1),
......@@ -419,6 +422,7 @@ prim_compareHNF(X,Y,R,E0,E) :- var(X), !,
prim_compareHNF('FAIL'(Src),_,'FAIL'(Src),E,E) :- !.
prim_compareHNF(_,Y,R,E0,E) :- nonvar(Y), Y='FAIL'(_), !, R=Y, E0=E.
prim_compareHNF(X,Y,R,E0,E) :- var(Y), (number(X); isCharCons(X)), !,
addSuspensionReason('Comparing (with <, >,...) a free variable with a number or character'),
when(nonvar(Y), prim_compareHNF(X,Y,R,E0,E)).
prim_compareHNF(X,Y,R,E0,E) :- number(X), !,
(X=Y -> R='Prelude.EQ' ; (X<Y -> R='Prelude.LT' ; R='Prelude.GT')),
......
......@@ -17,7 +17,7 @@ together with the following operations:
assertTrue :: String -> Bool -> Assertion ()
assertEqual :: String -> a -> a -> Assertion a
assertValues :: String -> a -> [a] -> Assertion a
assertSolutions :: String -> (a->Success) -> [a] -> Assertion a
assertSolutions :: String -> (a->Bool) -> [a] -> Assertion a
assertIO :: String -> IO a -> a -> Assertion a
assertEqualIO :: String -> IO a -> IO a -> Assertion a
\end{curry}
......
......@@ -194,11 +194,11 @@ where $k$ is the arity of $C$.}
\noindent
For example, we could define a Smith-tester by writing:
\begin{curry}
isSmith Agent { lastName = "Smith" } = success
isSmith Agent { lastName = "Smith" } = True
\end{curry}
which is equivalent to
\begin{curry}
isSmith (Agent _ "Smith" _) = success
isSmith (Agent _ "Smith" _) = True
\end{curry}
\subsubsection{Field Labels and Modules}
......
......@@ -44,13 +44,13 @@ Subtraction on floating point numbers.
Multiplication on floating point numbers.
\item[\code{(/.) :: Float -> Float -> Float}]~\\
Division on floating point numbers.
\item[\code{(<.) :: Float -> Float -> Success}]~\\
\item[\code{(<.) :: Float -> Float -> Bool}]~\\
Comparing two floating point numbers with the ``less than'' relation.
\item[\code{(>.) :: Float -> Float -> Success}]~\\
\item[\code{(>.) :: Float -> Float -> Bool}]~\\
Comparing two floating point numbers with the ``greater than'' relation.
\item[\code{(<=.) :: Float -> Float -> Success}]~\\
\item[\code{(<=.) :: Float -> Float -> Bool}]~\\
Comparing two floating point numbers with the ``less than or equal'' relation.
\item[\code{(>=.) :: Float -> Float -> Success}]~\\
\item[\code{(>=.) :: Float -> Float -> Bool}]~\\
Comparing two floating point numbers with the ``greater than or equal''
relation.
\item[\code{i2f :: Int -> Float}]~\\
......@@ -104,7 +104,7 @@ Appendix~\ref{sec-external-functions}), it is relatively
easy to provide the complete functionality.}
\begin{description}
\item[\code{domain :: [Int] -> Int -> Int -> Success}]~\\
\item[\code{domain :: [Int] -> Int -> Int -> Bool}]~\\
The constraint \ccode{domain [$x_1,\ldots,x_n$] $l$ $u$}
is satisfied if the domain of all variables $x_i$ is the interval $[l,u]$.
\item[\code{(+\#) :: Int -> Int -> Int}]~\\
......@@ -113,36 +113,36 @@ Addition on finite domain values.
Subtraction on finite domain values.
\item[\code{(*\#) :: Int -> Int -> Int}]~\\
Multiplication on finite domain values.
\item[\code{(=\#) :: Int -> Int -> Success}]~\\
\item[\code{(=\#) :: Int -> Int -> Bool}]~\\
Equality of finite domain values.
\item[\code{(/=\#) :: Int -> Int -> Success}]~\\
\item[\code{(/=\#) :: Int -> Int -> Bool}]~\\
Disequality of finite domain values.
\item[\code{(<\#) :: Int -> Int -> Success}]~\\
\item[\code{(<\#) :: Int -> Int -> Bool}]~\\
``less than'' relation on finite domain values.
\item[\code{(<=\#) :: Int -> Int -> Success}]~\\
\item[\code{(<=\#) :: Int -> Int -> Bool}]~\\
``less than or equal'' relation on finite domain values.
\item[\code{(>\#) :: Int -> Int -> Success}]~\\
\item[\code{(>\#) :: Int -> Int -> Bool}]~\\
``greater than'' relation on finite domain values.
\item[\code{(>=\#) :: Int -> Int -> Success}]~\\
\item[\code{(>=\#) :: Int -> Int -> Bool}]~\\
``greater than or equal'' relation on finite domain values.
\item[\code{sum :: [Int] -> (Int -> Int -> Success) -> Int -> Success}]~\\
\item[\code{sum :: [Int] -> (Int -> Int -> Bool) -> Int -> Bool}]~\\
The constraint \ccode{sum [$x_1,\ldots,x_n$] $op$ $x$}
is satisfied if all $x_1+\cdots + x_n \mathrel{op} x$ is satisfied,
where $op$ is one of the above finite domain constraint relations
(e.g., \ccode{=\#}).
\item[\code{scalar_product :: [Int] -> [Int] -> (Int -> Int -> Success) -> Int -> Success}]~\\
\item[\code{scalar_product :: [Int] -> [Int] -> (Int -> Int -> Bool) -> Int -> Bool}]~\\
The constraint \ccode{scalar_product [$c_1,\ldots,c_n$] [$x_1,\ldots,x_n$] $op$ $x$}
is satisfied if all $c_1 x_1+\cdots + c_n x_n \mathrel{op} x$ is satisfied,
where $op$ is one of the above finite domain constraint relations.
\item[\code{count :: Int -> [Int] -> (Int -> Int -> Success) -> Int -> Success}]~\\
\item[\code{count :: Int -> [Int] -> (Int -> Int -> Bool) -> Int -> Bool}]~\\
The constraint \ccode{count $k$ [$x_1,\ldots,x_n$] $op$ $x$}
is satisfied if all $k \mathrel{op} x$ is satisfied,
where $n$ is the number of the $x_i$ that are equal to $k$ and
$op$ is one of the above finite domain constraint relations.
\item[\code{all_different :: [Int] -> Success}]~\\
The constraint \ccode{all_different [$x_1,\ldots,x_n$]}
\item[\code{allDifferent :: [Int] -> Bool}]~\\
The constraint \ccode{allDifferent [$x_1,\ldots,x_n$]}
is satisfied if all $x_i$ have pairwise different values.
\item[\code{labeling :: [LabelingOption] -> [Int] -> Success}]~\\
\item[\code{labeling :: [LabelingOption] -> [Int] -> Bool}]~\\
The constraint \ccode{labeling $os$ [$x_1,\ldots,x_n$]}
non-deterministically instantiates all $x_i$ to the values
of their domain according to the options $os$ (see the module documentation
......@@ -170,7 +170,7 @@ smm l =
domain l 0 9 &
s ># 0 &
m ># 0 &
all_different l &
allDifferent l &
1000 *# s +# 100 *# e +# 10 *# n +# d
+# 1000 *# m +# 100 *# o +# 10 *# r +# e
=# 10000 *# m +# 1000 *# o +# 100 *# n +# 10 *# e +# y &
......@@ -204,14 +204,14 @@ This declaration includes the following entities in the program:
\item[\code{Port a}\pindex{Port}]~\\
This is the datatype of a port to which one can send messages of type \code{a}.
\item[\code{openPort :: Port a -> [a] -> Success}]~\\
\item[\code{openPort :: Port a -> [a] -> Bool}]~\\
The constraint \ccode{openPort p s}\pindex{openPort}
establishes a new \emph{internal port}
\code{p} with an associated message stream \code{s}. \code{p} and \code{s} must be
unbound variables,
otherwise the constraint fails (and causes a runtime error).
\item[\code{send :: a -> Port a -> Success}]~\\
\item[\code{send :: a -> Port a -> Bool}]~\\
The constraint \ccode{send m p}\pindex{send}
is satisfied if \code{p} is constrained
to contain the message \code{m}, i.e., \code{m} will be sent to the port
......
......@@ -16,7 +16,7 @@ magic n | take n (generateFD n) =:= l &
generateFD n | n ># 0 & domain [x] 0 (n-1) = x : generateFD n where x free
constrain [] _ _ [] = success
constrain [] _ _ [] = True
constrain (x:xs) l i (j:s2) = i=:=j & count i l (=#) x & constrain xs l (i+1) s2
......
......@@ -8,11 +8,11 @@ queens options n l =
all_safe l &
labeling options l
all_safe [] = success
all_safe [] = True
all_safe (q:qs) = safe q qs 1 & all_safe qs
safe :: Int -> [Int] -> Int -> Success
safe _ [] _ = success
safe :: Int -> [Int] -> Int -> Bool
safe _ [] _ = True
safe q (q1:qs) p = no_attack q q1 p & safe q qs (p+#1)
no_attack q1 q2 p = q1 /=# q2 & q1 /=# q2+#p & q1 /=# q2-#p
......