The function and synchronized-function macros are a type-checking extension to the lambda expression. The synchronized-function macro is identical to the function macro except that it is used to designate critcal code sections for multi-threaded applications.
The first step in creating the function and synchronized-function macros is to define utility functions for argument checking. The procedure function-args->lambda-args recursively strips out formal lambda-style arguments from Sol function-style arguments passed to the function and synchronized-function macros.
(define (function-args->lambda-args args)
; Check for empty-list
; termination condition
(cond ((null? args)
; Return empty list
'())
; Check to see if args is a
; pair (it may not be if
; function-args->lambda-args was
; previously called with a
; non-list pair, e.g. (a . b).
((pair? args)
; Get the first argument unit
; and bind it to arg.
(let ((arg (car args)))
(cons ; Return a list of...
(if (symbol? arg)
; If it's a symbol (an
; un-typed argument) just pass
; it along.
arg
; Otherwise pull the symbol
; out of the IN expression.
(car arg))
; ... followed by a recursive
; call to yourself with the
; rest of the list.
(function-args->lambda-args (cdr args)))))
; We've fallen down to the
; else clause, meaning that
; args is just a symbol.
; Return it.
(else args)))
The procedure function-args->error-check does type checking by calling in? to verify the type expressions in the Sol function args list.
(define (function-args->error-check args)
; Check for empty-list
; termination condition.
(cond ((null? args)
; Return empty list.
'())
; Check to see if args is a
; pair.
((pair? args)
; Get the first argument unit
; and bind it to arg.
(let ((arg (car args)))
; If it's a symbol (an
; un-typed argument)...
(if (symbol? arg)
; ... ignore it, and check the
; rest of the list.
(function-args->error-check (cdr args))
; Otherwise, generate the
; following code, which is a
; recursive construction of
; type checks:
`(if (not ,(cons 'in? arg))
(error "Bad argument to function:"
',arg ,(car arg))
,(function-args->error-check (cdr args))))))
; Args is a symbol - ignore it.
(else '())))
Now we define the macros.
(defmacro function (type args . body)
; The body of the macro
; produces a lambda-expression
; followed by the
; type-checking code.
`(lambda ,(function-args->lambda-args args)
(let ((rval
(call-with-current-continuation
(lambda (return)
,(function-args->error-check args)
,@body))))
(if (in? rval ,type)
rval
(error "function: Bad return value."
(list 'in? rval ,type) '-> '#f))))
)
(defmacro synchronized-function (type args . body)
; The body of the macro
; produces a lambda-expression
; followed by the
; type-checking code.
`(lambda ,(function-args->lambda-args args)
(let ((rval
(call-with-current-continuation
(lambda (return)
,(function-args->error-check args)
(synchronize
(lambda ()
,@body))))))
(if (in? rval ,type)
rval
(error "synchronized-function: Bad return value."
(list 'in? rval ,type) '-> '#f))))
)