1/* 2 Copyright 2014-2015 Samer Abdallah (UCL) 3 4 This program is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public License 6 as published by the Free Software Foundation; either version 2 7 of the License, or (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17*/ 18 19:- module(memo, 20 [ memo/1, memo/2 21 , browse/1, browse/2 22 , clear_all/1, clear_all/2 23 , compute/1, compute/2 24 , recompute_all/3 25 , (volatile_memo)/1 26 , (persistent_memo)/1 27 , call_with_mode/2 28 , current_mode/1 29 , memo_property/2 30 , op(1150,fx,volatile_memo) 31 , op(1150,fx,persistent_memo) 32 , modally/1 33 , meta_property/2 34 , memo_attach/2 35 ]).

Memoisation of deterministic predicates

This module provides the ability to store the results of expensive to run deterministic predicates to save recomputation. The memo table can be volatile (in memory only) and therefore lost when SWI terminates, or stored persistently on disk using the facilities provided by library(persistency).

Suppose you have a predicate expensive/4 which is deterministic with two inputs and two outputs, eg, its PlDoc comment could look like this:

%% expensive(+In1:atom, +In2:int, -Out1:float, -Out2:compound) is det.

Then a volatile memo could be declared with the following directive:

:- volatile_memo expensive( +atom, +int, -float, -compound).

This causes a dynamic predicate expensive/5 to be declared (the extra argument is for metadata about the computation that produced the result). It also causes the definition of the predicate expensive/4 to be renamed to compute_expensive/4, and a new expensive/4 is generated which looks in the memo table (expensive/5) to avoid recomputations.

To declare a persistently memoised predicate, you would use

:- persistent_memo expensive( +atom, +int, -float, -compound).

This causes a persistent predicate expensive/5 to be declared via facilities provided by library(persistency). Otherwise, things look the same externally (there are some internal differences). It is the caller's responsibility to attach a persistent database.

Argument specifiers

Each volatile_memo/1 or persistent_memo/1 directive can contain one or more predicate declarations, where each argument of the predicate declaration term specifies an input or out argument of the predicate to be memoised. The predicate will be treated as semi-deterministic in the sense that it will succeed at most once for each combination of inputs. Each argument specifier must look like one of these:

+ Type: An input of type Type.
+ Name:Type: An input named Name of type Type.
- Type: An output of type Type.
- Name:Type: An output named Name of type Type.

Meta-level interface

Memoised predicates can be accessed at a 'meta-level' using some meta-predicates which you can think of as modal operators.

First of all, each memoised call to the base predicate has some recorded meta-data whose type is metadata, defined below:

metadata    == pair(comp_event,result).
pair(A,B)  ---> A-B.
result     ---> ok ; fail ; ex(any).
comp_event ---> comp(hostname,time,duration)
              ; comp(hostname,duration)
              ; none.
hostname == ground.
time     == float.
duration == float.

Thus, the meta-data can record the computer on which the computation was done, the time it was called (as returned by get_time/1), the duration of the computation in seconds, and whether or not the computation succeeded, failed, or threw an exception. The fact that failures and exception-throwings are recorded means that object level interface (eg expensive/4 in the example above) avoids repeating unsuccessful computation as well as successful ones.

The meta-level browse/1 and browse/2 allow you to access this information. browse(Goal) is a nondeterministic predicate which unifies Goal with all the successful calls in the memo table. browse(Goal,Meta) matches all calls in the memo table including unsuccessful ones.

The meta-level clear_all/1 and clear_all/2 allow you to delete memo table entries. The meta-level memo(Goal) is the same as the object level Goal, failing or throwing an expection depending on what the underlying predicate does, but the meta-level memo(Goal,Meta) catches failures and exceptions, returning the meta-data in Meta.

Finally, the meta-level compute/1 by-passes all the memoisation machinery and calls the original underlying predicate directly. This is useful in cases where you absolutely need any side-effects caused by the original computation. compute/2 is the same except that failures and exceptions are reified as meta-data.

Setting the host name

The meta-data includes the host name of the computer used to do the computations. On a Unix system, this should get picked up from the environment automatically, using getenv('HOSTNAME',Hostname) (see getenv/2) OR, if this fails, by calling the shell command 'hostname'.

TODO:

check for duplicate declarations
check for missing predicate definitions

139:- meta_predicate 140 memo_attach(:,+), 141 modally(0), 142 call_with_mode(+,0), 143 memo(0), memo(0,-), 144 browse(0), browse(0,-), 145 clear_all(0), clear_all(0,-), 146 compute(0), compute(0,-), 147 recompute_all(0,-,-). 148 149:- use_module(library(persistency)). 150:- use_module(library(typedef)). 151:- use_module(library(hostname)). 152:- use_module(library(settings)). 153:- use_module(library(sandbox)). 154 155:- multifile memoised/4, lookerup/4, asserter/4, retracter/4, computer/3. 156 157:- set_prolog_flag(double_quotes,string). 158:- set_prolog_flag(back_quotes,codes). 159 160:- type pair(A,B) ---> A-B. 161:- type module == atom. 162:- type time == float. 163:- type duration == float. 164:- type hostname == ground. 165:- type metadata == pair(comp_event,result). 166:- type result ---> ok ; fail ; ex(any). 167:- type comp_event ---> comp(hostname,time,duration) 168 ; comp(hostname,duration) 169 ; none. 170 171 172:- setting(confirmation_style, list(ground), [bold,fg(red)], "Confirmation message style options."). 173:- setting(confirmation_threshold, integer, 1, "Maximum entries for silent clear_all deletion.").

180memo_attach(Module:Spec,Opts) :- 181 ( absolute_file_name(Spec,Path,[access(read),extensions([db]), file_errors(fail)]) 182 -> debug(memo,'memo spec ~w: found old db file ~s',[Spec,Path]) 183 ; absolute_file_name(Spec,Path,[access(write)]), 184 debug(memo,'memo spec ~w: creating new db file ~s',[Spec,Path]) 185 ), 186 db_attach(Module:Path,Opts).

239clear_all(Module:Head) :- clear_all(Module:Head,_). 240clear_all(Module:Head,Meta) :- 241 must_be(nonvar,Head), 242 lookerup(Module,Head,Meta,MemoHead), 243 retracter(Module,Head,Meta,RetractHead), 244 aggregate_all(count,Module:MemoHead,Count), 245 setting(confirmation_threshold,Thresh), 246 (Count>Thresh -> confirm(format("Will delete ~d entries.",[Count])); true), 247 call(Module:RetractHead). 248 249confirm(Printer) :- 250 setting(confirmation_style,Style), 251 ansi_format(Style,"~@ Type 'yes' [return] to proceed: ",[Printer]), 252 read_line_to_string(user_input,Response), 253 (Response \= "yes" -> throw(operation_cancelled); true).

268compute(Module:Head,Meta) :- 269 memoised(Module,Head,Spec), 270 type_and_mode_check(Spec,Head), 271 computer(Module,Head,ComputeHead), 272 timed(reify(Module:ComputeHead,Res),Comp), 273 Meta=Comp-Res.

283recompute_all(Module:Head,Meta,Res) :- 284 must_be(nonvar,Head), 285 memoised(Module,Head,Spec), 286 unbind_outputs(Spec,Head,Head1), 287 lookerup(Module,Head,Meta,MemoHead), % use bound outputs to lookup 288 computer(Module,Head1,ComputeHead), % use unbound outputs to compute 289 asserter(Module,Head1,Comp-Res,AssertHead), % to add new computation 290 retracter(Module,Head,Meta,RetractHead), % to remove old computation 291 forall( Module:MemoHead, ( 292 debug(memo,"recomputing ~q...",[Module:Head1]), 293 ( timed(reify(Module:ComputeHead,Res),Comp) 294 -> debug(memo,"storing (~w) ~q...",[Res,Module:Head1]), 295 call(Module:RetractHead), % ideally these would be atomic 296 call(Module:AssertHead) 297 ; debug(memo,"rejecting (~w) ~q...",[Res,Module:Head1]) 298 ) 299 )). 300 301 302% copies Head0 to Head1, but leaves output arguments unbound. 303unbind_outputs(Type,Head0,Head1) :- 304 Type=..[Name|Types], 305 Head0=..[Name|Args0], 306 maplist(copy_if_input,Types,Args0,Args1), 307 Head1=..[Name|Args1]. 308 309copy_if_input(+_,X,X). 310copy_if_input(-_,_,_).

327memo(Module:Head) :- 328 freeze(Res,reflect(Res)), % this will prevent storage on failure or exception 329 memo(Module:Head,_-Res). 330memo(Module:Head,Meta) :- 331 memoised(Module,Head,Spec), 332 type_and_mode_check(Spec,Head,Head1), 333 lookerup(Module,Head1,Meta1,MemoHead), 334 ( call(Module:MemoHead) *-> Meta=Meta1 335 ; debug(memo,"computing ~q...",[Module:Head]), 336 computer(Module,Head1,ComputeHead), 337 timed(reify(Module:ComputeHead,Res),Comp), Meta=Comp-Res, 338 asserter(Module,Head1,Meta,AssertHead), 339 debug(memo,"storing (~w) ~W...",[Res,Module:Head,[quoted(true),max_depth(6)]]), 340 call(Module:AssertHead) 341 ), 342 Head=Head1. 343 344:- public reflect/1. 345reflect(ok) :- !. 346reflect(fail) :- !, fail. 347reflect(ex(Ex)) :- throw(Ex). 348 349 350:- nb_setval(memo_mode,memo).

354current_mode(Mode) :- nb_current(memo_mode,Mode), Mode\=[], !. 355current_mode(memo). 356 357 358sandbox:safe_meta(memo:browse(_),[]). 359sandbox:safe_meta(memo:browse(_,_),[]). 360sandbox:safe_meta(memo:call_with_mode(browse,_),[]) :- !. 361sandbox:safe_meta(memo:call_with_mode(_,G),[G]). 362sandbox:safe_meta(memo:modally(Module:Head),[Module:ComputeHead]) :- 363 computer(Module,Head,ComputeHead). 364 365 366modally(Module:Head) :- 367 current_mode(Mode), 368 call(Mode,Module:Head).

375call_with_mode(Mode,Goal) :- 376 must_be(oneof([memo,compute,browse]),Mode), 377 current_mode(Mode0), 378 b_setval(memo_mode,Mode), 379 catch(Goal,E,(b_setval(memo_mode,Mode0),throw(E))), 380 b_setval(memo_mode,Mode0). 381 382compile_memo(_,Var, _) --> { var(Var), !, instantiation_error(Var) }. 383 384compile_memo(Type, (A,B), Module) --> !, 385 compile_memo(Type, A, Module), 386 compile_memo(Type, B, Module). 387 388compile_memo(volatile, Spec, Module) --> 389 { % strip any arg names from spec 390 debug(memo,"registering volatile memo predicate ~q...",[Spec]), 391 Spec =.. [Name|ArgSpecs], 392 maplist(strip_name,ArgSpecs,ArgTypes), 393 Type =.. [Name|ArgTypes], 394 395 functor(Spec, Name, Arity), 396 length(Args, Arity), 397 build_term([Name], Args, Head), 398 build_term([Name], [Meta|Args], MemoHead), 399 functor(MemoHead, MemoName, MemoArity), 400 401 build_term([MemoName], [MetaA|Args], AssertHead), 402 build_term([MemoName], [Meta|Args], RetractHead), 403 build_term(['compute_',Name],Args, ComputeHead), 404 hostname(Host), MetaA=comp(Host,_,_)-_ 405 }, 406 [ :- dynamic(MemoName/MemoArity), 407 408 memo:memoised(Module, Head, Type, volatile), 409 memo:lookerup(Module, Head, Meta, MemoHead), 410 memo:computer(Module, Head, ComputeHead), 411 memo:asserter(Module, Head, MetaA, assertz(Module:AssertHead)), 412 memo:retracter(Module, Head, Meta, retractall(Module:RetractHead)), 413 (Head :- memo:modally(Module:Head)) 414 ]. 415 416compile_memo(persistent, Spec, Module) --> 417 { % strip any arg names from spec 418 debug(memo,"registering persistent memo predicate ~q...",[Spec]), 419 Spec =.. [Name|ArgSpecs], 420 maplist(strip_name,ArgSpecs,ArgTypes), 421 Type =.. [Name|ArgTypes], 422 423 functor(Spec, Name, Arity), 424 length(Args, Arity), 425 build_term([Name], Args, Head), 426 build_term([Name], [Meta|Args], MemoHead), 427 functor(MemoHead, MemoName, _), 428 429 build_term(['compute_', Name], Args, ComputeHead), 430 build_term(['assert_', MemoName], [MetaA|Args], AssertHead), 431 build_term(['retractall_', MemoName], [Meta|Args], RetractHead), 432 433 maplist(mtype_to_ptype, ArgSpecs, PTypes), 434 PersistencySpec =.. [MemoName,meta:metadata | PTypes], 435 expand_term( (:- persistent(PersistencySpec)), PersistClauses), 436 hostname(Host), MetaA=comp(Host,_,_)-_ 437 }, 438 phrase(PersistClauses), 439 [ memo:memoised(Module, Head, Type, persistent), 440 memo:lookerup(Module, Head, Meta, MemoHead), 441 memo:computer(Module, Head, ComputeHead), 442 memo:asserter(Module, Head, MetaA, Module:AssertHead), 443 memo:retracter(Module, Head, Meta, Module:RetractHead), 444 (Head :- memo:modally(Module:Head)) 445 ]. 446 447build_term(NameParts,Args,Term) :- 448 atomic_list_concat(NameParts,Name), 449 Term =.. [Name|Args]. 450 451mtype_to_ptype( +N:T, N:T) :- !. 452mtype_to_ptype( -N:T, N:partial(T)) :- !. 453mtype_to_ptype( +T, _:T). 454mtype_to_ptype( -T, _:partial(T)). 455strip_name(+_:T,+T) :- !. 456strip_name(-_:T,-T) :- !. 457strip_name(S,S) :- !. 458 459memoised(Module,Head,Type) :- memoised(Module,Head,Type,_).

468memo_property(Module:Head,type(Type)) :- memoised(Module,Head,Type,_). 469memo_property(Module:Head,storage(SC)) :- memoised(Module,Head,_,SC). 470memo_property(Module:Head,count(N)) :- 471 lookerup(Module,Head,_,MemoHead), 472 aggregate_all(count,MemoHead,N). 473 474type_and_mode_check(Type,Head) :- 475 forall( arg(I,Type,ArgSpec), 476 ( arg(I,Head,Arg), 477 ( ArgSpec = +ArgType -> must_be(ArgType,Arg) 478 ; ArgSpec = -_ -> must_be(var,Arg)))). 479 480type_and_mode_check(Spec,Head0,Head1) :- 481 Spec =.. [Name|Types], 482 Head0 =.. [Name|Args0], 483 maplist(check_arg,Types,Args0,Args1), 484 Head1 =.. [Name|Args1]. 485 486check_arg(+Type,X,X) :- must_be(Type,X). 487check_arg(-_,_,_). 488 489user:term_expansion((:- volatile_memo(Spec)), Clauses) :- 490 prolog_load_context(module, Module), 491 phrase(compile_memo(volatile, Spec, Module), Clauses). 492 493user:term_expansion((:- persistent_memo(Spec)), Clauses) :- 494 prolog_load_context(module, Module), 495 phrase(compile_memo(persistent, Spec, Module), Clauses). 496 497user:term_expansion((Head :- Body),(ComputeHead :- Body)) :- 498 prolog_load_context(module, Module), 499 computer(Module,Head,ComputeHead). 500 501user:term_expansion(Head,ComputeHead) :- 502 prolog_load_context(module, Module), 503 computer(Module,Head,ComputeHead). 504 505timed(Goal,comp(_,T1,DT)) :- 506 get_time(T1), call(Goal), !, 507 get_time(T2), DT is T2-T1. 508 509:- public reify/2. 510reify(Goal,R) :- catch((Goal -> R=ok ; R=fail), Ex, R=ex(Ex)).

526meta_property(comp(_,_,D)-_, duration(D)). 527meta_property(comp(_,D)-_, duration(D)). 528meta_property(comp(_,T)-_, time(T)). 529meta_property(comp(H,_,_)-_, host(H)). 530meta_property(comp(H,_)-_, host(H)). 531meta_property(_-R, result(R))