Pascal J. Bourguignon
3/7/2016 11:33:00 PM
Jim Newton <jimka.issy@gmail.com> writes:
> Hi Pascal, (and anyone else who's interested)
> Is there a problem with this code with respect to fasl files?
> I mean will loading the .lisp file have the same semantics as loading the compiled fasl file?
> Are we certain that in either case a function will get defined and set as the symbol function of
> a symbol, and that name will be associated with the number in the hash table, and
> divisible-by will do the same thing later on independent of whether the deftype sat
> in a .lisp or a .fasl file?
>
> I ask because, I have a strange problem that sometimes, i get an error in my unit tests
> that the the function is not defined, and when I remove all the .fasl files and run it again, the
> problem goes away.
>
>> > CL-USER 3 : 2 > (let ((tab (make-hash-table)))
>> > (deftype divisible-by (n)
>> > `(satisfies ,(or (gethash n tab)
>> > (setf (gethash n tab)
>> > (let ((sym (gensym)))
>> > (setf (symbol-function sym)
>> > (lambda (x) (zerop (mod x n))))
>> > sym))))))
>> > DIVISIBLE-BY
You ask a good question indeed.
Types defined with deftype are similar to macros, and you can expect them
to be expanded at compilation time, dixit clhs deftype:
If a deftype form appears as a top level form, the compiler must
ensure that the name is recognized in subsequent type declarations.
The programmer must ensure that the body of a deftype form can be
evaluated at compile time if the name is referenced in subsequent
type declarations. If the expansion of a type specifier is not
defined fully at compile time (perhaps because it expands into an
unknown type specifier or a satisfies of a named function that isn't
defined in the compile-time environment), an implementation may
ignore any references to this type in declarations and/or signal a
warning.
Notably, the consequent of the first sentence doesn't apply when we wrap
deftype in such a LET form as in my example.
When you compile (and generate a fasl file), a toplevel LET form, this
form is not evaluated at compilation time. It is just compiled. The
type is therefore not defined until you load the fasl file (much later
then). And therefore you won't be able to use this type in the rest of
the program at compilation time.
Let's begin by transforming it so that the type is defined at
compilation time:
(defvar *divisible-satisfying-functions* (make-hash-table))
(deftype divisible-by (n)
`(satisfies ,(or (gethash n *divisible-satisfying-functions*)
(setf (gethash n *divisible-satisfying-functions*)
(let ((sym (gensym)))
(setf (symbol-function sym)
(lambda (x) (zerop (mod x n))))
sym)))))
(defun f (3n)
(declare (type (divisible-by 3) 3n))
(/ 3n 3))
Now we have the problem that the type (divisible-by 3) is used at
compilation time (it is known, since deftype is a toplevel form), so the
expansion must be evaluable at compilation time. But defvar doesn't
define the variable at compilation time!
clhs defvar says:
If a defvar or defparameter form appears as a top level form, the
compiler must recognize that the name has been proclaimed
special. However, it must neither evaluate the initial-value form
nor assign the dynamic variable named name at compile time.
To define a global variable that can be used at compilation time, we
need to wrap it in an eval-when:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *divisible-satisfying-functions* (make-hash-table)))
(deftype divisible-by (n)
`(satisfies ,(or (gethash n *divisible-satisfying-functions*)
(setf (gethash n *divisible-satisfying-functions*)
(let ((sym (gensym)))
(setf (symbol-function sym)
(lambda (x) (zerop (mod x n))))
sym)))))
(defun f (3n)
(declare (type (divisible-by 3) 3n))
(/ 3n 3))
But now, we have two different environments: compilation environment and
run-time environment and they may be separated by light.years. How can
the closure built at compilation time, the (lambda (x) (zerop (mod x n)))
be stored in the hash-table at run-time, if we kill the image after
compilation and load the fasl file in a new image perhaps even on a
different computer? At :load-toplevel time, the variable will be
redefined, and bound to a new empty hash-table.
When you write a normal macro, you can solve this problem by duplicating
the creation of your objects, doing it both at compilation time and at
run (ie. load) time:
(defmacro define-stuff (x)
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *memory* (make-hash-table)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (gethash ',x *memory*) ',x))))
So when you compile:
(define-stuff foo)
an entry is stored in the *memory* at compilation time, and the code is
generated and compiled to store a similar entry in the *memory* at
load-time.
In the case of deftype we don't have the luxury of generating code that
will be compiled and executed later at load time, since the result of
the deftype expander shall be a type form, in our case, a
(satisfies <a-symbol-fbound-to-a-predicate>) form.
So we have a situation where we will fill define new predicate functions
at compilation time as needed by all the divisible-by types found at
compilation time, but those functions won't be compiled and saved in the
fasl file.
It wouldn't be a problem for new uses of the divisible-by type at
run-time, since then new predicate functions would be created at
run-time.
But if you compile a form such as (typep 3n '(divisible-by 3))
then the compiled expansion will be:
(typep 3n '(satisfies #:G31231))
and since we never defined at compilation time a function named
#:G31231, it hasn't been saved to the fasl file, and it's not defined
anymore when we load it in a new image.
I don't think we can do it only from the deftype form, since while it's
expanded at compilation time, it's not a macro, and we cannot expand
several forms (notably eval-when forms with different situations) from a
deftype. So we will have to use two macros.
So in addition to generate the predicate at compilation-time for
compilation-time usage, we would have to record them, and before the end
of the compilation unit, we would have to generate them (on the
top-level), so that they are compiled and saved in the fasl file for
load-time and run-time.
We will define two macros: register-predicate and generate-predicates.
Register-predicate will be used to register the predicate for a
satisfies type. The first argument will be the type form with its
parameters (the macro will take note of both the name and the value of
the parameters, and bound the names to the values in the body of the
predicate). The second argument will the the predicate parameter, and
the rest the predicate body:
(deftype divisible-by (n)
`(satisfies ,(register-predicate (divisible-by n)
(x) (zerop x n))))
This macro will save a symbol fbound at compilation-time to the predicate function generated
at compilation-time along with a corresponding defun form in the
*register-predicates* hash-table.
Then the generate-predicates macro will expand to the saved defun forms
(and it will also refill the hash-table at load-time so we may re-use
generate-predicate in a new compilation).
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *registered-predicates* (make-hash-table :test (function equal)))
(defmacro register-predicate (type (predicate-parameter) &body body)
`(let* ((actual-type (list ',(first type) ,@(rest type)))
(fname (intern (format nil "~S" actual-type))))
(first (or (print (gethash actual-type *registered-predicates*))
(setf (gethash actual-type *registered-predicates*)
(let* ((lambda-list `(,',predicate-parameter
&aux ,@(mapcar (lambda (var val)
`(,var ',val))
(rest ',type)
(rest actual-type))))
(func (coerce `(lambda ,lambda-list
(block ,',(first type) ,@',body))
'function))
(def `(defun ,fname ,lambda-list
(block ,',(first type) ,@',body))))
(setf (symbol-function fname) func)
(print `',def)
(list fname def)))))))
(defmacro generate-predicates ()
`(progn
,@(let ((predicates '()))
(maphash (lambda (k v)
(push `(progn
(setf (gethash ',k *registered-predicates*) ',v)
,(second v))
predicates))
*registered-predicates*)
predicates)))
(values))
The trick then is not to forget to call generate-predicates at the end
of the compilation unit (at the end of the source file that uses the
satisfies type):
(with-compilation-unit
(deftype divisible-by (n)
`(satisfies ,(register-predicate (divisible-by n)
(x) (zerop x n))))
(defun notfizzbuzz (n)
(cond
((zerop (mod n 15)) (print (the (divisible-by 15) n)))
((zerop (mod n 5)) (print (the (divisible-by 5) n)))
((zerop (mod n 3)) (print (the (divisible-by 3) n)))
(t (print 'hi))))
(generate-predicates))
In general, with-compilation-unit is called automatically by
compile-file, so don't need to call it yourself; just put a
generate-predicate at the end of the source file (or just once in a last
source file compiled with the system that would gather all the
predicates for your system; it would do too, if you load the whole
system at once, as is usually done with asdf).
(pprint (macroexpand-1 '(generate-predicates)))
(progn (progn (setf (gethash '(divisible-by 3) *registered-predicates*)
'(|(divisible-by 3)|
(defun |(divisible-by 3)| (x &aux (n '3)) (block divisible-by (zerop x n)))))
(defun |(divisible-by 3)| (x &aux (n '3)) (block divisible-by (zerop x n))))
(progn (setf (gethash '(divisible-by 5) *registered-predicates*)
'(|(divisible-by 5)|
(defun |(divisible-by 5)| (x &aux (n '5)) (block divisible-by (zerop x n)))))
(defun |(divisible-by 5)| (x &aux (n '5)) (block divisible-by (zerop x n))))
(progn (setf (gethash '(divisible-by 15) *registered-predicates*)
'(|(divisible-by 15)|
(defun |(divisible-by 15)| (x &aux (n '15)) (block divisible-by (zerop x n)))))
(defun |(divisible-by 15)| (x &aux (n '15)) (block divisible-by (zerop x n)))))
--
__Pascal Bourguignon__