1 files changed, 49 insertions, 0 deletions
diff --git a/scheme/logo.scm b/scheme/logo.scm
new file mode 100644
index 0000000..18fc9ed
--- /dev/null
+++ b/scheme/logo.scm
@@ -0,0 +1,49 @@
+
+; Equivalent to test/logo.adb
+
+
+(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)))))
+
+
+(define (run-logo args)
+  (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)))
+
+