View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2004-2016, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module('$attvar',
   37          [ '$wakeup'/1,                % +Wakeup list
   38            freeze/2,                   % +Var, :Goal
   39            frozen/2,                   % @Var, -Goal
   40            call_residue_vars/2,        % :Goal, -Vars
   41            copy_term/3                 % +Term, -Copy, -Residue
   42          ]).

Attributed variable handling

Attributed variable and coroutining support based on attributed variables. This module is complemented with C-defined predicates defined in pl-attvar.c */

 $wakeup(+List)
Called from the kernel if assignments have been made to attributed variables.
   56'$wakeup'([]).
   57'$wakeup'(wakeup(Attribute, Value, Rest)) :-
   58    call_all_attr_uhooks(Attribute, Value),
   59    '$wakeup'(Rest).
   60
   61call_all_attr_uhooks([], _).
   62call_all_attr_uhooks(att(Module, AttVal, Rest), Value) :-
   63    uhook(Module, AttVal, Value),
   64    call_all_attr_uhooks(Rest, Value).
 uhook(+AttributeName, +AttributeValue, +Value)
Run the unify hook for attributed named AttributeName after assigning an attvar with attribute AttributeValue the value Value.

This predicate deals with reserved attribute names to avoid the meta-call overhead.

   76uhook(freeze, Goal, Y) :-
   77    !,
   78    (   attvar(Y)
   79    ->  (   get_attr(Y, freeze, G2)
   80        ->  put_attr(Y, freeze, '$and'(G2, Goal))
   81        ;   put_attr(Y, freeze, Goal)
   82        )
   83    ;   unfreeze(Goal)
   84    ).
   85uhook(Module, AttVal, Value) :-
   86    Module:attr_unify_hook(AttVal, Value).
 unfreeze(+ConjunctionOrGoal)
Handle unfreezing of conjunctions. As meta-calling control structures is slower than meta-interpreting them we do this in Prolog. Another advantage is that having unfreeze/1 in between makes the stacktrace and profiling easier to intepret. Please note that we cannot use a direct conjunction as this would break freeze(X, (a, !, b)).
   98unfreeze('$and'(A,B)) :-
   99    !,
  100    unfreeze(A),
  101    unfreeze(B).
  102unfreeze(Goal) :-
  103    Goal.
 freeze(@Var, :Goal)
Suspend execution of Goal until Var is unbound.
  109:- meta_predicate
  110    freeze(?, 0).  111
  112freeze(Var, Goal) :-
  113    '$freeze'(Var, Goal),
  114    !.        % Succeeds if delayed
  115freeze(_, Goal) :-
  116    Goal.
 frozen(@Term, -Goal)
Unify Goals with the goals frozen on Var or true if no goals are grozen on Var.
  123frozen(Term, Goal) :-
  124    term_attvars(Term, AttVars),
  125    (   AttVars == []
  126    ->  Goal = true
  127    ;   sort(AttVars, AttVars2),
  128        phrase(attvars_residuals(AttVars2), GoalList0),
  129        sort(GoalList0, GoalList),
  130        make_conjunction(GoalList, Goal)
  131    ).
  132
  133make_conjunction([], true).
  134make_conjunction([H|T], Goal) :-
  135    (   T == []
  136    ->  Goal = H
  137    ;   Goal = (H,G),
  138        make_conjunction(T, G)
  139    ).
  140
  141
  142                 /*******************************
  143                 *             PORTRAY          *
  144                 *******************************/
 portray_attvar(@Var)
Called from write_term/3 using the option attributes(portray) or when the prolog flag write_attributes equals portray. Its task is the write the attributes in a human readable format.
  152:- public
  153    portray_attvar/1.  154
  155portray_attvar(Var) :-
  156    write('{'),
  157    get_attrs(Var, Attr),
  158    portray_attrs(Attr, Var),
  159    write('}').
  160
  161portray_attrs([], _).
  162portray_attrs(att(Name, Value, Rest), Var) :-
  163    portray_attr(Name, Value, Var),
  164    (   Rest == []
  165    ->  true
  166    ;   write(', '),
  167        portray_attrs(Rest, Var)
  168    ).
  169
  170portray_attr(freeze, Goal, Var) :-
  171    !,
  172    Options = [ portray(true),
  173                quoted(true),
  174                attributes(ignore)
  175              ],
  176    format('freeze(~W, ~W)', [ Var, Options, Goal, Options
  177                             ]).
  178portray_attr(Name, Value, Var) :-
  179    G = Name:attr_portray_hook(Value, Var),
  180    (   '$c_current_predicate'(_, G),
  181        G
  182    ->  true
  183    ;   format('~w = ...', [Name])
  184    ).
  185
  186
  187                 /*******************************
  188                 *          CALL RESIDUE        *
  189                 *******************************/
 call_residue_vars(:Goal, -Vars)
If Goal is true, Vars is the set of residual attributed variables created by Goal. Goal is called as in call/1. This predicate is for debugging constraint programs. Assume a constraint program that creates conflicting constraints on a variable that is not part of the result variables of Goal. If the solver is powerful enough it will detect the conflict and fail. If the solver is too weak however it will succeed and residual attributed variables holding the conflicting constraint form a witness of this problem.
  203:- meta_predicate
  204    call_residue_vars(0, -).  205
  206call_residue_vars(Goal, Vars) :-
  207    prolog_current_choice(Chp),
  208    setup_call_cleanup(
  209        '$call_residue_vars_start',
  210        run_crv(Goal, Chp, Vars, Det),
  211        '$call_residue_vars_end'),
  212    (   Det == true
  213    ->  !
  214    ;   true
  215    ).
  216call_residue_vars(_, _) :-
  217    fail.
  218
  219run_crv(Goal, Chp, Vars, Det) :-
  220    call(Goal),
  221    deterministic(Det),
  222    '$attvars_after_choicepoint'(Chp, Vars).
 copy_term(+Term, -Copy, -Gs) is det
Creates a regular term Copy as a copy of Term (without any attributes), and a list Gs of goals that when executed reinstate all attributes onto Copy. The nonterminal attribute_goals//1, as defined in the modules the attributes stem from, is used to convert attributes to lists of goals.
  232copy_term(Term, Copy, Gs) :-
  233    term_attvars(Term, Vs),
  234    (   Vs == []
  235    ->  Gs = [],
  236        copy_term(Term, Copy)
  237    ;   sort(Vs, Vs2),
  238        findall(Term-Gs,
  239                ( phrase(attvars_residuals(Vs2), Gs),
  240                  delete_attributes(Term)
  241                ),
  242                [Copy-Gs])
  243    ).
  244
  245attvars_residuals([]) --> [].
  246attvars_residuals([V|Vs]) -->
  247    (   { get_attrs(V, As) }
  248    ->  attvar_residuals(As, V)
  249    ;   []
  250    ),
  251    attvars_residuals(Vs).
  252
  253attvar_residuals([], _) --> [].
  254attvar_residuals(att(Module,Value,As), V) -->
  255    (   { nonvar(V) }
  256    ->  % a previous projection predicate could have instantiated
  257        % this variable, for example, to avoid redundant goals
  258        []
  259    ;   (   { Module == freeze }
  260        ->  frozen_residuals(Value, V)
  261        ;   { current_predicate(Module:attribute_goals//1),
  262              phrase(Module:attribute_goals(V), Goals)
  263            }
  264        ->  list(Goals)
  265        ;   [put_attr(V, Module, Value)]
  266        )
  267    ),
  268    attvar_residuals(As, V).
  269
  270list([])     --> [].
  271list([L|Ls]) --> [L], list(Ls).
  272
  273delete_attributes(Term) :-
  274    term_attvars(Term, Vs),
  275    delete_attributes_(Vs).
  276
  277delete_attributes_([]).
  278delete_attributes_([V|Vs]) :-
  279    del_attrs(V),
  280    delete_attributes_(Vs).
 frozen_residuals(+FreezeAttr, +Var)// is det
Instantiate a freeze goal for each member of the $and conjunction. Note that we cannot map this into a conjunction because freeze(X, a), freeze(X, !) would create freeze(X, (a,!)), which is fundamentally different. We could create freeze(X, (call(a), call(!))) or preform a more eleborate analysis to validate the semantics are not changed.
  292frozen_residuals('$and'(X,Y), V) -->
  293    !,
  294    frozen_residuals(X, V),
  295    frozen_residuals(Y, V).
  296frozen_residuals(X, V) -->
  297    [ freeze(V, X) ]