Primitive recursion

pr.scm

(use-modules (srfi srfi-26))

;; Zero function
(define Z (lambda _ (const 0))) 

;; Successor function
(define (S n) (+ n 1)) 

;; Projector function
(define (P i) ; 
  (lambda args (list-ref args (- i 1))))

;; Composition / Substitution
(define (C f . gs)
  (lambda args (apply f (map (lambda (g) (apply g args)) gs))))

;; Recursion
(define (R n . args)
  (lambda (f g)
    (letrec* ((recurse-iter (lambda (i j result)
			  (if (<= i n)
			      (recurse-iter (+ i 1) (+ j 1) (apply (cut g j result <...>) args))
			      result))))
      (recurse-iter 1 0 (apply f args)))))

;; What follows are derivations of the 3 functions closed under composition and recursion.
;; Any function obtained is by definition computable and primitive recursive

;; Constant function
(define (k n) (lambda _ n))

;; addition
(define (add x y)
  (let ((f (P 1))
	(g (C S (P 2))))
    ((R x y) f g)))

;; multiplication
(define (mul x y)
  (let ((f (Z))
	(g (C add (P 2) (P 3))))
    ((R x y) f g)))

;; exponentiation
(define (pow x y)
  (let ((f (k 1))
        (g (C mul (P 2) (P 3))))
    ((R y x) f g)))

;; factorial
(define (fac n)
  (let ((f (k 1))
	(g (C mul (P 2) (C S (P 1)))))
    ((R n) f g)))

;; predecessor
(define (pred n)
  (let ((f (Z))
	(g (P 1)))
    ((R n) f g)))

;; zero predicate function
(define (z n)
  (let ((f (k 1))
	(g (Z)))
    ((R n) f g)))

;; subtraction
(define (sub x y)
  (let ((f (P 1))
	(g (C pred (P 2))))
    ((R y x) f g)))

;; alternate between 0 and 1
(define (alt x)
  (let ((f (k 1))
	(g (C sub (k 1) (P 2))))
    ((R x) f g)))

;; less or equal
(define (le x y)
  ((C z sub) x y))

;; greater or equal
(define (ge x y)
  ((C le (P 2) (P 1)) x y))

;; if-then-else
(define (ite x y z)
  (let ((f (P 2))
	(g (P 3)))
    ((R x y z) f g)))

;; equal
(define (eq x y)
  (& (le x y) (ge x y)))

;; double
(define (double n)
  ((C add (P 1) (P 1)) n))

;; identity

(define (id n)
  ((P 1) n))

;; Boolean

(define (bool x)
  (let ((f (Z))
        (g (k 1)))
    ((R x) f g)))

;; Conjunction

(define & (C bool mul))

;; Disjunction
(define or (C bool add))

;; Negation
(define (not x)
  (let ((f (k 1))
        (g (Z)))
    ((R x) f g)))

;; Exclusive or
(define (xor x y)
  (let ((f (P 1))
        (g (C not (P 2))))
    ((R x y) f g)))

;; less than
(define (lt x y)
  ((C not ge) x y))

;; Min
(define (min x y)
  (sub y (sub y x)))

;; Max
(define (max x y)
  (sub (add x y) (min x y)))

;; Greater than
(define (gt x y)
  ((C not le) x y))

;; Distance
(define (dist x y )
  ((C add sub (C sub (P 2) (P 1))) x y))

;; Modulo

(define (mod* x y)
  (let ((f (Z))
        (g (C ite (C lt (C S (P 2)) (P 3)) (C S (P 2)) (Z))))
    ((R x y) f g)))

(define (mod x y)
  ((C ite (C z (P 2)) (P 1) (C mod* (P 1) (P 2))) x y))

;; Divisible
(define (divisible x y)
  ((C z mod) x y))

;; is Prime?
(define (prime n)
  (let ((f (Z))
        (g (C add (C divisible (P 3) (P 1)) (P 2))))
    ((C eq (k 1) (lambda () ((R n n) f g))))))

;; is Even?
(define even alt)

;; is Odd?
(define odd (C not alt))

;; Division / ceiling
(define (ceil x y)
  (let ((f (k 0))
        (g (C ite (C mod (P 1) (P 3)) (P 2) (C S (P 2)))))
    ((R x y) f g)))

;; Division / floor
(define (floor x y)
  (let ((f (k 0))
        (g (C ite (C mod (C S (P 1)) (P 3)) (P 2) (C S (P 2)) )))
    ((R x y) f g)))

;; Case 
(define (case n)
  (lambda (f h r)
    (add (mul (f n) (bool (r n))) (mul (h n) (not (r n))))))

;;; Your turn now. Please leave in the comments below the solution to the following exercises
;;; 1. Collapse the modulo functions, currently split in mod* and mod, into one. 
;;; 2. Write a function that takes n and returns the nth prime.