Mercurial > hg > plml
changeset 9:60b7b78b3167
Removed utility Prolog libraries, which are now a prerequisite (package plcore);
Moved cellmap.m from matlab/general to matlab/db/dbcellmap.m.
| author | samer |
|---|---|
| date | Fri, 20 Jan 2012 16:46:57 +0000 |
| parents | 173e1c48e335 |
| children | 7947baf7a624 |
| files | INSTALL matlab/Makefile matlab/general/cellmap.m prolog/Makefile prolog/dcgu.pl prolog/ops.pl prolog/plml.pl prolog/update prolog/utils.pl |
| diffstat | 9 files changed, 5 insertions(+), 1993 deletions(-) [+] |
line wrap: on
line diff
--- a/INSTALL Thu Jan 19 15:23:35 2012 +0000 +++ b/INSTALL Fri Jan 20 16:46:57 2012 +0000 @@ -21,6 +21,9 @@ that comes with SWI. This only has a hope of working on Unix systems, and I've only tried with Mac OS X and Linux. +You also need the plcore package, which contains the required Prolog +libraries utils.pl, dcgu.pl and ops.pl. + *** Binary and Prolog code ***
--- a/matlab/Makefile Thu Jan 19 15:23:35 2012 +0000 +++ b/matlab/Makefile Fri Jan 20 16:46:57 2012 +0000 @@ -2,5 +2,4 @@ install: install -d $(INSTALL_ML_TO) cp -pR db $(INSTALL_ML_TO) - cp -pR general $(INSTALL_ML_TO)
--- a/matlab/general/cellmap.m Thu Jan 19 15:23:35 2012 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function Y=cellmap(fn,X) -% cellmap - Map a function over a cell array -% -% cellmap :: (A->B, {[Size]->A}) -> {[Size]->B} - -% preallocate to fix size -Y=cell(size(X)); -for i=1:numel(X) - Y{i}=feval(fn,X{i}); -end
--- a/prolog/Makefile Thu Jan 19 15:23:35 2012 +0000 +++ b/prolog/Makefile Fri Jan 20 16:46:57 2012 +0000 @@ -1,8 +1,5 @@ install: install -d $(INSTALL_PL_TO) - install $(INSTALL_FLAGS) -m 644 ops.pl $(INSTALL_PL_TO) install $(INSTALL_FLAGS) -m 644 plml.pl $(INSTALL_PL_TO) - install $(INSTALL_FLAGS) -m 644 utils.pl $(INSTALL_PL_TO) - install $(INSTALL_FLAGS) -m 644 dcgu.pl $(INSTALL_PL_TO)
--- a/prolog/dcgu.pl Thu Jan 19 15:23:35 2012 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,953 +0,0 @@ -:- module(dcgu, [ - writedcg/1 - - , nop/2 - , out//1 - , (>>)//2 - , (\<)//1 - , (\>)//1 - , (\#)//2 - , run_left//3 - , run_right//3 - , trans//2 - - , maybe//1 - , opt//1 - , if//3, if//2 - , parmap//2, parmap//3, parmap//4, parmap//5, parmap//6 - , seqmap//2, seqmap//3, seqmap//4, seqmap//5, seqmap//6 - , seqmap_n//3, seqmap_n//4, seqmap_n//5 - , seqmap_with_sep//3 - , seqmap_with_sep//4 - , seqmap_with_sep//5 - , seqmap_ints//3 - , seqmap_args//4 - , seqmap_args//5 - , seqmap_args//6 - , iterate//3 - %, apply/4, apply/5 - , seq//1, seq//2, seq_n//3 - , smap//2 - , rep//2, rep_nocopy//2 - , at//1, wr//1, str//1, fmt//2 - , brace//1, paren//1, sqbr//1 - , q//1, qq//1 - , escape//2, escape_with//3 - , null//0, cr//0, sp//0, fs//0 - , fssp/2, tb/2, comma/2, commasp/2 - , padint/5 - - , do_then_call/5 - , do_then_call/6 - , do_then_call/7 - - , any/3, notany/3, arb/2, arbno/3, bal/2 - , span/3, break/3, len/3 - , exhaust/3 - , set/3, get/3, set_with/3 - , with/4, iso/3 - , once/3 - , repeat/2 - , (//)//2 - , until//2 - - , findall//3 - , setof//3 - - , op(900,fy,\<) - , op(900,fy,\>) - , op(900,xfy,\#) - - , lift//1 - , lift//2 - , lift//3 -]). - -/** <module> DCG utilities - -This module contains predicates for working with definite clause -grammars and the related stateful programming style where state -arguments are automatically threaded through sequences -of calls. Some useful DCG procedures are also included. - -When a predicate is declared with type =|foo(...)// is Det|=, -any requirements on the type of the DCG state are hidden, i.e. the -types of the two extra arguments are hidden. In these cases, -the documentation below will sometimes state that the predicate -'runs in the =|S|= DCG'. - ----+++ Types used in this module - -We use the following to denote types of terms that can -be interpreted as DCG phrases with or without further -arguments. - * phrase(S) - If P is a term of type =|phrase(S)|=, then P is a valid DCG phrase - when the DCG state is of type =|S|=, i.e. =|phrase(P,S1,S2)|= is - valid Prolog goal when S1 and S2 are of type =|S|=. N.B. the type - =|phrase(S)|= is almost but not quite equivalent to the binary - predicate type =|pred(S,S)|=. All such predicates are valid phrases, - but phrases involving braces (e.g. {Goal}), commas, semicolons, - and if-then constructs (->) are not equivalent to predicates - with two extra arguments. - * phrase(A,S) - If P is of type =|phrase(A,S)|= and X has type A, then =|call(P,X)|= - is a valid DCG phrase when the DCG is of type S. This type _|is|_ - equivalent to =|pred(A,S,S)|= because the only way to call it - is with call//1 inside a DCG or call/3 outside it. - * phrase(A,B,S) - If P is of type =|phrase(A,B)|= and =|X|= and =|Y|= are of types - =|A|= and =|B|= respectively, then =|call(P,X,Y)|= - is a valid DCG phrase. And so on. You get the idea. - -The type =|pair(A,B)|= will be used to denote the type of terms -with functor (,)/2 and arguments of types =|A|= and =|B|= respectively: -== -pair(A,B) ---> (A,B). -== -This type is used to support a set of general purpose predicates -for combining commands in two distinct DCGs into a single DCG -over a product space of states. -*/ - -:- use_module(library(ops)). - -:- module_transparent seq/3, seq/4, smap/4. - -:- meta_predicate - writedcg(2) - , if(0,0,0,?,?) - , if(0,0,?,?) - , maybe(2,?,?) - , opt(2,?,?) - , once(2,?,?) - , repeat(?,?) - , >>(2,2,?,?) - , //(2,?,?,?) - , \<(2,?,?) - , \>(2,?,?) - , \#(?,2,?,?) - , brace(2,?,?) - , paren(2,?,?) - , sqbr(2,?,?) - , qq(2,?,?) - , q(2,?,?) - , arbno(2,?,?) - , rep(?,2,?,?) - , rep_nocopy(+,2,?,?) - , exhaust(2,?,?) - , with(?,2,?,?) - , iso(2,?,?) - , set_with(1,?,?) - , run_left(2,?,?,?,?) - , run_right(2,?,?,?,?) - , iterate(2,?,?,?,?) - , parmap(1,?,?,?) - , parmap(2,?,?,?,?) - , parmap(3,?,?,?,?,?) - , parmap(4,?,?,?,?,?,?) - , parmap(5,?,?,?,?,?,?,?) - , seqmap(1,?,?,?) - , seqmap(2,?,?,?,?) - , seqmap(3,?,?,?,?,?) - , seqmap(4,?,?,?,?,?,?) - , seqmap(5,?,?,?,?,?,?,?) - , seqmap_n(+,1,?,?,?) - , seqmap_n(+,2,?,?,?,?) - , seqmap_n(+,3,?,?,?,?,?) - , seqmap_ints(1,+,+,?,?) - , seqmap_with_sep(0,1,?,?,?) - , seqmap_with_sep(0,2,?,?,?,?) - , seqmap_with_sep(0,3,?,?,?,?,?) - , seqmap_args(1,+,+,?,?,?) - , seqmap_args(2,+,+,?,?,?,?) - , seqmap_args(3,+,+,?,?,?,?,?) - , do_then_call(0,1,?,?,?) - , do_then_call(0,2,?,?,?,?) - , do_then_call(0,3,?,?,?,?,?) - , until(0,2,?,?) - . - -:- op(900,fy,\<). -:- op(900,fy,\>). -:- op(900,xfy,\#). - - -%%% -%%% The first lot of stuff is completely general for any stateful system. -%%% - - -%% trans( ?Old:S, ?New:S, ?S1:S, ?S2:S) is det. -% -% Unifies Old and New with the states S1 and S2 respectively. -trans(X,Y,X,Y). - -% these will be useful for seq (they define a sort of generalised -% lazy mapping over sequences of DCG terms) -empty([]). -empty(_:[]). -empty(map(_,L)) :- empty(L). -empty(_:map(_,L)) :- empty(L). -empty(M..N) :- N<M. - -singleton([H|T],H) :- empty(T). -singleton(M:[H|T],M:H) :- empty(T). -singleton(map(F,L),call(F,H)) :- singleton(L,H). -singleton(M:map(F,L),call(M:F,H)) :- singleton(L,H). -singleton(M..M,M). - -properlist([H|T],H,T) :- \+empty(T). -properlist(M:[H|T],M:H,M:T) :- \+empty(T). -properlist(map(F,L),call(F,H),map(F,T)) :- properlist(L,H,T). -properlist(M:map(F,L),call(M:F,H),M:map(F,T)) :- properlist(L,H,T). -properlist(M..N,M,M1..N) :- N>M, succ(M,M1). - -%% nop// is det. -% -% Do nothing. (More neutral than []). -nop(X,X). - -%% set(S:A, S1:_, S2:A) is det. -% Set state to S. Implemented by goal expansion. -set(S,_,S). - -%% get(S:A, S1:A, S2:A) is det. -% Get state to S. Implemented by goal expansion. -get(S,S,S). - -%% with(S:A, P:phrase(A), S1:B, S2:B) is nondet. -% -% Run phrase P starting from state S and discarding -% the final state, meanwhile preserving the state -% of the current system, i.e. guarantees S1=S2. -with(S,G) --> {phrase(G,S,_)}. - -%% iso(P:phrase(A), S1:A, S2:A) is nondet. -% -% Run phrase P starting with current state but discarding -% its final state and preserving the current state, so -% that S1=S2. -iso(G) --> get(S), {phrase(G,S,_)}. - -%% set_with(+G:pred(A), S1:_, S2:A) is det. -% -% Set current state using a given callable goal G, which should accept one argument. -% should be of type pred( -S:A), ie it should set S to the new desired -% state, which is installed in the DCG state. -set_with(G,_,S) :- call(G,S). - -%% \<(P:phrase(A), ?S1:pair(A,B), ?S2:pair(A,B)) is nondet. -% -% Apply phrase P to left part of a paired state. -% Implemented by goal expansion so incurs only very small -% speed penalty. -\<(P,(A1,B),(A2,B)) :- phrase(P,A1,A2). - -%% \>(P:phrase(B), ?S1:pair(A,B), ?S2:pair(A,B)) is nondet. -% -% Apply phrase P which must be of type pred(B,B) to right -% part of a paired state. -% Implemented by goal expansion so incurs only very small -% speed penalty. -\>(P,(A,B1),(A,B2)) :- phrase(P,B1,B2). - -%% run_left(P:phrase(pair(A,B)), ?A1:A, ?A2:A, ?B1:B, ?B2:B) is multi. -% -% Applies DCG phrase P to state formed by pairing A1 and A2 with -% current DCG states B1 and B2. Phrase can use (\<) to access the -% A state and (\>) to access the underlying B state. -run_left(P,S1,S2,T1,T2) :- phrase(P,(S1,T1),(S2,T2)). - -%% run_right(P:phrase(pair(A,B)), ?B1:B, ?B2:B, ?A1:A, ?A2:A) is multi. -% -% Applies DCG phrase P to state formed by pairing A1 and A2 with -% current DCG states B1 and B2. Phrase can use (\<) to access the -% A state and (\>) to access the underlying B state. -run_right(P,S1,S2,T1,T2) :- phrase(P,(T1,S1),(T2,S2)). - -%% \#(N:natural, P:phrase(A), ?S1, ?S2) is nondet. -% -% Apply phrase P to the Nth argument of state which must -% be a compound term (with arbitrary functor), with the -% Nth argument of type A. -\#(N, P, S1, S2) :- with_nth_arg(N,P,S1,S2). - - -system:goal_expansion( run_left(P,S1,S2,T1,T2), phrase(P,(S1,T1),(S2,T2))). -system:goal_expansion( run_right(P,S1,S2,T1,T2), phrase(P,(T1,S1),(T2,S2))). -system:goal_expansion( \<(P,S1,S2), (S1=(L1,R),S2=(L2,R),phrase(P,L1,L2)) ). -system:goal_expansion( \>(P,S1,S2), (S1=(L,R1),S2=(L,R2),phrase(P,R1,R2)) ). -system:goal_expansion( nop(S1,S2), (S1=S2) ). -system:goal_expansion( out(X,S1,S2), (S1=[X|S2]) ). -system:goal_expansion( get(S,S1,S2), (S=S1,S1=S2) ). -system:goal_expansion( set(S,_,S2), (S=S2) ). -system:goal_expansion( A >> B, (A,B) ). -system:goal_expansion( set_with(C,_,S2), Call) :- mk_call(C,[S2],Call). -system:goal_expansion( trans(A1,A2,S1,S2), (S1=A1,S2=A2) ). -system:goal_expansion( //(P1,P2,S1,S2), (G1,G2)) :- - nonvar(P1), P1=..[F1|A1], append(A1,[S1,S2],B1), G1=..[F1|B1], - nonvar(P2), P2=..[F2|A2], append(A2,[S1,S2],B2), G2=..[F2|B2]. - -mk_call(C,XX,Call) :- var(C), !, mk_call(call(C),XX,Call). -mk_call(M:C,XX,M:Call) :- !, mk_call(C,XX,Call). -mk_call(C,XX,Call) :- C =.. CL, append(CL,XX,CL2), Call =.. CL2. - - -%% pushl(S:A,S1:B,S2:pair(A,B)) is det. -% Create a paired state by putting S on the left and the -% old state on the right. -pushl(S,S0,(S,S0)). - -%% pushr(S:A,S1:B,S2:pair(B,A)) is det. -% Create a paired state by putting S on the right and the -% old state on the left. -pushr(S,S0,(S0,S)). - -%% popl(S:A,S1:pair(A,B),S2:B) is det. -% Unpair state by removing left state and unifying it with S. -popl(S,(S,S0),S0). - -%% popr(S:A,S1:(B,A),S2:B) is det. -% Unpair state by removing right state and unifying it with S. -popr(S,(S0,S),S0). - -%% >>(G1:phrase(S), G2:phrase(S))// is nondet. -% Sequential conjuction of phrases G1 and G2, equivalent to (G1,G2), -% but sometimes more convenient in terms of operator priorities. -% Implemented by goal expansion. -A >> B --> A, B. - -%% once(G:phrase(_))// is semidet. -% Call DCG phrase G succeeding at most once. -once(G,A,B) :- once(phrase(G,A,B)). - -%% repeat// is nondet. -% Create an infinite number of choice points. -repeat(A,A) :- repeat. - -%% maybe(P:phrase(_))// is det. -% Try P, if it fails, then do nothing. If it succeeds, -% cut choicepoints and continue. -maybe(P) --> P -> nop; nop. - -%% opt(P:phrase(_))// is nondet. -% P or nothing. Like maybe but does not cut if P succeeds. -opt(P) --> P; nop. - -%% if(G:pred,P,Q)// is det. -%% if(G:pred,P)// is det. -% -% If Prolog goal =|call(G)|= succeeds, do P, otherwise, do Q. -% if(G,P) is equivalent to if(G,P,nop), i.e. does nothing -% if P fails. -if(A,B,C) --> {nonvar(A), call(A)} -> B; C. -if(A,B) --> if(A,B,nop). - - -%% exhaust( P:phrase(_))// is det. -% -% Run phrase sequentially as many times as possible until it fails. -% Any choice points left by G are cut. -exhaust(G) --> G -> exhaust(G); nop. - - -%% until( +Q:pred, +P:phrase(_))// is det. -% -% Repeatedly call phrase P and test ordinary Prolog goal -% Q until Q fails. P and Q are copied together before each -% iteration, so variables can be shared between them, but -% are not shared between iterations. -until( Pred, Op) --> - {copy_term(Pred/Op,Pred1/Op1)}, - call(Op1), - ( {call(Pred1)} - -> {Pred/Op=Pred1/Op1} - ; until(Pred, Op) - ). - -%% iterate( +P:phrase(A,A,S), +X:A, -Y:A)// is nondet. -% -% Sequentially call P zero or more times, passing in X on -% the first call and threading the result through subsequent calls, -% (as well as threading the DCG state in the normal way) -% ending in Y. - -iterate(_,A,A) --> []. -iterate(F,A1,A3) --> call(F,A1,A2), iterate(F,A2,A3). - - -%% rep( +N:natural, +P:phrase(_))// is nondet. -%% rep( -N:natural, +P:phrase(_))// is nondet. -% -% Equivalent to N sequential copies of phrase P. -% Free variables in P are *not* shared between copies. -% If N is unbound on entry, rep//2 is _cautious_: it tries -% gradually increasing N from 0 on backtracking. - -rep(N,G,S1,S2) :- - ( var(N) - -> rep_var(N,G,S1,S2) - ; rep_nonvar(N,G,S1,S2) - ). - -rep_var(0,_,S,S). -rep_var(N,G,S1,S3) :- - copy_term(G,G1), phrase(G1,S1,S2), - rep_var(M,G,S2,S3), succ(M,N). - -rep_nonvar(0,_,S,S) :- !. -rep_nonvar(N,G,S1,S3) :- - copy_term(G,G1), phrase(G1,S1,S2), - succ(M,N), rep_nonvar(M,G,S2,S3). - - -%% rep_nocopy( +N:natural, +P:phrase(_))// is nondet. -% -% Like rep//2 but does not copy P before calling, so -% any variables in P are shared between all calls. -% Also, N cannot be a variable in this implementation. -rep_nocopy(0,_) --> !. -rep_nocopy(N,P) --> call(P), {succ(M,N)}, rep_nocopy(M,P). - - -%% seq( +L:plist, +Sep)// is nondet. -%% seq( +L:plist)// is nondet. -% Sequence list of phrases with separator. L can be a sort of _generalised_ -% list of phrases, which can be: -% == -% plist ---> list(A) % ordinary list -% ; map(phrase(B),plist) % map phrase head P over list -% . -% == -% Sep is inserted strictly betweened elements of L. seq(L) is equivalent -% to seq(L,nop). - -seq(L,_) --> {dcgu:empty(L)}. -seq(L,_) --> {dcgu:singleton(L,H)}, H. -seq(L,S) --> {dcgu:properlist(L,H,T)}, H, S, seq(T,S). -seq(L) --> seq(L,nop). % if no separator specified, use nop. - - -%% seq_n( N:natural, +L:plist, +Sep)// is nondet. -% Sequence list of phrases with separator and counting. -% -% @see seq//2. - -seq_n(0,L,_) --> {dcgu:empty(L)}. -seq_n(1,L,_) --> {dcgu:singleton(L,H)}, H. -seq_n(N,L,S) --> {dcgu:properlist(L,H,T)}, H, S, seq_n(M,T,S), {succ(M,N)}. - -%% smap(+F,+L:list)// is nondet. -% Equivalent to seq(map(F,L),nop). -smap(F,L) --> seq(map(F,L),nop). - - - -%% seqmap( +P:phrase(A,S), X:list(A))// is nondet. -%% seqmap( +P:phrase(A,B,S), X:list(A), Y:list(B))// is nondet. -%% seqmap( +P:phrase(A,B,C,S), X:list(A), Y:list(B), Z:list(C))// is nondet. -%% seqmap( +P:phrase(A,B,C,D,S), X:list(A), Y:list(B), Z:list(C), W:list(D))// is nondet. -%% seqmap( +P:phrase(A,B,C,D,E,S), X:list(A), Y:list(B), Z:list(C), W:list(D), V:list(E))// is nondet. -% -% seqmap//N is like maplist/N except that P is an incomplete _phrase_ -% rather an ordinary goal, which is applied to the elements of the supplied -% lists _|in order|_, while threading the DCG state correctly through all -% the calls. -% -% seqmap//N is very powerful - it is like =foldl= and =mapaccum= in functional -% languages, but with the added flexibility of bidirectional Prolog variables. -% -% @see maplist/2. - -seqmap(_,[]) --> []. -seqmap(P,[A|AX]) --> call(P,A), seqmap(P,AX). -seqmap(_,[],[]) --> []. -seqmap(P,[A|AX],[B|BX]) --> call(P,A,B), seqmap(P,AX,BX). -seqmap(_,[],[],[]) --> []. -seqmap(P,[A|AX],[B|BX],[C|CX]) --> call(P,A,B,C), seqmap(P,AX,BX,CX). -seqmap(_,[],[],[],[]) --> []. -seqmap(P,[A|AX],[B|BX],[C|CX],[D|DX]) --> call(P,A,B,C,D), seqmap(P,AX,BX,CX,DX). -seqmap(_,[],[],[],[],[]) --> []. -seqmap(P,[A|AX],[B|BX],[C|CX],[D|DX],[E|EX]) --> call(P,A,B,C,D,E), seqmap(P,AX,BX,CX,DX,EX). - -true(_,_). -parmap(_,[]) --> true. -parmap(P,[A|AX]) --> call(P,A) // parmap(P,AX). -parmap(_,[],[]) --> true. -parmap(P,[A|AX],[B|BX]) --> call(P,A,B) // parmap(P,AX,BX). -parmap(_,[],[],[]) --> true. -parmap(P,[A|AX],[B|BX],[C|CX]) --> call(P,A,B,C) // parmap(P,AX,BX,CX). -parmap(_,[],[],[],[]) --> true. -parmap(P,[A|AX],[B|BX],[C|CX],[D|DX]) --> call(P,A,B,C,D) // parmap(P,AX,BX,CX,DX). -parmap(_,[],[],[],[],[]) --> true. -parmap(P,[A|AX],[B|BX],[C|CX],[D|DX],[E|EX]) --> call(P,A,B,C,D,E) // parmap(P,AX,BX,CX,DX,EX). - -%% seqmap_n( +N:natural, +P:phrase(A), X:list(A))// is nondet. -%% seqmap_n( +N:natural, +P:phrase(A,B), X:list(A), Y:list(B))// is nondet. -%% seqmap_n( +N:natural, +P:phrase(A,B,C), X:list(A), Y:list(B), Z:list(C))// is nondet. -% -% seqmap_n//.. is like seqmap/N except that the lists of arguments are of lenght N. - -seqmap_n(0,_,[]) --> []. -seqmap_n(N,P,[A|AX]) --> {succ(M,N)}, call(P,A), seqmap_n(M,P,AX). -seqmap_n(0,_,[],[]) --> []. -seqmap_n(N,P,[A|AX],[B|BX]) --> {succ(M,N)}, call(P,A,B), seqmap_n(M,P,AX,BX). -seqmap_n(0,_,[],[],[]) --> []. -seqmap_n(N,P,[A|AX],[B|BX],[C|CX]) --> {succ(M,N)}, call(P,A,B,C), seqmap_n(M,P,AX,BX,CX). - - -/* - * Goal expansions - */ - -cons(A,B,[A|B]). - -expand_seqmap_with_prefix(Sep0, Callable0, SeqmapArgs, Goal) :- - ( Callable0 = M:Callable - -> NextGoal = M:NextCall - ; Callable = Callable0, - NextGoal = NextCall - ), - - append(Lists, [St1,St2], SeqmapArgs), - - Callable =.. [Pred|Args], - length(Args, Argc), - length(Argv, Argc), - length(Lists, N), - length(Vars, N), - MapArity is N + 4, - format(atom(AuxName), '__aux_seqmap/~d_~w_~w+~d', [MapArity, Sep0, Pred, Argc]), - build_term(AuxName, Lists, Args, St1, St2, Goal), - - AuxArity is N+Argc+2, - prolog_load_context(module, Module), - ( current_predicate(Module:AuxName/AuxArity) - -> true - ; rep(N,[[]],BaseLists,[]), - length(Anon, Argc), - build_term(AuxName, BaseLists, Anon, S0, S0, BaseClause), - - length(Vars,N), - maplist(cons, Vars, Tails, NextArgs), - ( Sep0=_:Sep -> true; Sep=Sep0 ), - ( is_list(Sep) -> append(Sep,S2,S1), NextThing=NextGoal - ; build_term(phrase, [Sep0], [], S1, S2, NextSep), - NextThing = (NextSep,NextGoal) - ), - build_term(Pred, Argv, Vars, S2, S3, NextCall1), - build_term(AuxName, Tails, Argv, S3, S4, NextIterate), - build_term(AuxName, NextArgs, Argv, S1, S4, NextHead), - - ( goal_expansion(NextCall1,NextCall) -> true - ; NextCall1=NextCall), - - NextClause = (NextHead :- NextThing, NextIterate), - - ( predicate_property(Module:NextGoal, transparent) - -> compile_aux_clauses([ (:- module_transparent(Module:AuxName/AuxArity)), - BaseClause, - NextClause - ]) - ; compile_aux_clauses([BaseClause, NextClause]) - ) - ). - -expand_call_with_prefix(Sep0, Callable0, InArgs, (SepGoal,CallGoal)) :- - append(CallArgs, [S1,S3], InArgs), - - ( Sep0=_:Sep -> true; Sep=Sep0 ), - ( is_list(Sep) -> append(Sep,S2,SS), SepGoal=(S1=SS) - ; build_term(phrase, [Sep0], [], S1, S2, SepGoal) - ), - - ( var(Callable0) - -> build_term(call,[Callable0], CallArgs, S2, S3, CallGoal1) - ; ( Callable0 = M:Callable - -> CallGoal1 = M:NextCall - ; Callable = Callable0, - CallGoal1 = NextCall - ), - Callable =.. [Pred|Args], - build_term(Pred, Args, CallArgs, S2, S3, NextCall) - ), - ( goal_expansion(CallGoal1,CallGoal) -> true - ; CallGoal1=CallGoal - ). - -seqmap_with_sep_first_call(P,[A1|AX],AX) --> call(P,A1). -seqmap_with_sep_first_call(P,[A1|AX],[B1|BX],AX,BX) --> call(P,A1,B1). -seqmap_with_sep_first_call(P,[A1|AX],[B1|BX],[C1|CX],AX,BX,CX) --> call(P,A1,B1,C1). - -expand_seqmap_with_sep(Sep, Pred, SeqmapArgs, (dcgu:FirstCall,dcgu:SeqmapCall)) :- - prolog_load_context(module,Context), - (Sep=SMod:Sep1 -> true; SMod=Context, Sep1=Sep), - (Pred=CMod:Pred1 -> true; CMod=Context, Pred1=Pred), - append(Lists, [St1,St3], SeqmapArgs), - length(Lists, N), - length(Tails, N), - build_term(seqmap_with_sep_first_call, [CMod:Pred1|Lists], Tails, St1, St2, FirstCall), - build_term(seqmap_with_prefix, [SMod:Sep1,CMod:Pred1], Tails, St2, St3, SeqmapCall). - -build_term(H,L1,L2,S1,S2,Term) :- - append(L2,[S1,S2],L23), - append(L1,L23,L123), - Term =.. [H | L123]. - - -expand_dcgu(Term, Goal) :- - functor(Term, seqmap, N), N >= 4, - Term =.. [seqmap, Callable | Args], - callable(Callable), !, - expand_seqmap_with_prefix([],Callable, Args, Goal). - -expand_dcgu(Term, Goal) :- - functor(Term, seqmap_with_sep, N), N >= 5, - Term =.. [seqmap_with_sep, Sep, Callable | Args], - nonvar(Sep), callable(Callable), !, - expand_seqmap_with_sep(Sep, Callable, Args, Goal). - -expand_dcgu(Term, Goal) :- - functor(Term, seqmap_with_prefix, N), N >= 5, - Term =.. [seqmap_with_prefix, Sep, Callable | Args], - callable(Callable), nonvar(Sep), !, - expand_seqmap_with_prefix(Sep, Callable, Args, Goal). - -expand_dcgu(Term, Goal) :- - functor(Term, do_then_call, N), N >= 2, - Term =.. [do_then_call, Prefix, Callable | Args], - nonvar(Prefix), !, - expand_call_with_prefix(Prefix, Callable, Args, Goal). - -system:goal_expansion(GoalIn, GoalOut) :- - \+current_prolog_flag(xref, true), - expand_dcgu(GoalIn, GoalOut). -% prolog_load_context(module,Mod), -% writeln(expanded(Mod:GoalIn)). - - -%% seqmap_with_sep(+S:phrase, +P:phrase(A), X:list(A))// is nondet. -%% seqmap_with_sep(+S:phrase, +P:phrase(A,B), X:list(A), Y:list(B))// is nondet. -%% seqmap_with_sep(+S:phrase, +P:phrase(A,B,C), X:list(A), Y:list(B), Z:list(C))// is nondet. -% -% As seqmap//2.. but inserting the separator phrase S between each call to P. -% NB: *Fails* for empty lists. -% -% @see seqmap//2 -%seqmap_with_sep(S,P,[A|AX]) --> call(P,A), seqmap_with_prefix(S,P,AX). -%seqmap_with_sep(S,P,[A|AX],[B|BX]) --> call(P,A,B), seqmap_with_prefix(S,P,AX,BX). -%seqmap_with_sep(S,P,[A|AX],[B|BX],[C|CX]) --> call(P,A,B,C), seqmap_with_prefix(S,P,AX,BX,CX). -seqmap_with_sep(S,P,[A|AX]) --> call(P,A), seqmap(do_then_call(S,P),AX). -seqmap_with_sep(S,P,[A|AX],[B|BX]) --> call(P,A,B), seqmap(do_then_call(S,P),AX,BX). -seqmap_with_sep(S,P,[A|AX],[B|BX],[C|CX]) --> call(P,A,B,C), seqmap(do_then_call(S,P),AX,BX,CX). - -%seqmap_with_prefix(_,_,[]) --> []. -%seqmap_with_prefix(S,P,[A|AX]) --> S, call(P,A), seqmap_with_prefix(S,P,AX). -%seqmap_with_prefix(_,_,[],[]) --> []. -%seqmap_with_prefix(S,P,[A|AX],[B|BX]) --> S, call(P,A,B), seqmap_with_prefix(S,P,AX,BX). -%seqmap_with_prefix(_,_,[],[],[]) --> []. -%seqmap_with_prefix(S,P,[A|AX],[B|BX],[C|CX]) --> S, call(P,A,B,C), seqmap_with_prefix(S,P,AX,BX,CX). - - -% do_then_call( +S:phrase, +P:phrase(A), X:A)// is nondet. -% do_then_call( +S:phrase, +P:phrase(A,B), X:A, Y:B)// is nondet. -% do_then_call( +S:phrase, +P:phrase(A,B,C), X:A, Y:B, Z:C)// is nondet. -% -% Call phrase S, then call phrase P with arguments A, B, C etc. -do_then_call(S,P,A) --> S, call(P,A). -do_then_call(S,P,A,B) --> S, call(P,A,B). -do_then_call(S,P,A,B,C) --> S, call(P,A,B,C). - - -%% seqmap_ints( +P:phrase(integer), +I:integer, +J:integer)// is nondet. -% -% Equivalent to seqmap(P) applied to the list of integers from I to J inclusive. -% -% @see seqmap//2. -seqmap_ints(P,L,N) --> - ( {L>N} -> [] - ; {M is L+1}, call(P,L), seqmap_ints(P,M,N) - ). - - -%% seqmap_args( +P:phrase(integer), +I:integer, +J:integer, X:term)// is nondet. -%% seqmap_args( +P:phrase(integer), +I:integer, +J:integer, X:term, Y:term)// is nondet. -%% seqmap_args( +P:phrase(integer), +I:integer, +J:integer, X:term, Y:term, Z:term)// is nondet. -% -% Like seqmap//N, but applied to the arguments of term X, Y and Z, from the I th to the -% J th inclusive. -% -% @see seqmap//2. - -seqmap_args(P,L,N,A) --> - ( {L>N} -> [] - ; {succ(L,M), arg(L,A,AA)}, - call(P,AA), seqmap_args(P,M,N,A) - ). - -seqmap_args(P,L,N,A,B) --> - ( {L>N} -> [] - ; {succ(L,M), arg(L,A,AA), arg(L,B,BB)}, - call(P,AA,BB), seqmap_args(P,M,N,A,B) - ). - -seqmap_args(P,L,N,A,B,C) --> - ( {L>N} -> [] - ; {succ(L,M), arg(L,A,AA), arg(L,B,BB), arg(L,C,CC)}, - call(P,AA,BB,CC), seqmap_args(P,M,N,A,B,C) - ). - - - -%%% ------------------------------------------------------------------ -%%% These are for sequence building DCGs. -%%% ------------------------------------------------------------------ - - - -%% out(?X)// is det. -% -% Equivalent to [X]. prepends X to the difference list represented by -% the DCG state variables. -out(L,[L|L0],L0). - - -% SNOBOL4ish rules -% -% Others: -% maxarb -% pos rpos -% tab rtab -% rem - - -%% any(+L:list(_))// is nondet. -% Matches any element of L. -any(L) --> [X], {member(X,L)}. - -%% notany(+L:list(_))// is nondet. -% Matches anything not in L. -notany(L) --> [X], {maplist(dif(X),L)}. - -%% arb// is nondet. -% Matches an arbitrary sequence. Proceeds cautiously. -arb --> []; [_], arb. - -%% arbno(+P:phrase)// is nondet. -% Matches an arbitrary number of P. Proceeds cautiously. -% Any variables in P are shared across calls. -arbno(P) --> []; P, arbno(P). - -%% bal// is nondet. -% Matches any expression with balanced parentheses. -bal --> balexp, arbno(balexp). -balexp --> "(", bal, ")". -balexp --> notany("()"). - -%% span(+L:list(_))// is nondet. -% Matches the longest possible sequence of symbols from L. -span(L,A,[]) :- any(L,A,[]). -span(L) --> any(L), span(L). -span(L), [N] --> any(L), [N], { maplist( dif( N), L) }. - -%% break(+L:list(_))// is nondet. -% Matches the longest possible sequence of symbols not in L. -break(L,A,[]) :- notany(L,A,[]). -break(L) --> notany(L), break(L). -break(L), [N] --> notany(L), [N], { member(N,L) }. - -%% len(N:natural)// is nondet. -% Matches any N symbols. -len(0) --> []. -len(N) --> [_], ({var(N)} -> len(M), {succ(M,N)}; {succ(M,N)}, len(M)). - - -%% //(+P:phrase(A), ?C:list(A), ?S1:list(A), ?S2:list(A)) is nondet. -%% //(+P:phrase(A), +C:phrase(A), ?S1:list(A), ?S2:list(A)) is nondet. -% -% Sequence capture operator - captures the matching sequence C of any -% phrase P, eg. -% == -% ?- phrase(paren(arb)//C,"(hello)world",_) -% C = "(hello)". -% true -% == -% If nonvar(C) and C is a phrase, it is called after calling P. - -//(H,C,L,T) :- - ( var(C) - -> phrase(H,L,T), append(C,T,L) - ; phrase(H,L,T), phrase(C,L,T) - ). - -%%% ------------------------------------------------------------------ -%%% These are for character sequences DCGs. - -%% writedcg(+P:phrase) is nondet. -% -% Run the phrase P, which must be a standard list-of-codes DCG, -% and print the output. -writedcg(Phrase) :- - phrase(Phrase,Codes), - format('~s',[Codes]). - -%% null// is det. -% Empty string. -null --> "". - -%% cr// is det. -% Carriage return "\n". -cr --> "\n". - -%% sp// is det. -% Space " ". -sp --> " ". - -%% fs// is det. -% Full stop (period) ".". -fs --> ".". - -%% fssp// is det. -% Full stop (period) followed by space. -fssp --> ". ". - -%% tb// is det. -% Tab "\t". -tb --> "\t". - -%% comma// is det. -% Comma ",". -comma --> ",". - -%% commasp// is det. -% Comma and space ", ". -commasp --> ", ". - -%% at(X:atom)// is det. -% Generate code list for textual representation of atom X. -at(A,C,T) :- atomic(A), with_output_to(codes(C,T),write(A)). - -%% wr(X:term)// is det. -% Generate the list of codes for term X, as produced by write/1. -wr(X,C,T) :- ground(X), with_output_to(codes(C,T),write(X)). - -%% wq(X:term)// is det. -% Generate the list of codes for term X, as produced by writeq/1. -wq(X,C,T) :- ground(X), with_output_to(codes(C,T),writeq(X)). - -%% str(X:term)// is det. -% Generate the list of codes for string X, as produced by writeq/1. -str(X,C,T):- string(X), with_output_to(codes(C,T),write(X)). - -%% fmt(+F:atom,+Args:list)// is det -% Generate list of codes using format/3. -fmt(F,A,C,T) :- format(codes(C,T),F,A). - -%% brace(P:phrase)// is nondet. -% Generate "{" before and "}" after the phrase P. -brace(A) --> "{", A, "}". - -%% paren(P:phrase)// is nondet. -% Generate "(" before and ")" after the phrase P. -paren(A) --> "(", A, ")". - -%% sqbr(P:phrase)// is nondet. -% Generate "[" before and "]" after the phrase P. -sqbr(A) --> "[", A, "]". - -%% q(P:phrase(list(code)))// is nondet. -% Generate list of codes from phrase P, surrounds it with single quotes, -% and escapes (by doubling up) any internal quotes so that the -% generated string is a valid quoted string. Must be list of codes DCG. -q(X,[39|C],T) :- T1=[39|T], escape_with(39,39,X,C,T1). % 39 is ' - -%% qq(P:phrase(list(code)))// is nondet. -% Generate list of codes from phrase P, surrounds it with double quotes, -% and escapes (by doubling up) any double quotes so that the -% generated string is a valid double quoted string. -qq(X,[34|C],T) :- T1=[34|T], escape_with(34,34,X,C,T1). % 34 is " - -% escape difference list of codes with given escape character -escape_codes(_,_,A,A,A). -escape_codes(E,Q,[Q|X],[E,Q|Y],T) :-escape_codes(E,Q,X,Y,T). -escape_codes(E,Q,[A|X],[A|Y],T) :- Q\=A, escape_codes(E,Q,X,Y,T). - -%% escape_with(E:C, Q:C, P:phrase(list(C)))// is nondet. -% -% Runs phrase P to generate a list of elements of type C and -% then escapes any occurrences of Q by prefixing them with E, e.g., -% =|escape_with(92,39,"some 'text' here")|= escapes the single quotes -% with backslashes, yielding =|"some \'text\' here"|=. -escape_with(E,Q,Phrase,L1,L2) :- - phrase(Phrase,L0,L2), - escape_codes(E,Q,L0,L1,L2). - -%% escape(Q:C, P:phrase(list(C)))// is nondet. -% -% Runs phrase P to generate a list of elements of type C and -% then escapes any occurrences of Q by doubling them up, e.g., -% =|escape(39,"some 'text' here")|= doubles up the single quotes -% yielding =|"some ''text'' here"|=. -escape(Q,A) --> escape_with(Q,Q,A). - -%% padint( +N:integer, +Range, +X:integer)// is nondet. -% -% Write integer X padded with zeros ("0") to width N. -padint(N,L..H,X,C,T) :- - between(L,H,X), - format(atom(Format),'~~`0t~~d~~~d|',[N]), - format(codes(C,T),Format,[X]). - -difflength(A-B,N) :- unify_with_occurs_check(A,B) -> N=0; A=[_|T], difflength(T-B,M), succ(M,N). - -% tail recursive version -difflength_x(A-B,M) :- difflength_x(A-B,0,M). -difflength_x(A-B,M,M) :- unify_with_occurs_check(A,B). -difflength_x([_|T]-A,M,N) :- succ(M,L), difflength_x(T-A,L,N). - - -%term_codes(T,C) :- with_output_to(codes(C),write(T)). - - - - -% try these? -%setof(X,Q,XS,S1,S2) :- setof(X,phrase(Q,S1,S2),XS). -%findall(X,Q,XS,S1,S2) :- findall(X,phrase(Q,S1,S2),XS). - -with_nth_arg(K,P,T1,T2) :- - functor(T1,F,N), - functor(T2,F,N), - with_nth_arg(N,K,P,T1,T2). - -with_nth_arg(K,K,P,T1,T2) :- - arg(K,T1,C1), phrase(P,C1,C2), - arg(K,T2,C2), succ(N,K), - copy_args(N,T1,T2). - -with_nth_arg(N,K,P,T1,T2) :- - arg(N,T1,C), - arg(N,T2,C), - succ(M,N), - with_nth_arg(M,K,P,T1,T2). - -copy_args(0,_,_) :- !. -copy_args(N,T1,T2) :- - succ(M,N), arg(N,T1,X), arg(N,T2,X), - copy_args(M,T1,T2). - - -%% setof( Template:X, Phrase:phrase(S), Results:list(X), S1:S, S2:S) is nondet. -setof(X,Q,XS,S1,S2) :- setof(X,phrase(Q,S1,S2),XS). - -%% findall( Template:X, Phrase:phrase(S), Results:list(X), S1:S, S2:S) is nondet. -findall(X,Q,XS,S1,S2) :- findall(X,phrase(Q,S1,S2),XS). - - -:- meta_predicate lift(0,?,?), lift(1,?,?), lift(2,?,?). - -lift(P) --> { call(P) }. -lift(P,X) --> { call(P,X) }. -lift(P,X,Y) --> { call(P,X,Y) }. -
--- a/prolog/ops.pl Thu Jan 19 15:23:35 2012 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ - -:- module(ops,[ - op(550,xfx,..) % range of integers - , op(550,xfx,--) % closed real interval - , op(600,xfx,--\) % half open real interval - , op(1100,xfx,:<:) % subtype declaration - , op(1100,xfx,::=) % definition - , op(1100,xfx,:=:) % type equivalence/definition - , op(1100,xfx,::) % declaration - , op(1100,xfx,<-) % element of, instance etc. - %, op(1050,yfx,¬) % restriction, eg real¬integer means fractional - , op(750,xfy,\\) % lambda abdstraction - , op(400,xfy,\) % reverse matrix division - , op(800,xfx,~) % for annotations - , op(900,fy,struct) - , op(900,fy,options) - , op(100,yfx,@) % used for signal@rate... - , op(200,yfx,++) % used for sequential composition - , op(700,xfx,in) - , op(150,yfx,`) % function application - , op(100,yfx,/) - %, op(400,xfy,>>) % monad sequencing NB: standard prolog has yfx not xfy - %, op(400,xfy,>>=) % monad bind - , op(1050,xfy,>>) % monad sequencing NB: standard prolog has yfx not xfy - , op(1050,xfy,>>=) % monad bind - , op(100,fx,'<?>') - , op(800,xfx,'</>') - , op(100,fx,?) - ]). - -/** <module> - Operator declarations - -This module consists entirely of operator declarations, as follows: -== -op(550,xfx,..). -op(550,xfx,--). -op(600,xfx,--\). -op(1100,xfx,:<:). -op(1100,xfx,::=). -op(1100,xfx,:=:). -op(1100,xfx,::). -op(1100,xfx,<-). -op(750,xfy,\\). -op(400,xfy,\). -op(800,xfx,~). -op(900,fy,maybe). -op(900,fy,struct). -op(900,fy,options). -op(100,yfx,@). -op(200,yfx,++). -op(700,xfx,in). -op(150,yfx,`). -op(100,yfx,/). -op(1050,xfy,>>). -op(1050,xfy,>>=). -op(100,fx,'<?>'). -op(800,xfx,'</>'). -op(100,fx,?). -== - -@author Samer Abdallah -*/
--- a/prolog/plml.pl Thu Jan 19 15:23:35 2012 +0000 +++ b/prolog/plml.pl Fri Jan 20 16:46:57 2012 +0000 @@ -746,8 +746,8 @@ db_tmp(I,Z,Y) :- ml_eval(I,dbtmp(Z),[loc],[Y]). db_drop(I,mat(A,B)) :- ml_exec(I,dbdrop(\loc(A,B))). -db_save_all(I,Z,L,Size) :- ml_eval(I,cellmap(@dbsave,Z),[cell(loc,Size)],[L]). -db_tmp_all(I,Z,L,Size) :- ml_eval(I,cellmap(@dbtmp,Z),[cell(loc,Size)],[L]). +db_save_all(I,Z,L,Size) :- ml_eval(I,dbcellmap(@dbsave,Z),[cell(loc,Size)],[L]). +db_tmp_all(I,Z,L,Size) :- ml_eval(I,dbcellmap(@dbtmp,Z),[cell(loc,Size)],[L]). db_drop_all(I,L,Size) :- length(Size,Dims), ml_exec(I,hide(foreach(@dbdrop,arr(Dims,L,X\\{loc(X)})))).
--- a/prolog/update Thu Jan 19 15:23:35 2012 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2 +0,0 @@ -#!/bin/sh -cp -p ~/src/sapl-2.0/{dcgu,ops,utils}.pl .
--- a/prolog/utils.pl Thu Jan 19 15:23:35 2012 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,960 +0,0 @@ -% Some general utilities - -:- module(utils,[ - - % type testing and enumeration - natural/1 % test or enumerate natural numbers - , isfinite/1 % check number is non NaN or Inf - , int/1 % test or enumerate integers - , in/2 - - % mathematical utilities - , max/3 - , min/3 - - % list utilities - , list_idx1_member/3 % like nth1 but more useful argument order - , apply_to_nth1/4 - , measure/3 % match list lengths - , equal_length/2 % match 2 list lengths - , getopts/2 - , rep/3 % make a list of repeats of the same term - , cons/3 % list constructror - , decons/3 % list deconstructor - - % comma lists - , cl_list/2 - , cl_list_vt/2 - , cl_length/2 - , cl_length_vt/2 - , cl_member/2 - - - % term manipulation - , copy_head/2 % check terms for same head and arity - , unify_args/5 - , reinstatevars/3 - , reinstatevars/4 - - % formatting and parsing - , aphrase/2 % like phrase but makes an atom instead of a string - , aphrase/3 % like aphrase but takes code list - , print_list/1 % writes each element on a new line - , printq_list/1 % as print_list but quotes atom as necessary - , print_numbered_list/1 - - % database management - , extensible/1 % declare dynamic multifile predicate - , bt_assert/1 - , bt_retract/1 - , strict_assert/1 - , strict_retract/1 - , browse/2 % browse predicate with unknown arity - , current_state/2 - , set_state/2 - - % file system utilities - , dir/2 % directory listing - , path_atom/2 % expand paths - , expand_path/2 % expand paths - - % operating system - , open_with/2 % apply shell command to a file (SIDE EFFECTS) - , open_with/3 % apply shell command to a file with options (SIDE EFFECTS) - , shellcmd/2 % apply shell command to arguments - , open_/1 % open with 'open' command (Mac OS X). - , fmt_shellcmd/3 % format a shell command with switches and args - , hostname/1 - - % user interaction - , read_char_echo/1 % read one character and echo it immediately - , get_key/2 % read and validate keypress - , userchk/1 % unary predicate which allows user to force failure - , prompt_for_key/3 - - % ---- high order stuff ---- - - % modes of computation - , retry/1 % keep trying until success - , parallel/1 % parallel computation using threads - , bt_call/2 % Construct backtrackable operation - , on_backtracking/1 - - % iteration - , exhaust/1 % trigger all solutions to a goal (SIDE EFFECTS) - , iterate/3 % apply predicate recursively till failure - - % mapping - , for_naturals/2 % call predicate with natural numbers N down to 1 - , mapints/2 % call predicate with integers - , mapints/3 - , mapargs/2, mapargs/3, mapargs/4 - , mapargs_x/4, mapargs_x/5, mapargs_x/6 - , mapargs_xx/6 - , sfold/4 % structural fold for lists - , take/3 - , drop/3 - , drop_while/3 - , take_while/3 - - % lambda expressions - , mcall/2, mcall/3, mcall/4 - - ]). - -/** <module> General utilities - -The predicates in this module can be divided into several groups as listed -below. - ----+++ Type testing and enumeration - * natural/1 - test or enumerate natural numbers - * isfinite/1 - check number is non NaN or Inf - * int/1 - test or enumerate integers - * in/2 - ----+++ mathematical utilities - * max/3 - * min/3 - ----+++ list utilities - * list_idx1_member/3 % like nth1 but more useful argument order - * measure/3 - match list lengths - * equal_length/2 - match two list lenghts - * getopts/2 - * rep/3 - make a list of repeats of the same term - * cons/3 - make list from head and tail - * decons/3 - get head and tail from list - ----+++ term manipulation - * copy_head/2 - check terms for same head and arity - * unify_args/5 - * reinstatevars/3 - * reinstatevars/4 - ----+++ formatting and parsing - * aphrase/2 - like phrase but makes an atom instead of a string - * aphrase/3 - like aphrase but takes code list - * print_list/1 - write/1 each element, one per line - * printq_list/1 - as print_list but quotes atom as with writeq/1 - * print_numbered_list/1 - as print_list/1 but with line numbers - ----+++ database management - * extensible/1 - declare dynamic multifile predicate - * bt_assert/1 - * bt_retract/1 - * strict_assert/1 - * strict_retract/1 - * browse/2 - browse predicate with unknown arity - * current_state/2 - * set_state/2 - ----+++ file system utilities - * dir/2 - directory listing - * path_atom/2 - expand paths - * expand_path/2 - expand paths - ----+++ operating system - * open_with/2 - apply shell command to a file (SIDE EFFECTS) - * open_with/3 - apply shell command to a file with options (SIDE EFFECTS) - * shellcmd/2 - apply shell command to arguments - * open_/1 - open with 'open' command (Mac OS X). - * fmt_shellcmd/3 - format a shell command with switches and args - * hostname/1 - ----+++ user interaction - * read_char_echo/1 - read one character and echo it immediately - * get_key/2 - read and validate keypress - * userchk/1 - unary predicate which allows user to force failure - * prompt_for_key/3 - print message and get keypress from user - ----+++ High order stuff - ----++++ modes of computation - * retry/1 - keep trying until success - * parallel/1 - parallel computation using threads - * bt_call/2 - Construct backtrackable operation - , on_backtracking/1 - ----++++ iteration - * exhaust/1 - trigger all solutions to a goal (SIDE EFFECTS) - * iterate/3 - apply predicate recursively till failure - ----++++ mapping - * for_naturals/2 - call predicate with natural numbers N down to 1 - * mapints/2 - call predicate with integers - * mapints/3 - * mapargs/2, mapargs/3, mapargs/4 - * mapargs_xx/6 - * sfold/4 - structural fold for lists - * take/3 - * drop/3 - * drop_while/3 - * take_while/3 - ----++++ lambda expressions - * mcall/2, mcall/3, mcall/4 - */ - -:- use_module(library(ops)). - -:- meta_predicate - exhaust(0) - , retry(0) - , iterate(2,?,?) - , drop_while(1,?,?) - , take_while(1,?,?) - , apply_to_nth1(?,2,?,?) - , for_naturals(+,1) - , for_ints(+,+,1) - , mapints(1,?) - , mapints(2,?,?) - , mapargs(1,?) - , mapargs(2,?,?) - , mapargs(3,?,?,?) - , mapargs_x(+,+,1,?) - , mapargs_x(+,+,2,?,?) - , mapargs_x(+,+,3,?,?,?) - , mapargs_xx(2,?,?,?,?,?) - , on_backtracking(0) - , bt_call(0,0) - , bt_assert(:) - , bt_retract(:) - , strict_assert(:) - , strict_retract(:) - , extensible(:) - , aphrase(2,?) - , aphrase(2,?,?) - . - -:- multifile user:path/2. -:- multifile user:demo/1. -:- dynamic current_state/2. - - -%% extensible(+P) is det. -% declares 'extensible' predicates, ie ones that can have new clauses -% added in other files. Equivalent to dynamic(P), multifile(P). -extensible(P) :- dynamic(P), multifile(P). - - -%% natural(+N) is semidet. -%% natural(-N:natural) is multi. -% -% Means N is a natural number (includes 0). If N is -% a variable, succeeds an infinite number of times on backtracking, -% returning all natural numbers. -natural(N) :- (var(N) -> between(0,inf,N); integer(N), N>=0). - - -%% int(+N) is semidet. -%% int(-N:integer) is multi. -% -% Means N is an integer. If N is -% a variable, succeeds an infinite number of times on backtracking, -% returning all integers starting at zero and interleaving positive -% and negative values. -int(N) :- nonvar(N), integer(N). -int(N) :- var(N), (N=0; (between(1,inf,M), (N=M; N is -M))). - - -%% isfinite(+N:number) is semidet. -% -% Succeeds when N is a finite number. -isfinite(N):- catch(_ is N+0,error(_,_),fail). % !! workable hack - - -%% in(+X,Set) is semidet. -%% in(-X,Set) is nondet. -% -% Simple testing and enumration of values in some sets. -% Set can be -% * {A,B,_} -% Explicit list of values. -% * natural -% Natural numbers starting from 0. -% * integer -% Natural numbers. -% * real -% Real (floating point) numbers. -% * A..B -% Integer range from A to B inclusive. -% * A--B -% Closed interval [A,B]. -X in A--\B :- X in A--(\B). -X in \A--(\B):- !, ch(A<X), ch(X<B). -X in \A--B :- !, ch(A<X), ch(X=<B). -X in A--(\B) :- !, ch(A=<X), ch(X<B). -X in A--B :- !, ch(A=<X), ch(X=<B). -X in A..B :- integer(A), integer(B), between(A,B,X). -X in {CList} :- member_clist(X,CList). -X in natural :- natural(X). % enumerate! -X in integer :- int(X). % enumerates! -X in real :- number(X). % same as X :: real - - -ch(_ =<inf) :- !. -ch(inf=< _ ) :- !, fail. -ch(-inf=< _) :- !. -ch(_ =<(-inf)) :- !, fail. -ch(A=<B) :- !, A=<B. - -ch(inf<_ ) :- !, fail. -ch(_ <inf) :- !. -ch(_ <(-inf)) :- !, fail. -ch(-inf<_ ) :- !. -ch(A<B) :- !, A<B. - - - -%% exhaust(:Goal) is det. -% -% Repeat Goal until failure, then succeed. -exhaust(Q) :- call(Q), fail; true. - -%% iterate(+P:pred(A,A), X:A, Y:A) is semidet. -% apply P recursively to X until failure, then return final value Y. -iterate(P,X,Y) :- call(P,X,Z) -> iterate(P,Z,Y); Y=X. - -%% sfold(Functor,Initial,L:list,Final) is semidet. -% *Structural* fold applied to a term, -% rather than a relational fold using a predicate name. -sfold(_,E,[],E). -sfold(O,E,[X|XX],R) :- R=..[O,X,YY], sfold(O,E,XX,YY). - - -%% dir( +Pattern, -File) is nondet. -% -% Directory listing for directory matching Pattern. File -% names are returned one by one on backtracking. -dir(Pattern,File) :- - expand_file_name(Pattern,List), - member(File,List). - - -%% path_atom( +Spec:path_expr, -Path:atom) is nondet. -% -% Expand a 'path expression' into a flat path (an atom). -% A path expression is defined by: -% == -% path_expr ---> atom % literal path component name -% ; path_expr/atom % child of path_expr -% ; path_macro % a previously defined abbr for a path. -% == -% A path_macro is defined using path/2. - -path_atom(P,C) :- path(P,C), atom(C). - -path_atom(PA/B,C) :- - once((nonvar(C); nonvar(B); nonvar(PA))), - path_atom(PA,A), - concat3atoms(A,'/',B,C). - - -path_atom(Path,Atom) :- path(Path, Def), \+atom(Def), path_atom(Def,Atom). -path_atom(Path,Atom) :- - nonvar(Path), - \+path(Path,_), - Path\=_/_, - Atom=Path. - -concat3atoms(A,B,C,ABC) :- - nonvar(A), nonvar(B), nonvar(C), !, concat_atom([A,B,C],ABC). - -concat3atoms(_,_,_,ABC) :- var(ABC), !, fail. -concat3atoms(A,B,C,ABC) :- nonvar(C), !, atom_concat(AB,C,ABC), atom_concat(A,B,AB). -concat3atoms(A,B,C,ABC) :- nonvar(A), !, atom_concat(A,BC,ABC), atom_concat(B,C,BC). -concat3atoms(A,B,C,ABC) :- - maplist(atom_codes,[B,ABC],[BX,ABCX]), - append(ABX,CX,ABCX), - append(AX,BX,ABX), - maplist(atom_codes,[A,C],[AX,CX]). - -%% expand_path( +P:path_expr, -FP:atom) is semidet. -% -% Expand path_exp including wildcards to fully qualified path -expand_path(P,FP) :- path_atom(P,PP), expand_file_name(PP,[FP]). - - -%% open_with( +Program:atom, +Thing:path_expr, +Options:list) is semidet. -%% open_with( +Program:atom, +Thing:path_expr) is semidet. -% -% The only option is bg, which adds "&" to make command execute in background. -open_with(Q,P) :- open_with(Q,P,[]). -open_with(Q,P,Opts) :- - expand_path(P,FP), - (member(bg,Opts) -> OO=' &'; OO=''), - sformat(S,'~w ~q~w',[Q,FP,OO]), - shell(S). - -%% open_( +Thing:path_expr) is semidet. -% Equivalent to open_with(open,Thing). -open_(P) :- open_with(open,P). - -%% shellcmd( +Head:atom, +Args:list(atom)) is det. -% -% Execute a shell command on a given list of arguments -shellcmd(Head,Args) :- - concat_atom([Head|Args],' ',Cmd), - shell(Cmd,_Status). - -%% fmt_shellcmd( +Prog:atom, +Args:list(shellarg), -Cmd) is det. -% make a shell command string. -fmt_shellcmd(Prog,Args,Cmd) :- - phrase(utils:shellcmd(l_(Args)),FArgs), - concat_atom([Prog|FArgs],' ',Cmd). - -shellcmd(l_([])) --> !, []. -shellcmd(l_([H|T])) --> !, shellcmd(H), shellcmd(l_(T)). -shellcmd(s(N,V)) --> !, shellcmd(s(N)), shellcmd(V). -shellcmd(q(X)) --> !, { concat_atom(['"',X,'"'],A) }, [A]. -shellcmd(s(N)) --> !, { - (atom_codes(N,[_]) -> F='-' ; F='--'), - atom_concat(F,N,A) }, [A]. -shellcmd(l(X)) --> [X]. - - - -%% read_char_echo( -C:atom) is det. -% -% Read a single character from the current input, -% echo it to the output. -read_char_echo(C) :- - get_single_char(Code), - put_code(Code), flush_output, - char_code(C,Code). - - - -%% set_state( +Key, +Value) is det. -% -% Maintains a mutable global set of Key-Value pairs, sets the value -% associated with Key to Value. -set_state(Flag,Value) :- - ground(Flag), - retractall(current_state(Flag,_)), - assert(current_state(Flag,Value)). - - -%% current_state( -Key, -Value) is nondet. -%% current_state( +Key, -Value) is semidet. -% -% Lookup the value associated with Key, or enumerate all the -% key value pairs. - - - -%% parallel( +List:list(query)) is semidet. -% -% Use this by giving a list of queries of the form -% [Vars2:Goal, Vars2:Goal2, ...] -% where Vars is the term that each thread must return -% when it has finished computing its Goal. The -% parallel predicate finishes when all the threads -% have finished, and should result in all the Vars -% being bound appropriately. - -parallel(Queries) :- - maplist(async,Queries,Collecters), - maplist(call,Collecters). - -% these are used to initiate and wait for each -% computation thread. -async_collect(Id,X:_) :- thread_join(Id,exited(X)). -async(X:Goal,utils:async_collect(Id,X:_)) :- - thread_create((Goal,thread_exit(X)),Id,[]). - -%% browse( +PredSpec, -Goal) is nondet. -% -% PredSpec is a term like (PredicateName/Arity). Goal -% is unified with solutions of PredicateName/Arity. -browse(P/A,Goal) :- - current_predicate(P/A), - length(L,A), - Goal=..[P|L], - call(Goal). - - - -%% aphrase(P:phrase(code), -A:atom, +S:list(code)) is nondet. -%% aphrase(P:phrase(code), +A:atom, -S:list(code)) is nondet. -%% aphrase(P:phrase(code), -A:atom, -S:list(code)) is nondet. -%% aphrase(P:phrase(code), -A:atom) is nondet. -% -% Generate or parse an atom using given DCG phrase P. -% aphrase(P,A) is equivalent to aphrase(P,A,_). -aphrase(X,A) :- aphrase(X,A,_). -aphrase(X,A,S) :- - ( ground(A) - -> atom_codes(A,S), phrase(X,S) - ; phrase(X,S), atom_codes(A,S)). - - -%% print_list( +L:list) is det. -% -% Print a list, one item per line. -print_list([]) :- writeln('~'), nl. -print_list([H|T]) :- print(H), nl, print_list(T). - -%% printq_list( +L:list) is det. -% -% Print a list, one item per line, as with writeq/1. -printq_list([]) :- writeln('~'), nl. -printq_list([H|T]) :- writeq(H), nl, printq_list(T). - -%% print_numbered_list( +L:list) is det. -% -% Print a list with numbered lines. -print_numbered_list(L) :- - length(L,Max), - number_codes(Max,MC), - length(MC,Width), - print_num_list(Width,1,L). - -print_num_list(_,_,[]) :- nl. -print_num_list(Width,N,[H|T]) :- succ(N,M), - copy_term(H,H1), - numbervars(H1,0,_), - number_codes(N,NC), " "=[Pad], - padleft(Pad,Width,NC,PNC), - format('~s. ~q\n',[PNC,H1]), - print_num_list(Width,M,T). - -padleft(_,W,In,In) :- length(In,W). -padleft(P,W,In,[P|Out]) :- succ(V,W), padleft(P,V,In,Out). - - - - -%% get_key( +Valid:list(char), -C:char) is det. -% -% Get and validate a key press from the user. The character -% must be one of the ones listed in Valid, otherwise, an -% error message is printed and the user prompted again. -get_key(Valid,C) :- - read_char_echo(D), nl, - ( member(D,Valid) -> C=D - ; D='\n' -> get_key(Valid,C) % this improves interaction with acme - ; format('Unknown command "~q"; valid keys are ~q.\n', [D,Valid]), - write('Command? '), - get_key(Valid,C)). - - -%% userchk(T) is semidet. -% -% Write T and ask this user if it is ok. User presses y or n. -% userchk succeeds if if the keypress was y and fails if it was n. -userchk(T) :- prompt_for_key(T,[y,n],y). - - -%% prompt_for_key( +Msg:atom, +Keys:list(char), -Key:char) is semidet. -% -% Prompt user for a keypress. Prompt message is Msg, and valid keys are -% listed in Keys. -prompt_for_key(Msg,Keys,Key) :- format('~p ~q? ',[Msg,Keys]), get_key(Keys,Key). - -% ------------------- TERM MANIPULATION ------------------------------ - - -%% copy_head(+T1,-T2) is det. -%% copy_head(+T1,+T2) is semidet. -% -% true if T1 and T2 have the same head and arity -copy_head(T1,T2) :- functor(T1,N,A), functor(T2,N,A). - - - -%% reinstatevars( F:atom, V:list, Eh, What) is nondet. -%% reinstatevars( V:list, Eh, What) is nondet. -% -% Reverse of numbervars. Each '$VAR'(N) subterm of X is replaced -% with the Nth element of V, which can be uninstantiated on entry -% reinstatevars/4 uses an arbitrary functor F instead of $VAR. - -reinstatevars(V,'$VAR'(N),Y) :- !, nth0(N,V,Y). -reinstatevars(_,X,Y) :- atomic(X), !, Y=X. -reinstatevars(V,X,Y) :- mapargs(reinstatevars(V),X,Y). - -reinstatevars(F,V,T,Y) :- functor(T,F,1), !, arg(1,T,N), nth0(N,V,Y). -reinstatevars(_,_,X,Y) :- atomic(X), !, Y=X. -reinstatevars(F,V,X,Y) :- mapargs(reinstatevars(F,V),X,Y). - - -%% unify_args( Src, SrcIndex, Dest, DestIndex, Num) is det. -% -% this unifies N consecutive arguments of Src and Dest starting -% from SI and DI in each term respectively -unify_args(_,_,_,_,0). -unify_args(Src,SI,Dest,DI,N) :- - arg(SI,Src,X), arg(DI,Dest,X), !, - succ(SI,SI2), succ(DI,DI2), succ(N2,N), - unify_args(Src,SI2,Dest,DI2,N2). - - -% ---------------------- LIST UTILITIES ----------------------------- - - -%member_clist(_,Z) :- var(Z), !, fail. -member_clist(A,A) :- A\=(_,_). -member_clist(A,(A,_)). -member_clist(A,(_,B)) :- member_clist(A,B). - - - -%% measure(Ruler,In,Out) is det. -% true if Out is the same length as Ruler but matches In as far as possible -measure([],_I,[]). -measure([_|R],[],[_|O]) :- measure(R,[],O). -measure([_|R],[X|I],[X|O]) :- measure(R,I,O). - -%% equal_length( ?In, ?Out) is nondet. -% equal_length( +L1:list, -L2:list) is det. -% equal_length( -L1:list, +L2:list) is det. -% -% True if L1 and L2 are the same length. -equal_length([],[]). -equal_length([_|T1],[_|T2]) :- equal_length(T1,T2). - -%split_at(0,T,I-I,T). -%split_at(N,[H|T],[H|I1]-Z,T1) :- succ(M,N), split_at(M,T,I1-Z,T1). - -%split_at2(0,T,I-I,T). -%split_at2(N,[H|T],[H|I1]-Z,T1) :- split_at2(M,T,I1-Z,T1), succ(M,N). - -%% max(+X:number, +Y:number, -Z:number) is det. -% -% Unify Z with the larger of X and Y. Legal values are -% any numerical value or inf or -inf. -max(_,inf,inf) :- !. -max(inf,_,inf) :- !. -max(X,-inf,X) :- !. -max(-inf,X,X) :- !. -max(X,Y,Z) :- X<Y -> Z=Y; Z=X. - -%% max(+X:number, +Y:number, -Z:number) is det. -% -% Unify Z with the larger of X and Y. Legal values are -% any numerical value or inf or -inf. -min(_,-inf,-inf) :- !. -min(-inf,_,-inf) :- !. -min(X,inf,X) :- !. -min(inf,X,X) :- !. -min(X,Y,Z) :- X<Y -> Z=X; Z=Y. - -%% list_idx1_member( +L:list(A), +N:natural, ?X:A) is semidet. -%% list_idx1_member( ?L:list(A), ?N:natural, ?X:A) is nondet. -% -% Equivalent to nth1(N,L,X). -list_idx1_member(L,I,X) :- nth1(I,L,X). - - -%% getopts( +Opts:list(option), ?Spec:list(optspec)) is det. -% -% Get value from option list. -% == -% option(A) ---> term(A). -% optspec ---> option(A)/A. -% == -getopts(OptsIn,Spec) :- maplist(getopt(OptsIn),Spec). -getopt(OptsIn,Option/Default) :- option(Option,OptsIn,Default). - -%% cons( ?Head:A, ?Tail:list(A), ?List:list(A)) is det. -% -% List constructor. -cons(H,T,[H|T]). - -%% decons( ?Head:A, ?List:list(A), ?Tail:list(A)) is det. -% -% List deconstructor. -decons(H,[H|T],T). - -% ---------------------- MAPPING, HIGH ORDER STUFF --------------------- - -%% for_naturals(+N:natural, P:pred(natural)) is nondet. -% apply predicate to each natural number from 1 to N (backwards) -for_naturals(0,_). -for_naturals(N,P) :- succ(M,N), call(P,N), for_naturals(M,P). - -%% mapints( +P:pred(integer,A), +R:intrange, -X:list) is nondet. -%% mapints( +P:pred(integer), +R:intrange) is nondet. -% -% Mapping predicates over lists of integers. Range is like M..N. -% mapints/3 maps 2 argument predicate over implicit list of -% integers M..N and explicit list of values X. -mapints(_,M..N) :- N<M, !. -mapints(P,M..N) :- call(P,M), plus(M,1,L), mapints(P,L..N). - -mapints(_,M..N,[]) :- N<M, !. -mapints(P,M..N,[X|T]) :- call(P,M,X), plus(M,1,L), mapints(P,L..N,T). - -%% rep( +N:natural, ?X:A, -L:list(A)) is det. -%% rep( -N:natural, ?X:A, -L:list(A)) is multi. -% Make a list consisting of N repeats of the same term. If called -% with N unbount, creates progressively longer and longer lists -% on backtracking. -rep(0,_,[]). -rep(N,A,[A|X]) :- - ( nonvar(N) - -> succ(M,N), rep(M,A,X) - ; rep(M,A,X), succ(M,N) - ). - -%% mapargs( P:pred(A,B,C), T1:tuple(F,A), T2:tuple(F,B), T3:tuple(F,C)) is nondet. -%% mapargs( P:pred(A,B), T1:tuple(F,A), T2:tuple(F,B)) is nondet. -%% mapargs( P:pred(A), T1:term) is nondet. -% -% Map predicate over to args of a term preserving head. -% A tuple(F,A) is a term with head functor F and any number of arguments -% of type A, ie -% == -% tuple(F,A) ---> F ; F(A) ; F(A,A) ; F(A,A,A) ; .. . -% == - -mapargs(P,T1) :- - functor(T1,_,N), - mapargs_x(1,N,P,T1). - -mapargs(P,T1,T2) :- - ( nonvar(T1) - -> functor(T1,F,N), functor(T2,F,N) - ; functor(T2,F,N), functor(T1,F,N)), - mapargs_x(1,N,P,T1,T2). - -mapargs(P,T1,T2,T3) :- - functor(T1,F,N), - functor(T2,F,N), - functor(T3,F,N), - mapargs_x(1,N,P,T1,T2,T3). - -mapargs_x(I,N,P,T1) :- - ( I>N -> true - ; arg(I,T1,X1), - call(P,X1), - succ(I,J), mapargs_x(J,N,P,T1)). - -mapargs_x(I,N,P,T1,T2) :- - ( I>N -> true - ; arg(I,T1,X1), - arg(I,T2,X2), - call(P,X1,X2), - succ(I,J), mapargs_x(J,N,P,T1,T2)). - -mapargs_x(I,N,P,T1,T2,T3) :- - ( I>N -> true - ; arg(I,T1,X1), - arg(I,T2,X2), - arg(I,T3,X3), - call(P,X1,X2,X3), - succ(I,J), mapargs_x(J,N,P,T1,T2,T3)). - -%% drop( +N:natural, +In:list(A), -Out:list(A)) is det. -drop(0,T,T). -drop(N,[_|T],V) :- succ(M,N), drop(M,T,V). - - -%% take( +N:natural, +In:list(A), -Out:list(A)) is det. -take(N,T,X) :- length(X,N), append(X,_,T). - - -%% drop_while( +P:pred(A), +In:list(A), -Out:list(A)) is det. -% -% Remove all elements from head of In that are accepted by P -% and return the remained in Out. -drop_while(P,[X|T],V) :- call(P,X) -> drop_while(P,T,V); V=[X|T]. - - -%% take_while( +P:pred(A), +In:list(A), -Out:list(A)) is det. -% -% Remove all elements from head of In that are accepted by P -% and return them in Out. -take_while(P,[X|T],O) :- call(P,X) -> O=[X|V], take_while(P,T,V); O=[]. - - - -%% retry( :Goal) is det. -% -% Keep retrying Goal until it succeeds. Only makes sense if Goal -% has side effects. Might be nonterminating. -retry(G) :- once((repeat,G)). - -%% apply_to_nth1( N:natural, Op:pred(A,A), +In:list(A), +Out:list(A)) is nondet. -% -% Apply predicate Op to the N th element of list In and unify Out with the result. -%apply_to_nth1(N,Op,Old,Init) :- -% ( nonvar(N) -% -> succ(M,N), split_at(M,Old,Init-[Y|Tail],[X|Tail]) -% ; split_at2(M,Old,Init-[Y|Tail],[X|Tail]), succ(M,N) -% ), -% call(Op,X,Y). - -apply_to_nth1(1,P,[X|XX],[Y|XX]) :- call(P,X,Y). -apply_to_nth1(N,P,[X|X1],[X|Y1]) :- nonvar(N), !, N>1, succ(M,N), apply_to_nth1(M,P,X1,Y1). -apply_to_nth1(N,P,[X|X1],[X|Y1]) :- var(N), !, apply_to_nth1(M,P,X1,Y1), succ(M,N). - - -%% mapargs_xx( +P:pred(A,B), +Src:term(_,A), +SrcIndex:natural, +Dest:term(_,B), +DestIndex:natural, +N:natural) is nondet. -% -% Maps predicate P over N consecutive arguments of Src and Dest. Starts -% at SrcIndex th argument of Src and DestIndex th argument of Dest. -mapargs_xx(_,_,_,_,_,0). -mapargs_xx(Pred,Src,SI,Dest,DI,N) :- - arg(SI,Src,SX), arg(DI,Dest,DX), call(Pred,SX,DX), !, - succ(SI,SI2), succ(DI,DI2), succ(N2,N), - mapargs_xx(Pred,Src,SI2,Dest,DI2,N2). - - -%% mcall(P:pred(A), X:A) is nondet. -%% mcall(P:pred(A,B), X:A, Y:B) is nondet. -%% mcall(P:pred(A,B,C), X:A, Y:B, Z:C) is nondet. -%% mcall(P:pred(A,B,C,D), X:A, Y:B, Z:C, W:D) is nondet. -% -% Like call/N but P can additionally be a lambda expression in one of several -% forms: -% * Tuple :- Body -% If functor(Tuple,\,N), Body is executed after unifying tuple arguments -% with arguments to mcall, eg =mcall(\(X):-member(X,[a,b,c]),Y)= is equivalent -% to member(Y,[a,b,c]), or =mcall(\(X,Y):-nth1(X,[a,b,c],Y),2,c)=. -% * Tuple -% Equivalent to Tuple:-true. - -mcall(P,A) :- mc(P,\(A),Q), Q. -mcall(P,A,B) :- mc(P,\(A,B),Q), Q. -mcall(P,A,B,C) :- mc(P,\(A,B,C),Q), Q. -mcall(P,A,B,C,D) :- mc(P,\(A,B,C,D),Q), Q. - -mc(Tuple:-Body,Params,Goal) :- !, copy_term(Tuple/Body,Params/Goal). -mc(Tuple,Params,true) :- functor(Tuple,\,_), !, copy_term(Tuple,Params). -mc(P,Params,apply(P,Args)) :- Params=..[\|Args]. - - -%% on_backtracking( :Goal) is det. -% -% The first time this is called, it succeeds and does nothing. -% On backtracking, Goal is called and then a failure is generated. - -on_backtracking(_). -on_backtracking(P) :- P, !, fail. - - -%% bt_call( :Do, :Undo) is nondet. -% -% Creates a backtrackable operation from a non-backtrackable Do -% operation and a corresponding operation to undo it. Do can -% be non-deterministic, in which case bt_call(Do,Undo) will also -% have multiple solutions. Undo is called inside once/1. -% -% bt_call/2 is implemented both as a predicate and as a goal -% expansion (see goal_expansion/2). -bt_call(Do,Undo) :- Do, (true; once(Undo), fail). - -user:goal_expansion( bt_call(Do,Undo), (Do, (true; once(Undo), fail))). - - - -/* Might include these at some point - -% apply lambda term to another term -app(X\\F,Y,G) :- !, copy_term(X\\F,Y\\G). -app(T,A,Z) :- addargs(T,[A],Z). -app(T,A,B,Z) :- addargs(T,[A,B],Z). -app(T,A,B,C,Z) :- addargs(T,[A,B,C],Z). - -applist(F,N,A,Z) :- length(Z,N), maplist(app(F),A,Z). -applist(F,N,A,B,Z) :- length(Z,N), maplist(app(F),A,B,Z). -applist(F,N,A,B,C,Z) :- length(Z,N), maplist(app(F),A,B,C,Z). - -*/ - - -% ------------------ DATABASE ------------------------------ - -%% bt_assert(Clause) is det. -% Backtrackable assert. -bt_assert(H) :- bt_call(assert(H),retract(H)). - -%% bt_retract(Clause) is det. -% Backtrackable retract. -bt_retract(H) :- bt_call(retract(H), assert(H)). - -%% strict_assert(Fact) is semidet. -% -% Asserts fact only if it is not already true. Fails -% if fact is already provable. Retracts fact on backtracking. -strict_assert(H) :- \+call(H), bt_call(assert(H),retract(H)). - - -%% strict_retract(Fact) is semidet. -% -% Retracts fact only if it is currently in the database. Fails -% if fact is not provable. Reasserts fact on backtracking. -strict_retract(H) :- call(H), bt_call(retract(H), assert(H)). - - -% when loaded, this sets the hostname/1 predicate. -:- dynamic hostname/1. - -%% hostname( -A:atom) is det. -% -% Unifies A with the computer's hostname. This is set when the -% module is loaded by calling the system command 'hostname -s'. - -% init_hostname is det - read hostname from UNIX command hostname. -init_hostname :- - setup_call_cleanup( - open(pipe('hostname -s'),read,SID), - (read_line_to_codes(SID,C), atom_codes(H,C), retractall(hostname(_)), assert(hostname(H))), - close(SID)). - -:- ( hostname(H) - -> format('% hostname already set to ~w\n',[H]) - ; init_hostname, hostname(H), format('% hostname set to ~w\n',[H]) - ). - -% Comma lists -% ie, lists built up using (,) as a pairing functor -% Note, these functor lists do NOT have a nil element - the -% last item in the list is the 2nd argument to the final -% functor term, which can therefore be a term headed by any -% other functor. Eg: -% (1,(2,3)) <-> [1,2,3] -% (1,(2,(3+4)) <-> [1,2,(3+4)] - -%% cl_list( +CL:clist(A), -L:list(A)) is det. -%% cl_list( -CL:clist(A), +L:list(A)) is det. -% -% Convert between comma lists and ordinary lists -cl_list((A,B),[A|BL]) :- cl_list(B,BL). -cl_list(A,[A]) :- A\=(_,_). - -%% cl_length( +L:clist, -N:natural) is det. -%% cl_length( -L:clist, +N:natural) is det. -% -% Length of a comma-list. -cl_length((_,B),N) :- cl_length(B,M), succ(M,N). -cl_length(X,1) :- X\=(_,_). - - -%% cl_list_vt( +CL:clist(A), -L:list(A)) is det. -%% cl_list_vt( -CL:clist(A), +L:list(A)) is det. -% -% Convert between comma lists (with open tails) and ordinary lists. -cl_list_vt(FL,[FL]) :- var(FL), !. -cl_list_vt(FL,[A|BL]) :- FL = (A,B), cl_list_vt(B,BL). -cl_list_vt(A,[A]) :- A\=(_,_). - - -%% cl_length_vt( +L:clist, -N:natural) is det. -%% cl_length_vt( -L:clist, +N:natural) is det. -% -% Length of a comma-list with possible variable tail. -% This version handles lists where the last element is variable (counts as 1) -cl_length_vt(FL,1) :- var(FL), !. -cl_length_vt(FL,N) :- FL=(_,B), cl_length_vt(B,M), succ(M,N). -cl_length_vt(FL,1) :- FL\=(_,_). - -%% cl_member(-X, +L:clist) is nondet. -% List membership for comma lists. -cl_member(X,(X,_)). -cl_member(X,(_,T)) :- cl_member(X,T). -cl_member(X,X) :- X\=(_,_). -