Did you know ... Search Documentation:
attvar.pl -- Attributed variable handling
PublicShow source

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

Source $wakeup(+List)
Called from the kernel if assignments have been made to attributed variables.
Source uhook(+AttributeName, +AttributeValue, +Value)[private]
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.

Source unfreeze(+ConjunctionOrGoal)[private]
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)).
Source freeze(@Var, :Goal)
Suspend execution of Goal until Var is unbound.
Source frozen(@Term, -Goal)
Unify Goals with the goals frozen on Var or true if no goals are frozen on Var.

Note that attribute_goals//1 may destructively update attributes, often used to simplify the produced attributes. For frozen/2 however we must keep the original variables. Ideally we would demand attribute_goals//1 to not modify any attributes. As that is hard given where we are we now copy the result and fail, restoring the bindings. This is a simplified version of bagof/3.

Source rebind_vars(+Keep, +Kept) is det[private]
Rebind the variables that have been copied and possibly instantiated by attribute_goals//1. Note that library(clpfd) may bind internal variables to e.g., processed. We do not rebind such variables as that would trigger constraints. These variables should not appear in the produced goal anyway. If both are attvars, unifying may also re-trigger. Therefore, we remove the variables from the copy before rebinding. This should be ok as all variable identifies are properly restored.
Source 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.
Source 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.
Source 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.
Source frozen_residuals(+FreezeAttr, +Var)// is det[private]
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.