(define-library (csc ir2)
  (export
    atom-continuation
    atom-expression
    atom?
    branch-atom
    branch-false
    branch-true
    branch?
    call-closure-args
    call-closure-closure
    call-closure?
    ir2=?
    kargs-expression
    kargs-refs
    kargs?
    klabel-expression
    klabel?
    ktail?
    make-atom
    make-branch
    make-call-closure
    make-kargs
    make-klabel
    make-ktail
    make-update
    update-atom
    update-continuation
    update-ref

    ; Re-exports from IR1.
    constant-expression
    constant?
    lexical-ref-gensym
    lexical-ref-name
    lexical-ref?
    library-ref-library
    library-ref-name
    library-ref?
    make-constant
    make-lexical-ref
    lexical-set-expression
    lexical-set-ref
    lexical-set?
    make-lexical-set
    make-library-ref)
  (import (scheme base)
          (only (csc ir1)
            constant?
            ir1=?
            lexical-ref-gensym
            lexical-ref-name
            lexical-ref?
            lexical-set-expression
            lexical-set-ref
            lexical-set?
            library-ref-library
            library-ref-name
            library-ref?
            make-constant
            make-lexical-ref
            make-lexical-set
            make-library-ref)
          (only (csc loop)
            loop
            return))
  (begin
    ; This library defines the intermediate representation IR2.
    ; It's CPS time bitch.

    ; CPS atom:
    ;   An atom is a value that can be computed immediately without
    ;   any subexpressions.
    ;   Atoms consist of
    ;     - constant,
    ;     - lexical-ref,
    ;     - or library-ref

    ; CPS expressions:
    ;   CPS expressions are similar to IR1 expressions,
    ;   but constrained not to have any subexpressions except atoms.
    ;   And they take a continuation.

    ; CPS continuations
    ;   There are a few continuations.
    ;   Continuations are identified by an integer ID into the
    ;   continuation map.
    ;   Guile calls this map the "continuation soup".


    ; CPS expressions.


    ; An atom consists of an atom and a continuation.
    (define-record-type <atom>
      (make-atom expression continuation)
      atom?
      (expression atom-expression)
      (continuation atom-continuation))


    ; Modifies a library or lexically bound variable to the given atom.
    (define-record-type <update>
      (make-update ref atom continuation)
      update?
      (ref update-ref)
      (atom update-atom)
      (continuation update-continuation))


    ; Evaluates the given atom.
    ; If it is true, continue with continuation true.
    ; If false, continue with continuation false.
    (define-record-type <branch>
      (make-branch atom true false)
      branch?
      (atom branch-atom)
      (true branch-true)
      (false branch-false))


    ; Calls the given closure. Closure is an atom, and args is a list of atoms.
    (define-record-type <call-closure>
      (make-call-closure closure args continuation)
      call-closure?
      (closure call-closure-closure)
      (args call-closure-args)
      (continuation call-closure-continuation))


    ; CPS continuations.


    ; The tail continuation.
    (define-record-type <ktail>
      (make-ktail)
      ktail?)


    ; Binds the incoming values to the given lexically-bound variables
    ; and then evaluates expression.
    (define-record-type <kargs>
      (make-kargs refs expression)
      kargs?
      (refs kargs-refs)
      (expression kargs-expression))


    ; Ignores any incoming values and evaluates the given expression.
    (define-record-type <klabel>
      (make-klabel expression)
      klabel?
      (expression klabel-expression))


    (define (ir2=?-sametype x y)
      (cond
        ((and (atom? x) (atom? y))
          (and (ir1=? (atom-expression x) (atom-expression y))
               (= (atom-continuation x) (atom-continuation y))))
        ((and (update? x) (update? y))
          (and (ir1=? (update-ref x) (update-ref y))
               (ir1=? (update-atom x) (update-atom y))
               (= (update-continuation x) (update-continuation y))))
        ((and (branch? x) (branch? y))
          (and (ir1=? (branch-atom x) (branch-atom y))
               (= (branch-true x) (branch-true y))
               (= (branch-false x) (branch-false y))))
        ((and (call-closure? x) (call-closure? y))
          (let ((x-args (call-closure-args x))
                (y-args (call-closure-args y)))
            (and (ir1=? (call-closure-closure x) (call-closure-closure y))
                 (= (length x-args) (length y-args))
                 (loop for x-arg in (call-closure-args x)
                       for y-arg in (call-closure-args y)
                       unless (ir1=? x-arg y-arg)
                         return #f
                       finally (return #t))
                 (= (call-closure-continuation x) (call-closure-continuation y)))))
        ((and (ktail? x) (ktail? y)) #t)
        ((and (kargs? x) (kargs? y))
          (let ((x-refs (kargs-refs x))
                (y-refs (kargs-refs y)))
            (and (= (length x-refs) (length y-refs))
                 (loop for x-ref in x-refs
                       for y-ref in y-refs
                       unless (ir1=? x-ref y-ref)
                         return #f
                       finally (return #t))
                 (ir2=? (kargs-expression x) (kargs-expression y)))))
        ((and (klabel? x) (klabel? y))
          (ir2=? (klabel-expression x) (klabel-expression y)))
        (else #f)))


    (define (ir2=? x y)
      (cond
        ((ir2=?-sametype x y) #t)
        ((and (ir2=?-sametype x x) (ir2=?-sametype y y))
          #f)
        (else (error "One or more arguments has a type unknown to ir2=?" x y))))))