;; SCAM == Scheme-like Code-generation for an Abstract Machine
;; Simple code generation for a Scheme-ish language

(defstruct scam-env
  (labels 0)      ; Counter -- labels so far
  (bindings nil)  ; Name -> index bindings for current func
  (asm nil))      ; Assemble language accumulator

(defun emit (env code)
  "Emit an instruction or label"
  (push code (scam-env-asm env)))

(defun lookup (env sym)
  "Look up the index for a variable"
  (cdr (assoc sym (scam-env-bindings env))))

(defun label (env)
  "Get a new label symbol"
  (intern (format nil "L~A" (incf (scam-env-labels env)))))

(defun compile-scam (code)
  "Compiler for SCAM"
  (let ((env (make-scam-env)))
    (emit env '(pushi 0))
    (emit env '(pushi 0))
    (emit env '(call main 0))
    (emit env '(exit 0))
    (dolist (def code)
      (compile-s env def))
    (nreverse (scam-env-asm env))))

(defun compile-s (env code)
  "Compile SCAM statement"
  (cond
    ((numberp code) (emit env `(pushi ,code)))
    ((symbolp code) (emit env `(lvar  ,(lookup env code))))
    ((listp   code)
     (case (car code)

       ((+ - *) 
        (compile-s env (second code))
        (dolist (op-code (cddr code))
          (compile-s env op-code)
          (emit env '(swap))
          (emit env `(,(car code)))))

       (if
        (let ((lab-else  (label env))
              (lab-endif (label env)))
          (compile-s env (second code))
          (emit env `(jumpz ,lab-else))
          (compile-s env (third code))
          (emit env `(jump ,lab-endif))
          (emit env lab-else)
          (compile-s env (fourth code))
          (emit env lab-endif)))

       (print
        (compile-s env (second code))
        (emit env '(print)))

       (define 
        (compile-func env (car (second code)) (cdr (second code)) 
                      (cddr code)))

       (otherwise
        (emit env '(pushi 0))
        (emit env '(pushi 0))
        (dolist (arg (cdr code))
          (compile-s env arg))
        (emit env `(call ,(car code) ,(- (length code) 1))))))))

(defun compile-func (env name args code)
  "Compile a SCAM function definition"
  (setup-args env args)
  (emit env name)
  (dolist (stmt code)
    (compile-s env stmt))
  (emit env '(return)))

(defun setup-args (env args)
  "Set up the bindings for a SCAM argument"
  (let ((arg-count 0))
    (setf (scam-env-bindings env) nil)
    (dolist (arg args)
      (push (cons arg arg-count) (scam-env-bindings env))
      (incf arg-count))))

#|
(setf *fact-test* (compile-scam
  '( (define (main)
       (print (factorial 5)))
     (define (factorial n)
       (if n
           (* n (factorial (- n 1)))
           1)))))

(pprint-code *fact-test*)
(run-vm (make-vm-state :code (assemble *fact-test*)))
|#