vmtest.scm 1.39 KB
Newer Older
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
1 2
(use-modules (logic guile-log iso-prolog))
(use-modules (logic guile-log guile-prolog ops))
3
(use-modules (logic guile-log guile-prolog vm-compiler))
4

5 6 7 8 9 10
#;
(eval-when (compile)
(pk (prolog-run-rewind 1 (x) 
		   (dyntrace (@@ (logic guile-log guile-prolog vm vm-goal2) 
				 compile_goal)))))
#;
11 12 13 14 15 16
(compile-prolog-string
"
- eval_when(compile).
the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
")
17

18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
(compile-prolog-string
"
compiles_only_clauses.
")


(define-prolog q "
q(Code,Narg) :-
  (
    Code = (F(|A) :- Goal) -> length(A,Narg) ;
    Code = (F     :- Goal) -> Narg = 0       ;
    throw(compiles_only_clauses(Code))
  ).
")

33 34 35 36 37 38 39
(define-prolog b "
  b(X,Y) :- Y is X + 1.
")

(define-prolog a "
  a(X,Z) :- b(X,Y),b(Y,Z)
")
40

41
#;
42
(define-prolog f1 "
43
   f1(N,I,J,S) :- 
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
44 45 46 47 48 49 50 51 52
      I < N -> 
        (
          II is I + 1, 
          JJ is J + I, 
          f1(N,II,JJ,S)
        ) ; 
      S=J
  ")

53
#;
54 55 56 57 58 59 60 61 62 63
(define-prolog f0 "
   f1(N,I,J,S) :- 
      I > N -> S=J ;
        (
          II is I + 1, 
          JJ is J + I, 
          f1(N,II,JJ,S)
        ).
  ")

64
#;
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
65 66 67 68 69 70 71 72 73 74 75 76 77 78
(define-prolog f2 "
   f2(N,S) :-
     recur * lp((I,0),(J,0)),
       (
         I < N ->
           (
             II is I + 1,
             JJ is J + I,
             lp(II,JJ)
           ) ;
         S=J
       ).
")

79
#;
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
80 81 82 83 84 85 86 87 88 89
(define-prolog memb "
   memb(X,L) :-
     recur * lp((LL,L)),
        LL=[A|B],
        (
          A=X;
          lp(B)
        ).
")

90

91 92