fixed a bug in the way recursive metafunctions bound the recursive calls for use in 'where' clauses
svn: r13809
This commit is contained in:
parent
ab47ac0f10
commit
b6e60bdd6e
|
@ -977,9 +977,9 @@
|
|||
[((tl-var tl-exp) ...) bindings])
|
||||
(syntax
|
||||
(λ (name bindings)
|
||||
(term-let ([names/ellipses (lookup-binding bindings 'names)] ...)
|
||||
(term-let ([tl-var (term tl-exp)] ...)
|
||||
(term-let-fn ((name name))
|
||||
(term-let-fn ((name name))
|
||||
(term-let ([names/ellipses (lookup-binding bindings 'names)] ...)
|
||||
(term-let ([tl-var (term tl-exp)] ...)
|
||||
(term rhs)))))))))
|
||||
(syntax->list (syntax (lhs ...)))
|
||||
(syntax->list (syntax (rhs ...)))
|
||||
|
|
|
@ -34,6 +34,10 @@
|
|||
(raise-syntax-error what (format "~a expected to have arguments" name) orig-stx stx))
|
||||
(let loop ([term orig-stx])
|
||||
(syntax-case term (side-condition variable-except variable-prefix hole name in-hole in-named-hole hide-hole side-condition cross)
|
||||
[(side-condition pre-pat (and))
|
||||
;; rewriting metafunctions (and possibly other things) that have no where, etc clauses
|
||||
;; end up with side-conditions that are empty 'and' expressions, so we just toss them here.
|
||||
(loop #'pre-pat)]
|
||||
[(side-condition pre-pat exp)
|
||||
(with-syntax ([pat (loop (syntax pre-pat))])
|
||||
(let-values ([(names names/ellipses) (extract-names all-nts what bind-names? (syntax pat))])
|
||||
|
|
|
@ -536,6 +536,16 @@
|
|||
'no-exn)
|
||||
'no-exn))
|
||||
|
||||
(let ()
|
||||
;; test that 'where' clauses can contain recursive calls.
|
||||
(define-metafunction empty-language
|
||||
[(f (any))
|
||||
x
|
||||
(where x (f any))]
|
||||
[(f any) any])
|
||||
(test (term (f ((((x))))))
|
||||
(term x)))
|
||||
|
||||
;; test that tracing works properly
|
||||
;; note that caching comes into play here (which is why we don't see the recursive calls)
|
||||
(let ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user