/[cmucl]/src/compiler/ir1opt.lisp
ViewVC logotype

Diff of /src/compiler/ir1opt.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by ram, Wed May 9 11:32:40 1990 UTC revision 1.7 by ram, Sat May 12 20:24:39 1990 UTC
# Line 976  Line 976 
976    (undefined-value))    (undefined-value))
977    
978    
979    ;;; CONSTANT-REFERENCE-P  --  Internal
980    ;;;
981    ;;;    Return true if the value of Ref will always be the same (and is thus
982    ;;; legal to substitute.)
983    ;;;
984    (defun constant-reference-p (ref)
985      (declare (type ref ref))
986      (let ((leaf (ref-leaf ref)))
987        (typecase leaf
988          (constant t)
989          (functional t)
990          (lambda-var
991           (null (lambda-var-sets leaf)))
992          (global-var
993           (case (global-var-kind leaf)
994             (:global-function
995              (not (eq (ref-inlinep ref) :notinline)))
996             (:constant t))))))
997    
998    
999    ;;; SUBSTITUTE-SINGLE-USE-CONTINUATION  --  Internal
1000    ;;;
1001    ;;;    If we have a non-set let var with a single use, then (if possible)
1002    ;;; replace the variable reference's CONT with the arg continuation.  This is
1003    ;;; inhibited when:
1004    ;;; -- CONT has other uses, or
1005    ;;; -- CONT receives multiple values, or
1006    ;;; -- the reference is in a different environment from the variable.
1007    ;;;
1008    ;;;    We change the Ref to be a reference to NIL with unused value, and let it
1009    ;;; be flushed as dead code.  A side-effect of this substitution is to delete
1010    ;;; the variable.
1011    ;;;
1012    (defun substitute-single-use-continuation (arg var)
1013      (declare (type continuation arg) (type lambda-var var))
1014      (let* ((ref (first (leaf-refs var)))
1015             (cont (node-cont ref))
1016             (dest (continuation-dest cont)))
1017        (when (and (eq (continuation-use cont) ref)
1018                   dest
1019                   (not (typep dest '(or creturn exit mv-combination)))
1020                   (eq (lambda-home (block-lambda (node-block ref)))
1021                       (lambda-var-home var)))
1022          (assert-continuation-type arg (continuation-asserted-type cont))
1023          (change-ref-leaf ref (find-constant nil))
1024          (substitute-continuation arg cont)
1025          (reoptimize-continuation arg)
1026          t)))
1027    
1028    
1029  ;;; Propagate-Let-Args  --  Internal  ;;; Propagate-Let-Args  --  Internal
1030  ;;;  ;;;
1031  ;;;    This function is called when one of the arguments to a LET changes.  We  ;;;    This function is called when one of the arguments to a LET changes.  We
# Line 1001  Line 1051 
1051                (cond                (cond
1052                 ((lambda-var-sets var)                 ((lambda-var-sets var)
1053                  (propagate-from-sets var (continuation-type arg)))                  (propagate-from-sets var (continuation-type arg)))
1054                 (t                 ((let ((use (continuation-use arg)))
                 (let ((use (continuation-use arg)))  
1055                    (when (ref-p use)                    (when (ref-p use)
1056                      (let ((leaf (ref-leaf use)))                      (let ((leaf (ref-leaf use)))
1057                        (when (and (or (constant-p leaf)                        (when (and (constant-reference-p use)
                                      (functional-p leaf)  
                                      (and (lambda-var-p leaf)  
                                           (null (lambda-var-sets leaf))))  
1058                                   (values-subtypep                                   (values-subtypep
1059                                    (node-derived-type use)                                    (node-derived-type use)
1060                                    (continuation-asserted-type arg)))                                    (continuation-asserted-type arg)))
1061                          (substitute-leaf leaf var)))))                          (substitute-leaf leaf var)
1062                            (propagate-to-refs var (continuation-type arg))
1063                            t)))))
1064                   ((and (null (rest (leaf-refs var)))
1065                         (substitute-single-use-continuation arg var)))
1066                   (t
1067                  (propagate-to-refs var (continuation-type arg))))))                  (propagate-to-refs var (continuation-type arg))))))
1068          (basic-combination-args call)          (basic-combination-args call)
1069          (lambda-vars fun))          (lambda-vars fun))

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5