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

adjust the expansion of #%module-begin so it doesn't

Browse Source 
generate so much code

(Mostly to avoid pain with the macro stepper, but also
reducing the amount of code macros generates is good
for performance reasons)
This commit is contained in:
Robby Findler 2013-03-09 09:19:47 -06:00
parent 46eb91b578
commit ba3e676057
1 changed files with 36 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/plai/gc2/mutator.rkt
View File

@ -310,27 +310,31 @@
(define-for-syntax (allocator-setup-internal stx) (define-for-syntax (allocator-setup-internal stx)
(syntax-case stx () (syntax-case stx ()
[(collector-module heap-size) [(collector-module heap-size)
(with-syntax ([(init-allocator gc:deref gc:alloc-flat gc:cons (with-syntax ([(args ...)
gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref
gc:first gc:rest
gc:flat? gc:cons?
gc:set-first! gc:set-rest!)
(map (λ (s) (datum->syntax stx s)) (map (λ (s) (datum->syntax stx s))
'(init-allocator gc:deref gc:alloc-flat gc:cons '(init-allocator gc:deref gc:alloc-flat gc:cons
gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref
gc:first gc:rest gc:first gc:rest
gc:flat? gc:cons? gc:flat? gc:cons?
gc:set-first! gc:set-rest!))]) gc:set-first! gc:set-rest!))])
(begin
#`(begin #`(begin
#,(begin #,(if (alternate-collector)
(if (alternate-collector)
#`(require #,(datum->syntax #'collector-module (alternate-collector))) #`(require #,(datum->syntax #'collector-module (alternate-collector)))
#`(require #,(syntax-case #'collector-module (mutator-quote) #`(require #,(syntax-case #'collector-module (mutator-quote)
[(mutator-quote . x) [(mutator-quote . x)
(datum->syntax #'collector-module (cons #'quote #'x))] (datum->syntax #'collector-module (cons #'quote #'x))]
[else #'collector-module])))) [else #'collector-module])))
(allocator-setup/proc args ... (#%datum . heap-size))))]
[_ (raise-syntax-error 'mutator
"Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)"
stx)]))
(define (allocator-setup/proc init-allocator gc:deref gc:alloc-flat gc:cons
gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref
gc:first gc:rest
gc:flat? gc:cons?
gc:set-first! gc:set-rest!
heap-size)
(set-collector:deref! gc:deref) (set-collector:deref! gc:deref)
(set-collector:alloc-flat! gc:alloc-flat) (set-collector:alloc-flat! gc:alloc-flat)
(set-collector:cons! gc:cons) (set-collector:cons! gc:cons)
@ -345,15 +349,12 @@
(set-collector:closure-code-ptr! gc:closure-code-ptr) (set-collector:closure-code-ptr! gc:closure-code-ptr)
(set-collector:closure-env-ref! gc:closure-env-ref) (set-collector:closure-env-ref! gc:closure-env-ref)
(init-heap! (#%datum . heap-size)) (init-heap! heap-size)
(when (gui-available?) (when (gui-available?)
(if (<= (#%datum . heap-size) 500) (if (<= heap-size 500)
(set-ui! (dynamic-require `plai/gc2/private/gc-gui 'heap-viz%)) (set-ui! (dynamic-require `plai/gc2/private/gc-gui 'heap-viz%))
(printf "Large heap; the heap visualizer will not be displayed.\n"))) (printf "Large heap; the heap visualizer will not be displayed.\n")))
(init-allocator))))] (init-allocator))
[_ (raise-syntax-error 'mutator
"Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)"
stx)]))
(define-for-syntax allocator-setup-error-msg (define-for-syntax allocator-setup-error-msg
"Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)") "Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup <module-path> <literal-number>)")