Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3367

Modified Files: special-operators-cl.lisp Log Message: Changed the way let installs lexical variables. This code is so ugly, but it's too much work to make it neat.

Date: Thu Aug 12 10:26:49 2004 Author: ffjeld

Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.20 movitz/special-operators-cl.lisp:1.21 --- movitz/special-operators-cl.lisp:1.20 Wed Jul 21 05:19:15 2004 +++ movitz/special-operators-cl.lisp Thu Aug 12 10:26:49 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.20 2004/07/21 12:19:15 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.21 2004/08/12 17:26:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -98,7 +98,8 @@ ;; lexical... else collect (compiler-values-bind (&code init-code &functional-p functional-p - &type type &returns init-register) + &type type &returns init-register + &final-form final-form) (compiler-call #'compile-form-to-register :env init-env :defaults all @@ -115,7 +116,8 @@ init-type) (case init-register (:non-local-exit :edi) - (t init-register)))) + (t init-register)) + final-form)) and do (movitz-env-add-binding local-env (make-instance 'located-binding :name var))))) (setf (stack-used local-env) @@ -172,7 +174,8 @@ )) (t (let ((code (append (loop - for ((var init-form init-code functional-p type init-register) + for ((var init-form init-code functional-p type init-register + final-form) . rest-codes) on binding-var-codes as binding = (movitz-binding var local-env nil) @@ -182,12 +185,12 @@ (assert (not (binding-lended-p binding))) appending (cond - ;; #+ignore ((and (typep binding 'located-binding) (not (binding-lended-p binding)) - (= 1 (length init-code)) - (eq :load-lexical (first (first init-code))) - (let* ((target-binding (second (first init-code)))) +;;; (= 1 (length init-code)) +;;; (eq :load-lexical (first (first init-code))) + (typep final-form 'lexical-binding) + (let ((target-binding final-form)) (and (typep target-binding 'lexical-binding) (eq (binding-funobj binding) (binding-funobj target-binding)) @@ -247,23 +250,39 @@ ((typep binding 'lexical-binding) (let ((init (type-specifier-singleton (type-specifier-primary type)))) - (if (and init (eq *movitz-nil* (car init))) - (append (if functional-p - nil - (compiler-call #'compile-form-unprotected - :env init-env - :defaults all - :form init-form - :result-mode :ignore - :modify-accumulate let-modifies)) - `((:init-lexvar ,binding - :init-with-register :edi - :init-with-type null))) - (append init-code - `((:init-lexvar - ,binding - :init-with-register ,init-register - :init-with-type ,(type-specifier-primary type))))))) + (cond + ((and init (eq *movitz-nil* (car init))) + (append (if functional-p + nil + (compiler-call #'compile-form-unprotected + :env init-env + :defaults all + :form init-form + :result-mode :ignore + :modify-accumulate let-modifies)) + `((:init-lexvar ,binding + :init-with-register :edi + :init-with-type null)))) + ((and (typep final-form 'lexical-binding) + (eq (binding-funobj final-form) + funobj)) + (append (if functional-p + nil + (compiler-call #'compile-form-unprotected + :env init-env + :defaults all + :form init-form + :result-mode :ignore + :modify-accumulate let-modifies)) + `((:init-lexvar ,binding + :init-with-register ,final-form + ;; :init-with-type ,final-form + )))) + (t (append init-code + `((:init-lexvar + ,binding + :init-with-register ,init-register + :init-with-type ,(type-specifier-primary type)))))))) (t init-code))) (when (plusp (num-specials local-env)) `((:locally (:movl :esp (:edi (:edi-offset dynamic-env))))))