(define-library (csc cps)
  (export
    ir1->ir2)
  (import (only (csc gensym) gensym)
          (only (csc hash-map)
            alist->map
            insert
            merge)
          (only (csc ir1)
            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)
          (only (csc ir2)
            make-atom
            make-branch
            make-kargs
            make-ktail
            make-update)
          (scheme base))
  (begin


    (define (make-soup . l)
      (alist->map (lambda (x) x) < l))


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


    (define-syntax cps-merge
      (syntax-rules ()
        ((cps-merge new-continuations sub-cps)
          (let-values (((expr soup) sub-cps))
            (values expr (merge soup new-continuations))))))


    (define (to-cps expr continuation next-id)
      (cond
        ((or (constant? expr)
             (lexical-ref? expr)
             (library-ref? expr))
          (values (make-atom expr continuation) (make-soup)))
        ((lexical-set? expr)
          (let ((id (next-id))
                (ref (new-ref)))
            (cps-merge
              (make-soup (cons id (make-kargs (list ref)
                                    (make-update (lexical-set-ref expr) ref continuation))))
              (to-cps (lexical-set-expression expr) id next-id))))
        ((library-define? expr)
          (let ((id (next-id))
                (ref (new-ref)))
            (cps-merge
              (make-soup (cons id (make-kargs (list ref)
                                    (make-update (library-define-ref expr) ref continuation))))
              (to-cps (library-define-expression expr) id next-id))))
        ((define-syntax? expr)
          ; no-op
          (values (make-atom (make-constant #f) continuation) (make-soup)))
        ((if? expr)
          (let-values (((id) (next-id))
                       ((test-ref) (new-ref))
                       ((true-id) (next-id))
                       ((false-id) (next-id))
                       ((true-expr true-soup) (to-cps (if-consequent expr) continuation next-id))
                       ((false-expr false-soup) (to-cps (if-alternate expr) continuation next-id)))
            (cps-merge
              (merge true-soup false-soup
                (make-soup (cons id (make-kargs (list test-ref)
                                      (make-branch test-ref true-id false-id)))
                           (cons true-id (make-kargs '() true-expr))
                           (cons false-id (make-kargs '() false-expr))))
              (to-cps (if-test expr) id next-id))))
        (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 (next-id)
        (set! current-continuation-id (+ 1 current-continuation-id))
        current-continuation-id)
      (define ktail (next-id))
      (define-values (expr m) (to-cps program ktail next-id))
      (set! m (insert m ktail (make-ktail)))
      (set! m (insert m 0 (make-kargs '() expr)))
      m)))