[comp.lang.clos] Closette in [A]KCL

jeff@aiai.edinburgh.ac.uk (Jeff Dalton) (04/25/91)

I have it more or less working in AKCL 1-505.  It may be that one
is meant to compile closette.lisp by loading it first.  However, I
started by trying to just compile it and fixed the problems that
came up.  Some of them, at least, would also occur if the load-then-
compile strategy were adopted.

The problems are:

(1) AKCL now tries to conform to COMPILE-FILE-HANDLING-OF-TOP-LEVEL-
FORMS.  Macros in closette.lisp such as DEFCLASS call functions in
closette.lisp when computing their expansion.  These macros are then
called in the bootstrap section of closette.lisp, but the functions
are not defined at compile time.  Similar problems occur with some
SETF definitions (for FIND-CLASS and FIND-GENERIC-FUNCTION).

Put the bootstrap section in a separate file called, say "boot.lisp".
Put (in-package 'closette :use '(lisp)) at the top.  Unless noted
otherwise, the reamining instructions refer to closette.lisp.

For the SETF case, add the following.

----------------------------------------------------------------------
#+kcl
(defmacro eval-always (&body forms)
  `(eval-when (eval compile load)
     ,@forms))
----------------------------------------------------------------------

Then put

----------------------------------------------------------------------
(#+kcl eval-always
 #-kcl progn

 ...

)
----------------------------------------------------------------------

around the LETs in which FIND-CLASS and FIND-GENERIC-FUNCTION are
defined.

(2) The #S notation for structure objects does not work unless
the standard defstruct constructor exists under some name.  If
there are only BOA constructors, for example, #S doesn't work.
So, change the definition of std-instance:

----------------------------------------------------------------------
(defstruct (std-instance (:constructor allocate-std-instance (class slots))
			 #+kcl
			 (:constructor make-std-instance-for-sharp-s)
                         (:predicate std-instance-p)
                         (:print-function print-std-instance))
  class
  slots)
----------------------------------------------------------------------

(3) The DEFVAR for EXPORTS and the (EXPORT EXPORTS) line cause
various problems.  The compiler wants to know the value of EXPORTS
at compile-time, but it isn't defined.  If you fix that, you'll
fins that it still goes wrong when the compiled file is loaded,
presumably because the compiler does something special with package
operations.  Therefore, avoid the export at compile-time and hide
it from the compiler, thus:

----------------------------------------------------------------------
#+kcl
(eval-when (load eval)
  (eval '(export exports)))		;don't confuse the compiler

#-kcl
(export exports)
----------------------------------------------------------------------

(4) The KCL COMPILE function is fairly slow and produces a fair amount
of output.  It is often better to avoid actually compiling.  I did
this by adding a variable to control whether compilation was done
and then changing the definition of compile-in-lexical-environment:

----------------------------------------------------------------------
;;; COMPILE is sufficiently slow that we may not want to.

#+kcl
(defvar *compile-methods* nil)

(defun compile-in-lexical-environment (env lambda-expr)
  (declare (ignore env))
  #+kcl
  (if *compile-methods* (compile nil lambda-expr) lambda-expr)
  #-kcl
  (compile nil lambda-expr))
----------------------------------------------------------------------

(5) The KCL compiler has trouble with unprintable constants in code
given to COMPILE, something that happens in methods.  Put "#-kcl"
before the usual definition of std-compute-method-function and add
the following:

----------------------------------------------------------------------
;;; In KCL/AKCL, COMPILE prints the function definition to a file
;;; and then calls COMPILE-FILE.  It takes some care in printing
;;; the definition so that such things as circular structures are
;;; handled.  Unfortunately, that isn't enough for us, because a
;;; method may (indirectly) contain unprintable objects such as
;;; compiled functions.  Here, we avoid putting the method object
;;; into the source code as a quoted object by putting a variable
;;; there instead.  Then, instead of compiling the method function
;;; directly, we compile a function that takes the method object
;;; as an argument and returns the actual method function.  When
;;; then call the function.

#+kcl
(defun std-compute-method-function (method)
  (let ((method-lambda (make-method-lambda method '.the-method.)))
    (funcall (compile-in-lexical-environment
	       (method-environment method)
	       `(lambda (.the-method.)
		  (function ,method-lambda)))
	     method)))
	
#+kcl
(defun make-method-lambda (method method-variable)
  (let ((form (method-body method))
        (lambda-list (method-lambda-list method)))
    `(lambda (args next-emfun)
       (flet ((call-next-method (&rest cnm-args)
		(if (null next-emfun)
		    (error "No next method for the~@
                            generic function ~S."
			   (method-generic-function ,method-variable))
		    (funcall next-emfun (or cnm-args args))))
	      (next-method-p ()
                (not (null next-emfun))))
	 (apply #'(lambda ,(kludge-arglist lambda-list)
		    ,form)
		args)))))
----------------------------------------------------------------------

(6) In addition, some optional changed to newcl.lisp can be made.
To print-unreadable-object, add the line:

	#+kcl    '(format .stream. "~O" (si:address .object.))

One problem that it may be worth fixing is that newcl.lisp is
sensative to the value of *PRINT-CASE*.  My init file for KCL
sets it to :DOWNCASE, and this led (somehow) to some SETF functions
not being found.  (Probably something to do with the compiler.)
But this can be a problem in other Lisps too if *PRINT_CASE*
might have different values at different times.  The following
change should suffice:

----------------------------------------------------------------------
(lisp:defun setf-function-symbol (function-specifier)
  (if (consp function-specifier)
      (let ((print-name
	     (let ((*print-case* :upcase)) ;need a consistent value
	       (format nil "~A" function-specifier))))
        (intern print-name
                (symbol-package (cadr function-specifier))))
      function-specifier))
----------------------------------------------------------------------

If the changes described above are made to closette.lisp and
newcl.lisp and the bootstrap section of closette.lisp is in a
spearate file, boot.lisp, you can compile, boot, and test by
evaluating:

    (compile-file "newcl.lisp")
    (load "newcl.o")
    (copmpile-file "closette.lisp")
    (load "closette.o")
    (load "boot.lisp")
    (load "closette-test.lisp")

I hope this is enough...

Jeff Dalton,                      JANET: J.Dalton@uk.ac.ed
AI Applications Institute,        ARPA:  J.Dalton%uk.ac.ed@nsfnet-relay.ac.uk
Edinburgh University.             UUCP:  ...!ukc!ed.ac.uk!J.Dalton