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)
(for-template "loc-wrapper-rt.rkt")
"term-fn.rkt")
(provide to-lw/proc to-lw/uq/proc is-term-fn?)
;; 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)))
(provide to-lw/proc to-lw/uq/proc)
(define (process-arg stx quote-depth)
(define quoted? (quote-depth . > . 0))
@ -67,9 +60,8 @@
#,quoted?)]
[x
(and (identifier? #'x)
(or (and (syntax-transforming?)
(term-fn? (syntax-local-value #'x (λ () #f))))
((is-term-fn?) #'x)))
(and (syntax-transforming?)
(term-fn? (syntax-local-value #'x (λ () #f)))))
#`(make-lw
'#,(syntax-e #'x)
#,(syntax-line stx)

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

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