home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / boot / bags.pl < prev    next >
Text File  |  1992-05-26  |  2KB  |  65 lines

  1. /*  bags.pl,v 1.1.1.1 1992/05/26 11:51:20 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: findall, bagof and setof
  7. */
  8.  
  9. :- module($bags, [
  10.     findall/3, 
  11.     bagof/3, 
  12.     setof/3]).
  13.  
  14. :- module_transparent
  15.     findall/3, 
  16.     setof/3, 
  17.     bagof/3, 
  18.     assert_bag/3.
  19.  
  20. %    findall(-Var, +Goal, -Bag)
  21. %    Bag holds all alternatives for Var  in  Goal.   Bag  might  hold
  22. %    duplicates.   Equivalent  to bagof, using the existence operator
  23. %    (^) on all free variables of Goal.  Succeeds with Bag  =  []  if
  24. %    Goal fails immediately.
  25.  
  26. findall(Var, Goal, Bag) :-
  27.     assert_bag(v, Var, Goal),
  28.     collect_bags([], [v-VarBag]), !,
  29.     VarBag = Bag.
  30. findall(_, _, []).
  31.  
  32. %    setof(+Var, +Goal, -Set
  33. %    Equivalent to bagof/3, but sorts the resulting bag  and  removes
  34. %    duplicate answers.
  35.  
  36. setof(Var, Goal, Set) :-
  37.     bagof(Var, Goal, Bag), 
  38.     sort(Bag, Set).
  39.  
  40. %    bagof(+Var, +Goal, -Bag)
  41. %    Implements Clocksin and  Melish's  bagof/3  predicate.   Bag  is
  42. %    unified  with the alternatives of Var in Goal, Free variables of
  43. %    Goal are bound, unless asked not to with the existence  operator
  44. %    (^).
  45.  
  46. bagof(Gen, Goal, Bag) :-
  47.     $e_free_variables(Gen^Goal, Vs),
  48.     Vars =.. [v|Vs],
  49.     assert_bag(Vars, Gen, Goal), 
  50.     collect_bags([], Bags), 
  51.     member(Vars-Bag, Bags),
  52.     Bag \== [].
  53.  
  54. assert_bag(Vs, Gen, G) :-
  55.     $record_bag(mark, -), 
  56.     G,
  57.         $record_bag(Vs, Gen), 
  58.     fail.
  59. assert_bag(_, _, _).
  60.  
  61. collect_bags(Sofar, Result) :-
  62.     $collect_bag(Vars, Bag), !,
  63.     collect_bags([Vars-Bag|Sofar], Result).
  64. collect_bags(L, L).
  65.