home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / high < prev    next >
Encoding:
Text File  |  1995-02-06  |  3.3 KB  |  131 lines
  1.  
  2. go:-foldl(+,0,[1,2,3],R),write(R),nl.
  3.  
  4. % fold,foldl based on safe failure driven destructive change_arg
  5. foldl(Closure,Null,List,Final):-fold(Closure,Null,X^member(X,List),Final).
  6.  
  7. fold(Closure,Null,I^Generator,Final):-
  8.   fold0(s(Null),I,Generator,Closure,Final).
  9.  
  10. fold0(Acc,I,Generator,Closure,_):-
  11.   term_append(Closure,args(SoFar,I,O),Selector),
  12.   Generator,
  13.     arg(1,Acc,SoFar),
  14.     Selector,
  15.     change_arg(1,Acc,O),
  16.   fail.
  17. fold0(Acc,_,_,_,Final):-
  18.   arg(1,Acc,Final).
  19.  
  20. % new version of bestof
  21. best_of(X^Generator,TotalOrder,Bottom,Result):-
  22.     term_append(TotalOrder,args(X,Y),Test),
  23.     fold(compare_closure(Y,Test),Bottom,X^Generator,Result).
  24.  
  25. % map with updates on place
  26. map(Closure,Xs):-
  27.   term_append(Closure,args(I,O),Goal),
  28.   update_on_place(Xs,I,O,Goal),
  29.   fail.
  30. map(_,_).
  31.  
  32. update_on_place(Xs,I,O,Goal):-
  33.    Xs=[I|_],
  34.    Goal,
  35.    change_arg(1,Xs,O).
  36. update_on_place([_|Xs],I,O,Goal):-
  37.    update_on_place(Xs,I,O,Goal).
  38.  
  39.     
  40. % gives the illusion of a parallel engine
  41. % works only with goals generating a finite stream of solutions
  42.  
  43. test_engine:-
  44.   open_engine(X,(X=1;X=2;X=3),E),
  45.   ask_engine(E,A),
  46.   ask_engine(E,B),
  47.   close_engine(E),
  48.   ask_engine(E,C),
  49.   ask_engine(E,D),
  50.   write([A,B,C,D]),nl.
  51.   
  52. open_engine(X,G,'$answers'(Gs)):-findall(X,G,Gs).
  53.  
  54. ask_engine('$answers'([]),X):-!,X='$empty'.
  55. ask_engine(E,'$answer'(X)):-E='$answers'([X|Xs]),setarg(1,E,Xs).
  56.  
  57. close_engine(Engine):-setarg(1,Engine,[]).
  58.  
  59.  
  60. /************************* maplist/3 ****************************/
  61. % maps a Closure to a list and collects the results
  62. %
  63. % ex: ?-maplist(+(1),[10,20,30],Xs).
  64. %
  65.  
  66. maplist(Closure,Is,Os):-maplist(Closure,Is,Os,[]).
  67.  
  68. maplist(Closure,Is,Os,End):-
  69.   term_append(Closure,args(I,O),Test),
  70.   findall(O,member_test(Test,I,Is),Os,End).
  71.  
  72. member_test(Test,I,[I|_]):-Test.
  73. member_test(Test,I,[_|Is]):-member_test(Test,I,Is).
  74.  
  75. /************************* find/4 ****************************/
  76. % combines 2 by 2 using Closure the selected answers I of Generator
  77. % accumulating in Final the overall result
  78. %
  79. % ex: ?-find(member(X,[10,20,30]),+,X,Sum).
  80. %
  81.  
  82. find(Generator,Closure,I,Final):-
  83.   term_append(Closure,args(SoFar,I,O),Selector),
  84.   find0(SoFar,I,O,Generator,Selector,Final).
  85.  
  86. find0(SoFar,I,O,Generator,Selector,_):-
  87.   inc_level(find,Level),
  88.   Generator,
  89.   select_or_init(Selector,Level,SoFar,I,O),
  90.   fail.
  91. find0(_,_,_,_,_,Final):-
  92.   dec_level(find,Level),
  93.   bb_val(find,Level,Final),
  94.   rm(find,Level).
  95.  
  96. select_or_init(Selector,Level,SoFar,_,O):-
  97.   bb_val(find,Level,SoFar),!,
  98.   Selector,
  99.   bb_set(find,Level,O).
  100. select_or_init(_,Level,_,I,_):-
  101.   bb_def(find,Level,I).
  102.  
  103. % ensure correct implementation of embedded calls to find/4
  104.  
  105. inc_level(Obj,X1):-bb_val(Obj,Obj,X),!,X1 is X+1,bb_set(Obj,Obj,X1).
  106. inc_level(Obj,1):-bb_def(Obj,Obj,1).
  107.  
  108. dec_level(Obj,X):-bb_val(Obj,Obj,X),X>0,X1 is X-1,bb_set(Obj,Obj,X1).
  109.  
  110. /************************* scan/3 ****************************/
  111. % Scans a list accumulating the results of applyng Closure on
  112. % the elements of the list
  113. % 
  114. % ex: ?-scan(+,[10,20,30],Sum).
  115. %
  116.  
  117. scan(Closure,List,Result):-find(member(X,List),Closure,X,Result).
  118.  
  119. % X is the best answer of G with respect to TotalOrder (a closure)
  120. % 
  121. % ex: ?-bestof(X,>,member(X,[3,2,9,1,5,4]).
  122. %
  123.  
  124. bestof(X,TotalOrder,Generator):-
  125.     term_append(TotalOrder,args(X,Y),Test),
  126.     find(Generator,compare_closure(Y,Test),X,X).
  127.  
  128. compare_closure(Y,Test,Y,X,R):-Test,!,R=X.
  129. compare_closure(_,_,Y,_,Y).
  130.  
  131.