(define-library (csc encoding)
  (export encode)
  (import (scheme base)
          (only (csc match) match))
  (begin


    (define (right-shift n1 n2)
      (floor-quotient n1 (expt 2 n2)))  ; Yikes.


    (define (low-byte n)
      (modulo n #x100))


    (define (64->le-bytes n)
      (list
        (low-byte n)
        (low-byte (right-shift n 8))
        (low-byte (right-shift n 16))
        (low-byte (right-shift n 24))
        (low-byte (right-shift n 32))
        (low-byte (right-shift n 40))
        (low-byte (right-shift n 48))
        (low-byte (right-shift n 56))))


    (define (opcode-switch opcode)
      (match opcode
        (((! 'const) n) (append (64->le-bytes 1010) (64->le-bytes n)))
        ((! 'add) (64->le-bytes 1020))
        ((! 'sub) (64->le-bytes 1030))
        ((! 'mul) (64->le-bytes 1040))
        ((! 'div) (64->le-bytes 1050))
        ((! 'mod) (64->le-bytes 1060))
        ((! 'alloc) (64->le-bytes 2010))
        (((! 'peek) n) (append (64->le-bytes 2020) (list n)))
        (((! 'poke) n) (append (64->le-bytes 2030) (list n)))
        ((! 'peekbyte) (64->le-bytes 2040))
        ((! 'pokebyte) (64->le-bytes 2050))
        ((! 'pop) (64->le-bytes 3010))
        (((! 'local) n) (append (64->le-bytes 3020) (list n)))
        (((! 'if) n) (append (64->le-bytes 4010) (64->le-bytes n)))
        (((! 'call) n) (append (64->le-bytes 4020) (list n)))
        ((! 'ret) (64->le-bytes 4030))
        ((! 'exit) (64->le-bytes 4040))
        ((! 'putc) (64->le-bytes 5010))
        ((! 'getc) (64->le-bytes 5020))
        (_ (error "invalid opcode" opcode))))


    (define (encode program)
      (apply append (map opcode-switch program)))))