; ssc: the sufficiently simple compiler

; The goal of ssc is to allow simple prefix expressions to be compiled into 65816 code that
; would run at least as fast or faster than the equivalent threaded Forth code. Complex
; optimizations are a non-goal; if you want to tune the generated code, go ahead and write
; the assembly directly.

; * All values are 16-bit integers, like Forth or BCPL.
; * Data and return addresses are mixed on one stack, unlike Forth.
; * Function calls take a fixed number of arguments, and return 0 or 1 results. The compiler enforces arity checking.
; * To call a function taking arguments [arg1 arg2 arg3], arg3 should be in the A register, and the stack should look like:
;     arg1 arg2 return-address
; * The caller is responsible for removing arg1 + arg2 from the stack once the function returns.
; * The caller is responsible for preserving the X and Y registers, if this is desirable.
; * If the function returns a value, it is stored in the A register.
; * If a function takes no arguments and returns no result, it is not obliged to preserve the A register.
; * Multitasking is achieved by overlapping the D and S registers on the same 256-byte page of memory.
;   Yielding to a new task involves saving the S register, setting the D register to the new task's page,
;   then setting the S register to the saved value in the old task.
; * Useful task-local "registers" are kept at the beginning of the page, and the stack grows down from the end of the page.
;   * DP register list:
;     * bank-local address (16 bits)
;     * long address (24 bits)
;     * Last suspended value of S
;     * Mailbox
;     * Pointer to next task

; Compiler notes:
; Expressions are of the form [:function arg1 arg2 arg3]
; args are either strings (symbols) or numbers
(local Object (require :core.object))
(local lume (require :lib.lume))
(local Ssc (Object:extend))
(local Prg (require :asm.asm))

(fn Ssc.new [self ?opts]
  (local opts (or ?opts {}))
  (set self.prg (or opts.prg (Prg.new nil :65816)))
  (when opts.exprforms (set self.exprforms opts.exprforms))
  (when opts.stmtforms (set self.stmtforms opts.stmtforms))
  (set self.functions {}))

(set Ssc.exprforms
  {:+ (lambda [self first ...]
        (local block [:block [:clc] (self:compile-expr first)])
        (for [i 1 (select :# ...)]
          (let [val (select i ...)]
            (table.insert block
              (match val
                1 [:inc]
                -1 [:dec]
                (where val (= (type val) :number)) [:adc val]
                _ [:block (self:compile-expr val) [:adc 0 :s] [:ply]]))))
        block)
   :- (lambda [self first ...]
        (local block [:block [:sec] (self:compile-expr first)])
        (for [i 1 (select :# ...)]
          (let [val (select i ...)]
            (table.insert block
              (match val
                1 [:dec]
                -1 [:inc]
                (where val (= (type val) :number)) [:sbc val]
                _ [:block (self:compile-expr val) [:sbc 0 :s] [:ply]]))))
        block)
    :asm (lambda [self ...] [:block ...])
  })
(fn countiter [minmax ?max]
  (let [min (if ?max minmax 1)
        max (or ?max minmax)]
    (values (fn [_ i] (if (>= i max) nil (+ i 1)))
            nil
            min)))

(fn Ssc.compile-expr [self expr]
  (match expr
    (where num (= (type num) :number)) [:block [:pha] [:lda num]]
    ;:string TODO: oh shit I need to keep track of local scoping etc
    (where [func & args] (= (?. self.functions func :arity) (length args))
                         (. self.functions func :returns-value))
      (let [pre (icollect [_ arg (ipairs args)] (self:compile-expr arg))
            post (if (<= (length args) 1) [] (icollect [_ (countiter (- (length args) 1))] [:ply]))]
        (lume.concat [:block] pre [[:jsr func]] post))
    (where [form & args] (. self.exprforms form))
      ((. self.exprforms form) self (table.unpack args))
    _ (error (.. "Unrecognized expression " (fv expr)))))

Ssc