assoc.scm 1.78 KB
Newer Older
1 2 3
(use-modules (logic guile-log iso-prolog))
(use-modules (logic guile-log guile-prolog hash))
(use-modules (logic guile-log guile-prolog ops))
4 5
(use-modules (logic guile-log vlist))
(use-modules (logic guile-log))
6 7 8 9 10 11 12 13 14 15 16 17 18 19
(use-modules (language prolog modules library assoc))


(compile-prolog-string
"
f([(N-N)|X],N) :- N > 0 -> (NN is N - 1, f(X,NN)) ; X=[].
runner1(N,A,S) :- N > 0 -> (get_assoc(N,A,V), 
                            SS is S + V, 
                            NN is N - 1,
                            runner1(NN,A,SS)) ; (write(res(S)), nl).
runner2(N,A,S) :- N > 0 -> (vhashq_ref(A,N,V), 
                            SS is S + V, 
                            NN is N - 1,
                            runner2(NN,A,SS)) ; (write(res(S)), nl).
20 21 22 23
runner4(N,A,S) :- N > 0 -> (vhash_ref(A,N,V), 
                            SS is S + V, 
                            NN is N - 1,
                            runner4(NN,A,SS)) ; (write(res(S)), nl).
24 25 26 27

ltoh([],H).
ltoh([K-V|L],H) :- vhashq_cons(H,K,V), ltoh(L,H).

28 29 30
ltoh4([],H).
ltoh4([K-V|L],H) :- vhash_cons(H,K,V), ltoh4(L,H).

31 32
do1(N,M,A) :- M > 0 -> (runner1(N,A,0), MM is M - 1, do1(N,MM,A)) ; true.
do2(N,M,A) :- M > 0 -> (runner2(N,A,0), MM is M - 1, do2(N,MM,A)) ; true.
33
do4(N,M,A) :- M > 0 -> (runner4(N,A,0), MM is M - 1, do4(N,MM,A)) ; true.
34 35
run1(N,M) :- once((f(L,N), list_to_assoc(L,A), do1(N,M,A))).
run2(N,M) :- once((f(L,N), make_vhash(A), ltoh(L,A), do2(N,M,A))).
36
run4(N,M) :- once((f(L,N), make_vhash(A), ltoh4(L,A), do4(N,M,A))).
37
")
38 39 40 41 42 43 44 45 46 47 48 49

(<define> (run3 n m)
  (<let*> ((h (let lp ((h vlist-null) (n n))
		(if (> n 0)
		    (lp (vhash-consq n n h) (- n 1))
		    h))))
    (<recur> lp1 ((m m))
      (when (> m 0)
        (<recur> lp2 ((n n) (s 0))
	  (if (> n 0)
	      (lp2 (- n 1) (+ s (vhashq-ref h n #f)))
	      (<and> (write s) (nl) (lp1 (- m 1)))))))))