Prolog and Scheme playground

Two of the most mind-expanding languages, runnable here.

Prolog

The program is real SWI-Prolog compiled to WebAssembly. Write facts and rules, then ask questions on lines that start with ?-. Each query prints its answers (up to 25), true, or false.

A family tree: facts, rules, and recursive queries

parent(tom, bob).
parent(tom, liz).
parent(bob, ann).
parent(bob, pat).
parent(pat, jim).

grandparent(G, C) :- parent(G, P), parent(P, C).
ancestor(A, D) :- parent(A, D).
ancestor(A, D) :- parent(A, X), ancestor(X, D).
sibling(X, Y) :- parent(P, X), parent(P, Y), X \= Y.

?- grandparent(tom, Who).
?- ancestor(tom, jim).
?- sibling(ann, S).
?- findall(D, ancestor(bob, D), Ds), length(Ds, N).

Eight queens, by constraint solving

:- use_module(library(clpfd)).

queens(N, Qs) :-
    length(Qs, N),
    Qs ins 1..N,
    safe(Qs),
    labeling([ff], Qs).

safe([]).
safe([Q|Qs]) :- no_attack(Q, Qs, 1), safe(Qs).

no_attack(_, [], _).
no_attack(Q, [Q1|Qs], D) :-
    Q #\= Q1,
    abs(Q - Q1) #\= D,
    D1 is D + 1,
    no_attack(Q, Qs, D1).

?- queens(8, Qs).
?- aggregate_all(count, queens(6, _), Solutions).

Scheme

BiwaScheme is a Scheme (R6RS/R7RS-ish) interpreter. The value of the last expression is shown after ⇒.

Closures and higher-order functions

(define (make-counter)
  (let ((n 0))
    (lambda () (set! n (+ n 1)) n)))

(define c1 (make-counter))
(define c2 (make-counter))
(c1) (c1) (c2)
(display (list (c1) (c2))) (newline)

(define (compose . fs)
  (if (null? fs) (lambda (x) x)
      (lambda (x) ((car fs) ((apply compose (cdr fs)) x)))))

(define inc-then-double (compose (lambda (x) (* 2 x)) (lambda (x) (+ x 1))))
(display (map inc-then-double '(1 2 3 4))) (newline)

(filter odd? (map (lambda (x) (* x x)) (iota 10)))

Tail recursion and quasiquote: a tiny symbolic differentiator

(define (deriv e x)
  (cond ((number? e) 0)
        ((symbol? e) (if (eq? e x) 1 0))
        ((eq? (car e) '+) `(+ ,(deriv (cadr e) x) ,(deriv (caddr e) x)))
        ((eq? (car e) '*) `(+ (* ,(cadr e) ,(deriv (caddr e) x))
                              (* ,(deriv (cadr e) x) ,(caddr e))))
        (else (error "unknown expression" e))))

(define (simplify e)
  (if (not (pair? e)) e
      (let ((op (car e)) (a (simplify (cadr e))) (b (simplify (caddr e))))
        (cond ((and (eq? op '+) (eqv? a 0)) b)
              ((and (eq? op '+) (eqv? b 0)) a)
              ((and (eq? op '*) (or (eqv? a 0) (eqv? b 0))) 0)
              ((and (eq? op '*) (eqv? a 1)) b)
              ((and (eq? op '*) (eqv? b 1)) a)
              ((and (number? a) (number? b)) (if (eq? op '+) (+ a b) (* a b)))
              (else (list op a b))))))

(define (sum-to n acc) (if (= n 0) acc (sum-to (- n 1) (+ acc n))))
(display (sum-to 100000 0)) (newline)

(simplify (deriv '(+ (* x x) (* 3 x)) 'x))