The Reasoned Schemer

miniKanren, microKanren and some implementations

 Posted on March 9, 2018  |  6 min  |  1260 words  |  Massimo Nocentini
Friedman, Daniel P. and Byrd, William E. and Kiselyov, Oleg and Hemann, Jason, 2018. The Reasoned Schemer. 2nd edition, The MIT Press,

Abstract: A new edition of a book, written in a humorous question-and-answer style, that shows how to implement and use an elegant little programming language for logic programming. The goal of this book is to show the beauty and elegance of relational programming, which captures the essence of logic programming. The book shows how to implement a relational programming language in Scheme, or in any other functional language, and demonstrates the remarkable flexibility of the resulting relational programs. As in the first edition, the pedagogical method is a series of questions and answers, which proceed with the characteristic humor that marked The Little Schemer and The Seasoned Schemer. Familiarity with a functional language or with the first five chapters of The Little Schemer is assumed. For this second edition, the authors have greatly simplified the programming language used in the book, as well as the implementation of the language. In addition to revising the text extensively, and simplifying and revising the Laws and Commandments, they have added explicit Translation rules to ease translation of Scheme functions into relations.

Tests

test/find: pass

(define (test/find _)
  (let* ((v1 (make-µkanren-var 0))
         (v2 (make-µkanren-var 1))
         (s0 µkanren-state-empty)
         (s1 (make-µkanren-state
               (cons/sbral 'a (µkanren-state-substitution s0))
               1))
         (s2 (make-µkanren-state
               (cons/sbral v1 (µkanren-state-substitution s1))
               2)))
    (⊦= 5 (µkanren-state-find 5 s2))
    (⊦= 'a (µkanren-state-find v1 s2))
    (⊦= 'a (µkanren-state-find v2 s2))))

((eta 0.002) (memory #(12582912 2287584 1048576)) (stdout "") (stderr ""))

test/=°: pass

(define (test/=° _) (⊦= '(#t) (°->list/ground (=° 'z 'z))))

((eta 0.002) (memory #(12582912 2288328 1048576)) (stdout "") (stderr ""))

test/sharing: pass

(define (test/sharing _)
  (⊦= '(((_0 z) z (_0 _1)))
        (°->list/ground
          (fresh°
            r
            (n q x)
            (=° q 'z)
            (fresh° (w r) (=° n (list w q)) (=° x (list w r)))))))

((eta 0.003) (memory #(12582912 2288168 1048576)) (stdout "") (stderr ""))

test/peano°: pass

(define (test/peano° _)
  (define-relation
    (peano° n)
    (or° (=° n 'z) (fresh° (r) (=° n `(s ,r)) (peano° r))))
  (define-relation
    (church° n)
    (fresh° (b) (=° n `(λ (s) (λ (z) ,b))) (peano° b)))
  (⊦= '(z (s z)
            (s (s z))
            (s (s (s z)))
            (s (s (s (s z))))
            (s (s (s (s (s z)))))
            (s (s (s (s (s (s z))))))
            (s (s (s (s (s (s (s z)))))))
            (s (s (s (s (s (s (s (s z))))))))
            (s (s (s (s (s (s (s (s (s z))))))))))
        (°->list/ground (take° 10 (fresh° (n) (peano° n)))))
  (⊦= '((λ (s) (λ (z) z))
          (λ (s) (λ (z) (s z)))
          (λ (s) (λ (z) (s (s z))))
          (λ (s) (λ (z) (s (s (s z)))))
          (λ (s) (λ (z) (s (s (s (s z))))))
          (λ (s) (λ (z) (s (s (s (s (s z)))))))
          (λ (s) (λ (z) (s (s (s (s (s (s z))))))))
          (λ (s) (λ (z) (s (s (s (s (s (s (s z)))))))))
          (λ (s) (λ (z) (s (s (s (s (s (s (s (s z))))))))))
          (λ (s) (λ (z) (s (s (s (s (s (s (s (s (s z))))))))))))
        (°->list/ground (take° 10 (fresh° (n) (church° n))))))

((eta 0.008) (memory #(12582912 2299336 1048576)) (stdout "") (stderr ""))

test/append°: pass

(define (test/append° _)
  (define-relation
    (append° r s rs)
    (cond°
      ((null° r) (=° s rs))
      ((fresh° (a d c) (cons° a d r) (append° d s c) (cons° a c rs)))))
  (⊦ equal?
       (list '_0
             (cons '_0 '_1)
             '(_0 _1)
             '(_0 _1 _2)
             '(_0 _1 _2 _3)
             '(_0 _1 _2 _3 _4)
             '(_0 _1 _2 _3 _4 _5)
             '(_0 _1 _2 _3 _4 _5 _6)
             '(_0 _1 _2 _3 _4 _5 _6 _7)
             '(_0 _1 _2 _3 _4 _5 _6 _7 _8))
       (µkanren-run (l 10 #t) (fresh° (a d) (append° a d l)))))

((eta 0.001) (memory #(12582912 2291488 1048576)) (stdout "") (stderr ""))

test/project°: pass

(define (test/project° _)
  (⊦= '(4700 6500 5000 5700 5700 4400 4000 5500 5300 5300)
        (°->list/ground
          (fresh°
            (r)
            (fresh°
              (d e s)
              (empsalary° d e s)
              (project° ((s* s)) (=° r (+ s* 500))))))))

((eta 0.001) (memory #(12582912 2286688 1048576)) (stdout "") (stderr ""))

test/groupby°/empty: pass

The following table has been kept from the PostgreSQL documentation example on window functions [1]:

  depname  | empno | salary |          avg
-----------+-------+--------+-----------------------
 develop   |    11 |   5200 | 5020.0000000000000000
 develop   |     7 |   4200 | 5020.0000000000000000
 develop   |     9 |   4500 | 5020.0000000000000000
 develop   |     8 |   6000 | 5020.0000000000000000
 develop   |    10 |   5200 | 5020.0000000000000000
 personnel |     5 |   3500 | 3700.0000000000000000
 personnel |     2 |   3900 | 3700.0000000000000000
 sales     |     3 |   4800 | 4866.6666666666666667
 sales     |     1 |   5000 | 4866.6666666666666667
 sales     |     4 |   4800 | 4866.6666666666666667
(10 rows)
with respect to the following query:
SELECT depname, empno, salary, avg(salary) OVER (PARTITION BY depname) FROM empsalary;

(define (test/groupby°/empty _)
  (⊦= '(47100)
        (°->list/ground
          (fresh°
            (r)
            (fresh°
              (d e s)
              (groupby°
                (((s* foldr/add) s))
                over
                ()
                from
                (empsalary° d e s)
                =>
                (=° r s*)))))))

((eta 0.001) (memory #(12582912 2306272 1048576)) (stdout "") (stderr ""))

test/groupby°/one-column: pass

(define (test/groupby°/one-column _)
  (⊦= '((personnel 7400) (sales 14600) (develop 25100))
        (sort (°->list/ground
                (fresh°
                  (r)
                  (fresh°
                    (d e s)
                    (groupby°
                      (((s* foldr/add) s))
                      over
                      (d)
                      from
                      (empsalary° d e s)
                      =>
                      (=° r `(,d ,s*))))))
              (λ (a b) (< (cadr a) (cadr b))))))

((eta 0.001) (memory #(12582912 2289784 1048576)) (stdout "") (stderr ""))

test/set°: pass

(define (test/set° _)
  (⊦= '((personnel 2) (sales 3) (develop 5))
        (sort (°->list/ground
                (fresh°
                  (r)
                  (fresh°
                    (d e s)
                    (set° (c (λ (k v) (add1 v)) 0)
                           over
                           ((d* d))
                           from
                           (empsalary° d e s)
                           =>
                           (=° r `(,d* ,c))))))
              (λ (a b) (< (cadr a) (cadr b))))))

((eta 0.001) (memory #(12582912 2289960 1048576)) (stdout "") (stderr ""))

test/enumerate°: pass

(define (test/enumerate° _)
  (⊦= '(((0 (sales))
           (1 (sales))
           (2 (sales))
           (3 (personnel))
           (4 (personnel))
           (5 (develop))
           (6 (develop))
           (7 (develop))
           (8 (develop))
           (9 (develop))))
        (°->list/ground
          (fresh°
            (r)
            (fresh°
              (d e s)
              (enumerate°
                (c (λ (i k) (list i (list k))))
                over
                (d)
                from
                (empsalary° d e s)
                =>
                (=° r c)))))))

((eta 0.001) (memory #(12582912 2303216 1048576)) (stdout "") (stderr ""))

test/window°: pass

(define (test/window° _)
  (⊦= '((develop 7 4200 5020)
          (develop 8 6000 5020)
          (develop 9 4500 5020)
          (develop 10 5200 5020)
          (develop 11 5200 5020)
          (personnel 2 3900 3700)
          (personnel 5 3500 3700)
          (sales 1 5000 14600/3)
          (sales 3 4800 14600/3)
          (sales 4 4800 14600/3))
        (°->list/ground
          (fresh°
            (r)
            (fresh°
              (d e s)
              (window°
                (((s* foldr/avg) s))
                over
                (d)
                from
                (empsalary° d e s)
                =>
                (=° r `(,d ,e ,s ,s*)))))))
  (⊦= '((develop 7 4200 4710)
          (develop 8 6000 4710)
          (develop 9 4500 4710)
          (develop 10 5200 4710)
          (develop 11 5200 4710)
          (personnel 2 3900 4710)
          (personnel 5 3500 4710)
          (sales 1 5000 4710)
          (sales 3 4800 4710)
          (sales 4 4800 4710))
        (°->list/ground
          (fresh°
            (r)
            (fresh°
              (d e s)
              (window°
                (((s* foldr/avg) s))
                over
                ()
                from
                (empsalary° d e s)
                =>
                (=° r `(,d ,e ,s ,s*))))))))

((eta 0.003) (memory #(12582912 2292672 1048576)) (stdout "") (stderr ""))

test/=°/structure: pass

(define (test/=°/structure _)
  (define-record person name age)
  (define p (make-person 'alice 30))
  (⊦= #t (record-instance? p))
  (⊦= `((record ,p))
        (°->list/ground (fresh° (r) (=° r (list 'record p)))))
  (⊦= `((record ,(make-person '_0 30)))
        (°->list/ground
          (fresh° (r a) (=° r (list 'record (make-person a 30)))))))

((eta 0.002) (memory #(12582912 2292176 1048576)) (stdout "") (stderr ""))

test/=°/structure/vector: pass

(define (test/=°/structure/vector _)
  (define-record person name age)
  (define p (make-person 'alice 30))
  (⊦= #t (record-instance? p))
  (⊦= #(person alice 30) (record->vector p))
  (⊦= '((person alice 30))
        (°->list/ground (fresh° r (t n a) (=° `#(,t ,n ,a) p)))))

((eta 0.001) (memory #(12582912 2292648 1048576)) (stdout "") (stderr ""))
References
[1] PostgreSQL Window Functions