From 8d1fb5147cc4a2b8cc2c725545e99d681c046dbe Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Tue, 14 Jul 2015 17:48:28 -0500 Subject: [PATCH] rought patch for #80 and #77 --- strace.rkt | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/strace.rkt b/strace.rkt index 2ab3c41..8489035 100644 --- a/strace.rkt +++ b/strace.rkt @@ -15,6 +15,7 @@ (define (make-annotate-top c cover-name) (define lift-name #'do-lift) (define set-box-name #'set-box!) + (define box-name #'box) (define hash-ref-name #'hash-ref) ;; -------- Specific `stacktrace^` Imports -------------- @@ -29,9 +30,10 @@ (with-syntax ([c cover-name] [loc loc/stx] [set-box! set-box-name] + [box box-name] [hash-ref hash-ref-name] [do-lift lift-name]) - #`(#%plain-app set-box! (do-lift (#%plain-app hash-ref c loc)) #t))) + #`(#%plain-app set-box! (do-lift (#%plain-app hash-ref c loc (box #f))) #t))) ;; -------- Cover's Specific Annotators -------------- @@ -63,6 +65,7 @@ (eq? 'module* (syntax-e #'m))) (with-syntax ([cover cover-name] [set-box set-box-name] + [box box-name] [hash-rf hash-ref-name] [do-lift lift-name]) (define lexical? (eq? #f (syntax-e #'lang))) @@ -75,7 +78,8 @@ (define/with-syntax (add ...) #'((#%require (rename cover/coverage cover coverage) (rename '#%kernel set-box set-box!) - (rename '#%kernel haah-rf hash-ref)) + (rename '#%kernel hash-rf hash-ref) + (rename '#%kernel box box)) (#%require (for-syntax '#%kernel)) (define-syntaxes (do-lift) (lambda (stx) @@ -106,7 +110,7 @@ [(begin e mod) (begin (syntax-case #'e (#%plain-app set-box! do-lift make-srcloc hash-ref) - [(#%plain-app set-box! (lift (#%plain-app hash-ref _ (quote v))) _) + [(#%plain-app set-box! (lift (#%plain-app hash-ref _ (quote v) b)) _) (let ([location (syntax->datum #'v)]) (set-box! (hash-ref c location) #t))]) #'mod)]