aboutsummaryrefslogtreecommitdiffstats
path: root/csc/ir2.csc
blob: 6ab070572d78ee66f259370236ea83e3e207083e (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
(define-library (csc ir2)
  (export
    atom-continuation
    atom-expression
    atom?
    ir2=?
    kargs-expression
    kargs-refs
    kargs?
    ktail?
    make-atom
    make-kargs
    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))


    ; 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))


    (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 (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)))))
        (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))))))