[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Fwd: Re: [Gcl-devel] Recent ansi fixes]
From: |
Camm Maguire |
Subject: |
Re: [Fwd: Re: [Gcl-devel] Recent ansi fixes] |
Date: |
24 Oct 2003 18:34:28 -0400 |
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings!
"Paul F. Dietz" <address@hidden> writes:
> (forgot to cc this)
>
> >>gcl apparently has to print things when compiling, which means it
> >>inappropriately rejects unprintable objects in literal constants.
> >>
> >>What you need to do, I think, is print some object that is a pointer
> >>back to the address of the unprintable object in the lisp's memory.
> >>When the reader reads this, it should be converted back to a reference
> >>to that object. LOAD-TIME-VALUE might be useful here?
> > Does this mean I can make up my own pseudo syntax, maybe using
> > #something-not-in-use, and instruct the reader to parse this
> > appropriately? Which compile bugs are you referring to below?
>
> This pseudosyntax would just be for the internal printing needed
> to implement COMPILE. It needn't be externally visible.
>
> The compiler bugs are in ansi-tests/compile.lsp, in the tests
> that check if COMPILE coalesces literal constants (note that it
> can't, unlike the file compiler; see section 3.2.4, paragraph 1.)
>
OK, I have a beginning of a fix, and would like some feedback from the
gurus:
=============================================================================
Index: gcl_cmpmain.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpmain.lsp,v
retrieving revision 1.4
diff -u -r1.4 gcl_cmpmain.lsp
--- gcl_cmpmain.lsp 10 Oct 2003 05:14:03 -0000 1.4
+++ gcl_cmpmain.lsp 24 Oct 2003 22:20:43 -0000
@@ -405,8 +405,10 @@
(wt-data1 form) ;; this binds all the print stuff
))
+(defmacro compile (name &optional def)
+ `(compile-internal ,name (do-compile-literal-objects ,def)))
-(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults*
#"."))
+(defun compile-internal (name &optional def &aux tem gaz
(*default-pathname-defaults* #"."))
(cond ((not(symbolp name)) (error "Must be a name"))
((and (consp def)
@@ -424,7 +426,8 @@
((and (setq tem (symbol-function name))
(consp tem))
(let ((na (if (symbol-package name) name 'cmp-anon)))
- (unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon)
(fmakunbound 'si::init-cmp-anon)))
+ (unless (and (fboundp 'si::init-cmp-anon)
+ (or (si::init-cmp-anon) (fmakunbound
'si::init-cmp-anon)))
(with-open-file
(st (setq gaz (gazonk-name)) :direction :output)
(prin1-cmp `(defun ,na ,@ (ecase (car tem)
Index: gcl_cmpeval.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpeval.lsp,v
retrieving revision 1.3
diff -u -r1.3 gcl_cmpeval.lsp
--- gcl_cmpeval.lsp 10 Oct 2003 02:37:59 -0000 1.3
+++ gcl_cmpeval.lsp 24 Oct 2003 22:20:44 -0000
@@ -681,4 +681,90 @@
(setq tem (get f 'si::struct-predicate)))
(c1expr `(typep ,(car args) ',tem)))))
+;; The following code is added to prevent coalescing literal objects in
(compile ...)
+;; CM 20031024
+(defvar *sym-list*)
+(defvar *new-form*)
+
+(defun add-to-sym-list-and-new-form (f)
+ (unless (member f *sym-list* :key #'cadadr)
+ (push `(list ',f (list 'si::nani (si::address ,f))) *sym-list*))
+ (push `',f *new-form*))
+
+(defun literal-to-be-quoted-p (form)
+ (when (consp form)
+ (let ((cdf (cadr form)))
+ (and (eq (car form) 'list)
+ (consp cdf)
+ (eq (car cdf) 'quote)
+ (eq (cadr cdf) 'quote)))))
+
+(defun compile-literal-objects (form)
+ (let (*new-form*)
+ (dolist (f form)
+ (cond ((literal-to-be-quoted-p f)
+ (add-to-sym-list-and-new-form (caddr f)))
+ ((consp f)
+ (push (if (eq (car f) 'quote) f (compile-literal-objects f))
*new-form*))
+ ((or (not (symbolp f)) (fboundp f) (constantp f))
+ (push f *new-form*))
+ (t
+ (add-to-sym-list-and-new-form f))))
+ (nreverse *new-form*)))
+
+(defmacro do-compile-literal-objects (form)
+
+ (let (new-form-head
+ (when (and (consp form) (eq (car form) 'list))
+ (let ((cdf (cadr form)))
+ (when (and (consp cdf)
+ (eq (car cdf) 'quote))
+ (let* ((lt (cadr cdf))
+ (ltt (car (member lt '(lambda lambda-block)))))
+ (when ltt
+ (push (pop form) new-form-head)
+ (push (pop form) new-form-head)
+ (push (pop form) new-form-head)
+ (when (eq ltt 'lambda-block)
+ (push (pop form) new-form-head)))))))
+
+ (if new-form-head
+ (let* (*sym-list*
+ (new-form (compile-literal-objects form)))
+ (append (nreverse new-form-head)
+ `((list 'let (list ,@*sym-list*)
+ ,@new-form))))
+ form)))
=============================================================================
This macroexpands "literal-list-lambda" code on the compile command
line like:
(let ((x 2))
(format t "~S~%" (si::address x))
(macroexpand '(compiler::do-compile-literal-objects
(list 'lambda nil (list 'eq x x)))))
139656144
(LIST 'LAMBDA NIL
(LIST 'LET
(LIST (LIST 'X (LIST 'SYSTEM:NANI (SYSTEM:ADDRESS X))))
(LIST 'EQ 'X 'X)))
which then evals to
(let ((x 2)) (LIST 'LAMBDA NIL
(LIST 'LET
(LIST (LIST 'X (LIST 'SYSTEM:NANI (SYSTEM:ADDRESS X))))
(LIST 'EQ 'X 'X))))
(LAMBDA () (LET ((X (SYSTEM:NANI 139668432))) (EQ X X)))
The strategy here is (obviously) to make use of GCL's si::address
function (to get the address of an object), and the si::nani function,
(to get the object at an address), and to wrap the lambda body in a
let setting the variable to its outer value, while quoting it in the
form to protect if from eval.
This fixes compile.5678, but not the.12 (yet?), as I don't know how to
get at the lambda function definition in a macro in a call like
(LET ((CL-TEST::LEXPR
(LIST 'LAMBDA NIL
(LIST* 'AND
(LOOP
CL-TEST::FOR
CL-TEST::E
CL-TEST::IN
CL-TEST::*MINI-UNIVERSE*
CL-TEST::FOR
TYPE
=
(TYPE-OF CL-TEST::E)
CL-TEST::COLLECT
(LIST 'CL-TEST::EQLT
(LIST 'QUOTE CL-TEST::E)
(LIST 'THE TYPE
(LIST 'QUOTE CL-TEST::E))))))))
(FUNCALL (COMPILE NIL CL-TEST::LEXPR)))
Inside the macro, lexpr is not fboundp nor boundp :-(.
I'm also not 100% sure on the logic of what constitutes an
'externalizable' (?) object. (See logic in compile-literal-objects).
Enlightenment, suggestions, and catcalls most welcome!
Take care,
> Paul
>
>
> ----------
>
>
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah