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 '>>'(, ), 54 '>>'(, , ), 55 '>>'(, , , ), 56 '>>'(, , , , ), 57 '>>'(, , , , , ), 58 '>>'(, , , , , , ), 59 '>>'(, , , , , , , ), 60 '>>'(, , , , , , , , ). 61 62:- meta_predicate 63 '/'(, ), 64 '/'(, , ), 65 '/'(, , , ), 66 '/'(, , , , ), 67 '/'(, , , , , ), 68 '/'(, , , , , , ), 69 '/'(, , , , , , , ), 70 '/'(, , , , , , , , ).
call(Lambda,A1,...),
but arguments are reordered according to the list Parameters:
length(Parameters) arguments from A1, ... are
unified with (a copy of) Parameters, which may share
them with variables in Lambda.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).
Free/[]>>Lambda. This is the same as applying
call/N on Lambda, except that only variables appearing in Free
are bound by the call. For example
p(1,a).
p(2,b).
?- {X}/p(X,Y).
X = 1;
X = 2.
This can in particularly be combined with bagof/3 and setof/3 to select particular variables to be concerned rather than using existential quantification (^/2) to exclude variables. For example, the two calls below are equivalent.
setof(X, Y^p(X,Y), Xs)
setof(X, {X}/p(X,_), Xs)
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).
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).
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 430systemgoal_expansion(Goal, Head) :- 431 lambda_like(Goal), 432 prolog_load_context(source, _), 433 \+ current_prolog_flag(xref, true), 434 expand_lambda(Goal, Head).
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).
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_colourgoal_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 550prologcalled_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)
Lambda expressions
Prolog realizes high-order programming with meta-calling. The core predicate of this is call/1, which simply calls its argument. This can be used to define higher-order predicates such as ignore/1 or forall/2. The call/N construct calls a closure with N-1 additional arguments. This is used to define higher-order predicates such as the maplist/2-5 family or foldl/4-7.
The closure concept used here is somewhat different from the closure concept from functional programming. The latter is a function that is always evaluated in the context that existed at function creation time. Here, a closure is a term of arity 0 =< L =< K. The term's functor is the name of a predicate of arity K and the term's L arguments (where L could be 0) correspond to L leftmost arguments of said predicate, bound to parameter values. For example, a closure involving atom_concat/3 might be the term
atom_concat(prefix). In order of increasing L, one would have increasingly more complete closures that could be passed to call/3, all giving the same result:The problem with higher order predicates based on call/N is that the additional arguments are always added to the end of the closure's argument list. This often requires defining trivial helper predicates to get the argument order right. For example, if you want to add a common postfix to a list of atoms you need to apply
atom_concat(In,Postfix,Out), butmaplist(atom_concat(Postfix),ListIn,ListOut)callsatom_concat(Postfix,In,Out). This is where library(yall) comes in, where the module name, yall, stands for Yet Another Lambda Library.The library allows us to write a lambda expression that wraps around the (possibly complex) goal to call:
A bracy list
{...}specifies which variables are shared between the wrapped goal and the surrounding context. This allows us to write the code below. Without the{Postfix}a fresh variable would be passed to atom_concat/3.add_postfix(Postfix, ListIn, ListOut) :- maplist({Postfix}/[In,Out]>>atom_concat(In,Postfix,Out), ListIn, ListOut).This introduces the second application area of lambda expressions: the ability to confine variables to the called goal's context. This features shines when combined with bagof/3 or setof/3 where one normally has to list those variables whose bindings one is not interested in using the
Var^Goalconstruct (marking Var as existentially quantified and confining it to the called goal's context). Lambda expressions allow you to do the converse: specify the variables which one is interested in. These variables are common to the context of the called goal and the surrounding context.Lambda expressions use the syntax below
{...}/[...]>>Goal.The
{...}optional part is used for lambda-free variables (the ones shared between contexts). The order of variables doesn't matter, hence the{...}set notation.The
[...]optional part lists lambda parameters. Here, order of variables matters, hence the list notation.As
/and>>are standard infix operators, no new operators are added by this library. An advantage of this syntax is that we can simply unify a lambda expression with{Free}/[Parameters]>>Lambdato access each of its components. Spaces in the lambda expression are not a problem although the goal may need to be written between '()'s. Goals that are qualified by a module prefix also need to be wrapped inside parentheses.Combined with library(apply_macros), library(yall) allows writing one-liners for many list operations that have the same performance as hand-written code.
This module implements Logtalk's lambda expressions syntax.
The development of this module was sponsored by Kyndi, Inc.