blob: fee72f71850801607551bef5301de46bab4d6c37 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
; Equivalent to test/logo.adb
; Place contents of mk.scm from simple-miniKanren here.
; An equivalent microKanren implementation such as from the 2013 paper will also work.
; Place contents of mkdefs.scm from simple-miniKanren here.
; Be sure to leave out the (load "mk.scm") line.
(define (value bin)
(cond
((null? bin) 0)
((zero? (car bin)) (* 2 (value (cdr bin))))
(#t (+ 1 (* 2 (value (cdr bin)))))))
(define (test pow base)
(begin
(display (string-append "log_" (number->string base) " (" (number->string pow) ") = "))
(let* ((n (build-num pow))
(b (build-num base))
(s (run 1 (d) (fresh (q r) (== d `(,q ,r)) (logo n b q r))))
(q (car (car s)))
(r (car (cdr (car s)))))
(begin
(display (value q))
(display " r ")
(display (value r))
(newline)))))
; Main program
(begin
(display "Logarithm")
(newline)
(test 1 1)
(test 68 2)
(test 68 3)
(test 68 4)
(test 68 5)
(test 68 6)
(test 68 7)
(test 68 8)
(newline)
(display "Expected Failure")
(newline)
(display (run 1 (d) (fresh (q r) (== d `(,q ,r)) (logo 68 1 q r))))
(newline)
(display (run 1 (d) (fresh (q r) (== d `(,q ,r)) (logo 68 0 q r))))
(newline)
(display (run 1 (d) (fresh (q r) (== d `(,q ,r)) (logo 0 0 q r))))
(newline))
|
