samer@0: % Some general utilities samer@0: samer@0: :- module(utils,[ samer@0: samer@0: % type testing and enumeration samer@0: natural/1 % test or enumerate natural numbers samer@0: , isfinite/1 % check number is non NaN or Inf samer@0: , int/1 % test or enumerate integers samer@0: , in/2 samer@0: samer@0: % mathematical utilities samer@0: , max/3 samer@0: , min/3 samer@0: samer@0: % list utilities samer@0: , list_idx1_member/3 % like nth1 but more useful argument order samer@0: , apply_to_nth1/4 samer@0: , measure/3 % match list lengths samer@0: , equal_length/2 % match 2 list lengths samer@0: , getopts/2 samer@0: , rep/3 % make a list of repeats of the same term samer@0: , cons/3 % list constructror samer@0: , decons/3 % list deconstructor samer@0: samer@0: % comma lists samer@0: , cl_list/2 samer@0: , cl_list_vt/2 samer@0: , cl_length/2 samer@0: , cl_length_vt/2 samer@0: , cl_member/2 samer@0: samer@0: samer@0: % term manipulation samer@0: , copy_head/2 % check terms for same head and arity samer@0: , unify_args/5 samer@0: , reinstatevars/3 samer@0: , reinstatevars/4 samer@0: samer@0: % formatting and parsing samer@0: , aphrase/2 % like phrase but makes an atom instead of a string samer@0: , aphrase/3 % like aphrase but takes code list samer@0: , print_list/1 % writes each element on a new line samer@0: , printq_list/1 % as print_list but quotes atom as necessary samer@0: , print_numbered_list/1 samer@0: samer@0: % database management samer@0: , extensible/1 % declare dynamic multifile predicate samer@0: , bt_assert/1 samer@0: , bt_retract/1 samer@0: , strict_assert/1 samer@0: , strict_retract/1 samer@0: , browse/2 % browse predicate with unknown arity samer@0: , current_state/2 samer@0: , set_state/2 samer@0: samer@0: % file system utilities samer@0: , dir/2 % directory listing samer@0: , path_atom/2 % expand paths samer@0: , expand_path/2 % expand paths samer@0: samer@0: % operating system samer@0: , open_with/2 % apply shell command to a file (SIDE EFFECTS) samer@0: , open_with/3 % apply shell command to a file with options (SIDE EFFECTS) samer@0: , shellcmd/2 % apply shell command to arguments samer@0: , open_/1 % open with 'open' command (Mac OS X). samer@0: , fmt_shellcmd/3 % format a shell command with switches and args samer@0: , hostname/1 samer@0: samer@0: % user interaction samer@0: , read_char_echo/1 % read one character and echo it immediately samer@0: , get_key/2 % read and validate keypress samer@0: , userchk/1 % unary predicate which allows user to force failure samer@0: , prompt_for_key/3 samer@0: samer@0: % ---- high order stuff ---- samer@0: samer@0: % modes of computation samer@0: , retry/1 % keep trying until success samer@0: , parallel/1 % parallel computation using threads samer@0: , bt_call/2 % Construct backtrackable operation samer@0: , on_backtracking/1 samer@0: samer@0: % iteration samer@0: , exhaust/1 % trigger all solutions to a goal (SIDE EFFECTS) samer@0: , iterate/3 % apply predicate recursively till failure samer@0: samer@0: % mapping samer@0: , for_naturals/2 % call predicate with natural numbers N down to 1 samer@0: , mapints/2 % call predicate with integers samer@0: , mapints/3 samer@0: , mapargs/2, mapargs/3, mapargs/4 samer@0: , mapargs_x/4, mapargs_x/5, mapargs_x/6 samer@0: , mapargs_xx/6 samer@0: , sfold/4 % structural fold for lists samer@0: , take/3 samer@0: , drop/3 samer@0: , drop_while/3 samer@0: , take_while/3 samer@0: samer@0: % lambda expressions samer@0: , mcall/2, mcall/3, mcall/4 samer@0: samer@0: ]). samer@0: samer@0: /** General utilities samer@0: samer@0: The predicates in this module can be divided into several groups as listed samer@0: below. samer@0: samer@0: ---+++ Type testing and enumeration samer@0: * natural/1 - test or enumerate natural numbers samer@0: * isfinite/1 - check number is non NaN or Inf samer@0: * int/1 - test or enumerate integers samer@0: * in/2 samer@0: samer@0: ---+++ mathematical utilities samer@0: * max/3 samer@0: * min/3 samer@0: samer@0: ---+++ list utilities samer@0: * list_idx1_member/3 % like nth1 but more useful argument order samer@0: * measure/3 - match list lengths samer@0: * equal_length/2 - match two list lenghts samer@0: * getopts/2 samer@0: * rep/3 - make a list of repeats of the same term samer@0: * cons/3 - make list from head and tail samer@0: * decons/3 - get head and tail from list samer@0: samer@0: ---+++ term manipulation samer@0: * copy_head/2 - check terms for same head and arity samer@0: * unify_args/5 samer@0: * reinstatevars/3 samer@0: * reinstatevars/4 samer@0: samer@0: ---+++ formatting and parsing samer@0: * aphrase/2 - like phrase but makes an atom instead of a string samer@0: * aphrase/3 - like aphrase but takes code list samer@0: * print_list/1 - write/1 each element, one per line samer@0: * printq_list/1 - as print_list but quotes atom as with writeq/1 samer@0: * print_numbered_list/1 - as print_list/1 but with line numbers samer@0: samer@0: ---+++ database management samer@0: * extensible/1 - declare dynamic multifile predicate samer@0: * bt_assert/1 samer@0: * bt_retract/1 samer@0: * strict_assert/1 samer@0: * strict_retract/1 samer@0: * browse/2 - browse predicate with unknown arity samer@0: * current_state/2 samer@0: * set_state/2 samer@0: samer@0: ---+++ file system utilities samer@0: * dir/2 - directory listing samer@0: * path_atom/2 - expand paths samer@0: * expand_path/2 - expand paths samer@0: samer@0: ---+++ operating system samer@0: * open_with/2 - apply shell command to a file (SIDE EFFECTS) samer@0: * open_with/3 - apply shell command to a file with options (SIDE EFFECTS) samer@0: * shellcmd/2 - apply shell command to arguments samer@0: * open_/1 - open with 'open' command (Mac OS X). samer@0: * fmt_shellcmd/3 - format a shell command with switches and args samer@0: * hostname/1 samer@0: samer@0: ---+++ user interaction samer@0: * read_char_echo/1 - read one character and echo it immediately samer@0: * get_key/2 - read and validate keypress samer@0: * userchk/1 - unary predicate which allows user to force failure samer@0: * prompt_for_key/3 - print message and get keypress from user samer@0: samer@0: ---+++ High order stuff samer@0: samer@0: ---++++ modes of computation samer@0: * retry/1 - keep trying until success samer@0: * parallel/1 - parallel computation using threads samer@0: * bt_call/2 - Construct backtrackable operation samer@0: , on_backtracking/1 samer@0: samer@0: ---++++ iteration samer@0: * exhaust/1 - trigger all solutions to a goal (SIDE EFFECTS) samer@0: * iterate/3 - apply predicate recursively till failure samer@0: samer@0: ---++++ mapping samer@0: * for_naturals/2 - call predicate with natural numbers N down to 1 samer@0: * mapints/2 - call predicate with integers samer@0: * mapints/3 samer@0: * mapargs/2, mapargs/3, mapargs/4 samer@0: * mapargs_xx/6 samer@0: * sfold/4 - structural fold for lists samer@0: * take/3 samer@0: * drop/3 samer@0: * drop_while/3 samer@0: * take_while/3 samer@0: samer@0: ---++++ lambda expressions samer@0: * mcall/2, mcall/3, mcall/4 samer@0: */ samer@0: samer@0: :- use_module(library(ops)). samer@0: samer@0: :- meta_predicate samer@0: exhaust(0) samer@0: , retry(0) samer@0: , iterate(2,?,?) samer@0: , drop_while(1,?,?) samer@0: , take_while(1,?,?) samer@0: , apply_to_nth1(?,2,?,?) samer@0: , for_naturals(+,1) samer@0: , for_ints(+,+,1) samer@0: , mapints(1,?) samer@0: , mapints(2,?,?) samer@0: , mapargs(1,?) samer@0: , mapargs(2,?,?) samer@0: , mapargs(3,?,?,?) samer@0: , mapargs_x(+,+,1,?) samer@0: , mapargs_x(+,+,2,?,?) samer@0: , mapargs_x(+,+,3,?,?,?) samer@0: , mapargs_xx(2,?,?,?,?,?) samer@0: , on_backtracking(0) samer@0: , bt_call(0,0) samer@0: , bt_assert(:) samer@0: , bt_retract(:) samer@0: , strict_assert(:) samer@0: , strict_retract(:) samer@0: , extensible(:) samer@0: , aphrase(2,?) samer@0: , aphrase(2,?,?) samer@0: . samer@0: samer@0: :- multifile user:path/2. samer@0: :- multifile user:demo/1. samer@0: :- dynamic current_state/2. samer@0: samer@0: samer@0: %% extensible(+P) is det. samer@0: % declares 'extensible' predicates, ie ones that can have new clauses samer@0: % added in other files. Equivalent to dynamic(P), multifile(P). samer@0: extensible(P) :- dynamic(P), multifile(P). samer@0: samer@0: samer@0: %% natural(+N) is semidet. samer@0: %% natural(-N:natural) is multi. samer@0: % samer@0: % Means N is a natural number (includes 0). If N is samer@0: % a variable, succeeds an infinite number of times on backtracking, samer@0: % returning all natural numbers. samer@0: natural(N) :- (var(N) -> between(0,inf,N); integer(N), N>=0). samer@0: samer@0: samer@0: %% int(+N) is semidet. samer@0: %% int(-N:integer) is multi. samer@0: % samer@0: % Means N is an integer. If N is samer@0: % a variable, succeeds an infinite number of times on backtracking, samer@0: % returning all integers starting at zero and interleaving positive samer@0: % and negative values. samer@0: int(N) :- nonvar(N), integer(N). samer@0: int(N) :- var(N), (N=0; (between(1,inf,M), (N=M; N is -M))). samer@0: samer@0: samer@0: %% isfinite(+N:number) is semidet. samer@0: % samer@0: % Succeeds when N is a finite number. samer@0: isfinite(N):- catch(_ is N+0,error(_,_),fail). % !! workable hack samer@0: samer@0: samer@0: %% in(+X,Set) is semidet. samer@0: %% in(-X,Set) is nondet. samer@0: % samer@0: % Simple testing and enumration of values in some sets. samer@0: % Set can be samer@0: % * {A,B,_} samer@0: % Explicit list of values. samer@0: % * natural samer@0: % Natural numbers starting from 0. samer@0: % * integer samer@0: % Natural numbers. samer@0: % * real samer@0: % Real (floating point) numbers. samer@0: % * A..B samer@0: % Integer range from A to B inclusive. samer@0: % * A--B samer@0: % Closed interval [A,B]. samer@0: X in A--\B :- X in A--(\B). samer@0: X in \A--(\B):- !, ch(A iterate(P,Z,Y); Y=X. samer@0: samer@0: %% sfold(Functor,Initial,L:list,Final) is semidet. samer@0: % *Structural* fold applied to a term, samer@0: % rather than a relational fold using a predicate name. samer@0: sfold(_,E,[],E). samer@0: sfold(O,E,[X|XX],R) :- R=..[O,X,YY], sfold(O,E,XX,YY). samer@0: samer@0: samer@0: %% dir( +Pattern, -File) is nondet. samer@0: % samer@0: % Directory listing for directory matching Pattern. File samer@0: % names are returned one by one on backtracking. samer@0: dir(Pattern,File) :- samer@0: expand_file_name(Pattern,List), samer@0: member(File,List). samer@0: samer@0: samer@0: %% path_atom( +Spec:path_expr, -Path:atom) is nondet. samer@0: % samer@0: % Expand a 'path expression' into a flat path (an atom). samer@0: % A path expression is defined by: samer@0: % == samer@0: % path_expr ---> atom % literal path component name samer@0: % ; path_expr/atom % child of path_expr samer@0: % ; path_macro % a previously defined abbr for a path. samer@0: % == samer@0: % A path_macro is defined using path/2. samer@0: samer@0: path_atom(P,C) :- path(P,C), atom(C). samer@0: samer@0: path_atom(PA/B,C) :- samer@0: once((nonvar(C); nonvar(B); nonvar(PA))), samer@0: path_atom(PA,A), samer@0: concat3atoms(A,'/',B,C). samer@0: samer@0: samer@0: path_atom(Path,Atom) :- path(Path, Def), \+atom(Def), path_atom(Def,Atom). samer@0: path_atom(Path,Atom) :- samer@0: nonvar(Path), samer@0: \+path(Path,_), samer@0: Path\=_/_, samer@0: Atom=Path. samer@0: samer@0: concat3atoms(A,B,C,ABC) :- samer@0: nonvar(A), nonvar(B), nonvar(C), !, concat_atom([A,B,C],ABC). samer@0: samer@0: concat3atoms(_,_,_,ABC) :- var(ABC), !, fail. samer@0: concat3atoms(A,B,C,ABC) :- nonvar(C), !, atom_concat(AB,C,ABC), atom_concat(A,B,AB). samer@0: concat3atoms(A,B,C,ABC) :- nonvar(A), !, atom_concat(A,BC,ABC), atom_concat(B,C,BC). samer@0: concat3atoms(A,B,C,ABC) :- samer@0: maplist(atom_codes,[B,ABC],[BX,ABCX]), samer@0: append(ABX,CX,ABCX), samer@0: append(AX,BX,ABX), samer@0: maplist(atom_codes,[A,C],[AX,CX]). samer@0: samer@0: %% expand_path( +P:path_expr, -FP:atom) is semidet. samer@0: % samer@0: % Expand path_exp including wildcards to fully qualified path samer@0: expand_path(P,FP) :- path_atom(P,PP), expand_file_name(PP,[FP]). samer@0: samer@0: samer@0: %% open_with( +Program:atom, +Thing:path_expr, +Options:list) is semidet. samer@0: %% open_with( +Program:atom, +Thing:path_expr) is semidet. samer@0: % samer@0: % The only option is bg, which adds "&" to make command execute in background. samer@0: open_with(Q,P) :- open_with(Q,P,[]). samer@0: open_with(Q,P,Opts) :- samer@0: expand_path(P,FP), samer@0: (member(bg,Opts) -> OO=' &'; OO=''), samer@0: sformat(S,'~w ~q~w',[Q,FP,OO]), samer@0: shell(S). samer@0: samer@0: %% open_( +Thing:path_expr) is semidet. samer@0: % Equivalent to open_with(open,Thing). samer@0: open_(P) :- open_with(open,P). samer@0: samer@0: %% shellcmd( +Head:atom, +Args:list(atom)) is det. samer@0: % samer@0: % Execute a shell command on a given list of arguments samer@0: shellcmd(Head,Args) :- samer@0: concat_atom([Head|Args],' ',Cmd), samer@0: shell(Cmd,_Status). samer@0: samer@0: %% fmt_shellcmd( +Prog:atom, +Args:list(shellarg), -Cmd) is det. samer@0: % make a shell command string. samer@0: fmt_shellcmd(Prog,Args,Cmd) :- samer@0: phrase(utils:shellcmd(l_(Args)),FArgs), samer@0: concat_atom([Prog|FArgs],' ',Cmd). samer@0: samer@0: shellcmd(l_([])) --> !, []. samer@0: shellcmd(l_([H|T])) --> !, shellcmd(H), shellcmd(l_(T)). samer@0: shellcmd(s(N,V)) --> !, shellcmd(s(N)), shellcmd(V). samer@0: shellcmd(q(X)) --> !, { concat_atom(['"',X,'"'],A) }, [A]. samer@0: shellcmd(s(N)) --> !, { samer@0: (atom_codes(N,[_]) -> F='-' ; F='--'), samer@0: atom_concat(F,N,A) }, [A]. samer@0: shellcmd(l(X)) --> [X]. samer@0: samer@0: samer@0: samer@0: %% read_char_echo( -C:atom) is det. samer@0: % samer@0: % Read a single character from the current input, samer@0: % echo it to the output. samer@0: read_char_echo(C) :- samer@0: get_single_char(Code), samer@0: put_code(Code), flush_output, samer@0: char_code(C,Code). samer@0: samer@0: samer@0: samer@0: %% set_state( +Key, +Value) is det. samer@0: % samer@0: % Maintains a mutable global set of Key-Value pairs, sets the value samer@0: % associated with Key to Value. samer@0: set_state(Flag,Value) :- samer@0: ground(Flag), samer@0: retractall(current_state(Flag,_)), samer@0: assert(current_state(Flag,Value)). samer@0: samer@0: samer@0: %% current_state( -Key, -Value) is nondet. samer@0: %% current_state( +Key, -Value) is semidet. samer@0: % samer@0: % Lookup the value associated with Key, or enumerate all the samer@0: % key value pairs. samer@0: samer@0: samer@0: samer@0: %% parallel( +List:list(query)) is semidet. samer@0: % samer@0: % Use this by giving a list of queries of the form samer@0: % [Vars2:Goal, Vars2:Goal2, ...] samer@0: % where Vars is the term that each thread must return samer@0: % when it has finished computing its Goal. The samer@0: % parallel predicate finishes when all the threads samer@0: % have finished, and should result in all the Vars samer@0: % being bound appropriately. samer@0: samer@0: parallel(Queries) :- samer@0: maplist(async,Queries,Collecters), samer@0: maplist(call,Collecters). samer@0: samer@0: % these are used to initiate and wait for each samer@0: % computation thread. samer@0: async_collect(Id,X:_) :- thread_join(Id,exited(X)). samer@0: async(X:Goal,utils:async_collect(Id,X:_)) :- samer@0: thread_create((Goal,thread_exit(X)),Id,[]). samer@0: samer@0: %% browse( +PredSpec, -Goal) is nondet. samer@0: % samer@0: % PredSpec is a term like (PredicateName/Arity). Goal samer@0: % is unified with solutions of PredicateName/Arity. samer@0: browse(P/A,Goal) :- samer@0: current_predicate(P/A), samer@0: length(L,A), samer@0: Goal=..[P|L], samer@0: call(Goal). samer@0: samer@0: samer@0: samer@0: %% aphrase(P:phrase(code), -A:atom, +S:list(code)) is nondet. samer@0: %% aphrase(P:phrase(code), +A:atom, -S:list(code)) is nondet. samer@0: %% aphrase(P:phrase(code), -A:atom, -S:list(code)) is nondet. samer@0: %% aphrase(P:phrase(code), -A:atom) is nondet. samer@0: % samer@0: % Generate or parse an atom using given DCG phrase P. samer@0: % aphrase(P,A) is equivalent to aphrase(P,A,_). samer@0: aphrase(X,A) :- aphrase(X,A,_). samer@0: aphrase(X,A,S) :- samer@0: ( ground(A) samer@0: -> atom_codes(A,S), phrase(X,S) samer@0: ; phrase(X,S), atom_codes(A,S)). samer@0: samer@0: samer@0: %% print_list( +L:list) is det. samer@0: % samer@0: % Print a list, one item per line. samer@0: print_list([]) :- writeln('~'), nl. samer@0: print_list([H|T]) :- print(H), nl, print_list(T). samer@0: samer@0: %% printq_list( +L:list) is det. samer@0: % samer@0: % Print a list, one item per line, as with writeq/1. samer@0: printq_list([]) :- writeln('~'), nl. samer@0: printq_list([H|T]) :- writeq(H), nl, printq_list(T). samer@0: samer@0: %% print_numbered_list( +L:list) is det. samer@0: % samer@0: % Print a list with numbered lines. samer@0: print_numbered_list(L) :- samer@0: length(L,Max), samer@0: number_codes(Max,MC), samer@0: length(MC,Width), samer@0: print_num_list(Width,1,L). samer@0: samer@0: print_num_list(_,_,[]) :- nl. samer@0: print_num_list(Width,N,[H|T]) :- succ(N,M), samer@0: copy_term(H,H1), samer@0: numbervars(H1,0,_), samer@0: number_codes(N,NC), " "=[Pad], samer@0: padleft(Pad,Width,NC,PNC), samer@0: format('~s. ~q\n',[PNC,H1]), samer@0: print_num_list(Width,M,T). samer@0: samer@0: padleft(_,W,In,In) :- length(In,W). samer@0: padleft(P,W,In,[P|Out]) :- succ(V,W), padleft(P,V,In,Out). samer@0: samer@0: samer@0: samer@0: samer@0: %% get_key( +Valid:list(char), -C:char) is det. samer@0: % samer@0: % Get and validate a key press from the user. The character samer@0: % must be one of the ones listed in Valid, otherwise, an samer@0: % error message is printed and the user prompted again. samer@0: get_key(Valid,C) :- samer@0: read_char_echo(D), nl, samer@0: ( member(D,Valid) -> C=D samer@0: ; D='\n' -> get_key(Valid,C) % this improves interaction with acme samer@0: ; format('Unknown command "~q"; valid keys are ~q.\n', [D,Valid]), samer@0: write('Command? '), samer@0: get_key(Valid,C)). samer@0: samer@0: samer@0: %% userchk(T) is semidet. samer@0: % samer@0: % Write T and ask this user if it is ok. User presses y or n. samer@0: % userchk succeeds if if the keypress was y and fails if it was n. samer@0: userchk(T) :- prompt_for_key(T,[y,n],y). samer@0: samer@0: samer@0: %% prompt_for_key( +Msg:atom, +Keys:list(char), -Key:char) is semidet. samer@0: % samer@0: % Prompt user for a keypress. Prompt message is Msg, and valid keys are samer@0: % listed in Keys. samer@0: prompt_for_key(Msg,Keys,Key) :- format('~p ~q? ',[Msg,Keys]), get_key(Keys,Key). samer@0: samer@0: % ------------------- TERM MANIPULATION ------------------------------ samer@0: samer@0: samer@0: %% copy_head(+T1,-T2) is det. samer@0: %% copy_head(+T1,+T2) is semidet. samer@0: % samer@0: % true if T1 and T2 have the same head and arity samer@0: copy_head(T1,T2) :- functor(T1,N,A), functor(T2,N,A). samer@0: samer@0: samer@0: samer@0: %% reinstatevars( F:atom, V:list, Eh, What) is nondet. samer@0: %% reinstatevars( V:list, Eh, What) is nondet. samer@0: % samer@0: % Reverse of numbervars. Each '$VAR'(N) subterm of X is replaced samer@0: % with the Nth element of V, which can be uninstantiated on entry samer@0: % reinstatevars/4 uses an arbitrary functor F instead of $VAR. samer@0: samer@0: reinstatevars(V,'$VAR'(N),Y) :- !, nth0(N,V,Y). samer@0: reinstatevars(_,X,Y) :- atomic(X), !, Y=X. samer@0: reinstatevars(V,X,Y) :- mapargs(reinstatevars(V),X,Y). samer@0: samer@0: reinstatevars(F,V,T,Y) :- functor(T,F,1), !, arg(1,T,N), nth0(N,V,Y). samer@0: reinstatevars(_,_,X,Y) :- atomic(X), !, Y=X. samer@0: reinstatevars(F,V,X,Y) :- mapargs(reinstatevars(F,V),X,Y). samer@0: samer@0: samer@0: %% unify_args( Src, SrcIndex, Dest, DestIndex, Num) is det. samer@0: % samer@0: % this unifies N consecutive arguments of Src and Dest starting samer@0: % from SI and DI in each term respectively samer@0: unify_args(_,_,_,_,0). samer@0: unify_args(Src,SI,Dest,DI,N) :- samer@0: arg(SI,Src,X), arg(DI,Dest,X), !, samer@0: succ(SI,SI2), succ(DI,DI2), succ(N2,N), samer@0: unify_args(Src,SI2,Dest,DI2,N2). samer@0: samer@0: samer@0: % ---------------------- LIST UTILITIES ----------------------------- samer@0: samer@0: samer@0: %member_clist(_,Z) :- var(Z), !, fail. samer@0: member_clist(A,A) :- A\=(_,_). samer@0: member_clist(A,(A,_)). samer@0: member_clist(A,(_,B)) :- member_clist(A,B). samer@0: samer@0: samer@0: samer@0: %% measure(Ruler,In,Out) is det. samer@0: % true if Out is the same length as Ruler but matches In as far as possible samer@0: measure([],_I,[]). samer@0: measure([_|R],[],[_|O]) :- measure(R,[],O). samer@0: measure([_|R],[X|I],[X|O]) :- measure(R,I,O). samer@0: samer@0: %% equal_length( ?In, ?Out) is nondet. samer@0: % equal_length( +L1:list, -L2:list) is det. samer@0: % equal_length( -L1:list, +L2:list) is det. samer@0: % samer@0: % True if L1 and L2 are the same length. samer@0: equal_length([],[]). samer@0: equal_length([_|T1],[_|T2]) :- equal_length(T1,T2). samer@0: samer@0: %split_at(0,T,I-I,T). samer@0: %split_at(N,[H|T],[H|I1]-Z,T1) :- succ(M,N), split_at(M,T,I1-Z,T1). samer@0: samer@0: %split_at2(0,T,I-I,T). samer@0: %split_at2(N,[H|T],[H|I1]-Z,T1) :- split_at2(M,T,I1-Z,T1), succ(M,N). samer@0: samer@0: %% max(+X:number, +Y:number, -Z:number) is det. samer@0: % samer@0: % Unify Z with the larger of X and Y. Legal values are samer@0: % any numerical value or inf or -inf. samer@0: max(_,inf,inf) :- !. samer@0: max(inf,_,inf) :- !. samer@0: max(X,-inf,X) :- !. samer@0: max(-inf,X,X) :- !. samer@0: max(X,Y,Z) :- X Z=Y; Z=X. samer@0: samer@0: %% max(+X:number, +Y:number, -Z:number) is det. samer@0: % samer@0: % Unify Z with the larger of X and Y. Legal values are samer@0: % any numerical value or inf or -inf. samer@0: min(_,-inf,-inf) :- !. samer@0: min(-inf,_,-inf) :- !. samer@0: min(X,inf,X) :- !. samer@0: min(inf,X,X) :- !. samer@0: min(X,Y,Z) :- X Z=X; Z=Y. samer@0: samer@0: %% list_idx1_member( +L:list(A), +N:natural, ?X:A) is semidet. samer@0: %% list_idx1_member( ?L:list(A), ?N:natural, ?X:A) is nondet. samer@0: % samer@0: % Equivalent to nth1(N,L,X). samer@0: list_idx1_member(L,I,X) :- nth1(I,L,X). samer@0: samer@0: samer@0: %% getopts( +Opts:list(option), ?Spec:list(optspec)) is det. samer@0: % samer@0: % Get value from option list. samer@0: % == samer@0: % option(A) ---> term(A). samer@0: % optspec ---> option(A)/A. samer@0: % == samer@0: getopts(OptsIn,Spec) :- maplist(getopt(OptsIn),Spec). samer@0: getopt(OptsIn,Option/Default) :- option(Option,OptsIn,Default). samer@0: samer@0: %% cons( ?Head:A, ?Tail:list(A), ?List:list(A)) is det. samer@0: % samer@0: % List constructor. samer@0: cons(H,T,[H|T]). samer@0: samer@0: %% decons( ?Head:A, ?List:list(A), ?Tail:list(A)) is det. samer@0: % samer@0: % List deconstructor. samer@0: decons(H,[H|T],T). samer@0: samer@0: % ---------------------- MAPPING, HIGH ORDER STUFF --------------------- samer@0: samer@0: %% for_naturals(+N:natural, P:pred(natural)) is nondet. samer@0: % apply predicate to each natural number from 1 to N (backwards) samer@0: for_naturals(0,_). samer@0: for_naturals(N,P) :- succ(M,N), call(P,N), for_naturals(M,P). samer@0: samer@0: %% mapints( +P:pred(integer,A), +R:intrange, -X:list) is nondet. samer@0: %% mapints( +P:pred(integer), +R:intrange) is nondet. samer@0: % samer@0: % Mapping predicates over lists of integers. Range is like M..N. samer@0: % mapints/3 maps 2 argument predicate over implicit list of samer@0: % integers M..N and explicit list of values X. samer@0: mapints(_,M..N) :- N succ(M,N), rep(M,A,X) samer@0: ; rep(M,A,X), succ(M,N) samer@0: ). samer@0: samer@0: %% mapargs( P:pred(A,B,C), T1:tuple(F,A), T2:tuple(F,B), T3:tuple(F,C)) is nondet. samer@0: %% mapargs( P:pred(A,B), T1:tuple(F,A), T2:tuple(F,B)) is nondet. samer@0: %% mapargs( P:pred(A), T1:term) is nondet. samer@0: % samer@0: % Map predicate over to args of a term preserving head. samer@0: % A tuple(F,A) is a term with head functor F and any number of arguments samer@0: % of type A, ie samer@0: % == samer@0: % tuple(F,A) ---> F ; F(A) ; F(A,A) ; F(A,A,A) ; .. . samer@0: % == samer@0: samer@0: mapargs(P,T1) :- samer@0: functor(T1,_,N), samer@0: mapargs_x(1,N,P,T1). samer@0: samer@0: mapargs(P,T1,T2) :- samer@0: ( nonvar(T1) samer@0: -> functor(T1,F,N), functor(T2,F,N) samer@0: ; functor(T2,F,N), functor(T1,F,N)), samer@0: mapargs_x(1,N,P,T1,T2). samer@0: samer@0: mapargs(P,T1,T2,T3) :- samer@0: functor(T1,F,N), samer@0: functor(T2,F,N), samer@0: functor(T3,F,N), samer@0: mapargs_x(1,N,P,T1,T2,T3). samer@0: samer@0: mapargs_x(I,N,P,T1) :- samer@0: ( I>N -> true samer@0: ; arg(I,T1,X1), samer@0: call(P,X1), samer@0: succ(I,J), mapargs_x(J,N,P,T1)). samer@0: samer@0: mapargs_x(I,N,P,T1,T2) :- samer@0: ( I>N -> true samer@0: ; arg(I,T1,X1), samer@0: arg(I,T2,X2), samer@0: call(P,X1,X2), samer@0: succ(I,J), mapargs_x(J,N,P,T1,T2)). samer@0: samer@0: mapargs_x(I,N,P,T1,T2,T3) :- samer@0: ( I>N -> true samer@0: ; arg(I,T1,X1), samer@0: arg(I,T2,X2), samer@0: arg(I,T3,X3), samer@0: call(P,X1,X2,X3), samer@0: succ(I,J), mapargs_x(J,N,P,T1,T2,T3)). samer@0: samer@0: %% drop( +N:natural, +In:list(A), -Out:list(A)) is det. samer@0: drop(0,T,T). samer@0: drop(N,[_|T],V) :- succ(M,N), drop(M,T,V). samer@0: samer@0: samer@0: %% take( +N:natural, +In:list(A), -Out:list(A)) is det. samer@0: take(N,T,X) :- length(X,N), append(X,_,T). samer@0: samer@0: samer@0: %% drop_while( +P:pred(A), +In:list(A), -Out:list(A)) is det. samer@0: % samer@0: % Remove all elements from head of In that are accepted by P samer@0: % and return the remained in Out. samer@0: drop_while(P,[X|T],V) :- call(P,X) -> drop_while(P,T,V); V=[X|T]. samer@0: samer@0: samer@0: %% take_while( +P:pred(A), +In:list(A), -Out:list(A)) is det. samer@0: % samer@0: % Remove all elements from head of In that are accepted by P samer@0: % and return them in Out. samer@0: take_while(P,[X|T],O) :- call(P,X) -> O=[X|V], take_while(P,T,V); O=[]. samer@0: samer@0: samer@0: samer@0: %% retry( :Goal) is det. samer@0: % samer@0: % Keep retrying Goal until it succeeds. Only makes sense if Goal samer@0: % has side effects. Might be nonterminating. samer@0: retry(G) :- once((repeat,G)). samer@0: samer@0: %% apply_to_nth1( N:natural, Op:pred(A,A), +In:list(A), +Out:list(A)) is nondet. samer@0: % samer@0: % Apply predicate Op to the N th element of list In and unify Out with the result. samer@0: %apply_to_nth1(N,Op,Old,Init) :- samer@0: % ( nonvar(N) samer@0: % -> succ(M,N), split_at(M,Old,Init-[Y|Tail],[X|Tail]) samer@0: % ; split_at2(M,Old,Init-[Y|Tail],[X|Tail]), succ(M,N) samer@0: % ), samer@0: % call(Op,X,Y). samer@0: samer@0: apply_to_nth1(1,P,[X|XX],[Y|XX]) :- call(P,X,Y). samer@0: apply_to_nth1(N,P,[X|X1],[X|Y1]) :- nonvar(N), !, N>1, succ(M,N), apply_to_nth1(M,P,X1,Y1). samer@0: apply_to_nth1(N,P,[X|X1],[X|Y1]) :- var(N), !, apply_to_nth1(M,P,X1,Y1), succ(M,N). samer@0: samer@0: samer@0: %% mapargs_xx( +P:pred(A,B), +Src:term(_,A), +SrcIndex:natural, +Dest:term(_,B), +DestIndex:natural, +N:natural) is nondet. samer@0: % samer@0: % Maps predicate P over N consecutive arguments of Src and Dest. Starts samer@0: % at SrcIndex th argument of Src and DestIndex th argument of Dest. samer@0: mapargs_xx(_,_,_,_,_,0). samer@0: mapargs_xx(Pred,Src,SI,Dest,DI,N) :- samer@0: arg(SI,Src,SX), arg(DI,Dest,DX), call(Pred,SX,DX), !, samer@0: succ(SI,SI2), succ(DI,DI2), succ(N2,N), samer@0: mapargs_xx(Pred,Src,SI2,Dest,DI2,N2). samer@0: samer@0: samer@0: %% mcall(P:pred(A), X:A) is nondet. samer@0: %% mcall(P:pred(A,B), X:A, Y:B) is nondet. samer@0: %% mcall(P:pred(A,B,C), X:A, Y:B, Z:C) is nondet. samer@0: %% mcall(P:pred(A,B,C,D), X:A, Y:B, Z:C, W:D) is nondet. samer@0: % samer@0: % Like call/N but P can additionally be a lambda expression in one of several samer@0: % forms: samer@0: % * Tuple :- Body samer@0: % If functor(Tuple,\,N), Body is executed after unifying tuple arguments samer@0: % with arguments to mcall, eg =mcall(\(X):-member(X,[a,b,c]),Y)= is equivalent samer@0: % to member(Y,[a,b,c]), or =mcall(\(X,Y):-nth1(X,[a,b,c],Y),2,c)=. samer@0: % * Tuple samer@0: % Equivalent to Tuple:-true. samer@0: samer@0: mcall(P,A) :- mc(P,\(A),Q), Q. samer@0: mcall(P,A,B) :- mc(P,\(A,B),Q), Q. samer@0: mcall(P,A,B,C) :- mc(P,\(A,B,C),Q), Q. samer@0: mcall(P,A,B,C,D) :- mc(P,\(A,B,C,D),Q), Q. samer@0: samer@0: mc(Tuple:-Body,Params,Goal) :- !, copy_term(Tuple/Body,Params/Goal). samer@0: mc(Tuple,Params,true) :- functor(Tuple,\,_), !, copy_term(Tuple,Params). samer@0: mc(P,Params,apply(P,Args)) :- Params=..[\|Args]. samer@0: samer@0: samer@0: %% on_backtracking( :Goal) is det. samer@0: % samer@0: % The first time this is called, it succeeds and does nothing. samer@0: % On backtracking, Goal is called and then a failure is generated. samer@0: samer@0: on_backtracking(_). samer@0: on_backtracking(P) :- P, !, fail. samer@0: samer@0: samer@0: %% bt_call( :Do, :Undo) is nondet. samer@0: % samer@0: % Creates a backtrackable operation from a non-backtrackable Do samer@0: % operation and a corresponding operation to undo it. Do can samer@0: % be non-deterministic, in which case bt_call(Do,Undo) will also samer@0: % have multiple solutions. Undo is called inside once/1. samer@0: % samer@0: % bt_call/2 is implemented both as a predicate and as a goal samer@0: % expansion (see goal_expansion/2). samer@0: bt_call(Do,Undo) :- Do, (true; once(Undo), fail). samer@0: samer@0: user:goal_expansion( bt_call(Do,Undo), (Do, (true; once(Undo), fail))). samer@0: samer@0: samer@0: samer@0: /* Might include these at some point samer@0: samer@0: % apply lambda term to another term samer@0: app(X\\F,Y,G) :- !, copy_term(X\\F,Y\\G). samer@0: app(T,A,Z) :- addargs(T,[A],Z). samer@0: app(T,A,B,Z) :- addargs(T,[A,B],Z). samer@0: app(T,A,B,C,Z) :- addargs(T,[A,B,C],Z). samer@0: samer@0: applist(F,N,A,Z) :- length(Z,N), maplist(app(F),A,Z). samer@0: applist(F,N,A,B,Z) :- length(Z,N), maplist(app(F),A,B,Z). samer@0: applist(F,N,A,B,C,Z) :- length(Z,N), maplist(app(F),A,B,C,Z). samer@0: samer@0: */ samer@0: samer@0: samer@0: % ------------------ DATABASE ------------------------------ samer@0: samer@0: %% bt_assert(Clause) is det. samer@0: % Backtrackable assert. samer@0: bt_assert(H) :- bt_call(assert(H),retract(H)). samer@0: samer@0: %% bt_retract(Clause) is det. samer@0: % Backtrackable retract. samer@0: bt_retract(H) :- bt_call(retract(H), assert(H)). samer@0: samer@0: %% strict_assert(Fact) is semidet. samer@0: % samer@0: % Asserts fact only if it is not already true. Fails samer@0: % if fact is already provable. Retracts fact on backtracking. samer@0: strict_assert(H) :- \+call(H), bt_call(assert(H),retract(H)). samer@0: samer@0: samer@0: %% strict_retract(Fact) is semidet. samer@0: % samer@0: % Retracts fact only if it is currently in the database. Fails samer@0: % if fact is not provable. Reasserts fact on backtracking. samer@0: strict_retract(H) :- call(H), bt_call(retract(H), assert(H)). samer@0: samer@0: samer@0: % when loaded, this sets the hostname/1 predicate. samer@0: :- dynamic hostname/1. samer@0: samer@0: %% hostname( -A:atom) is det. samer@0: % samer@0: % Unifies A with the computer's hostname. This is set when the samer@0: % module is loaded by calling the system command 'hostname -s'. samer@0: samer@0: % init_hostname is det - read hostname from UNIX command hostname. samer@0: init_hostname :- samer@0: setup_call_cleanup( samer@0: open(pipe('hostname -s'),read,SID), samer@0: (read_line_to_codes(SID,C), atom_codes(H,C), retractall(hostname(_)), assert(hostname(H))), samer@0: close(SID)). samer@0: samer@0: :- ( hostname(H) samer@0: -> format('% hostname already set to ~w\n',[H]) samer@0: ; init_hostname, hostname(H), format('% hostname set to ~w\n',[H]) samer@0: ). samer@0: samer@0: % Comma lists samer@0: % ie, lists built up using (,) as a pairing functor samer@0: % Note, these functor lists do NOT have a nil element - the samer@0: % last item in the list is the 2nd argument to the final samer@0: % functor term, which can therefore be a term headed by any samer@0: % other functor. Eg: samer@0: % (1,(2,3)) <-> [1,2,3] samer@0: % (1,(2,(3+4)) <-> [1,2,(3+4)] samer@0: samer@0: %% cl_list( +CL:clist(A), -L:list(A)) is det. samer@0: %% cl_list( -CL:clist(A), +L:list(A)) is det. samer@0: % samer@0: % Convert between comma lists and ordinary lists samer@0: cl_list((A,B),[A|BL]) :- cl_list(B,BL). samer@0: cl_list(A,[A]) :- A\=(_,_). samer@0: samer@0: %% cl_length( +L:clist, -N:natural) is det. samer@0: %% cl_length( -L:clist, +N:natural) is det. samer@0: % samer@0: % Length of a comma-list. samer@0: cl_length((_,B),N) :- cl_length(B,M), succ(M,N). samer@0: cl_length(X,1) :- X\=(_,_). samer@0: samer@0: samer@0: %% cl_list_vt( +CL:clist(A), -L:list(A)) is det. samer@0: %% cl_list_vt( -CL:clist(A), +L:list(A)) is det. samer@0: % samer@0: % Convert between comma lists (with open tails) and ordinary lists. samer@0: cl_list_vt(FL,[FL]) :- var(FL), !. samer@0: cl_list_vt(FL,[A|BL]) :- FL = (A,B), cl_list_vt(B,BL). samer@0: cl_list_vt(A,[A]) :- A\=(_,_). samer@0: samer@0: samer@0: %% cl_length_vt( +L:clist, -N:natural) is det. samer@0: %% cl_length_vt( -L:clist, +N:natural) is det. samer@0: % samer@0: % Length of a comma-list with possible variable tail. samer@0: % This version handles lists where the last element is variable (counts as 1) samer@0: cl_length_vt(FL,1) :- var(FL), !. samer@0: cl_length_vt(FL,N) :- FL=(_,B), cl_length_vt(B,M), succ(M,N). samer@0: cl_length_vt(FL,1) :- FL\=(_,_). samer@0: samer@0: %% cl_member(-X, +L:clist) is nondet. samer@0: % List membership for comma lists. samer@0: cl_member(X,(X,_)). samer@0: cl_member(X,(_,T)) :- cl_member(X,T). samer@0: cl_member(X,X) :- X\=(_,_). samer@0: