[cl-store-devel] Closure serialisation

[szergling]

Following on from my previous email at

http://common-lisp.net/pipermail/cl-store-devel/2007-November/000077.html

I hope the following might be useful so someone.


> I have code (but not right now, can send this later if you are
> interested) for serialising clisp closures, but of course, we can only

Some notes on how this may be done:

;; ffi::foreign-function not done

;; Initial clisp prototype (trying to find all the relevant objects in
;; a closure, and list them)

(defstore-cl-store (obj function stream)
  (output-type-code +function-code+ stream)
  (flet ((so (object)
           (store-object object stream)))
    (mapc #'so (multiple-value-list (function-lambda-expression obj)))
    (if (compiled-function-p obj)
        (flet ((es (func) ;; extract-and-store
                 (store-object (funcall func obj) stream)))
          (mapc #'es
                (list #'sys::closure-consts
                      #'sys::closure-codevec
                      #'sys::closure-documentation
                      #'sys::closure-lambda-list)))
        (dotimes (i 4) (so nil)))))

(defrestore-cl-store (function stream)
  (flet ((ro () (restore-object stream)))
    (let ((lambda-exp (ro))
          (closure-p (ro))
          (name (ro))
          (consts (ro))
          (codevec (ro))
          (doc (ro))
          (lambda-list (ro)))
      (if codevec ;; compiled
          ;; TODO What is a suitable default seclass? Currently ()
          (sys::%make-closure name codevec consts () lambda-list doc)
          ;; TODO Any functions to do this programmatically?  How to
          ;; store/restore dynamic, lexical, etc environment.
          (eval lambda-exp)
          ))))

;; Other alternatives include using the custom extensions to the clisp
;; printer/reader.
;; CL-USER> (let ((custom:*print-closure* t)) (format t "~s" (lambda () 3)))
;; #<FUNCTION :LAMBDA (NIL 3) NIL (3) #(*PRINT-CLOSURE* #<SPECIAL
REFERENCE> NIL)
;;   NIL NIL NIL ((DECLARATION OPTIMIZE DECLARATION)) #() #() 0 0 0 NIL 0 0 NIL
;;   NIL NIL 0 NIL>
;; NIL
;; CL-USER> (let ((custom:*print-closure* t)) (format t "~s" (compile
nil (lambda () 3))))
;; #Y(NIL #13Y(00 00 00 00 00 00 00 00 00 01 C5 19 01) (3) NIL)
;; NIL
;; CL-USER> #Y(NIL #13Y(00 00 00 00 00 00 00 00 00 01 C5 19 01) (3) NIL)
;; #<COMPILED-FUNCTION NIL>
;; CL-USER> (funcall *)
;; 3