* Routine for type propagation in function calls.

* Restore specialized function for FSET.

* Region-based computation of *VOLATILE* _after_ compiling the whole function.

* In SET-TRASH-LOC, we now consider that ALL function calls have side effects
  We should be able to distinguish which ones do.

* Implement tail recursion optimization.

;;; Tail-recursion optimization for a function F is possible only if
;;;	1. F receives only required parameters, and
;;;	2. no required parameter of F is enclosed in a closure.
;;;
;;; A recursive call (F e1 ... en) may be replaced by a loop only if
;;;	1. F is not declared as NOTINLINE,
;;;	2. n is equal to the number of required parameters of F,
;;;	3. the form is a normal function call (i.e. args are not ARGS-PUSHED),
;;;	4. (F e1 ... en) is not surrounded by a form that causes dynamic
;;;	   binding (such as LET, LET*, PROGV),
;;;	5. (F e1 ... en) is not surrounded by a form that that pushes a frame
;;;	   onto the frame-stack (such as BLOCK and TAGBODY whose tags are
;;;	   enclosed in a closure, and CATCH),

* Only produce functions which are different from each other.

(defun new-defun (new &optional no-entry)
  (unless (fun-exported new)
    ;; Check whether this function is similar to a previous one and
    ;; share code with it.
    (dolist (old *global-funs*)
      (when (similar (fun-lambda new) (fun-lambda old))
	(cmpnote "Sharing code among functions ~A and ~A"
		 (fun-name new) (fun-name old))
	(setf (fun-shares-with new) old
	      (fun-cfun new) (fun-cfun old)
	      (fun-minarg new) (fun-minarg old)
	      (fun-maxarg new) (fun-maxarg old))
	(return))))
  (push new *global-funs*))

(defun similar (x y)
  ;; FIXME! This could be more accurate
  (labels ((similar-ref (x y)
	     (and (equal (ref-ref-ccb x) (ref-ref-ccb y))
		  (equal (ref-ref-clb x) (ref-ref-clb y))
		  (equal (ref-ref x) (ref-ref y))))
	   (similar-var (x y)
	     (and (similar-ref x y)
		  (equal (var-name x) (var-name y))
		  (equal (var-kind x) (var-kind y))
		  (equal (var-loc x) (var-loc y))
		  (equal (var-type x) (var-type y))
		  (equal (var-index x) (var-index y))))
	   (similar-c1form (x y)
	     (and (equal (c1form-name x) (c1form-name y))
		  (similar (c1form-args x) (c1form-args y))
		  (similar (c1form-local-vars x) (c1form-local-vars y))
		  (eql (c1form-sp-change x) (c1form-sp-change y))
		  (eql (c1form-volatile x) (c1form-volatile y))))
	   (similar-fun (x y)
	     (and (similar-ref x y)
		  (eql (fun-global x) (fun-global y))
		  (eql (fun-exported x) (fun-exported y))
		  (eql (fun-closure x) (fun-closure y))
		  (similar (fun-var x) (fun-var y))
		  (similar (fun-lambda x) (fun-lambda y))
		  (= (fun-level x) (fun-level y))
		  (= (fun-env x) (fun-env y))
		  (= (fun-minarg x) (fun-minarg y))
		  (eql (fun-maxarg x) (fun-maxarg y))
		  (similar (fun-local-vars x) (fun-local-vars y))
		  (similar (fun-referred-vars x) (fun-referred-vars y))
		  (similar (fun-referred-funs x) (fun-referred-funs y))
		  (similar (fun-child-funs x) (fun-child-funs y)))))
    (and (eql (type-of x) (type-of y))
	 (typecase x
	   (CONS (and (similar (car x) (car y))
		      (similar (cdr x) (cdr y))))
	   (VAR (similar-var x y))
	   (FUN (similar-fun x y))
	   (REF (similar-ref x y))
	   (TAG NIL)
	   (BLK NIL)
	   (C1FORM (similar-c1form x y))
	   (SEQUENCE (and (every #'similar x y)))
	   (T (equal x y))))))

* Better handle the type of read-only variables without the need for
  :READ-ONLY declarations.

* Restore handling of shared data.

* The arguments of a function, when declared to have an unboxed type, generate
  inefficient CHECK-TYPE forms after that.