/* Port of applic.pi (Lawrence Byrd + Richard A. O'Keefe) in Picat v3. From http://www.picat-lang.org/bprolog/publib/applic.html """ File : APPLIC.PL Author : Lawrence Byrd + Richard A. O'Keefe Updated: 4 August 1984 and Ken Johnson 11-8-87 Purpose: Various "function" application routines based on apply/2. Needs : append/3 from listut.pl """ This Picat model was created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ % import util. % import cp. % main => go. test ?=> apply(plus,[1,2,ApplyPlus]), println(applyPlus=ApplyPlus), X = 1..20, sublist(sum_less_than_10,X,SublistSumLessThan10), println(sublistSumLessThan10=SublistSumLessThan10), nl, apply(sublist,[sum_less_than_10,1..10,ApplySublist]), println(applySublist=ApplySublist), convlist(foo, [1,a,0,$joe(99),101], ConvListRes), println(convListRes=ConvListRes), nl, println($some(even,[1,2,3,4,5])), if some(even,[1,2,3,4,5]) then println(ok) else println(no_ok) end, println($some(even,[1,3,5])), if some(even,[1,3,5]) then println(not_ok) else println(ok) end, println($somechk(even,[1,2,3,4,5])), if somechk(even,[1,2,3,4,5]) then println(ok) else println(no_ok) end, println($somechk(even,[1,3,5])), if somechk(even,[1,3,5]) then println(not_ok) else println(ok) end, println($callable(hakank)), if callable(hakank) then println(ok) else println(not_ok) end, println($callable(3)), if callable(3) then println(not_ok) else println(ok) end, println($callable(1+2)), if callable(1+2) then println(not_ok) else println(ok) end, println($callable($(1+2))), if callable($(1+2)) then println(ok) else println(not_ok) end, println($checklist(even,[0,2,4,6])), if checklist(even,[0,2,4,6]) then println(ok) else println(not_ok) end, println($checklist(even,[0,1,2,4,6])), if checklist(even,[0,1,2,4,6]) then println(not_ok) else println(ok) end, maplist(plus1,[1,2,3,4],MaplistPlusOne), println(maplistPlus1=MaplistPlusOne), exclude(odd,[1,2,3,4,5,6],ExcludeOdd), println(excludeOdd=ExcludeOdd), mapand(plus1,$&(10,&(20,30)),MapAndPlus1), println(mapAndPlus1=MapAndPlus1), nl. test => true. plus(X,Y,Z) :- Z = X+Y. plus1(X,Y) :- Y = X+1. sum_less_than_10(X) :- % println($sum_less_than_10(X)), sum(1..X) < 10. % for testing convlist/3 foo(X,Y) :- integer(X), Y is X+1. % % hakank: Comments below are from the original file applic.pl % (except comments with "hakank"). % % File : APPLIC.PL % Author : Lawrence Byrd + Richard A. O'Keefe % Updated: 4 August 1984 and Ken Johnson 11-8-87 % Purpose: Various "function" application routines based on apply/2. % Needs : append/3 from listut.pl % :- public % apply/2, % callable/1, % checkand/2, % checklist/2, % convlist/3, % exclude/3, % mapand/3, % maplist/3, % some/2, % somechk/2, % sublist/3. % :- mode % apply(+, +), % callable(?), % checkand(+, +), % checklist(+, +), % convlist(+, +, ?), % exclude(+, +, ?), % mapand(+, ?, ?), % maplist(+, ?, ?), % some(+, ?), % somechk(+, +), % sublist(+, +, ?). % % Operator declaration ued below % :- op(920,xfy,&). % Used for conjunction % apply(Pred, Args) % is the key to this whole module. It is basically a variant of call/1 % (see the Dec-10 Prolog V3.43 manual) where some of the arguments may % be already in the Pred, and the rest are passed in the list of Args. % Thus apply(foo, [X,Y]) is the same as call(foo(X,Y)), % and apply(foo(X), [Y]) is also the same as call(foo(X,Y)). % BEWARE: any goal given to apply is handed off to call/1, which is the % Prolog *interpreter*, so if you want to apply compiled predicates you % MUST have :- public declarations for them. The ability to pass goals % around with some of their (initial) arguments already filled in is % what makes apply/2 so useful. Don't bother compiling anything that % uses apply heavily, the compiler won't be able to help much. LISP % has the same problem. Later Prolog systems may have a simpler link % between compiled and interpreted code, or may fuse compilation and % interpretation, so apply/2 may come back into its own. At the moment, % apply and the routines based on it are not well thought of. apply(Pred, Args) :- ( atom(Pred), Goal =.. [Pred|Args] ; % compound(Pred) Pred =.. OldList, append(OldList, Args, NewList), Goal =.. NewList ), !, call(Goal). % callable(Term) % succeeds when Term is something that it would make sense to give to % call/1 or apply/2. That is, Term must be an atom or a compound term; % variables and integers are out. callable(Term) :- nonvar(Term), functor(Term, FunctionSymbol, _), atom(FunctionSymbol). % checkand(Pred, Conjunction) % succeeds when Pred(Conjunct) succeeds for every Conjunct in the % Conjunction. All the *and predicates in this module assume that % a&b&c&d is parsed as a&(b&(c&d)), and that the "null" conjunction % is 'true'. It is possible for this predicate, and most of the % others, to backtrack and try alternative solutions. If you do not % want that to happen, copying one of these predicates and putting a % cut in the suggested place will produce a tail-recursive version. % The cuts in the *and predicates are there because "non-and" is % defined by exclusion; they cannot be assigned types. checkand(_, true) :- !. checkand(Pred, &(A,B)) :- !, apply(Pred, [A]), checkand(Pred, B). checkand(Pred, A) :- apply(Pred, [A]). % checklist(Pred, List) % suceeds when Pred(Elem) succeeds for each Elem in the List. % In InterLisp, this is EVERY. It is also MAPC. checklist(_, []). checklist(Pred, [Head|Tail]) :- apply(Pred, [Head]), checklist(Pred, Tail). % mapand(Rewrite, OldConj, NewConj) % succeeds when Rewrite is able to rewrite each conjunct of OldConj, % and combines the results into NewConj. mapand(_, true, true) :- !. mapand(Pred, &(Old,Olds), &(New,News)) :- !, apply(Pred, [Old,New]), mapand(Pred, Olds, News). mapand(Pred, Old, New) :- apply(Pred, [Old,New]). % maplist(Pred, OldList, NewList) % succeeds when Pred(Old,New) succeeds for each corresponding % Old in OldList, New in NewList. In InterLisp, this is MAPCAR. % It is also MAP2C. Isn't bidirectionality wonderful? maplist(_, [], []). maplist(Pred, [Old|Olds], [New|News]) :- apply(Pred, [Old,New]), maplist(Pred, Olds, News). % convlist(Rewrite, OldList, NewList) % is a sort of hybrid of maplist/3 and sublist/3. % Each element of NewList is the image under Rewrite of some % element of OldList, and order is preserved, but elements of % OldList on which Rewrite is undefined (fails) are not represented. % Thus if foo(X,Y) :- integer(X), Y is X+1. % then convlist(foo, [1,a,0,joe(99),101], [2,1,102]). convlist(_, [], []). convlist(Pred, [Old|Olds], NewList) :- apply(Pred, [Old,New]), !, NewList = [New|News], convlist(Pred, Olds, News). convlist(Pred, [_|Olds], News) :- convlist(Pred, Olds, News). % exclude(Pred, List, SubList) % succeeds when SubList is the SubList of List containing all the % elements for which Pred(Elem) is *false*. That is, it removes % all the elements satisfying Pred. Efficiency would be somewhat % improved if the List argument came first, but this argument order % was copied from the older sublist/3 predicate, and let's face it, % apply/2 isn't stupendously efficient itself. exclude(_, [], []). exclude(Pred, [Head|List], SubList) :- apply(Pred, [Head]), !, exclude(Pred, List, SubList). exclude(Pred, [Head|List], [Head|SubList]) :- exclude(Pred, List, SubList). % some(Pred, List) % succeeds when Pred(Elem) succeeds for some Elem in List. It will % try all ways of proving Pred for each Elem, and will try each Elem % in the List. somechk/2 is to some/2 as memberchk/2 is to member/2; % you are more likely to want somechk with its single solution. % In InterLisp this is SOME. some(Pred, [Head|_]) :- apply(Pred, [Head]). some(Pred, [_|Tail]) :- some(Pred, Tail). somechk(Pred, [Head|_]) :- apply(Pred, [Head]), !. somechk(Pred, [_|Tail]) :- somechk(Pred, Tail). % sublist(Pred, List, SubList) % succeeds when SubList is the sub-sequence of the List containing all % the Elems of List for which Pred(Elem) succeeds. sublist(_, [], []). sublist(Pred, [Head|List], SubList) :- apply(Pred, [Head]), !, SubList = [Head|Rest], sublist(Pred, List, Rest). sublist(Pred, [_|List], SubList) :- sublist(Pred, List, SubList).