(define-library (csc linker)
  (export link)
  (import (scheme base)
          (only (csc hash-map)
            compare-numbers
            insert
            lookup
            make-map
            map-for-each)
          (only (csc loop)
            loop
            return)
          (only (csc match) match))
  (begin
    ; A CSC bytecode program is a list of opcodes and labels. An opcode is a
    ; list of an opcode and arguments. Arguments can be any of:
    ;   - (local x),
    ;   - (global x lib),
    ;   - (const x),
    ;   - or (label x).
    ; The full list of opcodes can be found in encoding.csc.


    ; Rewrites each (label x) form into a integer constant.
    (define (translate-labels program label-map)
      (loop for opcode in program
            for op = (car opcode)
            for args = (cdr opcode)
            unless (symbol=? op 'label)
              collect (cons op (loop for arg in args
                                     collect (match arg
                                               (('label 'init) 
                                                 (list 'const (lookup label-map -1)))
                                               (('label x)
                                                 (list 'const (lookup label-map x)))
                                               (_ arg))))))


    (define (make-label-map offset program)
      (loop for op in program
            for i from offset
            with m = (make-map compare-numbers)
            do (match op
                 (('label 'init)
                   (set! m (insert m -1 i))
                   (set! i (- i 1)))  ; Labels will be removed later.
                 (('label id)
                   (set! m (insert m id i))
                   (set! i (- i 1))))
            finally (return m)))


    (define (translate-globals program environment)
      (define next-global-id 0)
      (map-for-each (lambda (k v)
                      (when (>= v next-global-id)
                        (set! next-global-id (+ 1 v))))
        environment)
      (define (translate-global x)
        (or (lookup environment x #f)
            (let ((id next-global-id))
              (set! next-global-id (+ 1 next-global-id))
              (set! environment (insert environment x id))
              id)))
      (loop for opcode in program
            for op = (car opcode)
            for args = (cdr opcode)
            collect (cons op (loop for arg in args
                                   collect (match arg
                                             (('global x lib)
                                               (list 'const (translate-global arg)))
                                             (_ arg))))))


    (define (link programs environment)
      (translate-globals
        (loop for prog in programs
              for off = 0 then (+ off (length converted-prog))
              for converted-prog = (let ((prog-prelude (cons
                                                         (list 'jmp '(label init))
                                                         prog)))
                                     (translate-labels
                                       prog-prelude
                                       (make-label-map off prog-prelude)))
              append converted-prog)
        environment))))