(define-library (csc cps)
  (export
    ir1->ir2)
  (import (only (csc gensym) gensym)
          (only (csc hash-map)
            insert
            make-map
            merge)
          (only (csc ir1)
            call-arguments
            call-procedure
            call?
            constant?
            define-syntax?
            if-alternate
            if-consequent
            if-test
            if?
            lexical-ref?
            lexical-set-expression
            lexical-set-ref
            lexical-set?
            library-define-expression
            library-define-ref
            library-define?
            library-ref?
            make-constant
            make-lexical-ref
            sequence-head
            sequence-tail
            sequence?)
          (only (csc ir2)
            make-atom
            make-branch
            make-call-closure
            make-kargs
            make-klabel
            make-ktail
            make-update)
          (only (csc loop)
            loop
            return)
          (scheme base))
  (begin


    (define (new-ref)
      (make-lexical-ref 'generated-symbol (gensym)))


    (define (to-cps expr continuation add-continuation)
      (cond
        ((or (constant? expr)
             (lexical-ref? expr)
             (library-ref? expr))
          (make-atom expr continuation))
        ((lexical-set? expr)
          (let ((ref (new-ref)))
            (to-cps
              (lexical-set-expression expr)
              (add-continuation
                (make-kargs (list ref)
                  (make-update (lexical-set-ref expr) ref continuation)))
              add-continuation)))
        ((library-define? expr)
          (let ((ref (new-ref)))
            (to-cps
              (library-define-expression expr)
              (add-continuation
                (make-kargs (list ref)
                  (make-update (library-define-ref expr) ref continuation)))
              add-continuation)))
        ((define-syntax? expr)
          ; no-op
          (make-atom (make-constant #f) continuation))
        ((if? expr)
          (let* ((true-id (add-continuation
                            (make-klabel
                              (to-cps (if-consequent expr) continuation add-continuation))))
                 (false-id (add-continuation
                             (make-klabel
                               (to-cps (if-alternate expr) continuation add-continuation))))
                 (test-ref (new-ref))
                 (branch-id (add-continuation
                              (make-kargs (list test-ref)
                                (make-branch test-ref true-id false-id)))))
            (to-cps (if-test expr) branch-id add-continuation)))
        ((call? expr)
          ; Technically the order of evaluation is unspecified. We evaluate
          ; expressions left to right.
          (loop with terms = (cons (call-procedure expr) (call-arguments expr))
                with temps = (map (lambda (x) (new-ref)) terms)
                with expr = (make-call-closure (car temps) (cdr temps) continuation)
                for term in (reverse terms)
                for temp in (reverse temps)
                do (set! expr (to-cps term
                                (add-continuation
                                  (make-kargs (list temp) expr))
                                add-continuation))
                finally (return expr)))
        ((sequence? expr)
          (to-cps
            (sequence-head expr)
            (add-continuation
              (make-klabel
                (to-cps (sequence-tail expr) continuation add-continuation)))
            add-continuation))
        (else (error "unexpected type in to-cps" expr))))


    ; Returns a map from integers to CPS continuations.
    ; By convention the continuation at key 0 is the entrypoint.
    (define (ir1->ir2 program)
      (define current-continuation-id 0)
      (define soup (make-map (lambda (x) x) <))
      (define (add-continuation continuation)
        (set! current-continuation-id (+ 1 current-continuation-id))
        (set! soup (insert soup
                     current-continuation-id
                     continuation))
        current-continuation-id)
      (define ktail (add-continuation (make-ktail)))
      (define entrypoint (to-cps program ktail add-continuation))
      (insert soup 0 (make-klabel entrypoint)))))