(DEFINE-FILE-INFO PACKAGE "XCLC" READTABLE "XCL" BASE 10)
(il:filecreated "19-Feb-88 10:48:00" 
il:|{EG:PARC:XEROX}<LANNING>LISP>USERS>XCLC-CALL-LAMBDA-SUBST-PATCH.;5| 3855   

      il:|changes| il:|to:|  (il:functions meta-call-lambda-substitute)

      il:|previous| il:|date:| "18-Feb-88 07:37:32" 
il:|{EG:PARC:XEROX}<LANNING>LISP>USERS>XCLC-CALL-LAMBDA-SUBST-PATCH.;4|)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:xclc-call-lambda-subst-patchcoms)

(il:rpaqq il:xclc-call-lambda-subst-patchcoms (
(il:* il:|;;;| "Fix a bug with lambda-substitution")

                                               (il:functions meta-call-lambda-substitute)
                                               (il:declare\: il:dontcopy (il:props (
                                                                      il:xclc-call-lambda-subst-patch
                                                                                    
                                                                              il:makefile-environment
                                                                                    )
                                                                                (
                                                                      il:xclc-call-lambda-subst-patch
                                                                                 il:filetype)))))



(il:* il:|;;;| "Fix a bug with lambda-substitution")


(defun meta-call-lambda-substitute (node)
   (let* ((fn (call-fn node))
          (var-list (lambda-required fn))
          (spec-effects (il:for var il:in var-list il:unless (eq (variable-scope var)
                                                                 :lexical) il:collect (
                                                                               effects-representation
                                                                                       var)))
          (*subst-occurred* nil))                            (il:* il:\; 
 "Bind *SUBST-OCCURRED* just so that META-SUBST-VAR-REF has a binding to set even when nobody cares.")

         (il:for var il:in var-list il:as tail il:on (call-args node)
            il:when (and (eq (variable-scope var)
                             :lexical)
                         (substitutable-p (car tail)
                                var)
                         (dolist (spec-effect spec-effects t)
                                (when (not (null-effects-intersection spec-effect (node-affected
                                                                                   (car tail))))
                                      (return nil)))
                         (dolist (later-arg (cdr tail)
                                        t)
                                (when (not (passable (car tail)
                                                  later-arg))
                                      (return nil)))) il:do (setf (lambda-body fn)
                                                                  (meta-substitute (car tail)
                                                                         var
                                                                         (lambda-body fn))))
         (when (null (node-meta-p (lambda-body fn)))
               (setf (node-meta-p fn)
                     nil)
               (setq *made-changes* t))))

(il:declare\: il:dontcopy 

(il:putprops il:xclc-call-lambda-subst-patch il:makefile-environment (:package "XCLC" :readtable 
                                                                            "XCL" :base 10))

(il:putprops il:xclc-call-lambda-subst-patch il:filetype :compile-file)
)
(il:putprops il:xclc-call-lambda-subst-patch il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop