#+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 
                             mic-invoke-unary-method pic-invoke-unary-method 
                             pic-invoke-binary-method pic-invoke-trinary-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)
  (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 ((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)))))))
    (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
      (let ((token-stream (make-token-stream)))
	(loop for result =
	  (prog2
	      (progn (format t "~&Slate ~A> " (incf counter)) (finish-output))
	      (interpret-slate (parse-statement token-stream :end-statement))
	    (get-token token-stream))
	  do (format t "~&")
	  (invoke-method '|printOn:| nil result *console-output*)
	  (format t "~&")
	  (finish-output)))
      (incf counter))))