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

use splicing-let-syntax instead of namespace mangling

Browse Source 
and fix the tests; they were completely broken before.

This breaks the macro tests again.
This commit is contained in:
AlexKnauth 2017-01-12 00:38:39 -05:00
parent ea215a57f8
commit 15ad001f5c
3 changed files with 34 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
debug/repl.rkt
View File

@ -3,6 +3,8 @@
(provide debug-repl resume)
(require "private/make-variable-like-transformer.rkt"
racket/list
racket/splicing
(for-syntax racket/base
racket/list
syntax/parse
@ -19,10 +21,12 @@
(define debug-info (syntax-debug-info stx (syntax-local-phase-level) #t))
(define context (hash-ref debug-info 'context))
(define bindings (hash-ref debug-info 'bindings))
(for/list ([binding (in-list bindings)]
#:when (hash-has-key? binding 'local)
#:when (context-subset? (hash-ref binding 'context) context))
(datum->syntax stx (hash-ref binding 'name))))
(remove-duplicates
(for/list ([binding (in-list bindings)]
#:when (hash-has-key? binding 'local)
#:when (context-subset? (hash-ref binding 'context) context))
(datum->syntax stx (hash-ref binding 'name) stx))
bound-identifier=?))
;; context-subset? : Context Context -> Boolean
(define (context-subset? a b)
@ -52,33 +56,35 @@
#:with varref (syntax-local-introduce #'(#%variable-reference))
#'(debug-repl/varref+hash
varref
(vector-immutable (cons 'x (λ () x)) ...)
(vector-immutable (cons 'm mv) ...))])))
(list (list (quote-syntax x) (λ () x)) ...)
(list (list (quote-syntax m) mv) ...))])))
;; debug-repl/varref+hash :
;; Variable-Ref
;; (Vectorof (Cons Symbol (-> Any)))
;; (Vectorof (Cons Symbol Any))
;; (Listof (List Id (-> Any)))
;; (Listof (List Id Any))
;; ->
;; Any
(define (debug-repl/varref+hash varref var-vect macro-vect)
(define (debug-repl/varref+hash varref var-list macro-list)
(define ns (variable-reference->namespace varref))
(for ([pair (in-vector var-vect)])
(namespace-define-transformer-binding!
ns
(car pair)
(make-variable-like-transformer #`(#,(cdr pair)))))
(for ([pair (in-vector macro-vect)])
(namespace-define-transformer-binding!
ns
(car pair)
(cdr pair)))
(define local-bindings
(append
(for/list ([pair (in-list var-list)])
(list
(first pair)
(make-variable-like-transformer #`(#,(second pair)))))
macro-list))
(define old-prompt-read (current-prompt-read))
(define old-eval (current-eval))
(define (new-prompt-read)
(write-char #\-)
(old-prompt-read))
(define (new-eval stx)
(old-eval #`(splicing-let-syntax #,local-bindings
#,stx)))
(parameterize ([current-namespace ns]
[current-prompt-read new-prompt-read])
[current-prompt-read new-prompt-read]
[current-eval new-eval])
(call-with-continuation-prompt
read-eval-print-loop
debug-repl-prompt-tag

2
debug/test/debug-repl-macros.rkt
View File

@ -45,7 +45,7 @@
(λ () (f 1)))
(check-equal? (get-output-string o)
(string-append
"-> " #;(?list. bluh)))))
"-> " #;(?list . bluh)))))
;; TODO: !!! identifier used out of context !!!
#;

18
debug/test/debug-repl.rkt
View File

@ -45,29 +45,25 @@
a)
(test-with-io
#:i [i (open-input-string "y b c (+ y b c)")]
#:i [i (open-input-string "b (+ b 13)")]
#:o [o (open-output-string)]
(check-equal? (f) 1)
(check-equal? (get-output-string o)
(string-append
"-> " #;y "7\n"
"-> " #;b "8\n"
"-> " #;c "9\n"
"-> " #;(+ y b c) "24\n"
"-> " #;b "4\n"
"-> " #;(+ b 13) "17\n"
"-> ")))
(test-with-io
#:i [i (open-input-string "y b c (+ y b c) (+ y a b c)")]
#:i [i (open-input-string "b (+ b 13) (+ a b 13)")]
#:o [o (open-output-string)]
(check-exn #rx"a: undefined;\n cannot use before initialization"
(λ () (f)))
(check-equal? (get-output-string o)
(string-append
"-> " #;y "7\n"
"-> " #;b "8\n"
"-> " #;c "9\n"
"-> " #;(+ y b c) "24\n"
"-> " #;(+ y a b c)))))
"-> " #;b "4\n"
"-> " #;(+ b 13) "17\n"
"-> " #;(+ a b 13)))))
;; test for mutation
(define x-for-mutation 1)