I am trying to do the exercises on this tutorial about CLOS using SBCL and Slime (Emacs).
I have this class, instance, and function to set values for the slots:
(defclass point ()
(x y z))
(defvar my-point
(make-instance 'point))
(defun with-slots-set-point-values (point a b c)
(with-slots (x y z) point (setf x a y b z c)))
Using the REPL, it works fine:
CL-USER> (with-slots-set-point-values my-point 111 222 333)
333
CL-USER> (describe my-point)
#<POINT {1003747793}>
[standard-object]
Slots with :INSTANCE allocation:
X = 111
Y = 222
Z = 333
; No value
Now, the exercises indicates that using the symbol-macrolet I need to implement my version of with-slots.
I have a partial implementation of my with-slots (I still need to insert add the operation):
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) (slot-value object var)) slot-list)))
It works when calling it:
CL-USER> (partial-my-with-slots '(x y z) my-point)
((X 111) (Y 222) (Z 333))
Since this use of symbol-macrolet works:
CL-USER> (symbol-macrolet ((x 111) (y 222) (z 333))
(+ x y z))
666
I tried doing:
CL-USER> (symbol-macrolet (partial-my-with-slots '(x y z) my-point)
(+ x y z))
But, for some reason that I do not know, Slime throws the error:
malformed symbol/expansion pair: PARTIAL-MY-WITH-SLOTS
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Why does this happen? How can I fix this?
You can't write with-slots as a function which is called at run time. Instead it needs to be a function which takes source code as an argument and returns other source code. In particular if given this argument
(my-with-slots (x ...) <something> <form> ...)
It should return this result:
(let ((<invisible-variable> <something))
(symbol-macrolet ((x (slot-value <invisible-variable>)) ...)
<form> ...))
You need <invisible-variable> so you evaluate <object-form> only once.
Well, here is a function which does most of that:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
`(let ((<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value <invisible-variable>
',slot-name)))
slot-names)
,#forms))))
And you can check this:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((<invisible-variable> a))
(symbol-macrolet ((x (slot-value <invisible-variable> 'x))
(y (slot-value <invisible-variable> 'y)))
(list x y)))
So that's almost right, except the invisible variable really needs to be invisible:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable>
',slot-name)))
slot-names)
,#forms)))))
And now:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((#:g1509 a))
(symbol-macrolet ((x (slot-value #:g1509 'x))
(y (slot-value #:g1509 'y)))
(list x y)))
Well, a function which takes source code as an argument and returns other source code is a macro. So, finally, we need to install this function as a macroexpander, arranging to ignore the second argument that macro functions get:
(setf (macro-function 'mws)
(lambda (form environment)
(declare (ignore environment))
(mws-expander form)))
And now:
> (macroexpand '(mws (x y) a (list x y)))
(let ((#:g1434 a))
(symbol-macrolet ((x (slot-value #:g1434 'x)) (y (slot-value #:g1434 'y)))
(list x y)))
This would be more conventionally written using defmacro, of course:
(defmacro mws ((&rest slot-names) object-form &rest forms)
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable> ',slot-name)))
slot-names)
,#forms))))
However the two definitions are equivalent (modulo needing some eval-whenery to make the first work properly with the compiler).
You need to return expressions that will call slot-value when substituted into the macro expansion, rather than calling the function immediately. Backquote is useful for this.
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) `(slot-value ,object ',var)) slot-list)))
> (partial-my-with-slots '(x y z) 'my-point)
((x (slot-value my-point 'x)) (y (slot-value my-point 'y)) (z (slot-value my-point 'z)))
You use this in your with-slots macro like this:
(defmacro my-with-slots ((&rest slot-names) instance-form &body body)
`(symbol-macrolet ,(partial-my-with-slots slot-names instance-form)
,#body))
> (macroexpand '(my-with-slots (x y z) point (setf x a y b z c)))
(SYMBOL-MACROLET ((X (SLOT-VALUE POINT 'X))
(Y (SLOT-VALUE POINT 'Y))
(Z (SLOT-VALUE POINT 'Z)))
(SETF X A
Y B
Z C))
Related
The Common Lisp HyperSpec covers the with-slots macro. However, the example is hard to grasp.
Is there an easier and more didactic example about it?
To better understand with-slots, one should look into defclass first.
No reader or writer functions are defined by default; their generation must be explicitly requested. However, slots can always be accessed using slot-value.
It means that, unless specific request, defclass don't create any accessor for the slots:
> (defclass point ()
(x y))
(let ((new-point (make-instance 'point)))
(setf (point-x new-point) 1))
Error: The function (COMMON-LISP:SETF COMMON-LISP-USER::POINT-X) is undefined.
In this case, one must use the slot-value function to access or modify the slot value.
(defclass point ()
(x y))
(let ((new-point (make-instance 'point)))
(setf (slot-value new-point 'x) 1))
Obviously, when there are several slots to update, the code become a little cumbersome:
(defmethod translate ((point-instance point) delta-x delta-y)
(setf (slot-value point-instance 'x)
(+ (slot-value point-instance 'x) delta-x))
(setf (slot-value point-instance 'y)
(+ (slot-value point-instance 'y) delta-y)))
For that reason, the with-slots macro can make the code easier to read:
(defmethod translate ((point-instance point) delta-x delta-y)
(with-slots (x y) point-instance
(setf x (+ x delta-x))
(setf y (+ y delta-y))))
Yes. This (great) tutorial of 2003 has a good one from the geometry domain.
Create a class to represent points in 3-dimensions:
(defclass point ()
(x y z))
Create a variable to instantiate the class and a function to set the values:
(defvar my-point
(make-instance 'point))
(defun set-point-values (point x y z)
(setf (slot-value point 'x) x
(slot-value point 'y) y
(slot-value point 'z) z))
In the REPL, do:
CL-USER 17 > (set-point-values my-point 3 4 12)
12
Now, think about a function to compute the distance between points. A brute force way would be:
(defun brute-force-distance-from-origin (point)
(let ((x (slot-value point 'x))
(y (slot-value point 'y))
(z (slot-value point 'z)))
(sqrt (+ (* x x)
(* y y)
(* z z)))))
Using the with-slots macro:
(defun distance-from-origin (point)
(with-slots (x y z) point (sqrt (+ (* x x)
(* y y)
(* z z)))))
Calling the function in the REPL works as expected:
CL-USER> (distance-from-origin my-point)
13.0
In Common Lisp, I can get a function to pass around with the #' syntax, like this:
(let ((x #'+))
(funcall x 1 2))
But suppose I want to set a function so I don't have to use funcall for it. Does Common Lisp have a local function name table, or just the global one that is assigned to with defun?
Is there a way to assign to a function symbol other than defun? Or more generally: is there a way I can do something similar to this nonworking example:
(setf #'x #'+)
(x 1 2)
You can define a local function using
flet and labels:
(flet ((f (x) (1+ (* 2 x))))
(f 7))
==> 15
You can also set function definition of a symbol using fdefinition:
(setf (fdefinition 'f) #'+)
(f 1 2 3)
==> 6
Note that let binds the
value cell of the symbol while flet bind the function cell.
When the symbol appears in the "function" position, the "function"
cell is used, while when it appears in the "value" position, the "value"
cell is used:
(setf (symbol-function 'x) #'car)
(setf (symbol-value 'x) #'cdr)
(x '(1 . 2))
==> 1
(funcall x '(1 . 2))
==> 2
Similarly,
(flet ((x (o) (car o)))
(let ((x #'cdr))
(cons (x '(1 . 2))
(funcall x '(1 . 2)))))
==> (1 . 2)
This is the difference between Lisp-1 and Lisp-2.
Finally, note that CLISP is just one implementation of the language ANSI Common Lisp.
One option for getting this kind of behavior is to write a macro to do it.
(defmacro flet* (assignments &body body)
(let ((assignments (mapcar
(lambda (assn)
(list (first assn) '(&rest args)
(list 'apply (second assn) 'args)))
assignments)))
`(flet ,assignments ,#body)))
This macro translates flet* into flet + apply like this:
(flet* ((x #'+)
(y #'*))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
Becomes:
(flet ((x (&rest args) (apply #'+ args))
(y (&rest args) (apply #'* args)))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
Is there a way to do this:
(let ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
35 ;; value returned from LET
*current-form-value* ;; variable to hold the form
(let ((x 5))(y 7))(* x y)) ;; value of evaluating *current-form-value*
If it can be done, pseudo-code will suffice. I'll naively assume that this would have to be done with read, however, if there is too much overhead generated from doing this, I will have to find another solution. Thanks.
No its not possible by default. Doing so would need some advanced code and is not likely to work easily:
custom evaluator
code walker which injects the necessary code
I've been fiddling a little around and came up with this. It's not exactly what you want but it's close. It it were possible to rename let and make your own it would be exactly what you want.
(defmacro letc (p &body b)
(when (equal (car b) '(get-outer-form))
(setq b `((setf *current-form-value* '(let ,p ,#(cdr b))),#(cdr b))))
`(let ,p ,#b))
(letc ((x 5)(y 7))
(get-outer-form) ;; 'get-outer-form would capture the entire LET expression
(* x y))
;; ==> 35
*current-form-value*
;; ==> (let ((x 5) (y 7)) (* x y))
Or simpler. Using letc implies you want it captured.
(defmacro letc (p &body b)
`(let ,p (setf *current-form-value* '(letc ,p ,#b)),#b)))
(letc ((x 5)(y 7))
(* x y))
;; ==> 35
*current-form-value*
;; ==> (letc ((x 5) (y 7)) (* x y))
Both of them have problems with nesting:
(letc ((x 5)(y 7))
(letc ((a (+ x y)))
(* 2 a)))
;; ==> 24
*current-form-value*
;; ==> (let ((a (+ x y))) (* 2 a))
I think Rainer is basically correct, but I couldn't help trying for a subset of your goal with either *macroexpand-hook* or a reader approach. I don't bother removing (get-outer-form) from the current form in either case, but that should be straightforward list manipulation.
First a reader approach. Wrap the open parenthesis reader with a function that searches for (get-outer-form) within the result of calling the default open parenthesis reader.
;(in-package |cl-user|)
(defparameter *standard-readtable* (copy-readtable ()))
*STANDARD-READTABLE*
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun get-outer-form ()
())
GET-OUTER-FORM
;(in-package |cl-user|)
(defun get-outer-form-paren-reader (stream char &optional count)
(declare (ignore count))
(let* ((seen ())
(paren-reader
(get-macro-character #\( *standard-readtable*))
(form (funcall paren-reader stream char)))
(subst-if ()
(lambda (x)
;; never substitute, search only.
(prog1 ()
(when (equalp x '(get-outer-form))
(setq seen t))))
form)
(when seen
(setq *current-form-value* form))
form))
GET-OUTER-FORM-PAREN-READER
;(in-package |cl-user|)
(set-macro-character #\( #'get-outer-form-paren-reader)
T
Second, a *macroexpand-hook* approach. Look for (get-outer-form) in forms before they are macroexpanded.
;(in-package |cl-user|)
(defun get-outer-form ()
(error "get-outer-form only works from within a macro"))
GET-OUTER-FORM
;(in-package |cl-user|)
(defvar *current-form-value* ())
*CURRENT-FORM-VALUE*
;(in-package |cl-user|)
(defun mhook (expander form env)
(let* ((seen ())
(fixed (subst-if ()
(lambda (x)
(when (equalp x '(get-outer-form))
(setq seen t)))
form)))
(when seen (setq *current-form-value* form))
(funcall expander fixed env)))
MHOOK
;(in-package |cl-user|)
(setq *macroexpand-hook* #'mhook)
#<Compiled-function MHOOK #x30200FC5BB1F>
The problem with flet is that the functions bound therein must be defined inline. In other words, there's no way to do this:
(new-flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (function-generator)))
(a #'b 10))
I considered defining such a macro myself, but the problem is that flet seems to be the only way to set local function values. symbol-function always gets the global definition only, and function can't be used with setf. Anyone have an idea how this can be done fairly cleanly, if at all?
You can easily build a trampoline
(defun function-generator (x)
(lambda (y) (* x y)))
(let ((fg (function-generator 42)))
(flet ((a (f x) (funcall f (* x 2)))
(b (x) (funcall fg x)))
(a #'b 10)))
A macro implementation of new-flet with this approach is
(defmacro new-flet (bindings &body body)
(let ((let-bindings (list))
(flet-bindings (list))
(args (gensym)))
(dolist (binding bindings)
(let ((name (gensym)))
(push `(,name ,(second binding))
let-bindings)
(push `(,(first binding) (&rest ,args)
(apply ,name ,args))
flet-bindings)))
`(let ,(nreverse let-bindings)
(flet ,(nreverse flet-bindings)
,#body))))
that expands in your example case as
(macroexpand-1 '(new-flet ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(a #'b 10)))
==> (LET ((#:G605 (LAMBDA (F X)
(FUNCALL F (* X 2))))
(#:G606 (FUNCTION-GENERATOR)))
(FLET ((A (&REST #:G604)
(APPLY #:G605 #:G604))
(B (&REST #:G604)
(APPLY #:G606 #:G604)))
(A #'B 10)))
Is
(let* ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(funcall a b 10))
a fairly clean solution to your problem?
How about binding the variables with let, so that they're setfable, and then using an flet as the body of the let so that they're funcallable and (function …)-able, too. E.g., where I've given a silly little function instead of (generate-function):
(let ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(flet ((a (&rest args)
(apply a args))
(b (&rest args)
(apply b args)))
(a #'b 10)))
We can wrap this up in a macro relatively easily:
(defmacro let/flet (bindings &body body)
(let ((args (gensym (string '#:args-))))
`(let ,bindings
(flet ,(loop :for (name nil) :in bindings
:collect `(,name (&rest ,args) (apply ,name ,args)))
,#body))))
Now
(let/flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(a #'b 10))
expands into the first block of code. Note that you can also use (a b 10) in the body as well, since the binding of b is the same as the value of #'b. You can use setf on the variable as well:
(let/flet ((a (lambda (x)
(print (list 'from-a x)))))
(a 23)
(setf a (lambda (x)
(print (list 'from-new-a x x))))
(a 23))
prints
(FROM-A 23)
(FROM-NEW-A 23 23)
If anyone's interested in a labels equivalent, here it is:
(defmacro my-labels ((&rest definitions) &rest body)
(let ((gensyms (loop for d in definitions collect (gensym)))
(names (loop for d in definitions collect (car d)))
(fdefs (loop for f in definitions collect (cadr f)))
(args (gensym)))
`(let (,#(loop for g in gensyms collect (list g)))
(labels (,#(loop for g in gensyms for n in names
collect `(,n (&rest ,args) (apply ,g ,args))))
,#(loop for g in gensyms for f in fdefs
collect `(setf ,g ,f))
,#body))))
This is sort of like Scheme's letrec.
I'm trying to implement a Division function with clisp Lambda Calc. style
I read from this site that lambda expression of a division is:
Y (λgqab. LT a b (PAIR q a) (g (SUCC q) (SUB a b) b)) 0
These are TRUE and FALSE
(defvar TRUE #'(lambda(x)#'(lambda(y)x)))
(defvar FALSE #'(lambda(x)#'(lambda(y)y)))
These are conversion functions between Int and Church numbers
(defun church2int(numchurch)
(funcall (funcall numchurch #'(lambda (x) (+ x 1))) 0)
)
(defun int2church(n)
(cond
((= n 0) #'(lambda(f) #'(lambda(x)x)))
(t #'(lambda(f) #'(lambda(x) (funcall f
(funcall(funcall(int2church (- n 1))f)x))))))
)
This is my IF-THEN-ELSE Implementation
(defvar IF-THEN-ELSE
#'(lambda(c)
#'(lambda(x)
#'(lambda(y)
#'(lambda(acc1)
#'(lambda (acc2)
(funcall (funcall (funcall (funcall c x) y) acc1) acc2))))))
)
And this is my div implementation
(defvar division
#'(lambda (g)
#'(lambda (q)
#'(lambda (a)
#'(lambda (b)
(funcall (funcall (funcall (funcall (funcall IF-THEN-ELSE LT) a) b)
(funcall (funcall PAIR q)a))
(funcall (funcall g (funcall succ q)) (funcall (funcall sub a)b))
)))))
)
PAIR, SUCC and SUB functions work fine. I set my church numbers up like this
(set six (int2church 6))
(set two (int2church 2))
Then I do:
(setq D (funcall (funcall division six) two))
And I've got:
#<FUNCTION :LAMBDA (A)
#'(LAMBDA (B)
(FUNCALL (FUNCALL (FUNCALL (FUNCALL (FUNCALL IF-THEN-ELSE LT) A) B) (FUNCALL (FUNCALL PAR Q) A))
(FUNCALL (FUNCALL G (FUNCALL SUCC Q)) (FUNCALL (FUNCALL SUB A) B))))>
For what I understand, this function return a Church Pair. If I try to get the first element
with a function FRST (FRST works ok) like this:
(funcall frst D)
I've got
#<FUNCTION :LAMBDA (B)
(FUNCALL (FUNCALL (FUNCALL (FUNCALL (FUNCALL IF-THEN-ELSE LT) A) B) (FUNCALL (FUNCALL PAR Q) A))
(FUNCALL (FUNCALL G (FUNCALL SUCC Q)) (FUNCALL (FUNCALL SUB A) B)))>
If I try to get the int value with Church2int (Church2int works OK) like this:
(church2int (funcall frst D))
I've got
*** - +:
#<FUNCTION :LAMBDA (N)
#'(LAMBDA (F)
#'(LAMBDA (X)
(FUNCALL (FUNCALL (FUNCALL N #'(LAMBDA (G) #'(LAMBDA (H) (FUNCALL H (FUNCALL G F))))) #'(LAMBDA (U) X)) (LAMBDA (U) U))))>
is not a number
Where I expect to get 3
I think the problem is in DIVISION function, after the IF-THEN-ELSE, I tried to change it a little bit (I thought it was a nested parenthesis problem) but I got lots of errors.
Any help would be appreciated
Thanks
There are several problems with your definition.
DIVISION does not use the Y combinator, but the original definition does.
This is important, because the DIVISION function expects a copy of itself in the g
parameter.
However, even if you added the Y invocation, your code would still not work
but go into an infinite loop instead. That's because Common Lisp, like most of today's languages, is a call-by-value language. All arguments are evaluated before a function is called. This means that you cannot define conditional functions as elegantly as the traditional lambda calculus semantics would allow.
Here's one way of doing church number division in Common Lisp. I've taken the liberty of introducing some syntax to make this a bit more readable.
;;;; -*- coding: utf-8 -*-
;;;; --- preamble, define lambda calculus language
(cl:in-package #:cl-user)
(defpackage #:lambda-calc
;; note: not using common-lisp package
(:use)
(:export #:λ #:call #:define))
;; (lambda-calc:λ (x y) body)
;; ==> (cl:lambda (x) (cl:lambda (y) body))
(defmacro lambda-calc:λ ((arg &rest more-args) body-expr)
(labels ((rec (args)
(if (null args)
body-expr
`(lambda (,(car args))
(declare (ignorable ,(car args)))
,(rec (cdr args))))))
(rec (cons arg more-args))))
;; (lambda-calc:call f a b)
;; ==> (cl:funcall (cl:funcall f a) b)
(defmacro lambda-calc:call (func &rest args)
(labels ((rec (args)
(if (null args)
func
`(funcall ,(rec (cdr args)) ,(car args)))))
(rec (reverse args))))
;; Defines top-level lexical variables
(defmacro lambda-calc:define (name value)
(let ((vname (gensym (princ-to-string name))))
`(progn
(defparameter ,vname nil)
(define-symbol-macro ,name ,vname)
(setf ,name
(flet ((,vname () ,value))
(,vname))))))
;; Syntax: {f a b}
;; ==> (lambda-calc:call f a b)
;; ==> (cl:funcall (cl:funcall f a) b)
(eval-when (:compile-toplevel :load-toplevel :execute)
(set-macro-character #\{
(lambda (stream char)
(declare (ignore char))
`(lambda-calc:call
,#(read-delimited-list #\} stream t))))
(set-macro-character #\} (get-macro-character #\))))
;;;; --- end of preamble, fun starts here
(in-package #:lambda-calc)
;; booleans
(define TRUE
(λ (x y) x))
(define FALSE
(λ (x y) y))
(define NOT
(λ (bool) {bool FALSE TRUE}))
;; numbers
(define ZERO
(λ (f x) x))
(define SUCC
(λ (n f x) {f {n f x}}))
(define PLUS
(λ (m n) {m SUCC n}))
(define PRED
(λ (n f x)
{n (λ (g h) {h {g f}})
(λ (u) x)
(λ (u) u)}))
(define SUB
(λ (m n) {n PRED m}))
(define ISZERO
(λ (n) {n (λ (x) FALSE) TRUE}))
(define <=
(λ (m n) {ISZERO {SUB m n}}))
(define <
(λ (m n) {NOT {<= n m}}))
(define ONE {SUCC ZERO})
(define TWO {SUCC ONE})
(define THREE {SUCC TWO})
(define FOUR {SUCC THREE})
(define FIVE {SUCC FOUR})
(define SIX {SUCC FIVE})
(define SEVEN {SUCC SIX})
(define EIGHT {SUCC SEVEN})
(define NINE {SUCC EIGHT})
(define TEN {SUCC NINE})
;; combinators
(define Y
(λ (f)
{(λ (rec arg) {f {rec rec} arg})
(λ (rec arg) {f {rec rec} arg})}))
(define IF
(λ (condition if-true if-false)
{{condition if-true if-false} condition}))
;; pairs
(define PAIR
(λ (x y select) {select x y}))
(define FIRST
(λ (pair) {pair TRUE}))
(define SECOND
(λ (pair) {pair FALSE}))
;; conversion from/to lisp integers
(cl:defun int-to-church (number)
(cl:if (cl:zerop number)
zero
{succ (int-to-church (cl:1- number))}))
(cl:defun church-to-int (church-number)
{church-number #'cl:1+ 0})
;; what we're all here for
(define DIVISION
{Y (λ (recurse q a b)
{IF {< a b}
(λ (c) {PAIR q a})
(λ (c) {recurse {SUCC q} {SUB a b} b})})
ZERO})
If you put this into a file, you can do:
[1]> (load "lambdacalc.lisp")
;; Loading file lambdacalc.lisp ...
;; Loaded file lambdacalc.lisp
T
[2]> (in-package :lambda-calc)
#<PACKAGE LAMBDA-CALC>
LAMBDA-CALC[3]> (church-to-int {FIRST {DIVISION TEN FIVE}})
2
LAMBDA-CALC[4]> (church-to-int {SECOND {DIVISION TEN FIVE}})
0
LAMBDA-CALC[5]> (church-to-int {FIRST {DIVISION TEN FOUR}})
2
LAMBDA-CALC[6]> (church-to-int {SECOND {DIVISION TEN FOUR}})
2