2	Copyright 2014-2015 Samer Abdallah (UCL)
    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.
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   12	GNU Lesser General Public License for more details.
   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
   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'.



  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.
  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.").
 memo_attach(:Spec:filespec, +Options:list) is det
Convenience wrapper for db_attach/2. Attaches a persistent database file. Spec is interpreted by absolute_file_name/3, with a default extension of 'db'.
  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).
 volatile_memo(+Spec) is det
Directive to declare memoised predicates. Spec can be a single memo predicate specifier or several comma separated ones, as with dynamic/1 etc, for example,
:- volatile_memo pred1( ArgSpec1, ArgSpec2),

where ArgSpec1 etc are argument specifiers= as defined in the module header comment. It must look like +Type, -Type, +Name:Type or -Name:Type. Name, if given is not used.

  200volatile_memo(Spec) :- throw(error(context_error(nodirective, volatile_memo(Spec)), _)).
 persistent_memo(+Spec) is det
Directive to declare memoised predicates. Spec can be a single memo predicate specifier or several comma separated ones, as with dynamic/1 etc, for example,
:- persistent_memo pred1( ArgSpec1, ArgSpec2),
                   pred2( ArgSpec3, ArgSpec4, ArgSpec5).

where ArgSpec1 etc are argument specifiers= as defined in the module header comment. It must look like +Type, -Type, +Name:Type or -Name:Type. Name, if given is only used for the declaration of the persistent memo table.

  213persistent_memo(Spec) :- throw(error(context_error(nodirective, persistent_memo(Spec)), _)).
 browse(+Goal:callable, ?Meta:metadata) is nondet
 browse(+Goal:callable) is nondet
Looks up previous computations of memoised predicate Goal. browse/1 unifies Goal with all successful computations. browse/2 unifies Goal and Meta with all computations, including failed or exception-throwing computations. browse(Goal) is equivalent to browse(Goal, _-ok).
  222browse(Module:Head) :- browse(Module:Head,_-ok).
  223browse(Module:Head,Meta) :- 
  224   must_be(module,Module),
  225   lookerup(Module,Head,Meta,MemoHead), 
  226   call(Module:MemoHead).
 clear_all(@Goal:callable, @Meta:metadata) is det
 clear_all(@Goal:callable) is det
Clears all matching entries from the memo tables that unify with Goal. clear_all/2 additionally allows selection on the basis of meta-data. Deletion is NOT undone on backtracking.

Asks for confirmation if more than N entries are to be deleted, where N is determined by the setting memo:confirmation_threshold (see library(settings)). The default is 1. The confirmation message is printed with ansi_format/3 using a style determined by setting memo:confirmation_style, whose default is [bold,fg(red)]. The user must type "yes" and press return continue, otherwise an operation_cancelled is thrown.

  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).
  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).
 compute(+Goal:callable) is semidet
Calls the original un-memoised predicate without checking or modifying memo-tables.
  258compute(Module:Head) :- 
  259   memoised(Module,Head,Spec),
  260   type_and_mode_check(Spec,Head),
  261   computer(Module,Head,ComputeHead),
  262   call(Module:ComputeHead).
 compute(+Goal:callable, -Meta:metadata) is det
Calls the original un-memoised predicate without checking or modifying memo-tables. If the underlying predicate fails or throws an exception, Meta is set accordingly.
  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.
 recompute_all(+Goal:callable, @Meta:metadata, @Res:result) is semidet
Recomputes all memoised computations matching Goal and Meta. This will recompute all the entries that would have been returned by browse/2. The only extra condition is that Goal cannot be unbound on entry -- only one determinate predicate can be recomputed at a time. The old entry is removed only after the new computation produces a result that unifies with Res. Otherwise, the recomputed version is discarded.
  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   )).
  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].
 memo(+Goal:callable, -Meta:metadata) is semidet
 memo(+Goal:callable) is semidet
Calls memoised predicate if it has not been called before with these input arguments, storing the result, or looks up previous matching computations if they exist. Goal must be sufficiently instantiated to satisfy the underlying memoised predicate. memo/1 and memo/2 behave differently if the underlying predicate fails or throws an exception. memo/1 reflects this behaviour, failing or throwing the same exception, even if the computation was not actually repeated but was retrieve from the memo table. memo/2 reifies this behaviour, returing information in Meta.

Note that the types are checked strictly. An Input argument X declared with +T must satisfy must_be(T,X). An output argument declared with a -T may be bound or unbound. If it is bound, the predicate behaves as if it were unbound, followed by a final semi-deterministic unification. (Prior to v0.5.0, outputs had to be unbound.)

  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.
  344:- public reflect/1.  345reflect(ok) :- !.
  346reflect(fail) :- !, fail.
  347reflect(ex(Ex)) :- throw(Ex).
  350:- nb_setval(memo_mode,memo).
 current_mode(-Mode:oneof([memo,browse,compute])) is det
Gets the current memoisation mode.
  354current_mode(Mode) :- nb_current(memo_mode,Mode), Mode\=[], !.
  360sandbox:safe_meta(memo:call_with_mode(browse,_),[]) :- !.
  362sandbox:safe_meta(memo:modally(Module:Head),[Module:ComputeHead]) :-
  363   computer(Module,Head,ComputeHead).
  366modally(Module:Head) :-
  367   current_mode(Mode),
  368   call(Mode,Module:Head).
 call_with_mode(+Mode:oneof([memo,browse,compute]), +Goal:callable) is nondet
Executes an arbitrary Prolog goal with the current memo-evaluation-mode set to Mode. Thus, any calls to memoised predicates result in calls to memo/1, browse/1 or compute/1 respectively.
  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).
  382compile_memo(_,Var, _) --> { var(Var), !, instantiation_error(Var) }.
  384compile_memo(Type, (A,B), Module) --> !,
  385   compile_memo(Type, A, Module),
  386   compile_memo(Type, B, Module).
  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],
  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),
  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),
  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   ].
  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],
  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, _),
  429      build_term(['compute_', Name],     Args,        ComputeHead),
  430      build_term(['assert_',  MemoName], [MetaA|Args], AssertHead),
  431      build_term(['retractall_', MemoName], [Meta|Args], RetractHead),
  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   ].
  447build_term(NameParts,Args,Term) :- 
  448   atomic_list_concat(NameParts,Name), 
  449   Term =.. [Name|Args].
  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) :- !.
  459memoised(Module,Head,Type) :- memoised(Module,Head,Type,_).
 memo_property(-Goal, -Prop:memo_property) is nondet
memo_property ---> type(typespec)
                 ; storage(oneof([persistent,volatile]))
                 ; count(natural).                   .

Enumerates memoised and their properties.

  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).
  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)))).
  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].
  486check_arg(+Type,X,X) :- must_be(Type,X).
  489user:term_expansion((:- volatile_memo(Spec)), Clauses) :-
  490   prolog_load_context(module, Module),
  491   phrase(compile_memo(volatile, Spec, Module), Clauses).
  493user:term_expansion((:- persistent_memo(Spec)), Clauses) :-
  494   prolog_load_context(module, Module),
  495   phrase(compile_memo(persistent, Spec, Module), Clauses).
  497user:term_expansion((Head :- Body),(ComputeHead :- Body)) :-
  498   prolog_load_context(module, Module),
  499   computer(Module,Head,ComputeHead).
  501user:term_expansion(Head,ComputeHead) :-
  502   prolog_load_context(module, Module),
  503   computer(Module,Head,ComputeHead).
  505timed(Goal,comp(_,T1,DT)) :- 
  506   get_time(T1), call(Goal), !, 
  507   get_time(T2), DT is T2-T1.
  509:- public reify/2.  510reify(Goal,R) :- catch((Goal -> R=ok ; R=fail), Ex, R=ex(Ex)).
 meta_property(+Meta:metadata, -Prop:meta_property) is nondet
True when Prop is a meta-property of a memoised computation, where Meta is the metadata term retrieved from memo/2 or browse/2. Valid properties are:
The duration of the computation in seconds.
The time at which the computation was initiated, as returned by get_time/1
The name of host on which the computation was performed.
The success/fail status of the result
  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))