sg@icdoc.UUCP (06/27/85)
#!/bin/sh
#
# Apologies for posting such a long article.
#
# Since my recent announcement "PARLOG system available", in which
# I offered to mail copies of the PARLOG system to anyone on request,
# I have been inundated (!) with enquiries. Owing to the high cost
# of transatlantic net mail and its less-than-100% reliability, I
# have been advised to post it instead. So here it is.
#
# The version here runs on top of C-Prolog 1.4 - 1.5. Some changes may
# be required to run on compatible Prolog systems. There are 14 files
# altogether:
#
# parlog hamming.par
# parcomp primes.par
# parrts adpairs.par
# parstats print.par
# orrts prolog.par
# editor
# par
# npar
# nparrts
#
# Those with extension ".par" are example PARLOG programs, the others
# are Prolog programs comprising the PARLOG system.
#
# Before use, the article should be run through a shell to separate out
# the files: "sh <article".
#
# You will need the manual "How to use PARLOG". To get it, please send
# me a postal address, and request any PARLOG papers you require.
#
#
echo 'Start of PARLOG, part 01 of 01:'
echo 'x - parlog'
sed 's/^X//' > parlog << '/'
X/* PARLOG system: parlog
X*/
X
X %*********************************************************
X % *
X % PARLOG SYSTEM *
X % for C-Prolog 1.4 *
X % *
X % October 1984 *
X % *
X % Copyright 1984 Steve Gregory *
X % *
X % Ported to C-Prolog by Ken Satoh *
X % *
X %*********************************************************
X
X :-op(1100,xfx,:).
X :-op(1150,fx,[(parlist),(parcomp),(query),(parmode),(prolog),(trace),
X (statistics),(schedule),(try)]).
X :-op(1200,fx,[(enter),(reduce),(suspend)]).
X
X query(C):-
X conjlist(C,Clist),
X compconj(Clist,SH,[],PROCS,[]),
X abolish(andstate,1),
X assert(andstate(PROCS)),
X conjlist(SHCONJ,SH),
X call(SHCONJ),
X run.
X
X conjlist(true,[]):-!.
X conjlist((B,R),[B,H|T]):-!,conjlist(R,[H|T]).
X conjlist(B,[B]).
X
X compconj([],ST,ST,T,T):-!.
X compconj([CALL|CS],[CALL|SH],ST,H,T):-sys(CALL),!,
X compconj(CS,SH,ST,H,T).
X compconj([CALL|CS],SH,ST,[[CRN|ARGS]|H],T):-
X CALL =.. [RN|ARGS],
X compname(RN,CRN),
X compconj(CS,SH,ST,H,T).
X
X sys(V):-var(V).
X sys(C):-system(C).
X sys(C):-functor(C,RN,ARITY),prolog(RN).
X
X compname(RN,CRN):-
X name(RN,X),name(CRN,[99|X]).
X
/
echo 'x - parcomp'
sed 's/^X//' > parcomp << '/'
X/* PARLOG system: parcomp
X*/
X
X parcomp(RNS):-
X abolish(genfile,1),
X comp(RNS).
X
X parcomp(RNS,FN):-
X abolish(genfile,1),
X assert(genfile(FN)),
X comp(RNS),
X fail.
X parcomp(RNS,FN):-
X abolish(genfile,1),
X tell(FN),
X told.
X
X comp(all):-
X parmode(RNM),
X functor(RNM,RN,ARITY),
X compilereln(RN),
X fail.
X comp(all):-
X genfile(FN),
X prolog(RN),
X tell(FN),
X listing(RN),
X tell(user),
X fail.
X comp(all):-!.
X comp(RN):-atom(RN),!,
X compilereln(RN).
X comp([]):-!.
X comp([RelationName|Namelist]):-
X compilereln(RelationName),
X !,
X comp(Namelist).
X
X compilereln(RelationName):-
X parmode(RelationMode),
X RelationMode =.. [RelationName|Modelist],
X !,
X functor(RelationMode,RelationName,Arity),
X write('compiling '),write(RelationName),nl,
X killdefn(RelationName,Arity),
X setting((schedule),RelationName,breadth_first,Schedule),
X setting((try),RelationName,parallel,Try),
X setting((trace),RelationName,off,Traceflag),
X setting((statistics),RelationName,off,Stflag),
X firstclause(RelationName,Modelist,Traceflag,Stflag),
X assert(first),
X compileclauses(RelationName,Modelist,Schedule,Try,Traceflag,Stflag),
X abolish(first,0),
X writedefn(RelationName,Arity),
X write('compiled '),write(RelationName),nl.
X compilereln(RelationName):-
X write('!!! '),write(RelationName),write(' not defined'),nl.
X
X killdefn(RelationName,Arity):-
X compname(RelationName,CrelationName),
X Carity is Arity + 3,
X abolish(CrelationName,Carity).
X
X setting(Setting,RelationName,Def,S):-
X Head =.. [Setting,RelationName,S],
X call(Head),
X !.
X setting(Setting,RelationName,Def,S):-
X Head =.. [Setting,S],
X call(Head),
X !.
X setting(Setting,RelationName,Def,Def).
X
X firstclause(RelationName,Modelist,off,off):-!.
X firstclause(RelationName,Modelist,Traceflag,Stflag):-
X compname(RelationName,CrelationName),
X varargs(Modelist,Args),
X compstats(Stflag,[(enter)],Tail,[fail]),
X Call =.. [RelationName|Args],
X comptrace(Traceflag,enter(Call),Body,Tail),
X Head =.. [CrelationName,CompileH,CompileT,Result|Args],
X conjlist(Bconj,Body),
X assert((Head:-Bconj)).
X
X varargs([],[]):-!.
X varargs([U|X],[V|Y]):-varargs(X,Y).
X
X compstats(off,Call,T,T):-!.
X compstats(on,Call,[Scall|T],T):-Scall =.. [stats|Call].
X
X comptrace(off,Call,T,T):-!.
X comptrace(on,Call,[write(Call),nl|T],T).
X
X compileclauses(RelationName,Modelist,Schedule,Try,Traceflag,Stflag):-
X current_predicate(RelationName,Head),
X clause(Head,Body),
X Head =.. [RelationName|Args],
X compileclause(RelationName,Modelist,Args,Body,
X Schedule,Traceflag,Stflag),
X Try = sequential,
X susclause(RelationName,Modelist,Traceflag,Stflag),
X assert(first),
X fail.
X compileclauses(RelationName,Modelist,Schedule,parallel,Traceflag,Stflag):-
X !,
X susclause(RelationName,Modelist,Traceflag,Stflag).
X compileclauses(_,_,_,_,_,_).
X
X compileclause(RelationName,Modelist,Args,Body,Schedule,Traceflag,Stflag):-
X compname(RelationName,CrelationName),
X comphargs(Modelist,Args,Oargs,Inpairs,Eqpairs),
X compinmatch(Inpairs,T0,T1),
X compeqmatch(Eqpairs,T1,T2),
X splitrhs(Body,Guard,NewBody),
X compguard(Guard,T2,T3),
X compcommit(T3,T4),
X Call =.. [RelationName|Oargs],
X comptrace(Traceflag,reduce(Call),T4,T5),
X compstats(Stflag,[(reduce),RelationName],T5,T6),
X compbody(NewBody,Schedule,H,T,T6,[]),
X Head =.. [CrelationName,H,T,reduced|Oargs],
X conjlist(NewT0,T0),
X assert((Head:-NewT0)),
X !.
X compileclause(_,_,_,_,_,_,_):-
X write('!!! error in clause'),nl,fail.
X
X comphargs(Modelist,Args,Oargs,Inpairs,Eqpairs):-
X hargs(Modelist,Args,Oargs,Inargs,Oinargs,Inpairs),
X inargs(Inargs,Oinargs,Eqpairs,[],[],Vars).
X
X hargs([],[],[],[],[],[]):-!.
X hargs([^|Modelist],[Arg|Args],[Arg|Oargs],Inargs,Oinargs,Inpairs):-
X !,
X hargs(Modelist,Args,Oargs,Inargs,Oinargs,Inpairs).
X hargs([?|Modelist],[Arg|Args],[Oarg|Oargs],[Arg|Inargs],[Newarg|Oinargs],
X Inpairs):-
X !,
X harg(Arg,Oarg,Newarg,Inpairs,Inpairs1),
X hargs(Modelist,Args,Oargs,Inargs,Oinargs,Inpairs1).
X hargs(_,_,_,_,_,_):-
X write('!!! wrong number of head arguments'),nl,fail.
X
X harg(Arg,Oarg,Oarg,Inpairs,Inpairs):-var(Arg),!.
X harg(Arg,Oarg,Newarg,[(Oarg,Newarg)|Inpairs],Inpairs).
X
X inargs(Arg,V,[(Arg,V)|Eqpairs],Eqpairs,Ivars,Ivars):-
X var(Arg),
X varin(Arg,Ivars),
X !.
X inargs(Arg,Arg,Eqpairs,Eqpairs,Ivars,[Arg|Ivars]) :- var(Arg), !.
X inargs([Arg|Args],[Oarg|Oargs],Eqpairs,Oeqpairs,Ivars,Oivars) :- !,
X inargs(Arg,Oarg,Eqpairs,Ieqpairs,Ivars,Iivars),
X inargs(Args,Oargs,Ieqpairs,Oeqpairs,Iivars,Oivars).
X inargs(Arg,Arg,Eqpairs,Eqpairs,Ivars,Ivars):- atomic(Arg), !.
X inargs(Arg,Oarg,Eqpairs,Oeqpairs,Ivars,Oivars) :-
X Arg =.. [F|Args],
X inargs(Args,Oargs,Eqpairs,Oeqpairs,Ivars,Oivars),
X Oarg =.. [F|Oargs].
X
X varin(U,[V|Vars]):-samevar(U,V),!.
X varin(U,[_|Vars]):-varin(U,Vars).
X
X samevar(0,1):-!,fail.
X samevar(_,_).
X
X compinmatch([],T,T):-!.
X compinmatch(Pairs,H,T):-
X decompose(Pairs,Vars,Shterms,Npairs),
X (Vars = [V],Shterms = [Sht];
X V =.. [term|Vars], Sht =.. [term|Shterms]),
X !,
X vartests(Vars,H,[(V = Sht)|T1]),
X compinmatch(Npairs,T1,T).
X
X decompose([],[],[],[]):-!.
X decompose([(Var,Term)|Pairs],[Var|Vars],[Shterm|Shterms],Npairs):-
X decterm(Term,Shterm,Npairs,Np),
X decompose(Pairs,Vars,Shterms,Np).
X
X decterm(Term,Term,Pairs,Pairs) :- atomic(Arg), !.
X decterm(Term,Shterm,Pairs,Npairs) :-
X Term =.. [F|T],
X decsubterms(T,Sht,Pairs,Npairs),
X Shterm =.. [F|Sht].
X
X decsubterms([],[],Pairs,Pairs) :- !.
X decsubterms([Term|Terms],[Shterm|Shterms],Pairs,Npairs) :-
X decsubterm(Term,Shterm,Pairs,Ipairs),
X decsubterms(Terms,Shterms,Ipairs,Npairs).
X
X decsubterm(Term,Term,Pairs,Pairs):-var(Term),!.
X decsubterm(Term,Var,[(Var,Term)|Pairs],Pairs).
X
X vartests([],T,T):-!.
X vartests([Var|Vars],[testdata(Var)|H],T):-vartests(Vars,H,T).
X
X compeqmatch([],T,T):-!.
X compeqmatch([(Tm1,Tm2)|Tms],[unify0(Tm1,Tm2)|H],T):-
X compeqmatch(Tms,H,T).
X
X splitrhs((G:B),GL,BL):-!,conjlist(G,GL),conjlist(B,BL).
X splitrhs(B,[],BL):-conjlist(B,BL).
X
X compguard([],T,T):-!.
X compguard([Call|Guard],[Ncall|H],T):-
X compguardcall(Call,Ncall),
X compguard(Guard,H,T).
X
X compguardcall(data(U),testdata(U)):-!.
X compguardcall(Call,Call):-sys(Call),!.
X compguardcall(_,_):-
X write('!!! illegal call in guard'),nl,fail.
X
X compcommit([!|T],T):-
X first,
X !,
X abolish(first,0).
X compcommit([!,abolish(susflag,0)|T],T).
X
X compbody(Body,depth_first,Ch,Ct,H,T):-
X !,
X compconjdf(Body,Ch,Ct,H,T).
X compbody(Body,breadth_first,Ch,Ct,H,T):-
X compconj(Body,H,[Ch = Ch1|T],Ch1,Ct).
X
X compconjdf([],Ct,Ct,T,T):-!.
X compconjdf([Call|Conj],Ch,Ct,[Call|H],T):-
X sys(Call),
X !,
X compconjdf(Conj,Ch,Ct,H,T).
X compconjdf([Call|Conj],Ch,Ct,[NewCall|H],T):-
X Call =.. [RelationName|Args],
X compname(RelationName,Crn),
X NewCall =.. [Crn,Ch,Nct,Sus|Args],
X compconjdf(Conj,Nct,Ct,H,T).
X
X susclause(RelationName,Modelist,Traceflag,Stflag):-
X varargs(Modelist,Args),
X compname(RelationName,Crn),
X compstats(Stflag,[(suspend),RelationName],T,[]),
X Call =.. [RelationName|Args],
X comptrace(Traceflag,suspend(Call),H,T),
X Head =.. [Crn,[[Crn|Args]|Ct],Ct,Result|Args],
X conjlist(Body,[susflag,abolish(susflag,0),!|H]),
X assert((Head :- Body)).
X
X writedefn(RelationName,Arity):-
X genfile(FN),
X !,
X compname(RelationName,CrelationName),
X tell(FN),
X listing(CrelationName),
X tell(user),
X killdefn(RelationName,Arity).
X writedefn(_,_).
X
/
echo 'x - parrts'
sed 's/^X//' > parrts << '/'
X/* PARLOG system: parrts
X*/
X
X run:-
X abolish(set,2),
X abolish(next,1),
X abolish(solution,1),
X abolish(susflag,0),
X abolish(temp,1),
X abolish((reduce),2),
X abolish((reduce),3),
X abolish((enter),1),
X abolish((suspend),2),
X abolish((suspend),3),
X orsolve,
X andsolve.
X
X 'c??'(H,T,reduced,CONJ):-
X conjlist(CONJ,LIST),
X cnprocs(H,T,LIST).
X
X cnprocs(T,T,[]):-!.
X cnprocs([[CRN|AS]|H],T,[CALL|CALLS]) :-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X cnprocs(H,T,CALLS).
X
X solve([]):-!.
X solve(Processes):-
X next(_),
X !,
X abolish(andstate,1),
X assert(andstate(Processes)),
X fail.
X solve(Processes):-
X solveeval(Processes,Result,NewProcesses),
X !,
X solve(NewProcesses).
X
X andsolve:-andstate(PROCS),solve(PROCS).
X
X unify0(U,V):-
X testdata(U),testdata(V),unify0a(U,V).
X
X unify0a([U|X],[V|Y]):-!,
X unify0(U,V),unify0(X,Y).
X unify0a(U,U):-atomic(U),!.
X unify0a(U,V):-
X U =.. [F|ARGS1],
X V =.. [F|ARGS2],
X unify0a(ARGS1,ARGS2).
X
X eval(H,T,SUS,PROCS,R,S,SIM,STATES):-
X solveeval(PROCS,LSUS,NPROCS),
X eval1(NPROCS,H,T,SUS,LSUS,R,S,SIM,STATES).
X eval(T,T,reduced,PROCS,failed,S,SIM,STATES).
X
X eval1([],T,T,reduced,LSUS,succeeded,S,SIM,STATES).
X eval1(NPROCS,H,T,SUS,LSUS,R,S,SIM,STATES):-
X var(S),
X suscheck(LSUS,NAME,R,NR,SIM),
X SUS = LSUS,
X H = [[NAME,NPROCS,NR,S,SIM,STATES]|T].
X eval1(NPROCS,H,T,reduced,LSUS,R,S,SIM,STATES):-
X controleval(eval,S,NPROCS,R,H,T,SIM,STATES).
X
X suspeval([[suspeval,PROCS,R,S,SIM,STATES]|T],T,SUS,PROCS,R,S,SIM,STATES):-
X var(S).
X suspeval(H,T,reduced,PROCS,R,S,SIM,STATES):-
X controleval(suspeval,S,PROCS,R,H,T,SIM,STATES).
X
X controleval(NAME,stop,PROCS,stopped,T,T,SIM,STATES).
X controleval(NAME,[MESS|S],PROCS,[MESS|R],
X [[NNAME,NPROCS,R,S,SIM,NSTATES]|T],T,SIM,STATES):-
X controlmess(MESS,NAME,PROCS,STATES,NNAME,NPROCS,NSTATES).
X
X controlmess(continue,NAME,PROCS,STATES,eval,PROCS,STATES).
X controlmess((suspend),NAME,PROCS,STATES,suspeval,PROCS,STATES).
X controlmess(save,NAME,PROCS,STATES,NAME,PROCS,[[NAME|CPROCS]|STATES]):-
X assert(temp(PROCS)),
X temp(CPROCS),
X abolish(temp,1).
X controlmess(restore,NAME,PROCS,[[NNAME|NPROCS]|NSTATES],NNAME,NPROCS,NSTATES).
X
X solveeval([],_,[]).
X solveeval([[Functor|Arglist]|RestProcesses],Result,NewProcesses):-
X Process =.. [Functor,NewProcesses,TailNewProcesses,Result|Arglist],
X call(Process),
X !,
X solveeval(RestProcesses,Result,TailNewProcesses).
X
X suscheck(SUS,suspeval,[deadlock|R],R,sim):-var(SUS).
X suscheck(SUS,eval,R,R,SIM).
X
X csimcall(H,T,SUS,CALL,R,S):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X eval(H,T,SUS,[[CRN|AS]],R,S,sim,[]).
X
X cparcall(H,T,SUS,CALL):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X Process =.. [CRN,H,T,SUS|AS],
X call(Process).
X
X cparcall(H,T,SUS,CALL,R,S):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X eval(H,T,SUS,[[CRN|AS]],R,S,nosim,[]).
X
X testdata(U):-var(U),!,assert(susflag),fail.
X testdata(U).
X
X orsolve.
X orsolve:-newset(X,Y,Z),!,
X orsolve1(X,Y,Z).
X
/
echo 'x - parstats'
sed 's/^X//' > parstats << '/'
X/* PARLOG system: parstats
X*/
X
X stats((enter)):-partialstats,!.
X stats((enter)):-
X abolish((enter),1),
X NOW is cputime,
X assert(enter(NOW)).
X
X stats(NAME,RN):-
X (partialstats,SECDIFF is 0;
X NOW is cputime,enter(THEN),SECDIFF is NOW-THEN),
X (ASS1 =.. [NAME,RN,NTOT,STOT],retract(ASS1);
X NTOT is 0,STOT is 0),
X (ASS2 =.. [NAME,NALL,SALL],retract(ASS2);
X NALL is 0,SALL is 0),!,
X NTOT1 is NTOT+1,
X STOT1 is STOT+SECDIFF,
X NEWASS1 =.. [NAME,RN,NTOT1,STOT1], assert(NEWASS1),
X NALL1 is NALL+1,
X SALL1 is SALL+SECDIFF,
X NEWASS2 =.. [NAME,NALL1,SALL1],assert(NEWASS2).
X
X seestats:-
X listing((reduce)),listing((suspend)).
X
/
echo 'x - orrts'
sed 's/^X//' > orrts << '/'
X/* PARLOG system: orrts
X*/
X
Xcset(A, B, reduced, C, D, E) :-
X testdata(E), !,
X bagof(D, E, C),
X A = B.
Xcset([[cset,A,B,C]|D], D, E, A, B, C) :-
X susflag,
X abolish(susflag, 0), !.
X
Xcsubset(A, B, reduced, C, D, E) :-
X testdata(E),
X testnoset, !,
X assert(set(D, E)),
X A = [[csubset1,C]|B].
Xcsubset([[csubset,A,B,C]|D], D, E, A, B, C) :-
X susflag,
X abolish(susflag, 0), !.
X
Xcsubset1(A, B, reduced, C) :-
X testdata(C),
X C = [D|E], !,
X assert(next(1)),
X A = [[csubset2,D,E]|B].
Xcsubset1(A, B, reduced, C) :-
X testdata(C),
X C = [], !,
X abolish(susflag, 0),
X assert(next(0)),
X A = [[csubset4]|B].
Xcsubset1([[csubset1,A]|B], B, C, A) :-
X susflag,
X abolish(susflag, 0), !.
X
Xcsubset2(A, B, reduced, C, D) :-
X retract(solution(C)), !,
X A = [[csubset1,D]|B].
Xcsubset2(A, B, reduced, end, C) :- !,
X abolish(susflag, 0),
X abolish(set, 2),
X A = [[csubset3,C]|B].
Xcsubset2([[csubset2,A,B]|C], C, D, A, B) :-
X susflag,
X abolish(susflag, 0), !.
X
Xcsubset4(A, B, reduced) :- !,
X abolish(set, 2),
X A = B.
Xcsubset4([[csubset4]|A], A, B) :-
X susflag,
X abolish(susflag, 0), !.
X
Xcsubset3(A, B, reduced, C) :-
X testdata(C),
X C = [D|E], !,
X D = end,
X A = [[csubset3,E]|B].
Xcsubset3(A, B, reduced, C) :-
X testdata(C),
X C = [], !,
X abolish(susflag, 0),
X A = B.
Xcsubset3([[csubset3,A]|B], B, C, A) :-
X susflag,
X abolish(susflag, 0), !.
X
Xtestnoset :-
X set(A, B), !,
X assert(susflag),
X fail.
Xtestnoset.
X
Xorsolve1(1, A, B) :-
X call(B),
X assert(solution(A)),
X orsolve2.
Xorsolve1(A, B, C) :-
X orsolve.
X
Xorsolve2.
Xorsolve2 :-
X oldset(A), !,
X orsolve3(A).
X
Xorsolve3(1) :- !,
X fail.
Xorsolve3(A) :-
X orsolve.
X
Xnewset(A, B, C) :-
X set(B, C),
X oldset(A).
X
Xoldset(A) :-
X retract(next(A)).
/
echo 'x - editor'
sed 's/^X//' > editor << '/'
X/* PARLOG system: editor
X*/
X
X parlist(RNS,FN):-
X tell(FN),
X parlist(RNS),
X told.
X
X parlist(all):-
X directives([OPTION]),nl,fail.
X parlist(all):-parlist1(RN),fail.
X parlist(all):-!.
X parlist(RN):-atom(RN),!,
X parlist1(RN).
X parlist([]):-!.
X parlist([RN|RNS]):-
X parlist1(RN),!,
X parlist(RNS).
X
X parlist1(RN):-
X parmode(RNMODE),
X functor(RNMODE,RN,ARITY),
X directives([RN,OPTION]),
X write(parmode(RNMODE)),write(.),
X listing(RN/ARITY),nl.
X parlist1(RN):-
X prolog(RN),
X write(prolog(RN)),write(.),
X listing(RN),nl.
X
X directives(LIST):-
X dirname(NAME),
X ASS =.. [NAME|LIST],
X ASS,
X write(ASS),write(.),nl,
X fail.
X directives(LIST).
X
X dirname((trace)).
X dirname((statistics)).
X dirname((schedule)).
X dirname((try)).
X
X killall :-
X parmode(RNM),
X retract(parmode(RNM)),
X functor(RNM,RN,ARITY),
X abolish(RN,ARITY),
X fail.
X killall :-
X prolog(RN),
X retract(prolog(RN)),
X current_predicate(RN,HD),
X retractall(HD),
X fail.
X killall :-
X abolish((trace),1),
X abolish((trace),2),
X abolish((statistics),1),
X abolish((statistics),2),
X abolish((schedule),1),
X abolish((schedule),2),
X abolish((try),1),
X abolish((try),2).
X
/
echo 'x - par'
sed 's/^X//' > par << '/'
X/* PARLOG system: par
X*/
X
X:- [parlog,parcomp,parrts,orrts,parstats,editor].
X:- nl,
X write('*** PARLOG ***'), nl,
X write('*** October 1984 ***'), nl,
X write('*** Copyright 1984 Steve Gregory ***'), nl, nl.
X
/
echo 'x - npar'
sed 's/^X//' > npar << '/'
X/* PARLOG system: npar
X*/
X
X:- [parlog,parcomp,nparrts,parstats,editor].
X:- nl,
X write('*** PARLOG ***'), nl,
X write('*** October 1984 ***'), nl,
X write('*** Copyright 1984 Steve Gregory ***'), nl, nl.
X
/
echo 'x - nparrts'
sed 's/^X//' > nparrts << '/'
X/* PARLOG system: nparrts
X*/
X
X run:-
X abolish(set,2),
X abolish(next,1),
X abolish(solution,1),
X abolish(susflag,0),
X abolish(temp,1),
X abolish((reduce),2),
X abolish((reduce),3),
X abolish((enter),1),
X abolish((suspend),2),
X abolish((suspend),3),
X andsolve.
X
X 'c??'(H,T,reduced,CONJ):-
X conjlist(CONJ,LIST),
X cnprocs(H,T,LIST).
X
X cnprocs(T,T,[]):-!.
X cnprocs([[CRN|AS]|H],T,[CALL|CALLS]) :-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X cnprocs(H,T,CALLS).
X
X andsolve:-
X repeat,
X retract(andstate(PROCS)),
X andsolveeval(PROCS,SUS,NPROCS),
X assert(andstate(NPROCS)),
X NPROCS = [],
X !.
X
X andsolveeval(PROCS,SUS,NPROCS):-
X solveeval(PROCS,SUS,NPROCS),
X !.
X andsolveeval(PROCS,SUS,NPROCS):-
X nl, write('no'), nl,
X abort.
X
X unify0(U,V):-
X testdata(U),testdata(V),unify0a(U,V).
X
X unify0a([U|X],[V|Y]):-!,
X unify0(U,V),unify0(X,Y).
X unify0a(U,U):-atomic(U),!.
X unify0a(U,V):-
X U =.. [F|ARGS1],
X V =.. [F|ARGS2],
X unify0a(ARGS1,ARGS2).
X
X eval(H,T,SUS,PROCS,R,S,SIM,STATES):-
X solveeval(PROCS,LSUS,NPROCS),
X eval1(NPROCS,H,T,SUS,LSUS,R,S,SIM,STATES).
X eval(T,T,reduced,PROCS,failed,S,SIM,STATES).
X
X eval1([],T,T,reduced,LSUS,succeeded,S,SIM,STATES).
X eval1(NPROCS,H,T,SUS,LSUS,R,S,SIM,STATES):-
X var(S),
X suscheck(LSUS,NAME,R,NR,SIM),
X SUS = LSUS,
X H = [[NAME,NPROCS,NR,S,SIM,STATES]|T].
X eval1(NPROCS,H,T,reduced,LSUS,R,S,SIM,STATES):-
X controleval(eval,S,NPROCS,R,H,T,SIM,STATES).
X
X suspeval([[suspeval,PROCS,R,S,SIM,STATES]|T],T,SUS,PROCS,R,S,SIM,STATES):-
X var(S).
X suspeval(H,T,reduced,PROCS,R,S,SIM,STATES):-
X controleval(suspeval,S,PROCS,R,H,T,SIM,STATES).
X
X controleval(NAME,stop,PROCS,stopped,T,T,SIM,STATES).
X controleval(NAME,[MESS|S],PROCS,[MESS|R],
X [[NNAME,NPROCS,R,S,SIM,NSTATES]|T],T,SIM,STATES):-
X controlmess(MESS,NAME,PROCS,STATES,NNAME,NPROCS,NSTATES).
X
X controlmess(continue,NAME,PROCS,STATES,eval,PROCS,STATES).
X controlmess((suspend),NAME,PROCS,STATES,suspeval,PROCS,STATES).
X controlmess(save,NAME,PROCS,STATES,NAME,PROCS,[[NAME|CPROCS]|STATES]):-
X assert(temp(PROCS)),
X temp(CPROCS),
X abolish(temp,1).
X controlmess(restore,NAME,PROCS,[[NNAME|NPROCS]|NSTATES],NNAME,NPROCS,NSTATES).
X
X solveeval([],_,[]).
X solveeval([[Functor|Arglist]|RestProcesses],Result,NewProcesses):-
X Process =.. [Functor,NewProcesses,TailNewProcesses,Result|Arglist],
X call(Process),
X !,
X solveeval(RestProcesses,Result,TailNewProcesses).
X
X suscheck(SUS,suspeval,[deadlock|R],R,sim):-var(SUS).
X suscheck(SUS,eval,R,R,SIM).
X
X csimcall(H,T,SUS,CALL,R,S):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X eval(H,T,SUS,[[CRN|AS]],R,S,sim,[]).
X
X cparcall(H,T,SUS,CALL):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X Process =.. [CRN,H,T,SUS|AS],
X call(Process).
X
X cparcall(H,T,SUS,CALL,R,S):-
X CALL =.. [RN|AS],
X compname(RN,CRN),
X eval(H,T,SUS,[[CRN|AS]],R,S,nosim,[]).
X
X testdata(U):-var(U),!,assert(susflag),fail.
X testdata(U).
X
/
echo 'x - hamming.par'
sed 's/^X//' > hamming.par << '/'
X/* PARLOG example: hamming.par
X multiples of 2, 3 and 5
X*/
X
Xparmode mults(^).
Xmults(R):-
X tlist(2,[1|R],R2),
X tlist(3,[1|R],R3),
X tlist(5,[1|R],R5),
X amerge(R2,R3,R23),
X amerge(R23,R5,R).
X
Xparmode tlist(?,?,^).
Xtlist(U,[V|R],[W|S]):-
X W is U*V
X :
X tlist(U,R,S).
X
Xparmode amerge(?,?,^).
Xamerge([U|R],[V|S],[U|T]):-
X U = V
X :
X amerge(R,S,T).
Xamerge([U|R],[V|S],[U|T]):-
X U < V
X :
X amerge(R,[V|S],T).
Xamerge([U|R],[V|S],[V|T]):-
X V < U
X :
X amerge([U|R],S,T).
X
Xparmode plist(?).
Xplist([U|R]) :-
X write(U), nl,
X plist(R).
X
/
echo 'x - primes.par'
sed 's/^X//' > primes.par << '/'
X/* PARLOG example: primes.par
X sieve of Eratosthenes
X*/
X
Xparmode integers_from(?,^).
Xintegers_from(Int,[Int|Int_list]):-
X Intplus is Int + 1,
X integers_from(Intplus,Int_list).
X
Xparmode primes(^).
Xprimes(List):-
X integers_from(2,List1),
X sift(List1,List).
X
Xparmode sift(?,^).
Xsift([Num|Rem_list],[Num|Shifted_rem_list]):-
X filter(Num,Rem_list,Filtered_list),
X sift(Filtered_list,Shifted_rem_list).
X
Xparmode filter(?,?,^).
Xfilter(Filter_num,[Num|List1],[Num|List2]):-
X 0 =\= Num mod Filter_num :
X filter(Filter_num,List1,List2).
Xfilter(Filter_num,[Num|List1],List2):-
X 0 =:= Num mod Filter_num :
X filter(Filter_num,List1,List2).
X
Xparmode plist(?).
Xplist([U|R]) :-
X write(U), nl,
X plist(R).
X
/
echo 'x - adpairs.par'
sed 's/^X//' > adpairs.par << '/'
X/* PARLOG example: adpairs.par
X Kowalski's "admissible pairs" example
X*/
X
Xparmode go.
Xgo :-
X adm([(1,V)|T]),
X plistp([(1,V)|T]).
X
Xparmode double(?).
Xdouble([(U,V)|T]) :-
X times(2,U,V),
X double(T).
X
Xparmode triple(?).
Xtriple([(U,V)|T]) :-
X T = [(U1,V1)|R],
X times(3,V,U1),
X triple(T).
X
Xparmode times(?,?,^).
Xtimes(U,V,W) :-
X data(U), data(V) :
X W is U*V.
X
Xparmode adm(?).
Xadm(T) :-
X double(T),
X triple(T).
X
Xparmode plistp(?).
Xplistp([(U,V)|T]) :-
X data(U), data(V) :
X write((U,V)), nl,
X plistp(T).
X
/
echo 'x - print.par'
sed 's/^X//' > print.par << '/'
X/* PARLOG example: print.par
X print any term
X*/
X
Xtry(parprint,sequential).
Xparmode parprint(?).
Xparprint(TERM) :- data(TERM), TERM =.. [FN,ARG|ARGS] :
X write(FN),
X printlist('(',[ARG|ARGS]).
Xparprint(TERM) :- data(TERM) :
X write(TERM).
X
Xparmode printlist(?,?).
Xprintlist(CHAR,[ARG|ARGS]) :-
X write(CHAR),
X and(parprint(ARG),printlist(',',ARGS)).
Xprintlist(CHAR,[]) :-
X write(')').
X
Xparmode and(?,?).
Xand(A1,A2) :-
X parcall(A1,S,C),
X nextcall(S,A2).
X
Xparmode nextcall(?,?).
Xnextcall(succeeded,A) :-
X parcall(A).
X
X
/
echo 'x - prolog.par'
sed 's/^X//' > prolog.par << '/'
X/* PARLOG example: prolog.par
X Prolog front-end program
X*/
X
Xparmode go.
Xgo :-
X prologsys(USER),
X user(USER).
X
Xparmode prologsys(^).
Xprologsys(['command?',read(COMMAND)|USER]) :-
X prolog1(COMMAND,USER).
X
Xparmode prolog1(?,^).
Xprolog1(end,[]).
Xprolog1(add(CLAUSE),USER) :-
X assert(CLAUSE),
X prologsys(USER).
Xprolog1(which(T,CONJ),USER) :-
X subset([SOLN|SOLNS],T,CONJ),
X setint(SOLN,SOLNS,USER).
X
Xtry(setint,sequential).
Xparmode setint(?,^,^).
Xsetint(end,[],['No more answers'|USER]) :-
X prologsys(USER).
Xsetint(SOLN,SOLNS,[SOLN,read(CONTINUE)|USER]) :-
X setint1(CONTINUE,SOLNS,USER).
X
Xparmode setint1(?,^,^).
Xsetint1(c,[SOLN|SOLNS],USER) :-
X setint(SOLN,SOLNS,USER).
Xsetint1(s,[],USER) :-
X prologsys(USER).
X
Xparmode user(?).
Xuser([read(REPLY)|USER]) :-
X read(REPLY),
X user(USER).
Xuser([MESS|USER]) :-
X write(MESS), nl,
X user(USER).
Xuser([]).
X
/
echo 'Part 01 of PARLOG complete.'
exit
--
Steve Gregory Phone: +44 1 589 5111 x5082
Dept. of Computing Telex: 261503 IMPCOL G
Imperial College USENET: ...!ukc!icdoc!sg
London SW7 2BZ, UK ARPANET: sg%icdoc@ucl-cs.arpa