(declaim (optimize (speed 3) (safety 1)))

#+ecl
(defun generate-load-forms (code) 
  (let ((load-forms '())
        (code `(progn ,code)))
    (labels 
      ((walk-code (exp)
         (loop for sub-exp in exp
               for place on exp
           if (and (consp sub-exp)
                   (member (first sub-exp) 
                           '(activate-method sic-set-slot sic-get-slot #+jit jit-activate-method)))  
             do
                (walk-code (setf (car place) (macroexpand-1 sub-exp)))
           else 
           if (and (consp sub-exp)
                   (eq (first sub-exp) '%load-form))
             do 
                (unless (assoc (second sub-exp) load-forms)
                  (push `(,(second sub-exp) ,(third sub-exp)) load-forms))
                (setf (car place) (second sub-exp))
           else
           if (consp sub-exp)
             do
               (walk-code sub-exp))))
      (walk-code code)
      (values load-forms code))))

(defun compile-slate (code)
  (handler-bind ((warning #'muffle-warning)
		 (style-warning #'muffle-warning)
		 #+sbcl (sb-ext:compiler-note #'muffle-warning))
    (let ((method (make-slate-method "" 0 *primitive-nil* '() *primitive-nil*
                  (compile nil
#-ecl
                    `(lambda (currentBlock)
                       (declare (ignore currentBlock))
                       (let ((currentMethod *primitive-nil*))
                         (declare (ignore currentMethod))
                         ,code))
#+ecl
                    (multiple-value-bind (forms code) (generate-load-forms code)
                      `(lambda (currentBlock)
                         (declare (ignore currentBlock))
                         (let ((currentMethod *primitive-nil*) ,@forms)
                           (declare (ignore currentMethod))
                           ,code)))))))
    (or (apply-method method) *primitive-nil*))))

(defun interpret-slate (code)
  (let ((backtrace *slate-backtrace*)
        (method (make-slate-method "" 0 *primitive-nil* '() *primitive-nil*
                  (eval
#-ecl
                    `(lambda (currentBlock)
                       (declare (ignore currentBlock))
                       (let ((currentMethod *primitive-nil*))
                         (declare (ignore currentMethod))
                         ,code))
#+ecl
                    (multiple-value-bind (forms code) (generate-load-forms code)
                      `(lambda (currentBlock)
                         (declare (ignore currentBlock))
                         (let ((currentMethod *primitive-nil*) ,@forms)
                           (declare (ignore currentMethod))
                           ,code)))))))
    (prog1
      (invoke-method '|interpretHook:| nil *lobby* method)
      (setf *slate-backtrace* backtrace))))
;    (or (apply-method method) *primitive-nil*)))

(defun compile-slate-to-lisp (in-name out-name)
  (with-open-file (out-file out-name :direction :output :if-exists :supersede :if-does-not-exist :create)
    (with-open-file (in-file in-name)
      (with-file-name (file-name in-name)
        (with-line-number (line-number 0)
          (let ((token-stream (make-token-stream :stream in-file)))
            (loop for code = (parse-statement token-stream :eof)
              do
#-ecl
                (write code :stream out-file)
#+ecl
                (multiple-value-bind (forms code) (generate-load-forms code)
                  (if forms
                      (write `(let ,forms ,code) :stream out-file)
                      (write code :stream out-file)))
                (format out-file "~&")
              if (eq (peek-token token-stream) :end-statement)
                do (get-token token-stream)
              else
              if (eq (peek-token token-stream) :eof)
                do (return))))))))

(defun repl ()
  (do ((counter 0))
      (nil)
    (catch 'top-level
      (with-simple-restart (continue "Return to the Slate toplevel.")
        (setf *slate-backtrace* '())
        (invoke-method '|initHook| nil *lobby*)
        (let ((token-stream (make-token-stream)))
	  (loop for result =
	    (prog2
		(progn (format t "~&Slate ~A> " (incf counter)) (finish-output))
		(interpret-slate 
                  (prog1
                    (parse-statement token-stream :end-statement)
                    (when (eql (spy-char token-stream) #\Newline)
                      (get-char token-stream))))
	      (get-token token-stream))
	    do (format t "~&")
        (invoke-method '|resetLine| nil (invoke-method '|writer| nil *console*))
	    (invoke-method '|printOn:| nil result (invoke-method '|writer| nil *console*))
	    (format t "~&")
	    (finish-output)))
	(incf counter)))))

(dolist (sym (append '(|resetLine| |printOn:| |writer| |initHook| |interpretHook:|)))
  (%intern (symbol-name sym)))