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) 2019-2023, VU University Amsterdam 7 SWI-Prolog Solutions b.v. 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(prolog_wrap, 37 [ wrap_predicate/4, % :Head, +Name, -Wrapped, :Body 38 unwrap_predicate/2, % :PI, ?Name 39 current_predicate_wrapper/4 % :Head, -Name, -Wrapped, -Body 40 ]). 41:- autoload(library(lists),[member/2]). 42:- autoload(library(pairs),[pairs_keys/2]). 43 44 45:- meta_predicate 46 wrap_predicate(, , , ), 47% unwrap_predicate(:, ?), 48 current_predicate_wrapper(, , , ). 49 50/** <module> Wrapping predicates 51 52This library allows adding _wrappers_ to predicates. The notion of 53wrappers is known in various languages under several names. For example 54Logtalk knows these as _before methods_ or _after methods_ and Python 55has _decorators_. A SWI-Prolog wrapper is a _body term_ that normally 56calls the original wrapped definition somewhere. 57*/ 58 59%! wrap_predicate(:Head, +Name, -Wrapped, +Body) is det. 60% 61% Wrap the predicate referenced by Head using Body. Subsequent calls 62% to Head call the given Body term. Body may call the original 63% definition through Wrapped. Wrapped is a term of the shape below, 64% where _Closure_ is an opaque _blob_. 65% 66% call(Closure(A1, ...)) 67% 68% Name names the wrapper for inspection using predicate_property/2 or 69% deletion using unwrap_predicate/2. If Head has a wrapper with Name 70% the Body of the existing wrapper is updated without changing the 71% order of the registered wrappers. The same predicate may be wrapped 72% multiple times. Multiple wrappers are executed starting with the 73% last registered (outermost). 74% 75% The predicate referenced by Head does not need to be defined at the 76% moment the wrapper is installed. If Head is undefined, the predicate 77% is created instead of _searched for_ using e.g., the auto loader. 78% 79% Registered wrappers __are not part of saved states__ (see 80% qsave_program/2) and thus need to be re-registered, for example 81% using initialization/1. 82% 83% An example of using wrap_predicate/4 for computing GCD: 84% == 85% :- wrap_predicate(gcd(A,B,Gcd), gcd_wrap, W, gcd_wrap(W, A, B, Gcd)). 86% 87% gcd(X, Y, Gcd), X < Y => gcd(X, Y-X, Gcd). 88% gcd(X, Y, Gcd), X > Y => gcd(Y, X-Y, Gcd). 89% gcd(X, _, Gcd) => Gcd = X. 90% 91% gcd_wrap(call(Closure), X, Y, Gcd) :- 92% functor(Closure, ClosureBlob, 3), 93% X_eval is X, 94% Y_eval is Y, 95% call(ClosureBlob, X_eval, Y_eval, Gcd). 96% == 97% or (less efficient): 98% == 99% gcd_wrap(call(Closure), X, Y, Gcd) :- 100% functor(Closure, ClosureBlob, 3), 101% call(ClosureBlob, X_eval, Y_eval, G), 102% Gcd is G. 103% == 104 105wrap_predicate(M:Head, WName, Wrapped, Body) :- 106 '$wrap_predicate'(M:Head, WName, _Closure, Wrapped, Body). 107 108%! unwrap_predicate(:PI, ?Name) is semidet. 109% 110% Remove the outermost wrapper whose name unifies with Name. Fails if 111% no matching wrapper exists. 112 113%! current_predicate_wrapper(:Head, -Name, -Wrapped, -Body) is nondet. 114% 115% True if Head is wrapped with Body. The arguments are compatible with 116% wrap_predicate/4 such that the result may be used to re-create the 117% wrapper. 118% 119% Wrappers are enumerated starting with the first registered 120% (innermost) wrapper. 121 122current_predicate_wrapper(M:Head, Name, Wrapped, Body) :- 123 '$wrapped_predicate'(M:Head, Pairs), 124 Head =.. [_|Args], 125 member(Name-CRef, Pairs), 126 clause(M:, Body0, CRef), 127 WHead =.. [_|Args], 128 body_closure(Body0, Wrapped, Body). 129 130body_closure(call(ClosureTerm), Wrapped, Wrapped) :- 131 callable(ClosureTerm), 132 functor(ClosureTerm, Closure, _Arity), 133 blob(Closure, closure), 134 !. 135body_closure(Body0, Wrapped, Body) :- 136 compound(Body0), 137 !, 138 compound_name_arity(Body0, Name, Arity), 139 compound_name_arity(Body, Name, Arity), 140 body_closure_args(0, Arity, Body0, Wrapped, Body). 141body_closure(Body, _, Body). 142 143body_closure_args(I, Arity, Body0, Closure, Body) :- 144 I < Arity, 145 !, 146 I2 is I+1, 147 arg(I2, Body0, Arg0), 148 arg(I2, Body, Arg), 149 body_closure(Arg0, Closure, Arg), 150 body_closure_args(I2, Arity, Body0, Closure, Body). 151body_closure_args(_, _, _, _, _). 152 153 154% Not for public docs! 155% '$syspreds':'$predicate_property'(?Property, +Value) is nondet. 156% 157% Extend predicate_property/2 to provide the `wrapped` property 158 159:- multifile 160 '$syspreds':'$predicate_property'/2. 161 162'$syspreds''$predicate_property'(wrapped(List), Pred) :- 163 '$wrapped_predicate'(Pred, Pairs), 164 pairs_keys(Pairs, List)