git @ Cat's Eye Technologies Larabee / 834f090
Initial import of Larabee version 1.0 revision 2008.0110. Cat's Eye Technologies 10 years ago
3 changed file(s) with 733 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 <html>
1 <head>
2 <title>The Larabee Programming Language</title>
3 </head>
4 <body>
5
6 <h1>The Larabee Programming Language</h1>
7
8 <h2>Introduction</h2>
9
10 <p>The Larabee programming language, named after everybody's favourite
11 assistant to the Chief of CONTROL, is not a happy-go-lucky language.
12 Indeed no, it has plumbed the very depths of the bottomless pit of its own soul,
13 only to have its true nature revealed to it too quickly, the utter shock of this
14 <i>denoument</i> leaving it scarred and reeling.</p>
15
16 <p>You see, Larabee has borrowed the notion of <em>branch prediction</em>
17 from the realm of computer processor architecture, and has chosen to abuse it in
18 one simple but rather nasty way: the interpretation of each branch instruction is not
19 just <em>optimized</em> by the history of branches previously taken, it is
20 semantically <em>determined</em> in part by the history of branches
21 previously taken.
22 Each branch taken (or not taken) increments (or decrements) a value called
23 the branch prediction register (or BPR.) The BPR begins the program at
24 zero; when the BPR is positive, tests are interpreted in the usual way,
25 but when the BPR is negative, the interpretation changes: the
26 "then" and "else" branches are swapped.</p>
27
28 <p>What's more, to prevent (or rather, to <em>stymie</em>) working around
29 this by, say, coding up a lot of branches dependent on constant data to
30 "doctor" the BPR to some extremely (high or) low value, no constant data
31 is allowed in a Larabee program. This has the effect of making programs
32 highly dependent on their input.</p>
33
34 <p>But enough of this insipidly sentimental dada. We must move on to
35 insipidly sentimental dada frought with errors and inconsistencies. Woe!</p>
36
37 <h2>Syntax</h2>
38
39 <p>Larabee programs are notated as S-Expressions, familiar from LISP or
40 Scheme. This is not solely because I am too lazy to write a parser. It is also
41 very fitting for a language which has all of the abstraction and finesse
42 of assembly code <i>sans</i> immediate mode.</p>
43
44 <p>Larabee forms are as follows:</p>
45
46 <ul>
47
48 <li><code>(op <var>op</var> <var>expr1</var> <var>expr2</var>)</code>
49 <p>Evaluate <var>expr1</var>, then evaluate <var>expr2</var>, then perform the operation <var>op</var> on the results.
50 Valid <var>op</var>s are <code>+</code>, <code>-</code>, <code>*</code>,
51 and <code>/</code>, with their usual integer meanings, and
52 <code>&gt;</code>, <code>&lt;</code>, and <code>=</code>
53 with their usual comparison meanings, with a result of 0 on false and 1 on true.
54 Division by zero is not defined.</p>
55 </li>
56
57 <li><code>(test <var>cond-expr</var> <var>expr1</var> <var>expr2</var>)</code>
58
59 <p><code>test</code> evaluates the <var>cond-expr</var> to get either true
60 (non-zero) or false (zero). What happens next depends on the value of the BPR.</p>
61
62 <p>If the BPR is greater than or equal to 0:</p>
63
64 <ul>
65 <li>If <var>cond-expr</var> evaluated to true, evaluate <var>expr1</var> and decrement the BPR.</li>
66 <li>If <var>cond-expr</var> evaluated to false, evaluate <var>expr2</var> and increment the BPR.</li>
67 </ul>
68
69 <p>On the other hand, if the BPR is less than 0:</p>
70
71 <ul>
72 <li>If <var>cond-expr</var> evaluated to true, evaluate <var>expr2</var> and increment the BPR.
73 <li>If <var>cond-expr</var> evaluated to false, evaluate <var>expr1</var> and decrement the BPR.
74 </ul>
75
76 <p><code>test</code> is the lynchpin upon which Larabee's entire
77 notableness, if any, rests.</p>
78
79 <!--
80
81 Now. The semantics of test are as follows:
82
83 Evaluate cond to a boolean.
84 If cond is 'true', increment the BPR.
85 If cond is 'false', decrement the BPR.
86 If the BPR is greater than or equal to 0 {
87 If cond is 'true', evaluate part-a.
88 If cond is 'false', evaluate part-b.
89 }
90 Else if the BPR is less than 0 {
91 If cond is 'true', evaluate part-b.
92 If cond is 'false', evaluate part-a.
93 }
94
95 An alternate semantics for test are as follows:
96
97 Evaluate cond to a boolean.
98
99 -->
100
101 </li>
102
103 <li><code>(input)</code>
104 <p>Waits for an integer to arrive on the input channel, and evaluates to that
105 integer.</p>
106 </li>
107
108 <li><code>(output <var>expr</var>)</code>
109 <p>Evaluates <var>expr</var> to an integer value and produces that
110 integer value on the output channel.</p>
111 </li>
112
113 <li><code>(store <var>addr-expr</var> <var>value-expr</var>
114 <var>next-expr</var>)</code>
115 <p>Evaluates <var>addr-expr</var> to obtain an address, and
116 <var>value-expr</var> to obtain a value, then places that value in storage
117 at that address, overwriting whatever happened to be stored at that address
118 previously. After all that is said and done, evaluates to <var>next-expr</var>.</p>
119 </li>
120
121 <li><code>(fetch <var>addr-expr</var>)</code>
122 <p>Evaluates <var>addr-expr</var> to obtain an address, then
123 evaluates to whatever value is in storage at that address. Not defined
124 when the currently running Larabee program has never previously
125 <code>store</code>d any value at that address.</p>
126 </li>
127
128 <li><code>(label <var>label</var> <var>expr</var>)</code>
129 <p>Indicates that this <var>expr</var> is labelled <var>label</var>.
130 Serves only as a way to reference a program location from another
131 location (with a <code>goto</code>;) when executed directly,
132 has no effect over and above simply evaluating <var>expr</var>.</p>
133 </li>
134
135 <li><code>(goto <var>label</var>)</code>
136 <p>Diverts control to the expression in the leftmost, outermost occurrence of
137 a label named <var>label</var>.</p>
138 </li>
139
140 </ul>
141
142 <h2>Discussion</h2>
143
144 <p>Ah, the burning question: is Larabee Turing-complete? The burning answer is,
145 I think, a technical and somewhat subtle "no".</p>
146
147 <p>But first we must address our subject's special way of dealing with the world.
148 As you've no doubt noticed, Larabee has "issues" with input. (Somewhat interestingly,
149 this emotional baggage was not a direct design goal; it was an unintended consequence
150 of abusing branch prediction and trying to prevent it from going unabused.)
151 These issues will, it turns out, haunt the language unceasingly, day in and day out,
152 with despair and turmoil forever just around the corner.</p>
153
154 <p>A specific hullabaloo induced by Larabee's obdurately retrograde
155 (not to mention completely stupid)
156 input regime is that it's simply not possible to write a program in Larabee
157 which is independent of its input. This alone may make it fail to be
158 Turing-complete, for surely there are many Turing machine programs
159 which are input-invariant, and these programs Larabee cannot legitimately
160 aspire to one day become, or alas, even emulate.</p>
161
162 <p>For example, input invariance is the underlying idea used in converting the
163 usual proof of the uniform halting problem into a (less obvious) proof
164 of the standard halting problem &mdash; you say, for any given input, that
165 we can find a machine that erases whatever input it was given, writes the
166 desired input on its tape, and proceeds to perform a computation that we can't
167 decide will halt or not.</p>
168
169 <p>The idea is also embodied in a traditional quine program, which produces a
170 copy of itself on its output, while talking no input. That is, it doesn't matter what input
171 is given to it (and this is often trivial to prove since the quine is generally witten in
172 the subset of the language which does not contain any input instructions.)</p>
173
174 <p>But Larabee can't do either of these things. There is no Larabee
175 program that can replace its arbitrary input with some fixed, constant choice of
176 input. And while you can write a quine, it will require a certain input to
177 produce itself &mdash; there will always be other inputs which make it
178 produce something different.</p>
179
180 <p>"So what!" you say, being of bold philosophical bent, "it's mere mereology.
181 Whether we consider the input to be part of the program or not is simply not
182 relevant. Stop trying to confuse me with details and definitions when I already know
183 perfectly well what you're talking about."</p>
184
185 <p>Fine, let's say that. The customer is always right, after all...</p>
186
187 <p>The problem, Wendy, is that Larabee is <em>still</em> not Turing-complete.
188 But there are subtler reasons for this. Needle-fine, almost gossamer reasons.
189 Ephemeral reasons with a substantial bouquet; fruity, with notes of chocolate
190 and creosote. I doubt that I can do them justice in prose. However, it still
191 strikes me as a more promising medium than modern dance, I mean at least nominally
192 anyway.</p>
193
194 <p>The reason is basically that you need to know a lower bound on
195 how many tests and variable accesses a Larabee program will make in advance
196 of running it, so you can supply that many values in the input to ensure that
197 the <code>test</code>s in the program go where you want them to go.</p>
198
199 <p>(It should be noted that it was rougly at this point that Pressey reached one of the
200 peaks of his so-called "referential" period, in which he was apt to provide "commentary"
201 on his own work, in the form of interjections or asides, as if from the perspective of a
202 historian from a much later era. Such pretentious interruptions were generally
203 not well received, except perhaps by the occasional loser such as yourself.)</p>
204
205 <p>To illustrate, let's try walking through an attempt to have Larabee make a computation.
206 Factorial, say. In pseudocode, it might look like</p>
207
208 <pre>a := input
209 b := 1
210 while a &gt; 0 {
211 b := b * a
212 a := a - 1
213 }
214 print b</pre>
215
216 <p>Translating this one step toward Larabee, we find the
217 following misty wreck on our doorstep:</p>
218
219 <pre>(begin
220 (store a (input))
221 (store b 1)
222 (label loop
223 (begin
224 (store b (op * b a))
225 (store a (op - a 1))
226 (if (op &gt; a 0)
227 (goto loop) (nop))))
228 (print b))</pre>
229
230 <p>Now, we can't use names, so we say that a lives at
231 location 1 and b lives at location 2 and we have</p>
232
233 <pre>(begin
234 (store 1 (input))
235 (store 2 1)
236 (label loop
237 (begin
238 (store 2 (op * (fetch 2) (fetch 1)))
239 (store 1 (op - (fetch 1) 1))
240 (if (op &gt; (fetch 1) 0)
241 (goto loop) (nop))))
242 (print (fetch 2)))</pre>
243
244 <p>Now, we can't have constants either, so we hold our
245 breath and grope around in the dark to obtain</p>
246
247 <pre>(begin
248 (store (input) (input))
249 (store (input) (input))
250 (label loop
251 (begin
252 (store (input) (op * (fetch (input)) (fetch (input))))
253 (store (input) (op - (fetch (input)) (input)))
254 (if (op &gt; (fetch (input)) (input))
255 (goto loop) (nop))))
256 (print (fetch (input))))</pre>
257
258 <p>...with the understanding that the appropriate inputs for this
259 program are ones that have 0, 1, and 2 in the right places.
260 Naturally, sadly, magnificently, other kinds of inputs will
261 produce other, most likely non-factorial programs.</p>
262
263 <p>Lastly, we have to give up hope of ever seeing the familiar shores of
264 our homeland again, bite the bullet and kick the <code>if</code>
265 habit:</p>
266
267 <pre>(begin
268 (store (input) (input))
269 (store (input) (input))
270 (label loop
271 (begin
272 (store (input) (op * (fetch (input)) (fetch (input))))
273 (store (input) (op - (fetch (input)) (input)))
274 (test (op &gt; (fetch (input)) (input))
275 (goto loop) (nop))))
276 (print (fetch (input))))</pre>
277
278 <p>And, oh, actually, we don't have <code>begin</code> &mdash;
279 nor <code>nop</code>, neither. Hooray!</p>
280
281 <pre>(store (input) (input)
282 (store (input) (input)
283 (label loop
284 (store (input) (op * (fetch (input)) (fetch (input)))
285 (store (input) (op - (fetch (input)) (input))
286 (test (op &gt; (fetch (input)) (input))
287 (goto loop) (print (fetch (input)))))))))</pre>
288
289 <p>Now, if you've been following that, and if you can imagine in the
290 slightest how the input will need to look for any given integer, to
291 produce the correct factorial result on the output &mdash; even <em>assuming</em>
292 you added a bunch of <code>test</code>s somewhere in the program and
293 fed them all the right numbers so that the important <code>test</code> turned
294 out the way you wanted &mdash;
295 then I needn't go to the extra trouble of a rigourous
296 proof to convince you that Larabee is not Turing-complete.</p>
297
298 <p>If, on the other hand, you decide to be stubborn and you say well that might be
299 a very involved encoding you're forcing on the input but it's just an
300 encoding and every language is going to force <em>some</em> encoding on the input
301 so <em>duh</em> you haven't shown me anything <em>really</em>, I'd have to pull out the dreaded
302 ARGUMENT BY ACKERMANN'S FUNCTION. However, I'd really rather not, as it's
303 late, and I'm tired. Maybe later.</p>
304
305 <p><i>(later)</i> OK, it goes something like this. Ackermann's
306 function &mdash; which we know we need at least something that can do
307 better than primitive-recursive, to compute &mdash; has a lower-bound
308 complexity on the order of, well, Ackermann's function.
309 (This in itself seems to be one of those mathematical oddities that seems
310 wiggy when you first hear about it, then self-evident after you've thought
311 about it for a few months... and, if you are lucky, no less wiggy.)
312 So anyway, what does that imply about how many items would need to be
313 input to a Larabee program that computes Ackermann's function? And what does
314 <em>that</em> imply about what you'd need to obtain that input in the first place?
315 Hmm? Hmm?</p>
316
317 <h2>Trivia</h2>
318
319 <p>There is an implementation of Larabee written in a relatively pure
320 subset of Scheme. I hesitate to call it a reference implementation, but
321 it seems I have no choice in these matters.</p>
322
323 <h2>Conclusion</h2>
324
325 <p>It has come time to say goodbye to our subject, our illustrious monstrosity,
326 our glorious bottom-feeder, our feel-good cripple of the year. With such a
327 distressing burden to bear, what's a programming language to do? Who could
328 begrudge it seeking comfort in the arms of an understanding
329 mistress, a bottle of bourbon, the Cone of Silence? But even so, saving
330 such wretched constructions from their own self-annihilation, so we may all
331 learn from its example &mdash; this is one of the very reasons
332 we run this Home for Wayward Calculi, is it not?</p>
333
334 <p>Indeed.</p>
335
336 <p>This is the place where ordinarily where I would wish you a happy something or other.
337 But I shall graciously decline this time; it is all too clear that
338 there is simply no happiness left.</p>
339
340 <p>-Chris Pressey
341 <br />January 10, 2008
342 <br />Chicago, Illinois
343 <br />RICHARD M. DALEY, MAYOR
344 </p>
345
346 </body>
347 </html>
0 ;
1 ; larabee.scm - reference implementation of the Larabee programming language
2 ; $Id: larabee.scm 15 2008-01-09 06:09:13Z catseye $
3 ;
4
5 ;
6 ; Copyright (c)2006 Cat's Eye Technologies. All rights reserved.
7 ;
8 ; Redistribution and use in source and binary forms, with or without
9 ; modification, are permitted provided that the following conditions
10 ; are met:
11 ;
12 ; 1. Redistributions of source code must retain the above copyright
13 ; notices, this list of conditions and the following disclaimer.
14 ; 2. Redistributions in binary form must reproduce the above copyright
15 ; notices, this list of conditions, and the following disclaimer in
16 ; the documentation and/or other materials provided with the
17 ; distribution.
18 ; 3. Neither the names of the copyright holders nor the names of their
19 ; contributors may be used to endorse or promote products derived
20 ; from this software without specific prior written permission.
21 ;
22 ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 ; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
24 ; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 ; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 ; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 ; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 ; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 ; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 ; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 ; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 ; POSSIBILITY OF SUCH DAMAGE.
34
35 ; ----------------------------------------------------------------------------
36
37 ;
38 ; Updatable store ADT (implemented in pure Scheme.)
39 ;
40
41 (define make-empty-store
42 (lambda ()
43 (make-vector 10 0)))
44
45 (define store-update
46 (lambda (store addr value)
47 (let*
48 ((new-vector (expand-store store addr))
49 (foo (vector-set! new-vector addr value)))
50 new-vector)))
51
52 (define expand-store
53 (lambda (store addr)
54 (let*
55 ((extent (if (>= addr (vector-length store))
56 (vector->list (make-vector (- addr (vector-length store) -1) 0))
57 '()))
58 (base (vector->list store))
59 (full (append extent base)))
60 (list->vector full))))
61
62 (define store-retrieve
63 (lambda (store addr)
64 (vector-ref store addr)))
65
66 ; ----------------------------------------------------------------------------
67
68 ;
69 ; Larabee program state ADT.
70 ;
71 ; A state includes a "current value" (like an accumulator,) a store, and
72 ; a special unbounded integer value called the "branch predicition register,"
73 ; although it might be better called the "right bastard register."
74 ;
75
76 (define make-state
77 (lambda (value bpr store)
78 (vector value bpr store)))
79
80 (define get-value
81 (lambda (state)
82 (vector-ref state 0)))
83
84 (define get-bpr
85 (lambda (state)
86 (vector-ref state 1)))
87
88 (define get-store
89 (lambda (state)
90 (vector-ref state 2)))
91
92 (define initial-state
93 (make-state 0 0 (make-empty-store)))
94
95 (define bad-program
96 (make-state #f 0 (make-empty-store)))
97
98 (define alter-bpr
99 (lambda (state bpr-delta)
100 (make-state (get-value state) (+ (get-bpr state) bpr-delta) (get-store state))))
101
102 (define set-value
103 (lambda (state new-value)
104 (make-state new-value (get-bpr state) (get-store state))))
105
106 (define state-store
107 (lambda (state addr value)
108 (let*
109 ((old-store (get-store state))
110 (new-store (store-update old-store addr value)))
111 (make-state (get-value state) (get-bpr state) new-store))))
112
113 (define state-fetch
114 (lambda (state addr)
115 (let*
116 ((store (get-store state))
117 (value (store-retrieve store addr)))
118 (make-state value (get-bpr state) store))))
119
120 ; ----------------------------------------------------------------------------
121
122 ;
123 ; A function which can be uncommented to produce debugging output.
124 ;
125
126 (define debug
127 (lambda (str data)
128 ; (display str) (display ": ") (display data) (newline)
129 data
130 ))
131
132 ; ----------------------------------------------------------------------------
133
134 ;
135 ; Evaluate a Larabee expression. Returns a Larabee state.
136 ;
137
138 (define eval-expr
139 (lambda (expr prog state)
140 (debug "eval-expr" expr)
141 (cond
142 ((null? expr)
143 bad-program)
144 ((list? expr)
145 (let
146 ((command (car expr)))
147 (cond
148 ((eq? command 'label)
149 (let
150 ((body (caddr expr)))
151 (eval-expr body prog state)))
152 ((eq? command 'test)
153 (let
154 ((condo (cadr expr))
155 (expr-a (caddr expr))
156 (expr-b (cadddr expr)))
157 (eval-test condo expr-a expr-b prog state)))
158 ((eq? command 'goto)
159 (let
160 ((label (cadr expr)))
161 (eval-goto label prog state)))
162 ((eq? command 'op)
163 (let
164 ((operator (cadr expr))
165 (expr-a (caddr expr))
166 (expr-b (cadddr expr)))
167 (eval-op operator expr-a expr-b prog state)))
168 ((eq? command 'input)
169 (eval-input prog state))
170 ((eq? command 'output)
171 (let
172 ((msg-expr (cadr expr)))
173 (eval-output msg-expr prog state)))
174 ((eq? command 'store)
175 (let
176 ((addr-expr (cadr expr))
177 (value-expr (caddr expr))
178 (next-expr (cadddr expr)))
179 (eval-store addr-expr value-expr next-expr prog state)))
180 ((eq? command 'fetch)
181 (let
182 ((addr-expr (cadr expr)))
183 (eval-fetch addr-expr prog state)))
184 (else
185 bad-program))))
186 (else
187 bad-program))))
188
189 ;
190 ; Evaluate a 'test' expression.
191 ;
192
193 (define eval-test
194 (lambda (condo expr-a expr-b prog state)
195 (debug "eval-test" condo)
196 (let*
197 ((condo-state (eval-expr condo prog state))
198 (bool (get-value condo-state))
199 (bpr (get-bpr condo-state)))
200 (if (>= bpr 0)
201 (if bool
202 (eval-expr expr-a prog (alter-bpr condo-state -1))
203 (eval-expr expr-b prog (alter-bpr condo-state +1)))
204 (if bool
205 (eval-expr expr-b prog (alter-bpr condo-state +1)
206 (eval-expr expr-a prog (alter-bpr condo-state -1))))))))
207
208 ;
209 ; Evaluate a 'goto' expression.
210 ;
211
212 (define eval-goto
213 (lambda (label prog state)
214 (debug "eval-goto" label)
215 (let
216 ((targets (find-labels prog label)))
217 (if (null? targets)
218 (begin
219 (display "No such target") (newline)
220 bad-program)
221 (begin
222 (debug "found-targets" targets)
223 (eval-expr (car targets) prog state))))))
224
225 ;
226 ; Helper function for eval-goto.
227 ;
228
229 (define find-labels
230 (lambda (expr label)
231 (debug "find-labels" expr)
232 (cond
233 ((list? expr)
234 (let
235 ((command (car expr)))
236 (cond
237 ((eq? command 'label)
238 (let
239 ((putative-label (cadr expr))
240 (body-expr (caddr expr)))
241 (if (eq? putative-label label)
242 (list body-expr)
243 (find-labels body label))))
244 ((eq? (car expr) 'test)
245 (let
246 ((condo (cadr expr))
247 (expr-a (caddr expr))
248 (expr-b (cadddr expr)))
249 (append
250 (find-labels condo label)
251 (find-labels expr-a label)
252 (find-labels expr-b label))))
253 ((eq? command 'op)
254 (let
255 ((expr-a (caddr expr))
256 (expr-b (cadddr expr)))
257 (append
258 (find-labels expr-a label)
259 (find-labels expr-b label))))
260 ((eq? command 'output)
261 (let
262 ((msg-expr (cadr expr)))
263 (find-labels msg-expr label)))
264 ((eq? command 'store)
265 (let
266 ((addr-expr (cadr expr))
267 (value-expr (caddr expr)))
268 (append
269 (find-labels addr-expr label)
270 (find-labels value-expr label))))
271 ((eq? command 'fetch)
272 (let
273 ((addr-expr (cadr expr)))
274 (find-labels addr-expr label)))
275 (else
276 '()))))
277 (else
278 '()))))
279
280 (define eval-op
281 (lambda (operator expr-a expr-b prog state)
282 (let*
283 ((state-a (eval-expr expr-a prog state))
284 (value-a (get-value state-a))
285 (state-b (eval-expr expr-b prog state-a))
286 (value-b (get-value state-b))
287 (value-c (enact-op operator value-a value-b)))
288 (set-value state-b value-c))))
289
290 (define enact-op
291 (lambda (operator value-a value-b)
292 (cond
293 ((eq? operator '+)
294 (+ value-a value-b))
295 ((eq? operator '-)
296 (- value-a value-b))
297 ((eq? operator '*)
298 (* value-a value-b))
299 ((eq? operator '/)
300 (/ value-a value-b))
301 ((eq? operator '>)
302 (> value-a value-b))
303 ((eq? operator '<)
304 (< value-a value-b))
305 ((eq? operator '=)
306 (eq? value-a value-b))
307 (else
308 value-a))))
309
310 (define eval-input
311 (lambda (prog state)
312 (let
313 ((value (read)))
314 (if (number? value)
315 (set-value state value)
316 (begin (display "?REDO") (newline) (eval-input prog store))))))
317
318 (define eval-output
319 (lambda (msg-expr prog state)
320 (let
321 ((new-state (eval-expr msg-expr prog state)))
322 (begin
323 (display (get-value new-state)) (newline)
324 new-state))))
325
326 (define eval-store
327 (lambda (addr-expr value-expr next-expr prog state)
328 (let*
329 ((addr-state (eval-expr addr-expr prog state))
330 (addr (get-value addr-state))
331 (value-state (eval-expr value-expr prog addr-state))
332 (value (get-value value-state))
333 (new-state (state-store value-state addr value)))
334 (eval-expr next-expr prog new-state))))
335
336 (define eval-fetch
337 (lambda (addr-expr prog state)
338 (let*
339 ((addr-state (eval-expr addr-expr prog state))
340 (addr (get-value addr-state)))
341 (state-fetch state addr-state))))
342
343 ; ----------------------------------------------------------------------------
344
345 ;
346 ; Evaluate (run) a Larabee program.
347 ;
348
349 (define eval-larabee
350 (lambda (prog)
351 (begin
352 (eval-expr prog prog initial-state)
353 (display "OK")
354 (newline))))
0 ;
1 ; test.scm - test suite for the Larabee reference interpreter
2 ; $Id: test.scm 15 2008-01-09 06:09:13Z catseye $
3 ;
4
5 (load "larabee.scm")
6
7 ; ----------------------------------------------------------------------------
8
9 (define test1
10 (lambda ()
11 (eval-larabee '(label foo (goto foo)))
12 ))
13
14 (define test2
15 (lambda ()
16 (eval-larabee '(output (op + (input) (input))))
17 ))
18
19 (define test3
20 (lambda ()
21 (eval-larabee
22 '(store (input) (input)
23 (store (input) (input)
24 (label loop
25 (store (input) (op * (fetch (input)) (fetch (input)))
26 (store (input) (op - (fetch (input)) (input))
27 (test (op > (fetch (input)) (input))
28 (goto loop) (print (fetch (input)))))))))
29 )))