suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Removes special case for typesetting recursive calls

Browse Source 
This case doesn't appear necessary, since LWs are constructed in an
expansion step that occurs after all of the meta-function names
(including the current one) are bound.
This commit is contained in:
Casey Klein 2011-07-22 11:56:15 -05:00
parent c1198d0687
commit 24dc005ff4
2 changed files with 4 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/redex/private/loc-wrapper-ct.rkt
View File

@ -2,14 +2,7 @@
(require (for-template scheme/base) (require (for-template scheme/base)
(for-template "loc-wrapper-rt.rkt") (for-template "loc-wrapper-rt.rkt")
"term-fn.rkt") "term-fn.rkt")
(provide to-lw/proc to-lw/uq/proc is-term-fn?) (provide to-lw/proc to-lw/uq/proc)
;; this parameter allows define-metafunction to
;; communicate which name is the recursive calls
;; to the typesetting code, since the let-term-fn
;; won't have been expanded before to-lw/proc
;; is called.
(define is-term-fn? (make-parameter (λ (x) #f)))
(define (process-arg stx quote-depth) (define (process-arg stx quote-depth)
(define quoted? (quote-depth . > . 0)) (define quoted? (quote-depth . > . 0))
@ -67,9 +60,8 @@
#,quoted?)] #,quoted?)]
[x [x
(and (identifier? #'x) (and (identifier? #'x)
(or (and (syntax-transforming?) (and (syntax-transforming?)
(term-fn? (syntax-local-value #'x (λ () #f)))) (term-fn? (syntax-local-value #'x (λ () #f)))))
((is-term-fn?) #'x)))
#`(make-lw #`(make-lw
'#,(syntax-e #'x) '#,(syntax-e #'x)
#,(syntax-line stx) #,(syntax-line stx)

6
collects/redex/private/reduction-semantics.rkt
View File

@ -1242,11 +1242,7 @@
(with-syntax ([((rhs stuff ...) ...) (if relation? (with-syntax ([((rhs stuff ...) ...) (if relation?
#'((,(and (term raw-rhses) ...)) ...) #'((,(and (term raw-rhses) ...)) ...)
#'((raw-rhses ...) ...))]) #'((raw-rhses ...) ...))])
(parameterize ([is-term-fn? (parameterize ()
(let ([names (syntax->list #'(original-names ...))])
(λ (x) (and (not (null? names))
(identifier? (car names))
(free-identifier=? x (car names)))))])
(with-syntax ([(lhs ...) #'((lhs-clauses ...) ...)] (with-syntax ([(lhs ...) #'((lhs-clauses ...) ...)]
[name (let loop ([name (if contract-name [name (let loop ([name (if contract-name
contract-name contract-name