View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Paulo Moura
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2015, Paulo Moura, Kyndi Inc., VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(yall,
   36          [ (>>)/2, (>>)/3, (>>)/4, (>>)/5, (>>)/6, (>>)/7, (>>)/8, (>>)/9,
   37            (/)/2, (/)/3, (/)/4, (/)/5, (/)/6, (/)/7, (/)/8, (/)/9,
   38
   39            lambda_calls/2,                     % +LambdaExt, -Goal
   40            lambda_calls/3,                     % +Lambda, +Args, -Goal
   41            is_lambda/1                         % @Term
   42          ]).   43:- autoload(library(error),
   44	    [ instantiation_error/1,
   45	      must_be/2,
   46	      domain_error/2,
   47	      type_error/2
   48	    ]).   49:- autoload(library(lists),[append/3]).   50
   51
   52:- meta_predicate
   53    '>>'(?, 0),
   54    '>>'(?, :, ?),
   55    '>>'(?, :, ?, ?),
   56    '>>'(?, :, ?, ?, ?),
   57    '>>'(?, :, ?, ?, ?, ?),
   58    '>>'(?, :, ?, ?, ?, ?, ?),
   59    '>>'(?, :, ?, ?, ?, ?, ?, ?),
   60    '>>'(?, :, ?, ?, ?, ?, ?, ?, ?).   61
   62:- meta_predicate
   63    '/'(?, 0),
   64    '/'(?, 1, ?),
   65    '/'(?, 2, ?, ?),
   66    '/'(?, 3, ?, ?, ?),
   67    '/'(?, 4, ?, ?, ?, ?),
   68    '/'(?, 5, ?, ?, ?, ?, ?),
   69    '/'(?, 6, ?, ?, ?, ?, ?, ?),
   70    '/'(?, 7, ?, ?, ?, ?, ?, ?, ?).   71
   72/** <module> Lambda expressions
   73
   74Prolog realizes _high-order_ programming  with   meta-calling.  The core
   75predicate of this is call/1, which simply   calls its argument. This can
   76be used to define higher-order predicates  such as ignore/1 or forall/2.
   77The call/N construct calls a _closure_  with N-1 _additional arguments_.
   78This is used to define  higher-order predicates  such as the maplist/2-5
   79family or foldl/4-7.
   80
   81The _closure_ concept used here is   somewhat different from the closure
   82concept from functional programming. The latter   is  a function that is
   83always evaluated in the context that  existed at function creation time.
   84Here, a closure is a term of arity _0  =< L =< K_. The term's functor is
   85the name of a predicate of arity _K_ and the term's _L_ arguments (where
   86_L_ could be 0) correspond to _L_  leftmost arguments of said predicate,
   87bound  to  parameter  values.   For    example,   a   closure  involving
   88atom_concat/3  might  be  the  term  atom_concat(prefix).  In  order  of
   89increasing _L_, one would have increasingly  more complete closures that
   90could be passed to call/3, all giving the same result:
   91
   92```
   93call(atom_concat,prefix,suffix,R).
   94call(atom_concat(prefix),suffix,R).
   95call(atom_concat(prefix,suffix),R).
   96call(atom_concat(prefix,suffix,R)).
   97```
   98
   99The problem with higher order predicates  based   on  call/N is that the
  100additional arguments are always  added  to   the  end  of  the closure's
  101argument list. This often requires defining trivial helper predicates to
  102get the argument order right. For example, if   you want to add a common
  103postfix    to    a    list    of    atoms     you    need    to    apply
  104atom_concat(In,Postfix,Out),                                         but
  105maplist(atom_concat(Postfix),ListIn,ListOut)                       calls
  106atom_concat(Postfix,In,Out). This is where library(yall) comes in, where
  107the module name, _yall_, stands for _Yet Another Lambda Library_.
  108
  109The library allows us to write a   lambda expression that _wraps around_
  110the (possibly complex) goal to call:
  111
  112```
  113?- maplist([In,Out]>>atom_concat(In,'_p',Out), [a,b], ListOut).
  114ListOut = [a_p, b_p].
  115```
  116
  117A bracy list `{...}` specifies which  variables are _shared_ between the
  118wrapped goal and the surrounding context. This   allows  us to write the
  119code below. Without the `{Postfix}` a fresh  variable would be passed to
  120atom_concat/3.
  121
  122```
  123add_postfix(Postfix, ListIn, ListOut) :-
  124    maplist({Postfix}/[In,Out]>>atom_concat(In,Postfix,Out),
  125            ListIn, ListOut).
  126```
  127
  128This introduces the second application area   of lambda expressions: the
  129ability to confine variables to the called goal's context. This features
  130shines when combined with bagof/3 or setof/3   where one normally has to
  131list those variables whose bindings one is _not_ interested in using the
  132`Var^Goal` construct (marking `Var`  as   existentially  quantified  and
  133confining it to the called goal's context). Lambda expressions allow you
  134to do the converse: specify the variables  which one _is_ interested in.
  135These variables are common to the  context   of  the called goal and the
  136surrounding context.
  137
  138Lambda expressions use the syntax below
  139
  140```
  141{...}/[...]>>Goal.
  142```
  143
  144The `{...}` optional part is used   for  lambda-free variables (the ones
  145shared between contexts). The order of   variables doesn't matter, hence
  146the `{...}` set notation.
  147
  148The  `[...]`  optional  part  lists lambda  parameters.  Here, order  of
  149variables matters, hence the list notation.
  150
  151As `/` and `>>` are standard infix operators, no new operators are added
  152by this library. An advantage of this syntax is that we can simply unify
  153a lambda expression with `{Free}/[Parameters]>>Lambda` to access each of
  154its components. Spaces in  the  lambda   expression  are  not  a problem
  155although the goal may need to be   written between '()'s. Goals that are
  156qualified by a module prefix also need to be wrapped inside parentheses.
  157
  158Combined  with  library(apply_macros),  library(yall)    allows  writing
  159one-liners for many list operations that   have  the same performance as
  160hand-written code.
  161
  162This     module     implements     [Logtalk's     lambda     expressions
  163syntax](https://logtalk.org/manuals/refman/grammar.html#lambda-expressions).
  164
  165
  166The development of this module was sponsored by Kyndi, Inc.
  167
  168@tbd    Extend optimization support
  169@author Paulo Moura and Jan Wielemaker
  170*/
  171
  172%!  >>(+Parameters, +Lambda).
  173%!  >>(+Parameters, +Lambda, ?A1).
  174%!  >>(+Parameters, +Lambda, ?A1, ?A2).
  175%!  >>(+Parameters, +Lambda, ?A1, ?A2, ?A3).
  176%!  >>(+Parameters, +Lambda, ?A1, ?A2, ?A3, ?A4).
  177%!  >>(+Parameters, +Lambda, ?A1, ?A2, ?A3, ?A4, ?A5).
  178%!  >>(+Parameters, +Lambda, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6).
  179%!  >>(+Parameters, +Lambda, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6, ?A7).
  180%
  181%   Calls a copy of Lambda. This  is similar to call(Lambda,A1,...),
  182%   but arguments are reordered according to the list Parameters:
  183%
  184%     - The first length(Parameters) arguments from A1, ... are
  185%       unified with (a copy of) Parameters, which _may_ share
  186%       them with variables in Lambda.
  187%     - Possible excess arguments are passed by position.
  188%
  189%   @arg    Parameters is either a plain list of parameters or a term
  190%           `{Free}/List`. `Free` represents variables that are
  191%           shared between the context and the Lambda term.  This
  192%           is needed for compiling Lambda expressions.
  193
  194'>>'(Parms, Lambda) :-
  195    unify_lambda_parameters(Parms, [],
  196                            ExtraArgs, Lambda, LambdaCopy),
  197    Goal =.. [call, LambdaCopy| ExtraArgs],
  198    call(Goal).
  199
  200'>>'(Parms, Lambda, A1) :-
  201    unify_lambda_parameters(Parms, [A1],
  202                            ExtraArgs, Lambda, LambdaCopy),
  203    Goal =.. [call, LambdaCopy| ExtraArgs],
  204    call(Goal).
  205
  206'>>'(Parms, Lambda, A1, A2) :-
  207    unify_lambda_parameters(Parms, [A1,A2],
  208                            ExtraArgs, Lambda, LambdaCopy),
  209    Goal =.. [call, LambdaCopy| ExtraArgs],
  210    call(Goal).
  211
  212'>>'(Parms, Lambda, A1, A2, A3) :-
  213    unify_lambda_parameters(Parms, [A1,A2,A3],
  214                            ExtraArgs, Lambda, LambdaCopy),
  215    Goal =.. [call, LambdaCopy| ExtraArgs],
  216    call(Goal).
  217
  218'>>'(Parms, Lambda, A1, A2, A3, A4) :-
  219    unify_lambda_parameters(Parms, [A1,A2,A3,A4],
  220                            ExtraArgs, Lambda, LambdaCopy),
  221    Goal =.. [call, LambdaCopy| ExtraArgs],
  222    call(Goal).
  223
  224'>>'(Parms, Lambda, A1, A2, A3, A4, A5) :-
  225    unify_lambda_parameters(Parms, [A1,A2,A3,A4,A5],
  226                            ExtraArgs, Lambda, LambdaCopy),
  227    Goal =.. [call, LambdaCopy| ExtraArgs],
  228    call(Goal).
  229
  230'>>'(Parms, Lambda, A1, A2, A3, A4, A5, A6) :-
  231    unify_lambda_parameters(Parms, [A1,A2,A3,A4,A5,A6],
  232                            ExtraArgs, Lambda, LambdaCopy),
  233    Goal =.. [call, LambdaCopy| ExtraArgs],
  234    call(Goal).
  235
  236'>>'(Parms, Lambda, A1, A2, A3, A4, A5, A6, A7) :-
  237    unify_lambda_parameters(Parms, [A1,A2,A3,A4,A5,A6,A7],
  238                            ExtraArgs, Lambda, LambdaCopy),
  239    Goal =.. [call, LambdaCopy| ExtraArgs],
  240    call(Goal).
  241
  242%!  /(+Free, :Lambda).
  243%!  /(+Free, :Lambda, ?A1).
  244%!  /(+Free, :Lambda, ?A1, ?A2).
  245%!  /(+Free, :Lambda, ?A1, ?A2, ?A3).
  246%!  /(+Free, :Lambda, ?A1, ?A2, ?A3, ?A4).
  247%!  /(+Free, :Lambda, ?A1, ?A2, ?A3, ?A4, ?A5).
  248%!  /(+Free, :Lambda, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6).
  249%!  /(+Free, :Lambda, ?A1, ?A2, ?A3, ?A4, ?A5, ?A6, ?A7).
  250%
  251%   Shorthand for `Free/[]>>Lambda`.  This is the same as applying
  252%   call/N on Lambda, except that only variables appearing in Free
  253%   are bound by the call.  For example
  254%
  255%     ==
  256%     p(1,a).
  257%     p(2,b).
  258%
  259%     ?- {X}/p(X,Y).
  260%     X = 1;
  261%     X = 2.
  262%     ==
  263%
  264%   This can in particularly be combined with bagof/3 and setof/3 to
  265%   _select_ particular variables to be  concerned rather than using
  266%   existential quantification (^/2)  to   _exclude_  variables. For
  267%   example, the two calls below are equivalent.
  268%
  269%     ==
  270%     setof(X, Y^p(X,Y), Xs)
  271%     setof(X, {X}/p(X,_), Xs)
  272%     ==
  273
  274
  275'/'(Free, Lambda) :-
  276    lambda_free(Free),
  277    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  278    call(LambdaCopy).
  279
  280'/'(Free, Lambda, A1) :-
  281    lambda_free(Free),
  282    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  283    call(LambdaCopy, A1).
  284
  285'/'(Free, Lambda, A1, A2) :-
  286    lambda_free(Free),
  287    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  288    call(LambdaCopy, A1, A2).
  289
  290'/'(Free, Lambda, A1, A2, A3) :-
  291    lambda_free(Free),
  292    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  293    call(LambdaCopy, A1, A2, A3).
  294
  295'/'(Free, Lambda, A1, A2, A3, A4) :-
  296    lambda_free(Free),
  297    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  298    call(LambdaCopy, A1, A2, A3, A4).
  299
  300'/'(Free, Lambda, A1, A2, A3, A4, A5) :-
  301    lambda_free(Free),
  302    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  303    call(LambdaCopy, A1, A2, A3, A4, A5).
  304
  305'/'(Free, Lambda, A1, A2, A3, A4, A5, A6) :-
  306    lambda_free(Free),
  307    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  308    call(LambdaCopy, A1, A2, A3, A4, A5, A6).
  309
  310'/'(Free, Lambda, A1, A2, A3, A4, A5, A6, A7) :-
  311    lambda_free(Free),
  312    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  313    call(LambdaCopy, A1, A2, A3, A4, A5, A6, A7).
  314
  315
  316%!  unify_lambda_parameters(+ParmsAndFree, +Args, -CallArgs,
  317%!                          +Lambda, -LambdaCopy) is det.
  318%
  319%   @arg ParmsAndFree is the first argumen of `>>`, either a list
  320%        of parameters or a term `{Free}/Params`.
  321%   @arg Args is a list of input parameters, args 3.. from `>>`
  322%   @arg CallArgs are the calling arguments for the Lambda
  323%        expression.  I.e., we call call(LambdaCopy, CallArgs).
  324
  325unify_lambda_parameters(Parms, _Args, _ExtraArgs, _Lambda, _LambdaCopy) :-
  326    var(Parms),
  327    !,
  328    instantiation_error(Parms).
  329unify_lambda_parameters(Free/Parms, Args, ExtraArgs, Lambda, LambdaCopy) :-
  330    !,
  331    lambda_free(Free),
  332    must_be(list, Parms),
  333    copy_term_nat(Free/Parms>>Lambda, Free/ParmsCopy>>LambdaCopy),
  334    unify_lambda_parameters_(ParmsCopy, Args, ExtraArgs,
  335                             Free/Parms>>Lambda).
  336unify_lambda_parameters(Parms, Args, ExtraArgs, Lambda, LambdaCopy) :-
  337    must_be(list, Parms),
  338    copy_term_nat(Parms>>Lambda, ParmsCopy>>LambdaCopy),
  339    unify_lambda_parameters_(ParmsCopy, Args, ExtraArgs,
  340                             Parms>>Lambda).
  341
  342unify_lambda_parameters_([], ExtraArgs, ExtraArgs, _) :- !.
  343unify_lambda_parameters_([Parm|Parms], [Arg|Args], ExtraArgs, Culprit) :-
  344    !,
  345    Parm = Arg,
  346    unify_lambda_parameters_(Parms, Args, ExtraArgs, Culprit).
  347unify_lambda_parameters_(_,_,_,Culprit) :-
  348    domain_error(lambda_parameters, Culprit).
  349
  350lambda_free(Free) :-
  351    var(Free),
  352    !,
  353    instantiation_error(Free).
  354lambda_free({_}) :- !.
  355lambda_free({}) :- !.
  356lambda_free(Free) :-
  357    type_error(lambda_free, Free).
  358
  359%!  expand_lambda(+Goal, -Head) is semidet.
  360%
  361%   True if Goal is a   sufficiently  instantiated Lambda expression
  362%   that is compiled to the predicate   Head.  The predicate Head is
  363%   added    to    the    current    compilation    context    using
  364%   compile_aux_clauses/1.
  365
  366expand_lambda(Goal, Head) :-
  367    Goal =.. ['>>', Parms, Lambda| ExtraArgs],
  368    is_callable(Lambda),
  369    nonvar(Parms),
  370    lambda_functor(Parms>>Lambda, Functor),
  371    (   Parms = Free/ExtraArgs
  372    ->  is_lambda_free(Free),
  373        free_to_list(Free, FreeList)
  374    ;   Parms = ExtraArgs,
  375        FreeList = []
  376    ),
  377    append(FreeList, ExtraArgs, Args),
  378    Head =.. [Functor|Args],
  379    compile_aux_clause_if_new(Head, Lambda).
  380expand_lambda(Goal, Head) :-
  381    Goal =.. ['/', Free, Closure|ExtraArgs],
  382    is_lambda_free(Free),
  383    is_callable(Closure),
  384    free_to_list(Free, FreeList),
  385    lambda_functor(Free/Closure, Functor),
  386    append(FreeList, ExtraArgs, Args),
  387    Head =.. [Functor|Args],
  388    Closure =.. [ClosureFunctor|ClosureArgs],
  389    append(ClosureArgs, ExtraArgs, LambdaArgs),
  390    Lambda =.. [ClosureFunctor|LambdaArgs],
  391    compile_aux_clause_if_new(Head, Lambda).
  392
  393lambda_functor(Term, Functor) :-
  394    copy_term_nat(Term, Copy),
  395    variant_sha1(Copy, Functor0),
  396    atom_concat('__aux_yall_', Functor0, Functor).
  397
  398free_to_list({}, []).
  399free_to_list({VarsConj}, Vars) :-
  400    conjunction_to_list(VarsConj, Vars).
  401
  402conjunction_to_list(Term, [Term]) :-
  403    var(Term),
  404    !.
  405conjunction_to_list((Term, Conjunction), [Term|Terms]) :-
  406    !,
  407    conjunction_to_list(Conjunction, Terms).
  408conjunction_to_list(Term, [Term]).
  409
  410compile_aux_clause_if_new(Head, Lambda) :-
  411    prolog_load_context(module, Context),
  412    (   predicate_property(Context:Head, defined)
  413    ->  true
  414    ;   expand_goal(Lambda, LambdaExpanded),
  415        compile_aux_clauses([(Head :- LambdaExpanded)])
  416    ).
  417
  418lambda_like(Goal) :-
  419    compound(Goal),
  420    compound_name_arity(Goal, Name, Arity),
  421    lambda_functor(Name),
  422    Arity >= 2.
  423
  424lambda_functor(>>).
  425lambda_functor(/).
  426
  427:- dynamic system:goal_expansion/2.  428:- multifile system:goal_expansion/2.  429
  430system:goal_expansion(Goal, Head) :-
  431    lambda_like(Goal),
  432    prolog_load_context(source, _),
  433    \+ current_prolog_flag(xref, true),
  434    expand_lambda(Goal, Head).
  435
  436%!  is_lambda(@Term) is semidet.
  437%
  438%   True if Term is a valid Lambda expression.
  439
  440is_lambda(Term) :-
  441    compound(Term),
  442    compound_name_arguments(Term, Name, Args),
  443    is_lambda(Name, Args).
  444
  445is_lambda(>>, [Params,Lambda|_]) :-
  446    is_lamdba_params(Params),
  447    is_callable(Lambda).
  448is_lambda(/, [Free,Lambda|_]) :-
  449    is_lambda_free(Free),
  450    is_callable(Lambda).
  451
  452is_lamdba_params(Var) :-
  453    var(Var), !, fail.
  454is_lamdba_params(Free/Params) :-
  455    !,
  456    is_lambda_free(Free),
  457    is_list(Params).
  458is_lamdba_params(Params) :-
  459    is_list(Params).
  460
  461is_lambda_free(Free) :-
  462    nonvar(Free), !, (Free = {_} -> true ; Free == {}).
  463
  464is_callable(Term) :-
  465    strip_module(Term, _, Goal),
  466    callable(Goal).
  467
  468
  469%!  lambda_calls(+LambdaExpression, -Goal) is det.
  470%!  lambda_calls(+LambdaExpression, +ExtraArgs, -Goal) is det.
  471%
  472%   Goal  is  the   goal   called   if    call/N   is   applied   to
  473%   LambdaExpression, where ExtraArgs are   the additional arguments
  474%   to call/N. ExtraArgs can be an  integer   or  a list of concrete
  475%   arguments. This predicate is used for cross-referencing and code
  476%   highlighting.
  477
  478lambda_calls(LambdaExtended, Goal) :-
  479    compound(LambdaExtended),
  480    compound_name_arguments(LambdaExtended, Name, [A1,A2|Extra]),
  481    lambda_functor(Name),
  482    compound_name_arguments(Lambda, Name, [A1,A2]),
  483    lambda_calls(Lambda, Extra, Goal).
  484
  485lambda_calls(Lambda, Extra, Goal) :-
  486    integer(Extra),
  487    !,
  488    length(ExtraVars, Extra),
  489    lambda_calls_(Lambda, ExtraVars, Goal).
  490lambda_calls(Lambda, Extra, Goal) :-
  491    must_be(list, Extra),
  492    lambda_calls_(Lambda, Extra, Goal).
  493
  494lambda_calls_(Params>>Lambda, Args, Goal) :-
  495    unify_lambda_parameters(Params, Args, ExtraArgs, Lambda, LambdaCopy),
  496    extend(LambdaCopy, ExtraArgs, Goal).
  497lambda_calls_(Free/Lambda, ExtraArgs, Goal) :-
  498    copy_term_nat(Free+Lambda, Free+LambdaCopy),
  499    extend(LambdaCopy, ExtraArgs, Goal).
  500
  501extend(Var, _, _) :-
  502    var(Var),
  503    !,
  504    instantiation_error(Var).
  505extend(Cyclic, _, _) :-
  506    cyclic_term(Cyclic),
  507    !,
  508    type_error(acyclic_term, Cyclic).
  509extend(M:Goal0, Extra, M:Goal) :-
  510    !,
  511    extend(Goal0, Extra, Goal).
  512extend(Goal0, Extra, Goal) :-
  513    atom(Goal0),
  514    !,
  515    Goal =.. [Goal0|Extra].
  516extend(Goal0, Extra, Goal) :-
  517    compound(Goal0),
  518    !,
  519    compound_name_arguments(Goal0, Name, Args0),
  520    append(Args0, Extra, Args),
  521    compound_name_arguments(Goal, Name, Args).
  522
  523
  524                 /*******************************
  525                 *     SYNTAX HIGHLIGHTING      *
  526                 *******************************/
  527
  528:- multifile prolog_colour:goal_colours/2.  529
  530yall_colours(Lambda, built_in-[classify,body(Goal)|ArgSpecs]) :-
  531    catch(lambda_calls(Lambda, Goal), _, fail),
  532    Lambda =.. [>>,_,_|Args],
  533    classify_extra(Args, ArgSpecs).
  534
  535classify_extra([], []).
  536classify_extra([_|T0], [classify|T]) :-
  537    classify_extra(T0, T).
  538
  539prolog_colour:goal_colours(Goal, Spec) :-
  540    lambda_like(Goal),
  541    yall_colours(Goal, Spec).
  542
  543
  544                 /*******************************
  545                 *          XREF SUPPORT        *
  546                 *******************************/
  547
  548:- multifile prolog:called_by/4.  549
  550prolog:called_by(Lambda, yall, _, [Goal]) :-
  551    lambda_like(Lambda),
  552    catch(lambda_calls(Lambda, Goal), _, fail).
  553
  554
  555                 /*******************************
  556                 *        SANDBOX SUPPORT       *
  557                 *******************************/
  558
  559:- multifile
  560    sandbox:safe_meta_predicate/1,
  561    sandbox:safe_meta/2.  562
  563sandbox:safe_meta_predicate(yall:(/)/2).
  564sandbox:safe_meta_predicate(yall:(/)/3).
  565sandbox:safe_meta_predicate(yall:(/)/4).
  566sandbox:safe_meta_predicate(yall:(/)/5).
  567sandbox:safe_meta_predicate(yall:(/)/6).
  568sandbox:safe_meta_predicate(yall:(/)/7).
  569
  570sandbox:safe_meta(yall:Lambda, [Goal]) :-
  571    compound(Lambda),
  572    compound_name_arity(Lambda, >>, Arity),
  573    Arity >= 2,
  574    lambda_calls(Lambda, Goal)