;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ZL-USER; Base: 10; Patch-File: T -*-

;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:l-COMPILER;OPTIMIZE.LISP.179")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*- Mode: Lisp; Package: L-compiler; Lowercase: T; Base: 8 -*-")

;;; Does simple constant folding.  This works for everything that doesn't have side-effects
;;; ALL operands must be constant.  Note that commutative-constant-folder
;;; can hack this case perfectly well by himself for the functions he handles.
(defun constant-fold-optimizer (form)
  (let ((eval-when-load-p nil))
    (flet ((constant-form-p (x)
	     (when (constant-form-p x)
	       (cond ((and (listp x)
			   (eq (car x) 'quote)
			   (listp (cadr x))
			   (eq (caadr x) eval-at-load-time-marker))
		      (setq eval-when-load-p t)
		      (cdadr x))
		     (t x)))))
      (if (every (cdr form) #'constant-form-p)
	  (if eval-when-load-p
	      (list 'quote
		    (list* eval-at-load-time-marker
			   (car form)
			   (mapcar #'constant-form-p (cdr form))))
	      (condition-case (error-object)
		   (multiple-value-call #'(lambda (&rest values)
					    (if (= (length values) 1)
						`',(first values)
						`(values ,@(mapcar #'(lambda (x) `',x)
								   values))))
					(eval form))
		 (error
		   (phase-1-warning "Constant form left unoptimized: ~S~%because: ~~A~"
				    form error-object)
		   form)))
	  form))))