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

compile the left-hand sides of define-judgment only once, not during each time we try to check a judgment

Browse Source 
related to PR 12380
This commit is contained in:
Robby Findler 2011-11-17 20:47:31 -06:00
parent 2d0fa3a60b
commit b93486ed69
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1883,18 +1883,20 @@
(define outputs (define outputs
(if mtchs (if mtchs
(for/fold ([outputs '()]) ([m mtchs]) (for/fold ([outputs '()]) ([m mtchs])
(define os (define os
(term-let ([names/ellipses (lookup-binding (mtch-bindings m) 'names)] ...) (term-let ([names/ellipses (lookup-binding (mtch-bindings m) 'names)] ...)
#,body)) #,body))
(if os (append os outputs) outputs)) (if os (append os outputs) outputs))
'())) '()))
(for ([output outputs]) (for ([output outputs])
(check-judgment-form-contract `#,name output compiled-output-ctcs 'O '#,mode)) (check-judgment-form-contract `#,name output compiled-output-ctcs 'O '#,mode))
outputs))))])) outputs))))]))
(with-syntax ([(clause-proc ...) (map compile-clause clauses)]) (with-syntax ([(clause-proc ...) (map compile-clause clauses)]
#'(λ (input) [(clause-proc-ids ...) (generate-temporaries clauses)])
(for/fold ([outputs '()]) ([rule (list clause-proc ...)]) (with-syntax ([(backwards-ids ...) (reverse (syntax->list #'(clause-proc-ids ...)))])
(append (rule input) outputs))))) #'(let ([clause-proc-ids clause-proc] ...)
(λ (input)
(append (backwards-ids input) ...))))))
(define-for-syntax (do-compile-judgment-form-lws clauses) (define-for-syntax (do-compile-judgment-form-lws clauses)
(syntax-case clauses () (syntax-case clauses ()