From: pop@cs.umass.edu ( Robin Popplestone )
Newsgroups: comp.lang.pop
Subject: memo functions
Summary: memoised functions avoid re-evaluation of arguments.
Keywords: memo function
Date: 18 Dec 92 16:37:52 GMT
Organization: University of Massachusetts, Amherst
Originator: pop@roo.cs.umass.edu

/*  memo.p                                    R.J.Popplestone June 1990

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 hansome factor
in the tak benchmark for big arguments - not surprising since memoisation
changes complexity.

Note that more efficient "tree-memo" functions are available for combinations
of up to 3 arguments.

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

 --  memo_gen memoises a function of one argument
 --  The function memo_n  memoises a function f of n arguments, m  results
 --  de_memo(f) restores a function to non-memoised form

*/




section Memoise =>
   memo_gen,
   memo_n,
   de_memo,
   memoise memo;  ;;; Modularise the capability.

;;; This is used as an auxiliary function by  memo_gen, to record the
;;; f(x) when it has not been previously evaluated.

define record(x,P,f);     ;;; Record the value of f(x) in property P
    lvars x,P,f;
    f(x) ->> P(x);        ;;; associate f(x) with P(x), AND return it as
enddefine;                ;;; result of the procedure.


/*
memo_gen memoises a function of one argument
--------------------------------------------
The procedure  memo_gen  returns a property which memoises the function  f,
f is a function of ONE argument.
f  is used to generate new values in the property when no value exists.
by a call to the auxiliary function record.
*/

define memo_gen(f,f_hash,f_eq,b_gc,v_default);
  lvars f,f_hash,f_eq,b_gc,v_default;
  newanyproperty([],        ;;; no pre-defined attribute-value pairs.
                 32,    	;;; Initial table size.
                 2,      	;;; Expansion shift
                 false,     ;;; Default expansion threshold.
                 f_hash,    ;;; the hashing function
                 f_eq,      ;;; the comparison function
                 b_gc,      ;;; action on GC -  see ref newanyproperty
                 v_default, ;;; The default value
                 record(%f%);;; The closure of the record procedure
                )
enddefine;



/*
The function memo_n  memoises a function f of n arguments, m  results
---------------------------------------------------------------------------

At (1) we create a function f2 which performs the same computation as as f,
but the call f(x1,...xn) is replaced by f2(vec_x), where vec_x is a  vector
formed of (x1...xn).  f2 also returns  a vector formed  of (y1...ym)  where
y1...ym are the values  f(x1...xn). Thus f2 is  a function of one  argument
that can be memoised using memo_gen.

In effect we have replaced the 'light weight tuple x1...xn on the stack  by
a 'heavy weight  tuple' vec_x  on the  heap. The  'commented arguments'  /*
x1...xn */  indicate  where  these  light-weight  tuples  are  passed  into
functions.

The convertion to and from the vector form is done at (2).

At (3) we use memo_gen to form f3 as a memoised version of f2.

At (4) we define a function f1 which converts f3 back into a function which
operates on a tuple on the stack, and returns its result as a tuple on  the
stack. We do the closure by partial application - this is more efficient since
the partially applied entities are constant.

At (6), if we have a version of POPLOG that supports updating of the number of
arguments of a closure, we give f4 the correct number of arguments.

At (7) we return f4 as the result.
*/

define memo_n(f,n,m);
  lvars n,m, f;

  define lvars f2(vec_x)/* -> vec_y*/;            ;;;  (1)
    lvars vec_x;
    consvector(f(explode(vec_x)),m)               ;;;  (2)
  enddefine;

  lvars f3 = memo_gen(f2,syshash,nonop =,false,0); ;;; (3)

  define lvars f1(/*x1...xn,*/f3,n );             ;;; (4)
    lvars f3,n,
        vec_x = consvector(/*x1...xn,*/ n);
		destvector(f3(vec_x))->;
  enddefine;
  lvars f4 = f1(%f3,n%);                          ;;; (5)
  #_IF pop_internal_version >= 141000             ;;; (6)
  n -> pdnargs(f4);
  #_ENDIF
  [memo ^f] -> pdprops(f4);
  return(f4)

enddefine;

/*
de_memo(f) restores a function to non-memoised form
----------------------------------------------------

*/

define de_memo(f);         ;;; interim.
  lvars f, L = pdprops(f);
  if islist(L) and hd(L) = "memo" then de_memo(hd(tl(L)))
  else f
  endif;
enddefine;

vars memo = true;

lvars pr_fn_old = class_print(datakey(memo_n));

define pr_memo(f);
  lvars f,L = pdprops(f);
  if islist(L) and hd(L) = "memo" then pr(L)
  else pr_fn_old(f)
  endif;
enddefine;

pr_memo -> class_print(datakey(memo_n));

endsection;