(define-module (scmvm language assembly)
  #:use-module (scmvm vm)
  #:use-module (scmvm assembler)
  #:use-module (srfi srfi-1)
  #:use-module ((scheme base) #:select (write-bytevector))
  #:export (assemble assemble-instructions!))

(define *aliases*
  '((if . branch)))

(define (or-alias inst)
  (or (assq-ref *aliases* inst) inst))

(define (lookup-instruction isa inst)
  (define inst-obj (instruction-lookup isa (or-alias inst)))
  (or inst-obj
      (error (format #f "could not find instruction ~a in ISA ~a" inst isa))))

(define label? (negate pair?))
(define (variable? x)
  (and (pair? x) (eq? (car x) 'variable)))
(define (ref? x)
  (and (pair? x) (eq? (car x) 'ref)))
(define (set!? x)
  (and (pair? x) (eq? (car x) 'set!)))
(define (push? x)
  (and (pair? x) (eq? (car x) 'push)))

(define (emit-push asm v)
  (emit-instruction asm 'push)
  (if (number? v)
      (emit-literal asm v)
      (emit-reference asm v)))

(define (assemble-instructions! asm inst-seq)
  (when (pair? inst-seq)
    (define next-inst (car inst-seq))
    (cond
     [(label? next-inst)
      (emit-label asm next-inst)]
     [(variable? next-inst)
      (emit-label asm (second next-inst))
      (emit-literal asm (third next-inst))]
     [(ref? next-inst)
      (emit-push asm (second next-inst))
      (emit-instruction asm '@)]
     [(set!? next-inst)
      (emit-push asm (second next-inst))
      (emit-instruction asm '!)]
     [(push? next-inst)
      (emit-push asm (second next-inst))]
     [else
      (emit-instruction asm (instruction-name (lookup-instruction (assembler-instruction-set asm) (first next-inst))))])
    (assemble-instructions! asm (cdr inst-seq))))

(define (assemble instructions instruction-set port)
  (define asm (make-assembler instruction-set))
  (assemble-instructions! asm instructions)
  (assembler-backpatch! asm)
  (assembler-dump-program asm port))