結果が大きくなるような計算用のmemo化 DNFなどを作る場合に有効なはず

memo.ml

type t = I of int | Add of t * t | Mul of t * t

type t1 = t
module TMap = Map.Make(struct
  type t=t1
  let eq_t t1 t2 =
    if t1==t2 then true else
    match t1,t2 with
    | Add(t1,t2),Add(t3,t4) -> t1==t3 && t2==t4
    | Mul(t1,t2),Mul(t3,t4) -> t1==t3 && t2==t4
    | _,_ -> t1=t2
  let rec compare t1 t2 =
    if eq_t t1 t2 then 0 else
    match t1,t2 with
    | I i1,I i2 -> Pervasives.compare i1 i2
    | Add(t1,t2),Add(t3,t4)
    | Mul(t1,t2),Mul(t3,t4) ->
      begin match compare t1 t3 with
      | 0 -> compare t2 t4
      | c -> c
      end
    | I _, _ -> 1
    | _, I _ -> -1
    | Add _, _ -> -1
    | _,Add _ -> 1
end)
let rec show_t = function
  | I i -> Printf.sprintf "%d" i
  | Add(t1,t2) -> Printf.sprintf "(%s+%s)" (show_t t1) (show_t t2)
  | Mul(t1,t2) -> Printf.sprintf "(%s*%s)" (show_t t1) (show_t t2)
let caches = ref (TMap.empty)
let cache k f =
  match TMap.find_opt k !caches with
  | Some t -> Printf.printf "hit %s %s\n" (show_t k) (show_t t); t
  | None -> let v = f() in caches := TMap.add k v !caches; v
let rec eval t =
  match t with
  | I v -> cache t (fun()->t)
  | Add(t1,t2) -> let v1,v2 = eval t1,eval t2 in
    cache (Add(v1,v2)) (fun()->Add(Add(v1,v2),Add(v1,v2)))
  | Mul(t1,t2) -> let v1,v2 = eval t1,eval t2 in
    cache (Mul(v1,v2)) (fun()->Mul(Add(v1,v2),Add(v1,v2)))
let _ = Printf.printf "%s\n" (show_t (eval(Add(I 20,I 10))))
let _ = Printf.printf "%s\n" (show_t (eval(Mul(Add(I 20,Mul(I 20,I 10)),Add(I 20,Mul(I 20,I 10))))))

memo.pl

:- nb_setval(id,0),retractall(i(_,_,_)).
genid(I1):-nb_getval(id,I),I1 is I+1,nb_setval(id,I1).
eval(I,i(X,i,I)):-integer(I),i(X,i,I),!.
eval(I,i(X,i,I)):-integer(I),!,genid(X),assert(i(X,i,I)).
eval(A+B,P):-eval(A,P1),eval(B,P2),cache(+,P1,P2,P).
eval(A*B,P):-eval(A,P1),eval(B,P2),cache(*,P1,P2,P).
cache(O,i(X1,_,_),i(X2,_,_),i(X,[X1,O,X2],V3)):-i(X,[X1,O,X2],V3),writeln(hit:X=V3),!.
cache(O,i(X1,_,I1),i(X2,_,I2),i(X,[X1,O,X2],I)):- E =..[O,I1,I2],
  I is E,genid(X),assert(i(X,[X1,O,X2],I)).
:- eval(((20+10)+(10*20))+((20+10)+(10*20)),i(_,C,R)),writeln(R;comment:C).
:- forall(i(I,X,V),writeln(i(I,X,V))).
:-halt.

tail.pl

% 後ろから探す
:- nb_setval(id,0),retractall(i(_,_,_,_)).
genid(I1):-nb_getval(id,I),I1 is I+1,nb_setval(id,I1).

eval(I,i(X,I,P,I)):-integer(I),i(X,I,P,I),!.
eval(I,i(X,I,[],I)):-integer(I),!,genid(X),asserta(i(X,I,[],I)).
eval(A+B,P):-eval(A,P1),eval(B,P2),cache(+,P1,P2,P).
eval(A*B,P):-eval(A,P1),eval(B,P2),cache(*,P1,P2,P).
cache(O,i(_,_,L1,_),i(X2,_,_,_),i(X,V3,P,C)):-XX=..[O,X2],member(XX:X,L1),i(X,V3,P,C),writeln(hit:X;comment:C=V3),!.
cache(O,i(X1,I1,L1,C1),i(X2,I2,_,C2),i(X,I,[],C)):- E =..[O,I1,I2],XX=..[O,X2],
  I is E,genid(X),C=..[O,C1,C2],asserta(i(X,I,[],C)),
  retract(i(X1,_,_,_)),asserta(i(X1,I1,[XX:X|L1],C1)).
:- eval(((20+10)+(10*20))+((20+10)+(10*20)),i(_,R,_,C)),writeln(R;comment:C).
:- forall(i(I,V,L,C),writeln(i(I,V,L,comment:C))).
:-halt.