fixed a bug in the way recursive metafunctions bound the recursive calls for use in 'where' clauses

svn: r13809
This commit is contained in:
Robby Findler 2009-02-24 01:36:48 +00:00
parent ab47ac0f10
commit b6e60bdd6e
3 changed files with 17 additions and 3 deletions

View File

@ -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 ...)))

View File

@ -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))])

View File

@ -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 ()