From ba3e676057d6faad477a2f50a1878d6c36c1f867 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 9 Mar 2013 09:19:47 -0600 Subject: [PATCH] adjust the expansion of #%module-begin so it doesn't 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) --- collects/plai/gc2/mutator.rkt | 71 ++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 35 deletions(-) diff --git a/collects/plai/gc2/mutator.rkt b/collects/plai/gc2/mutator.rkt index 9c1ed299fe..a85c705e8f 100644 --- a/collects/plai/gc2/mutator.rkt +++ b/collects/plai/gc2/mutator.rkt @@ -310,51 +310,52 @@ (define-for-syntax (allocator-setup-internal stx) (syntax-case stx () [(collector-module heap-size) - (with-syntax ([(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!) + (with-syntax ([(args ...) (map (λ (s) (datum->syntax stx s)) '(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!))]) - (begin - #`(begin - #,(begin - (if (alternate-collector) - #`(require #,(datum->syntax #'collector-module (alternate-collector))) - #`(require #,(syntax-case #'collector-module (mutator-quote) - [(mutator-quote . x) - (datum->syntax #'collector-module (cons #'quote #'x))] - [else #'collector-module])))) - - (set-collector:deref! gc:deref) - (set-collector:alloc-flat! gc:alloc-flat) - (set-collector:cons! gc:cons) - (set-collector:first! gc:first) - (set-collector:rest! gc:rest) - (set-collector:flat?! gc:flat?) - (set-collector:cons?! gc:cons?) - (set-collector:set-first!! gc:set-first!) - (set-collector:set-rest!! gc:set-rest!) - (set-collector:closure! gc:closure) - (set-collector:closure?! gc:closure?) - (set-collector:closure-code-ptr! gc:closure-code-ptr) - (set-collector:closure-env-ref! gc:closure-env-ref) - - (init-heap! (#%datum . heap-size)) - (when (gui-available?) - (if (<= (#%datum . heap-size) 500) - (set-ui! (dynamic-require `plai/gc2/private/gc-gui 'heap-viz%)) - (printf "Large heap; the heap visualizer will not be displayed.\n"))) - (init-allocator))))] + #`(begin + #,(if (alternate-collector) + #`(require #,(datum->syntax #'collector-module (alternate-collector))) + #`(require #,(syntax-case #'collector-module (mutator-quote) + [(mutator-quote . x) + (datum->syntax #'collector-module (cons #'quote #'x))] + [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 )" 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:alloc-flat! gc:alloc-flat) + (set-collector:cons! gc:cons) + (set-collector:first! gc:first) + (set-collector:rest! gc:rest) + (set-collector:flat?! gc:flat?) + (set-collector:cons?! gc:cons?) + (set-collector:set-first!! gc:set-first!) + (set-collector:set-rest!! gc:set-rest!) + (set-collector:closure! gc:closure) + (set-collector:closure?! gc:closure?) + (set-collector:closure-code-ptr! gc:closure-code-ptr) + (set-collector:closure-env-ref! gc:closure-env-ref) + + (init-heap! heap-size) + (when (gui-available?) + (if (<= heap-size 500) + (set-ui! (dynamic-require `plai/gc2/private/gc-gui 'heap-viz%)) + (printf "Large heap; the heap visualizer will not be displayed.\n"))) + (init-allocator)) + (define-for-syntax allocator-setup-error-msg "Mutator must start with an 'allocator-setup' expression, such as: (allocator-setup )")