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}}== |
||