(in-package "LISP")


;;; The default version of this function has a bug with relative
;;; pathnames.

(defun pathname->string (p)
  (let ((dirlist (pathname-directory p)))
    (format nil "~A~{~A/~}~A~A~A"
            (case (car dirlist)
              (:absolute "/")
              (:relative "./")
              (:up "../")
              (t ""))
            (cdr dirlist)
            (nil->empty-string (pathname-name p))
            (if (null (pathname-type p)) "" ".")
            (nil->empty-string (pathname-type p)))))


;;; The default version of this function defaults the C file to the
;;; wrong directory -- LOAD can't find it.

(defun my-comf (file &key
                  (output-file (merge-pathnames ".o" file))
                  (c-file (merge-pathnames ".c" output-file))
                  (verbose *compile-verbose*)
                  (print *compile-print*)
                  (config *config*)
                  (pic? *pic?*)
                  only-to-c?)
  (old-comf file
	    :output-file output-file
	    :c-file c-file
	    :verbose verbose
	    :print print
	    :config config
	    :pic? pic?
	    :only-to-c? only-to-c?))

(when (not (fboundp 'old-comf))
  (setf (symbol-function 'old-comf) #'comf)
  (setf (symbol-function 'comf) #'my-comf))


;;; WCL's evaluator tries to macroexpand everything before executing
;;; anything.  Unfortunately, this does the wrong thing with
;;; top-level PROGN's -- it tries to expand macros in subforms before
;;; executing earlier subforms that set up stuff required to do the
;;; the expansion properly.

(defun eval-1 (form venv fenv tenv benv)
  (let ((new-form  (macroexpand form *eval-macro-env*)))
    (if (and (consp new-form)
	     (eq (car new-form) 'progn))
	(do ((forms (cdr new-form) (cdr forms)))
	    ((null (cdr forms)) (eval-1 (car forms) venv fenv tenv benv))
	    (eval-1 (car forms) venv fenv tenv benv))
	(let ((expansion (expand new-form)))
	  (when (and (listp expansion)
		     (eq (car expansion) 'define-function))
	    (setf (get (second (second expansion))
		       :function-definition)
		  form))
	  (eval/5 expansion venv fenv tenv benv))
      )))