Skip to content
Newer
Older
100644 444 lines (357 sloc) 11.9 KB
c043025 initial commit
Danny Yoo authored Jul 12, 2011
1 #lang racket/base
2
d7133e5 renaming to farce
Danny Yoo authored Jul 12, 2011
3 ;; The absolute minimum necessary to play with:
4 ;;
5 ;; http://ycombinator.com/arc/tut.txt
6
7
8
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
9 (require (for-syntax racket/base)
ab2f654 some more
Danny Yoo authored Jul 16, 2011
10 (for-syntax racket/list)
cdc0dca added language helpers to help me generate the right code for datum a…
Danny Yoo authored Jul 12, 2011
11 (for-syntax "language-helpers.rkt")
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
12 racket/stxparam
cdc0dca added language helpers to help me generate the right code for datum a…
Danny Yoo authored Jul 13, 2011
13 "runtime.rkt")
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
14
15
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
16
17
18
ab2f654 some more
Danny Yoo authored Jul 16, 2011
19 (define-syntax (arc-datum stx)
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
20 (syntax-case stx ()
21 [(_ . v)
cdc0dca added language helpers to help me generate the right code for datum a…
Danny Yoo authored Jul 13, 2011
22 (convert-datum (syntax->datum #'v) #f)]))
c043025 initial commit
Danny Yoo authored Jul 12, 2011
23
24
ab2f654 some more
Danny Yoo authored Jul 16, 2011
25
26 ;; Returns true if stx is an identifier that's been lexically bound.
27 (define-for-syntax (lexically-bound? stx)
28 (let ([expanded (local-expand stx (syntax-local-context) #f)])
29 (cond
30 [(and (identifier? expanded)
31 (eq? #f (identifier-binding expanded)))
32 #f]
33 [else
34 #t])))
9d7ac58 very hacky versions of the noation for function composition and negation
Danny Yoo authored Jul 27, 2011
35
36
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 25, 2012
37 ;; looks-like-composition?: identifier-syntax -> boolean
38 ;;
39 ;; Returns true if the identifier looks like function composition.
9d7ac58 very hacky versions of the noation for function composition and negation
Danny Yoo authored Jul 27, 2011
40 (define-for-syntax (looks-like-composition? id)
41 (let ([name (symbol->string (syntax-e id))])
42 (let ([pieces (regexp-split #rx":" name)])
43 (cond
44 [(= (length pieces) 2)
45 (let ([lhs (datum->syntax id (string->symbol (car pieces)))]
46 [rhs (datum->syntax id (string->symbol (cadr pieces)))])
47 (if (and (lexically-bound? lhs)
48 (lexically-bound? rhs))
49 (list lhs rhs)
50 #f))]
51 [else
52 #f]))))
53
54 (define-for-syntax (looks-like-negation? id)
55 (let ([name (symbol->string (syntax-e id))])
56 (let ([a-match (regexp-match #rx"~(.+)" name)])
57 (cond
58 [a-match
59 (let ([maybe-negated-function
60 (datum->syntax id (string->symbol (cadr a-match)))])
61 (cond [(lexically-bound? maybe-negated-function)
62 maybe-negated-function]
63 [else
64 #f]))]
65 [else
66 #f]))))
67
68
69 ;; When we hit on toplevel identifiers that we don't know about, see if
70 ;; this is a use of the composition of two functions using ':', where the left
71 ;; and right sides are bound identifiers.
72 (define-syntax (arc-top stx)
73 (syntax-case stx ()
74 [(_ . id)
75 (cond
76 [(looks-like-composition? #'id)
77 => (lambda (lhs+rhs)
78 (with-syntax ([lhs (car lhs+rhs)]
79 [rhs (cadr lhs+rhs)])
80 (syntax/loc #'id
81 (arc-compose lhs rhs))))]
82 [(looks-like-negation? #'id)
83 => (lambda (negated-function)
84 (with-syntax ([negated-function negated-function])
85 (syntax/loc #'id
86 (arc-negate negated-function))))]
87 [else
88 ;; Otherwise, just reuse Racket's #%top.
89 (syntax/loc stx
90 (#%top . id))])]))
91
92
ab2f654 some more
Danny Yoo authored Jul 16, 2011
93
c043025 initial commit
Danny Yoo authored Jul 12, 2011
94 ;; Variable assignment.
95 ;; We expand the left hand side and see if it's already a bound identifier.
96 ;; If it hasn't been bound yet, this becomes a definition.
97 ;; Otherwise, it turns magically into an assignment.
cb49367 old work
Danny Yoo authored Mar 25, 2012
98 (define-syntax (arc-assign stx)
c043025 initial commit
Danny Yoo authored Jul 12, 2011
99 (syntax-case stx ()
100 [(_ lhs rhs)
101 (let ([expanded-lhs (local-expand #'lhs
102 (syntax-local-context)
103 #f)])
104 (begin
105 (cond
9bd0eef bug with the way we're constructing strings; must not use quote or else
Danny Yoo authored Jul 12, 2011
106 [(identifier? expanded-lhs)
107 (cond
108 [(eq? #f (identifier-binding expanded-lhs))
109 (quasisyntax/loc stx
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
110 ;; Note: we create a definition and then set! it so
111 ;; that we convince Racket that it shouldn't be
112 ;; treated as a constant.
113 (begin (define #,expanded-lhs #f)
114 (set! #,expanded-lhs rhs)
0226eca more play
Danny Yoo authored Jul 16, 2011
115 #,expanded-lhs))]
9bd0eef bug with the way we're constructing strings; must not use quote or else
Danny Yoo authored Jul 12, 2011
116 [else
117 (quasisyntax/loc stx
0226eca more play
Danny Yoo authored Jul 16, 2011
118 (begin (set! #,expanded-lhs rhs)
119 #,expanded-lhs))])]
c043025 initial commit
Danny Yoo authored Jul 12, 2011
120 [else
9bd0eef bug with the way we're constructing strings; must not use quote or else
Danny Yoo authored Jul 12, 2011
121 (syntax-case expanded-lhs ()
122 [(structure index)
123 (quasisyntax/loc stx
0226eca more play
Danny Yoo authored Jul 16, 2011
124 (let ([data structure]
125 [rhs-value rhs])
9bd0eef bug with the way we're constructing strings; must not use quote or else
Danny Yoo authored Jul 12, 2011
126 (if (prop:setter? data)
0226eca more play
Danny Yoo authored Jul 16, 2011
127 (begin ((prop:setter-accessor data) data index rhs-value)
128 rhs-value)
9bd0eef bug with the way we're constructing strings; must not use quote or else
Danny Yoo authored Jul 12, 2011
129 (error '= "~e does not support the setter protocol" data))))]
130
131 [else
132 (quasisyntax/loc stx
0226eca more play
Danny Yoo authored Jul 16, 2011
133 (let ([rhs-value rhs])
134 (set! #,expanded-lhs rhs-value)
135 rhs-value))])])))]))
c043025 initial commit
Danny Yoo authored Jul 12, 2011
136
d7133e5 renaming to farce
Danny Yoo authored Jul 12, 2011
137
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
138 (define-syntax (arc-zap stx)
139 (syntax-case stx ()
140 [(_ fn (structure index))
141 (quasisyntax/loc stx
142 (let ([data structure]
143 [rhs-value (fn (structure index))])
144 (if (prop:setter? data)
145 (begin ((prop:setter-accessor data) data index rhs-value)
146 rhs-value)
147 (error '= "~e does not support the setter protocol" data))))]
148 [(_ fn id)
149 (identifier? #'id)
150 (quasisyntax/loc stx
cb49367 old work
Danny Yoo authored Mar 25, 2012
151 (arc-assign id (fn id)))]))
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
152
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
153
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
154 (define-syntax (arc-increment stx)
d7133e5 renaming to farce
Danny Yoo authored Jul 12, 2011
155 (syntax-case stx ()
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
156 [(_ x)
157 (syntax/loc stx
158 (arc-zap add1 x))]))
d7133e5 renaming to farce
Danny Yoo authored Jul 12, 2011
159
cb49367 old work
Danny Yoo authored Mar 25, 2012
160
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
161 (define-syntax (arc-decrement stx)
b634e8c experiments with syntax properties, just so I know how to use them fo…
Danny Yoo authored Jul 12, 2011
162 (syntax-case stx ()
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
163 [(_ x)
164 (syntax/loc stx
165 (arc-zap sub1 x))]))
166
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
167
b634e8c experiments with syntax properties, just so I know how to use them fo…
Danny Yoo authored Jul 12, 2011
168
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
169
170
171 (define-syntax (arc-quote stx)
b634e8c experiments with syntax properties, just so I know how to use them fo…
Danny Yoo authored Jul 12, 2011
172 (syntax-case stx ()
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
173 [(_ thing)
174 (convert-datum (syntax->datum #'thing) #t)]))
175
176
b634e8c experiments with syntax properties, just so I know how to use them fo…
Danny Yoo authored Jul 12, 2011
177
178
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
179 (define-syntax (def stx)
180 (syntax-case stx ()
181 [(_ name args body ...)
ab2f654 some more
Danny Yoo authored Jul 16, 2011
182 (identifier? #'name)
183 (cond
184 [(lexically-bound? #'name)
185 (syntax/loc stx
0226eca more play
Danny Yoo authored Jul 16, 2011
186 (begin (set! name (fn args
187 body ...))
188 name))]
ab2f654 some more
Danny Yoo authored Jul 16, 2011
189 [else
190 (syntax/loc stx
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
191 ;; Note: we create a definition and then set! it so
192 ;; that we convince Racket that it shouldn't be
193 ;; treated as a constant.
194 (begin (define name #f)
195 (set! name (fn args body ...))
0226eca more play
Danny Yoo authored Jul 16, 2011
196 name))])]))
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
197
198 (define-syntax (fn stx)
199 (syntax-case stx ()
0226eca more play
Danny Yoo authored Jul 16, 2011
200 [(_ (id ...) body ...)
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
201 (syntax/loc stx
0226eca more play
Danny Yoo authored Jul 16, 2011
202 (lambda (id ...) body ...))]
203
204 [(_ (id ... . rest-id) body ...)
205 (with-syntax ([(rest-arg) (generate-temporaries #'(rest-id))])
206 (syntax/loc stx
207 (lambda (id ... . rest-arg)
208 (let ([rest-id (list->arc-list rest-arg)])
209 body ...))))]))
b634e8c experiments with syntax properties, just so I know how to use them fo…
Danny Yoo authored Jul 12, 2011
210
211
ab2f654 some more
Danny Yoo authored Jul 16, 2011
212 (define-syntax (arc-let stx)
213 (syntax-case stx ()
214 [(_ name value body ...)
215 (syntax/loc stx
216 (let ([name value])
217 body ...))]))
218
219
220 (define-for-syntax (evens lst)
221 (cond
222 [(empty? lst)
223 '()]
224 [else
225 (cons (first lst)
226 (evens (rest (rest lst))))]))
227
228
229 (define (pr . elts)
230 (for-each display elts))
231
232
233 (define (prn . elts)
234 (for-each display elts)
235 (newline))
236
237 (define-for-syntax (odds lst)
238 (cond
239 [(empty? lst)
240 '()]
241 [else
242 (cons (second lst)
243 (odds (rest (rest lst))))]))
244
245
246
247 (define-syntax (arc-with stx)
248 (syntax-case stx ()
249 [(_ (name-value ...) body ...)
250 (even? (length (syntax->list #'(name-value ...))))
251 (with-syntax ([(name ...) (evens (syntax->list #'(name-value ...)))]
252 [(value ...) (odds (syntax->list #'(name-value ...)))])
253 (syntax/loc stx
254 (let ([name value] ...)
255 body ...)))]))
256
257
258
259 (define-syntax (arc-if stx)
260 (syntax-case stx ()
261 [(_ forms ...)
262 (cond
263 [(= (length (syntax->list #'(forms ...))) 0)
264 (raise-syntax-error #f "missing clauses" stx)]
265 [(= (length (syntax->list #'(forms ...))) 1)
266 (raise-syntax-error #f "missing value" stx)]
267 [else
268 (let loop ([forms (syntax->list #'(forms ...))])
269 (cond
270 [(= (length forms) 0)
271 (syntax/loc stx nil)]
272 [(= (length forms) 1)
273 (first forms)]
274 [else
275 (quasisyntax/loc stx
276 (if (arc-true? #,(first forms))
277 #,(second forms)
278 #,(loop (rest (rest forms)))))]))])]))
279
280
a126b74 adding case
Danny Yoo authored Jul 28, 2011
281 (define-syntax (arc-do stx)
ab2f654 some more
Danny Yoo authored Jul 16, 2011
282 (syntax-case stx ()
283 [(_ body ...)
284 (syntax/loc stx
285 (begin body ...))]))
286
287
288
289 (define-syntax (arc-when stx)
290 (syntax-case stx ()
291 [(_ test body ...)
292 (syntax/loc stx
293 (arc-if test
a126b74 adding case
Danny Yoo authored Jul 28, 2011
294 (arc-do body ...)))]))
ab2f654 some more
Danny Yoo authored Jul 16, 2011
295
296
297
298 (define-syntax (arc-and stx)
299 (syntax-case stx ()
300 [(_)
301 (syntax/loc stx nil)]
302 [(_ x)
303 #'x]
304 [(_ x y ...)
305 (syntax/loc stx
306 (arc-if x (arc-and y ...)))]))
307
308
309 (define-syntax (arc-or stx)
310 (syntax-case stx ()
311 [(_)
312 (syntax/loc stx nil)]
313 [(_ x)
314 #'x]
315 [(_ x y ...)
316 (syntax/loc stx
317 (let ([x-val x])
318 (arc-if x-val
319 x-val
320 (arc-or y ...))))]))
321
a126b74 adding case
Danny Yoo authored Jul 28, 2011
322 (define-syntax (arc-case stx)
323 (syntax-case stx ()
324 [(_ val-exp k+v ...)
325 (quasisyntax/loc stx
326 (let ([val val-exp])
327 #,(let loop ([k+vs (syntax->list #'(k+v ...))])
328 (cond
329 [(empty? k+vs)
330 (syntax/loc stx nil)]
331 [(empty? (rest k+vs))
332 (first k+vs)]
333 [else
334 (quasisyntax/loc stx
335 (arc-if (arc-is val '#,(first k+vs))
336 #,(second k+vs)
337 #,(loop (rest (rest k+vs)))))]))))]))
338
339
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
340 ;; Returns true if the syntax looks like it has square brackets.
341 (define-for-syntax (square-bracketed? stx)
8f289d9 syntax properties are tricky. Darn.
Danny Yoo authored Mar 25, 2012
342 (define paren-shape (syntax-property stx 'paren-shape))
343 (or (eq? paren-shape #\[)
344 (and (pair? paren-shape)
345 (eq? (car paren-shape) #\[))))
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
346
347
348 ;; application sees if the expression is an implicit lambda
349 (define-syntax (arc-app stx)
350 (syntax-case stx ()
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
351 [(_ operator operands ...)
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
352 (cond
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
353 [(square-bracketed? stx)
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
354 (with-syntax ([(id) (generate-temporaries #'(_))])
355 (syntax/loc stx
356 (fn (id)
357 (syntax-parameterize ([arc-lambda-placeholder (make-rename-transformer #'id)])
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
358 (#%app operator operands ...)))))]
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
359 [else
360 (syntax/loc stx
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
361 (#%app operator operands ...))])]
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
362 [(_ . operator+operands)
363 (syntax/loc stx
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
364 (#%app . operator+operands))]
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
365 [(_)
366 (identifier? stx)
367 (syntax/loc stx
368 #%app)]))
369
9d7ac58 very hacky versions of the noation for function composition and negation
Danny Yoo authored Jul 27, 2011
370
371
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
372 (define-syntax-parameter arc-lambda-placeholder
373 (lambda (stx)
374 (syntax-case stx ()
375 ;; Edge case: if the placeholder itself is used like [_], then we really do want it to go
376 ;; through the #%app macro.
377 [(elts ...)
378 (square-bracketed? stx)
8f289d9 syntax properties are tricky. Darn.
Danny Yoo authored Mar 26, 2012
379 (syntax-property (syntax/loc stx
380 (arc-app elts ...))
381 'paren-shape
382 #\[)]
97bf43a correcting the behavior of implicit lambda
Danny Yoo authored Mar 26, 2012
383
384 ;; Otherwise, highlight the placeholder symbol itself in the error message.
385 [(placeholder-symbol elts ...)
386 (raise-syntax-error #f "placeholder is being used outside of a function template" #'placeholder-symbol)]
387
388 [else
389 (raise-syntax-error #f "placeholder is being used outside of a function template" stx)])))
390
391
9d7ac58 very hacky versions of the noation for function composition and negation
Danny Yoo authored Jul 27, 2011
392
393
394
395
396
397
398
cb49367 old work
Danny Yoo authored Mar 25, 2012
399 (provide [rename-out [arc-assign =]
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
400 [arc-cons cons]
ab2f654 some more
Danny Yoo authored Jul 16, 2011
401 [arc-quote quote]
402 [arc-car car]
403 [arc-cdr cdr]
0226eca more play
Danny Yoo authored Jul 16, 2011
404 [arc-list list]
ab2f654 some more
Danny Yoo authored Jul 16, 2011
405 [arc-datum #%datum]
406 [arc-let let]
407 [arc-with with]
408 [arc-if if]
409 [arc-and and]
410 [arc-or or]
0226eca more play
Danny Yoo authored Jul 16, 2011
411 [arc-is is]
412 [arc-iso iso]
ab2f654 some more
Danny Yoo authored Jul 16, 2011
413 [arc-odd odd]
9d7ac58 very hacky versions of the noation for function composition and negation
Danny Yoo authored Jul 27, 2011
414 [arc-even even]
60cb8b9 fixing some small bugs, added more tests for implicit lambda
Danny Yoo authored Jul 27, 2011
415 [arc-top #%top]
416 [arc-lambda-placeholder _]
417 [arc-app #%app]
a126b74 adding case
Danny Yoo authored Jul 28, 2011
418 [arc-map map]
419 [arc-do do]
420 [arc-when when]
421 [arc-no no]
32576ae using separate data structure for cons pairs. car and cdr themselves …
Danny Yoo authored Aug 1, 2011
422 [arc-case case]
423 [arc-zap zap]
424 [arc-increment ++]
a9e9166 a little more prose. Also replacing module-begin with plain-module-be…
Danny Yoo authored Mar 29, 2012
425 [arc-decrement --]
426 [#%plain-module-begin #%module-begin]]
c043025 initial commit
Danny Yoo authored Jul 12, 2011
427 #%top-interaction
ab2f654 some more
Danny Yoo authored Jul 16, 2011
428
429 nil
430
431 def
432 fn
433
56d358e strings are str instances, and look otherwise like regular strings.
Danny Yoo authored Jul 12, 2011
434 +
435 /
436 -
437 *
ab2f654 some more
Danny Yoo authored Jul 16, 2011
438 sqrt
439 expt
440
441 pr
442 prn
443 )
Something went wrong with that request. Please try again.