;; ** Making Schlac into a practical language (not an interpreter) #lang pl schlac (define identity (lambda (x) x)) ;; Natural numbers (define 0 (lambda (f x) x)) (define add1 (lambda (n) (lambda (f x) (f (n f x))))) ;; same as: ;; (define add1 (lambda (n) (lambda (f x) (n f (f x))))) (define 1 (add1 0)) (define 2 (add1 1)) (define 3 (add1 2)) (define 4 (add1 3)) (define 5 (add1 4)) (test (->nat (add1 (add1 5))) => '7) (define + (lambda (m n) (m add1 n))) (test (->nat (+ 4 5)) => '9) ;; (define * (lambda (m n) (m (+ n) 0))) (define * (lambda (m n f) (m (n f)))) (test (->nat (* 4 5)) => '20) (test (->nat (+ 4 (* (+ 2 5) 5))) => '39) ;; (define ^ (lambda (m n) (n (* m) 1))) (define ^ (lambda (m n) (n m))) (test (->nat (^ 3 4)) => '81) ;; Booleans (define #t (lambda (x y) x)) (define #f (lambda (x y) y)) (define if (lambda (c t e) (c t e))) ; not really needed (test (->nat (if #t 1 2)) => '1) (test (->nat (if #t (+ 4 5) (+ '1 '2))) => '9) (define and (lambda (a b) (a b a))) (define or (lambda (a b) (a a b))) ;; (define not (lambda (a) (a #f #t))) (define not (lambda (a x y) (a y x))) (test (->bool (and #f #f)) => '#f) (test (->bool (and #t #f)) => '#f) (test (->bool (and #f #t)) => '#f) (test (->bool (and #t #t)) => '#t) (test (->bool (or #f #f)) => '#f) (test (->bool (or #t #f)) => '#t) (test (->bool (or #f #t)) => '#t) (test (->bool (or #t #t)) => '#t) (test (->bool (not #f)) => '#t) (test (->bool (not #t)) => '#f) (define zero? (lambda (n) (n (lambda (x) #f) #t))) (test (->bool (and (zero? 0) (not (zero? 3)))) => '#t) ;; Lists (define cons (lambda (x y s) (s x y))) (define car (lambda (x) (x #t))) (define cdr (lambda (x) (x #f))) (test (->nat (+ (car (cons 2 3)) (cdr (cons 2 3)))) => '5) (define 1st car) (define 2nd (lambda (l) (car (cdr l)))) (define 3rd (lambda (l) (car (cdr (cdr l))))) (define 4th (lambda (l) (car (cdr (cdr (cdr l)))))) (define 5th (lambda (l) (car (cdr (cdr (cdr (cdr l))))))) (define null (lambda (s) #t)) (define null? (lambda (x) (x (lambda (x y) #f)))) (define l123 (cons 1 (cons 2 (cons 3 null)))) ;; Note that `->listof' is a H.O. converter (test ((->listof ->nat) l123) => '(1 2 3)) (test (->listof ->nat l123) => '(1 2 3)) ; same as the above (test (->listof (->listof ->nat) (cons l123 (cons l123 null))) => '((1 2 3) (1 2 3))) ;; Subtraction is tricky (define inccons (lambda (p) (cons (cdr p) (add1 (cdr p))))) (define sub1 (lambda (n) (car (n inccons (cons 0 0))))) (test (->nat (sub1 5)) => '4) (define - (lambda (a b) (b sub1 a))) (test (->nat (- 3 2)) => '1) (test (->nat (- (* 4 (* 5 5)) 5)) => '95) (test (->nat (- 2 4)) => '0) ; this is "natural subtraction" ;; Recursive functions (define Y (lambda (f) ((lambda (x) (x x)) (lambda (x) (f (x x)))))) (rewrite (define/rec f E) => (define f (Y (lambda (f) E)))) (define/rec length (lambda (l) (if (null? l) 0 (add1 (length (cdr l)))))) (test (->nat (length l123)) => '3) (define/rec fact (lambda (x) (if (zero? x) 1 (* x (fact (sub1 x)))))) (test (->nat (fact 5)) => '120) (define/rec fib (lambda (x) (if (or (zero? x) (zero? (sub1 x))) 1 (+ (fib (sub1 x)) (fib (sub1 (sub1 x))))))) (test (->nat (fib (* 5 2))) => '89) #| ;; Fully-expanded Fibonacci (define fib ((lambda (f) ((lambda (x) (x x)) (lambda (x) (f (x x))))) (lambda (f) (lambda (x) ((lambda (c t e) (c t e)) ((lambda (a b) (a a b)) ((lambda (n) (n (lambda (x) (lambda (x y) y)) (lambda (x y) x))) x) ((lambda (n) (n (lambda (x) (lambda (x y) y)) (lambda (x y) x))) ((lambda (n) ((lambda (x) (x (lambda (x y) x))) (n (lambda (p) ((lambda (x y s) (s x y)) ((lambda (x) (x (lambda (x y) y))) p) ((lambda (n) (lambda (f x) (f (n f x)))) ((lambda (x) (x (lambda (x y) y))) p)))) ((lambda (x y s) (s x y)) (lambda (f x) x) (lambda (f x) x))))) x))) ((lambda (n) (lambda (f x) (f (n f x)))) (lambda (f x) x)) ((lambda (x y) (x (lambda (n) (lambda (f x) (f (n f x)))) y)) (f ((lambda (n) ((lambda (x) (x (lambda (x y) x))) (n (lambda (p) ((lambda (x y s) (s x y)) ((lambda (x) (x (lambda (x y) y))) p) ((lambda (n) (lambda (f x) (f (n f x)))) ((lambda (x) (x (lambda (x y) y))) p)))) ((lambda (x y s) (s x y)) (lambda (f x) x) (lambda (f x) x))))) x)) (f ((lambda (n) ((lambda (x) (x (lambda (x y) x))) (n (lambda (p) ((lambda (x y s) (s x y)) ((lambda (x) (x (lambda (x y) y))) p) ((lambda (n) (lambda (f x) (f (n f x)))) ((lambda (x) (x (lambda (x y) y))) p)))) ((lambda (x y s) (s x y)) (lambda (f x) x) (lambda (f x) x))))) ((lambda (n) ((lambda (x) (x (lambda (x y) x))) (n (lambda (p) ((lambda (x y s) (s x y)) ((lambda (x) (x (lambda (x y) y))) p) ((lambda (n) (lambda (f x) (f (n f x)))) ((lambda (x) (x (lambda (x y) y))) p)))) ((lambda (x y s) (s x y)) (lambda (f x) x) (lambda (f x) x))))) x))))))))) ;; The same after reducing all immediate function applications (define fib ((lambda (f) ((lambda (x) (x x)) (lambda (x) (f (x x))))) (lambda (f) (lambda (x) (((x (lambda (x) (lambda (x y) y)) (lambda (x y) x)) (x (lambda (x) (lambda (x y) y)) (lambda (x y) x)) (((x (lambda (p) (lambda (s) (s (p (lambda (x y) y)) (lambda (f x) (f ((p (lambda (x y) y)) f x)))))) (lambda (s) (s (lambda (f x) x) (lambda (f x) x)))) (lambda (x y) x)) (lambda (x) (lambda (x y) y)) (lambda (x y) x))) (lambda (f x) (f x)) ((f ((x (lambda (p) (lambda (s) (s (p (lambda (x y) y)) (lambda (f x) (f ((p (lambda (x y) y)) f x)))))) (lambda (y s) (s (lambda (f x) x) (lambda (f x) x)))) (lambda (x y) x))) (lambda (n) (lambda (f x) (f (n f x)))) (f ((((x (lambda (p) (lambda (s) (s (p (lambda (x y) y)) (lambda (f x) (f ((p (lambda (x y) y)) f x)))))) (lambda (s) (s (lambda (f x) x) (lambda (f x) x)))) (lambda (x y) x)) (lambda (p) (lambda (s) (s (p (lambda (x y) y)) (lambda (f x) (f ((p (lambda (x y) y)) f x)))))) (lambda (s) (s (lambda (f x) x) (lambda (f x) x)))) (lambda (x y) x))))))))) ;; Cute reformatting of the above: (define fib((lambda(f)((lambda(x)(x x))(lambda(x)(f(x x)))))(lambda( f)(lambda(x)(((x(lambda(x)(lambda(x y)y))(lambda(x y)x))(x(lambda(x) (lambda(x y)y))(lambda(x y) x))(((x(lambda(p)(lambda(s)(s(p(lambda(x y)y))(lambda(f x)(f((p(lambda(x y)y))f x))))))(lambda(s) (s(lambda(f x)x)(lambda(f x)x))))(lambda(x y)x))(lambda(x)(lambda(x y)y))(lambda (x y)x)))(lambda(f x)(f x))((f((x(lambda(p)(lambda(s)(s(p(lambda(x y )y))(lambda(f x)(f((p(lambda(x y)y))f x))))))(lambda(y s)(s(lambda(f x)x)(lambda(f x)x))))(lambda(x y)x)))(lambda(n)(lambda(f x)(f(n f x) )))(f((((x(lambda(p)(lambda(s)(s(p (lambda(x y)y))(lambda(f x)(f((p( lambda(x y) y))f x))))))(lambda(s)(s(lambda(f x)x)(lambda(f x)x))))( ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; `---------------(cons 0 0)---------------' lambda(x y)x))(lambda(p)(lambda(s)(s(p(lambda(x y)y))(lambda(f x)(f( (p(lambda(x y)y))f x))))))(lambda(s)(s(lambda(f x)x)(lambda(f x)x))) )(lambda(x y)x))))))))) ;; And for extra fun: (λ(f)(λ (x)(((x(λ( x)(λ(x y)y) )(λ(x y)x))( x(λ(x)(λ(x y) y))(λ(x y )x))((( x(λ(p)( λ(s)(s (p (λ( x y)y)) (λ(f x )(f((p( λ(x y) y))f x ))))))( λ(s)(s( λ(f x)x) (λ(f x)x) )))(λ(x y) x))(λ(x)(λ( x y)y)) (λ( x y) x)))(λ( f x)(f x))((f ((x(λ(p )(λ (s )(s(p( λ(x y) y))(λ ( f x)(f( (p (λ( x y)y) )f x))) )))(λ( y s)(s (λ (f x )x)(λ( f x)x) )))(λ( x y)x)) )(λ(n) (λ (f x)(f (n f x))) )(f((( (x(λ(p) (λ(s)(s (p( λ( x y )y ))(λ(f x) (f(( p(λ(x y )y)) f x))))) )(λ(s)( s(λ(f x )x)(λ( f x)x) ))) (λ (x y)x ))(λ(p )(λ(s)( s(p(λ( x y)y) )(λ (f x)(f(( p(λ (x y)y)) f x)))))) (λ(s)( s(λ (f x)x)(λ (f x)x) )))(λ( x y)x) )))))) |#