(define-library (csc linker)
  (export
    add-to-environment
    compare-globals
    link)
  (import (scheme base)
          (only (csc format)
            sprintf)
          (only (csc hash-map)
            compare-numbers
            hash-bytevector
            insert
            lookup
            make-comparer
            make-map
            map-for-each)
          (only (csc loop)
            loop
            return)
          (only (csc match) match)
          (only (scheme case-lambda)
            case-lambda))
  (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 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 id)
                   (set! m (insert m id i))
                   (set! i (- i 1))))  ; Labels will be removed later.
            finally (return m)))


    (define (add-to-environment environment programs)
      (define next-global-id 0)
      (map-for-each (lambda (k v)
                      (when (>= v next-global-id)
                        (set! next-global-id (+ 1 v))))
        environment)
      (loop for opcode in (apply append programs)
            do (loop for arg in (cdr opcode)
                     do (match arg
                          (('global name lib)
                            (define id next-global-id)
                            (set! next-global-id (+ 1 next-global-id))
                            (set! environment (insert environment arg id))))))
      environment)


    (define compare-globals
      (make-comparer
        (lambda (x)
          (hash-bytevector (string->utf8 (sprintf "{}" x))))
        (lambda (x y)
          (cond
            ((equal? x y) 0)
            ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1)
            (else 1)))))


    (define (translate-globals program environment)
      (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 (lookup environment arg)))
                                             (_ arg))))))


    (define (num-globals environment)
      (define n 0)
      (map-for-each (lambda (k v)
                      (when (<= n v)
                        (set! n (+ 1 v))))
        environment)
      n)


    (define link
      (case-lambda
        ((programs environment)
          (append
            (list
              (list 'alloc (list 'local 0) (list 'const (num-globals environment))))
            (translate-globals
              (loop for prog in programs
                    for off = 1 then (+ off (length converted-prog))
                    for converted-prog = (translate-labels
                                           prog
                                           (make-label-map off prog))
                    append converted-prog)
              environment)))
        ((programs)
          (link programs (add-to-environment (make-map compare-globals) programs)))))))