Church numerals: Difference between revisions

Content added Content deleted
imported>Rowsety Moid
No edit summary
imported>Rowsety Moid
No edit summary
Line 681: Line 681:
81
81
64</pre>
64</pre>

=={{header|Common Lisp}}==

===Uncurried Church numerals===

{{trans|Acornsoft Lisp}}

<syntaxhighlight lang="lisp">
(defvar zero (lambda (f x) x))

(defvar one (lambda (f x) (funcall f x)))

(defun succ (n) (lambda (f x) (funcall f (funcall n f x))))

(defun plus (m n)
(lambda (f x) (funcall m f (funcall n f x))))

(defun times (m n)
(funcall n (lambda (sum) (plus m sum)) zero))

(defun power (m n)
(funcall n (lambda (product) (times m product)) one))

(defun church (i)
(if (zerop i) zero (succ (church (1- i)))))

(defun unchurch (n)
(funcall n #'1+ 0))

(defun show (example)
(format t "~(~S => ~S~)~%"
example (unchurch (eval example))))

(defvar two (succ one))
(defvar three (succ two))
(defvar four (succ three))

(show '(church 3))
(show '(plus three four))
(show '(times three four))
(show '(power three four))
(show '(power four three))
(show '(power (power two two) (plus two one)))
</syntaxhighlight>

{{Out}}

<pre>
(church 3) => 3
(plus three four) => 7
(times three four) => 12
(power three four) => 81
(power four three) => 64
(power (power two two) (plus two one)) => 64
</pre>

===Curried Church numerals===

<syntaxhighlight lang="lisp">
(defvar one (lambda (f) (lambda (x) (funcall f x))))

(defun succ (n) (lambda (f) (compose f (funcall n f))))

(defun plus (m n)
(lambda (f) (compose (funcall m f) (funcall n f))))

(defun times (m n)
(compose m n))

(defun power (m n)
(funcall n m))

(defun compose (f g)
(lambda (x) (funcall f (funcall g x))))

(defun church (i)
(if (zerop i) zero (succ (church (1- i)))))

(defun unchurch (n)
(funcall (funcall n #'1+) 0))
</syntaxhighlight>

The remaining definitions, the calls to <code>show</code>, and the resulting output are the same as in uncurried version above.

===Further Church numerals===

<syntaxhighlight lang="lisp">
(defun pred (n)
(flet ((value (v) (lambda (h) (funcall h v)))
(extract (k) (funcall k (lambda (u) u))))
(lambda (f x)
(let ((inc (lambda (g) (value (funcall g f))))
(const (lambda (u) x)))
(extract (funcall n inc const))))))

(defun minus (m n)
(funcall n #'pred m))

(defmacro church-if (test then else)
`(funcall ,test (lambda () ,then) (lambda () ,else)))

(defvar true (lambda (f g) (funcall f)))
(defvar false (lambda (f g) (funcall g)))

(defun bool (v) (if v true false))

(defun unbool (b)
(church-if b t nil))

(defun is-zero (n)
(funcall n (lambda (x) false) true))

(defun divide (m n)
(divide1 (succ m) n))

(defun divide1 (m n)
(let ((d (minus m n)))
(church-if (is-zero d)
zero
(succ (divide1 d n)))))

(show '(pred four))
(show '(minus (church 11) three))
(show '(divide (church 11) three))
(show '(divide (church 12) three))
</syntaxhighlight>

{{Out}}

<pre>
(pred four) => 3
(minus (church 11) three) => 8
(divide (church 11) three) => 3
(divide (church 12) three) => 4
</pre>

===Further, curried===

<syntaxhighlight lang="lisp">
(defun pred (n)
(flet ((value (v) (lambda (h) (funcall h v)))
(extract (k) (funcall k (lambda (u) u))))
(lambda (f)
(lambda (x)
(let ((inc (lambda (g) (value (funcall g f))))
(const (lambda (u) x)))
(extract (funcall (funcall n inc) const)))))))

(defun minus (m n)
(funcall (funcall n #'pred) m))

...

(defun is-zero (n)
(funcall (funcall n (lambda (x) false)) true))

...
</syntaxhighlight>

=={{header|Crystal}}==
=={{header|Crystal}}==