(define-library (csc encoding)
  (export encode)
  (import (scheme base)
          (only (csc match) match))
  (begin
    ; I'm only going to say this once, so pay attention.
    ; The format of unboxed constants is described in bytecocde/src/data.rs.
    ; Boxed values are represented by a pointer to an array on the heap. The
    ; first position in the array is an integer code indicating what type the
    ; object is. Vectors have code 0, codes for other types are not stable.
    ; Vectors are represented as an array, the first element of which is the
    ; integer 0 (the type code), the second element is the vector length, and
    ; the remaining slots hold the array values.


    (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)))))