commit 4551bf426130bbc5816e2b4212cdc54f6d2a6f3c
parent d460c678ac116e9f22f0fb524dd6c497b72fa844
Author: AlexKnauth <alexander@knauth.org>
Date: Sat, 18 Jul 2015 18:14:58 -0400
Revert "use uninterned symbols instead of syntax-marks"
This reverts commit dea60a15caa5eafdd7ed0607304425beabe5cdfb.
Diffstat:
2 files changed, 43 insertions(+), 53 deletions(-)
diff --git a/afl/reader.rkt b/afl/reader.rkt
@@ -16,33 +16,33 @@
racket/port
racket/list
syntax/srcloc
- (for-syntax racket/base
- racket/list
- ))
+ (for-meta -10 racket/base)
+ (for-meta -9 racket/base)
+ (for-meta -8 racket/base)
+ (for-meta -7 racket/base)
+ (for-meta -6 racket/base)
+ (for-meta -5 racket/base)
+ (for-meta -4 racket/base)
+ (for-meta -3 racket/base)
+ (for-meta -2 racket/base)
+ (for-meta -1 racket/base)
+ (for-meta 0 racket/base)
+ (for-meta 1 racket/base)
+ (for-meta 2 racket/base)
+ (for-meta 3 racket/base)
+ (for-meta 4 racket/base)
+ (for-meta 5 racket/base)
+ (for-meta 6 racket/base)
+ (for-meta 7 racket/base)
+ (for-meta 8 racket/base)
+ (for-meta 9 racket/base)
+ (for-meta 10 racket/base)
+ (for-meta 11 (only-in racket/base #%app make-rename-transformer syntax))
+ )
(module+ test
(require rackunit))
-(define-syntax (define-unbindable-ids stx)
- (syntax-case stx ()
- [(_ [name id] ...)
- (with-syntax ([(gen-id ...)
- (for/list ([id (in-list (syntax->list #'(id ...)))])
- (string->uninterned-symbol (symbol->string (syntax-e id))))]
- [(n ...) (range -10 11)])
- #`(begin
- (require (for-meta n (only-in racket/base [id gen-id] ...))
- ...)
- (define name (quote-syntax gen-id))
- ...))]))
-
-(define-unbindable-ids
- [lambda-id lambda]
- [define-syntax-id define-syntax]
- [app-id #%app]
- [make-rename-transformer-id make-rename-transformer]
- [syntax-id syntax])
-
(define (afl-read [in (current-input-port)] #:arg-str [arg-str (current-arg-string)])
(define orig-readtable (current-readtable))
(parameterize ([current-arg-string arg-str]
@@ -78,15 +78,13 @@
(module+ test
- (define-check (check-thing= a b)
- (check-equal? (format "~s" a) (format "~s" b)))
- (check-thing= (afl-read (open-input-string "#λ(+ % %2)"))
+ (check-equal? (afl-read (open-input-string "#λ(+ % %2)"))
'(lambda (%1 %2)
- (define-syntax % (#%app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
(+ % %2)))
- (check-thing= (afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
+ (check-equal? (afl-read (open-input-string "#λ(+ _ _2)") #:arg-str "_")
'(lambda (_1 _2)
- (define-syntax _ (#%app make-rename-transformer #'_1))
+ (define-syntax _ (make-rename-transformer #'_1))
(+ _ _2)))
)
@@ -127,7 +125,7 @@
(parameterize ([current-arg-string arg-str])
(define (string->id stx . strs)
(datum->syntax stx (string->symbol (apply string-append strs)) stx))
- (define intro (λ (x) x) #;(make-syntax-introducer))
+ (define intro (make-syntax-introducer))
(define stx* (intro stx))
(match-define (srcloc src ln col pos spn) (build-source-location loc))
(define stx-pos (syntax-position stx*))
@@ -137,11 +135,7 @@
#:column (and col (+ col 1))
#:position (and pos (+ pos 1))
#:span (and stx-pos pos (max 0 (- stx-pos pos 1)))))
- (with-syntax ([lambda (orig (quasisyntax/loc λ-loc #,lambda-id))]
- [define-syntax define-syntax-id]
- [app app-id]
- [make-rename-transformer make-rename-transformer-id]
- [syntax syntax-id]
+ (with-syntax ([lambda (orig (syntax/loc λ-loc lambda))]
[args (parse-args stx* #:arg-str arg-str)]
[% (string->id stx* arg-str)]
[%1 (string->id stx* arg-str "1")]
@@ -149,7 +143,7 @@
(intro
(syntax/loc loc-stx
(lambda args
- (define-syntax % (app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
body))))))
(define (orig stx)
@@ -158,26 +152,26 @@
(module+ test
;; These test `parse`. See test.rkt for tests of readtable use per se.
(define chk (compose1 syntax->datum parse))
- (check-thing= (chk #'(+))
+ (check-equal? (chk #'(+))
'(lambda ()
- (define-syntax % (#%app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
(+)))
- (check-thing= (chk #'(+ 2 %1 %1))
+ (check-equal? (chk #'(+ 2 %1 %1))
'(lambda (%1)
- (define-syntax % (#%app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
(+ 2 %1 %1)))
- (check-thing= (chk #'(+ 2 %3 %2 %1))
+ (check-equal? (chk #'(+ 2 %3 %2 %1))
'(lambda (%1 %2 %3)
- (define-syntax % (#%app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
(+ 2 %3 %2 %1)))
- (check-thing= (chk #'(apply list* % %&))
+ (check-equal? (chk #'(apply list* % %&))
'(lambda (%1 . %&)
- (define-syntax % (#%app make-rename-transformer #'%1))
+ (define-syntax % (make-rename-transformer #'%1))
(apply list* % %&)))
- (check-thing= (parameterize ([current-arg-string "_"])
+ (check-equal? (parameterize ([current-arg-string "_"])
(chk #'(apply list* _ _&)))
'(lambda (_1 . _&)
- (define-syntax _ (#%app make-rename-transformer #'_1))
+ (define-syntax _ (make-rename-transformer #'_1))
(apply list* _ _&))))
;; parse-args : Stx -> KW-Formals-Stx
diff --git a/afl/tests/test-afl-racket.rkt b/afl/tests/test-afl-racket.rkt
@@ -14,11 +14,7 @@
"I am x")
(check-equal? (#λ(begin (set! % "%") %1) "%1")
"%")
- (check-equal? (let ([lambda "not lambda"]
- [define-syntax "not define-syntax"]
- [make-rename-transformer "not"]
- [syntax "not"])
- (let-syntax ([#%app (syntax-rules () [(app f x) (f 4)])])
- (#λ% 3)))
- 4)
+ (check-equal? (let ([lambda "not lambda"] [define-syntax "not define-syntax"])
+ (#λ% 3))
+ 3)
)
