From: pop@cs.umass.edu ( Robin Popplestone )
Newsgroups: comp.lang.pop
Subject: memo functions - the tree versions
Summary: This function memoises a function of two arguments, using an
Date: 18 Dec 92 16:55:59 GMT
Organization: University of Massachusetts, Amherst
Originator: pop@roo.cs.umass.edu

Note - to save burning up the news network, I shall not post other versions
on the net. These include a 2-argument, n-result version, a 3-argument
1-result version and a 3-argument n-result version. and a 1 argument
n-result version. No doubt some patient person will write a perfectly
general all-singing-and-dancing memoiser which uses the Virtual Machine to
produce the most efficient possible kind of memoizer for a user's specified
combination of arguments and results, but I find closures easier.

Robin.


==============================================================================

/*
 memo_tree_2.p                                 R.J.Popplestone apr 92.

;;; 20sep92 Minor tidying and commenting.

This is an implementation by Robin Popplestone of the "memo function" idea of
Donald Michie. We use the term "function" for a non-updatable procedure.
The property functions of modern POP-11 are used to perform argument look-up.

Tests show that a memoised POP-11 function  can beat C by a handsome  factor
in the tak benchmark for big  arguments - not surprising since  memoisation
changes complexity.

Note that this


         CONTENTS - (Use <ENTER> g to access required sections)

 --  After garbage collection, memoised values are cleared out
 --  memo_tree_2 memoises a function f of two arguments
 --  An example of use.

*/

/*
After garbage collection, memoised values are cleared out
----------------------------------------------------------
*/
lvars sys_after_gc_old = pop_after_gc,
      L_memoed = [];




define pop_after_gc();
;;;  npr('after gc');
  for P in L_memoed do
     newassoc([]) -> frozval(2,P);
  endfor;
  sys_after_gc_old();
enddefine;

/*
memo_tree_2 memoises a function f of two arguments
---------------------------------------------------
This function uses == i.e. exact  equality to compare arguments. It  does a
two-stage lookup - the first  argument is used to  map to a property  which
maps the second argument to the function value.
*/

;;; vars n_same = 0, n_mem_tot = 0; (statistics indicate
;;; it is probably worth the test (== fastsubscr etc).

define memo_tree_2(f) -> f1;
  lvars f,f1 , undf = 'undf';
  define f_mem(x,y,f,P,vv) -> v;
    lvars x y f P vv v;
    ;;;    1 + n_mem_tot -> n_mem_tot;
    if   x == fast_subscrv(1,vv)         ;;; Exactly the same args as prev. ??
    and  y == fast_subscrv(2,vv)
    then                                 ;;; Yes - use previous result.
    ;;;      1 + n_same -> n_same;
      fast_subscrv(3,vv)
    else lvars P1 = P(x);                ;;; Get property assoc. with 1st arg
      if P1 then                         ;;; If there is one, use it to look
   		P1(y) ->> v;                     ;;; up value for second arg
        if v == undf then                ;;; No value?
          	-> ;                         ;;; Clear off the undf
          f(x,y) ->> P1(y);              ;;; and write computed value into
        endif;                           ;;; the property
                                         ;;; value of function now on stack
      else                               ;;; no property for first arg.
		newproperty([],32,undf,"tmparg") ;;; get a new one
        	->> P(x) -> P1;                ;;; and associate it with 1st. arg.
      	f(x,y) ->> P1(y);                ;;; evaluate the function and write
  		endif;                             ;;; to property, leaving result on stk.
	endif -> v;
    x -> fast_subscrv(1,vv);             ;;; Record immediate memo results.
    y -> fast_subscrv(2,vv);
    v -> fast_subscrv(3,vv);
	enddefine;

  if f.isclosure                         ;;; De-memoise if necessary.
  and pdpart(f) = f_mem then
    frozval(1,f) -> f
  endif;
  lvars
    P  = newanyproperty([],32,1,20,identfn,false,"tmparg",false,false);
  f_mem(%f,P,{%undf,undf,undf,undf%}%)
      -> f1;
  f1 -> frozval(3,f1)(4);                 ;;; supports purging.
  f1 :: L_memoed -> L_memoed;
enddefine;

/*
An example of use.
-------------------
The following example serves to test parts of the algorithm.
*/

example memo_tree_2;
vars ff = memo_tree_2(nonop +);
ff(4,5)=>
** 9
ff(4,5) =>
** 9
ff(9,8)=>
** 17
ff(9,6) =>
** 15
endexample
/*
pr_proc(ff);
frozval(3,ff)=>
*/

lvars pr_old = class_print(datakey(sin));

define lvars pr_prop(a,P);
  pr('arg 1 = '); pr(a); nl(1);
  appproperty(P, procedure(b,v); pr('arg_2 = '); pr(b); pr(' v = ');
                         pr(v); nl(1);
                 endprocedure);
enddefine;

define pr_proc(P);
  if isclosure(P) and pdprops(pdpart(P)) = "f_mem" then
     pr('memo ');
     pr(frozval(1,P)); nl(1);
     appproperty(frozval(2,P), pr_prop);
  else
    pr_old(P);
  endif;
enddefine;


pr_proc -> class_print(datakey(sin));
Newsgroups: comp.lang.pop