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
(if mtchs
(for/fold ([outputs '()]) ([m mtchs])
(define os
(term-let ([names/ellipses (lookup-binding (mtch-bindings m) 'names)] ...)
#,body))
(if os (append os outputs) outputs))
(define os
(term-let ([names/ellipses (lookup-binding (mtch-bindings m) 'names)] ...)
#,body))
(if os (append os outputs) 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))))]))
(with-syntax ([(clause-proc ...) (map compile-clause clauses)])
#'(λ (input)
(for/fold ([outputs '()]) ([rule (list clause-proc ...)])
(append (rule input) outputs)))))
(with-syntax ([(clause-proc ...) (map compile-clause clauses)]
[(clause-proc-ids ...) (generate-temporaries clauses)])
(with-syntax ([(backwards-ids ...) (reverse (syntax->list #'(clause-proc-ids ...)))])
#'(let ([clause-proc-ids clause-proc] ...)
(λ (input)
(append (backwards-ids input) ...))))))
(define-for-syntax (do-compile-judgment-form-lws clauses)
(syntax-case clauses ()