View source with formatted comments or as raw
    1:- module(scasp_clp_call_stack,
    2          [ (~>)/2,
    3            (<~)/2,
    4            dump_rules/3,
    5
    6            op(700, xfx, ~>),
    7            op(700, xfx, <~)
    8          ]).    9
   10/** <module> Call stack constraint solver
   11
   12This  module  contains  the  code  to  handle `StackIn`,  `StackOut` and
   13`Model`  as  attributes  in  order  to  check  entailment with  the TCLP
   14framework of CIAO. ~>/2 is the predicate used to get the  attribute from
   15the attributed variable. <~/2 is the predicate used to  put the  term as
   16an attribute.
   17
   18@author Joaquin Arias
   19*/
   20
   21
   22:- use_module(disequality).   23
   24
   25A ~> Att :- get_attr(A, clp_call_stack, rules(Att)).
   26A <~ Att :- put_attr(A, clp_call_stack, rules(Att)).
   27
   28dump_rules([],     [],     []).
   29dump_rules([X|Xs], [_|Ns], [D|Ds]) :-
   30    get_attr(X, clp_call_stack, rules(D)),
   31    dump_rules(Xs, Ns, Ds).
   32dump_rules([X|Xs], Ns, Ds) :-
   33    \+ get_attr(X, clp_call_stack, rules(_)),
   34    dump_rules(Xs, Ns, Ds).
   35
   36
   37		 /*******************************
   38		 *        ATTRIBUTE HOOKS	*
   39		 *******************************/
   40
   41:- multifile
   42    attr_unify_hook/2,
   43    attribute_goals/3,
   44    attr_portray_hook/2.   45
   46attr_unify_hook(rules(Att), B) :-
   47    get_attr(B, clp_call_stack, rules(AttB)),
   48    Att = AttB.
   49attr_unify_hook(neg(A), B) :- not_unify(B,A).
   50
   51attribute_goals(X) -->
   52    [X ~> G],
   53    { get_attr(X, clp_call_stack, rules(G))
   54    }.
   55attribute_goals(X) -->
   56    [X.\=.G],
   57    { get_attr(X, clp_call_stack, neg(G))
   58    }.
   59
   60attr_portray_hook(rules(Att), A) :- format(" ~w  .is ~w ", [A, Att]).
   61attr_portray_hook(neg(Att),   A) :- format("~w.\\=.~w", [A, Att])