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

scribble/eval: fix evaluation of literal #f expression

Browse Source 
Fixed part of PR 11790

original commit: ae8705611ba3ff03ed208aa5c590e8cfc52a36a6
This commit is contained in:
Matthew Flatt 2011-03-11 07:52:16 -06:00
parent c33146745d
commit 67888f2c2c
1 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/scribble/eval.rkt
View File

@ -183,6 +183,9 @@
(cdr val-list+outputs) (cdr val-list+outputs)
#f))))))) #f)))))))
;; extracts from a datum or syntax object --- while keeping the
;; syntax-objectness of the original intact, instead of always
;; generating a syntax object or always generating a datum
(define (extract s . ops) (define (extract s . ops)
(let loop ([s s][ops ops]) (let loop ([s s][ops ops])
(cond (cond
@ -190,13 +193,15 @@
[(syntax? s) (loop (syntax-e s) ops)] [(syntax? s) (loop (syntax-e s) ops)]
[else (loop ((car ops) s) (cdr ops))]))) [else (loop ((car ops) s) (cdr ops))])))
(struct nothing-to-eval ())
(define (extract-to-evaluate s) (define (extract-to-evaluate s)
(let loop ([s s][expect #f]) (let loop ([s s][expect #f])
(syntax-case s (code:comment eval:alts eval:check) (syntax-case s (code:comment eval:alts eval:check)
[(code:line v (code:comment . rest)) [(code:line v (code:comment . rest))
(loop (extract s cdr car) expect)] (loop (extract s cdr car) expect)]
[(code:comment . rest) [(code:comment . rest)
(values #f expect)] (values (nothing-to-eval) expect)]
[(eval:alts p e) [(eval:alts p e)
(loop (extract s cdr cdr car) expect)] (loop (extract s cdr cdr car) expect)]
[(eval:check e expect) [(eval:check e expect)
@ -207,7 +212,7 @@
(define ((do-eval ev) s) (define ((do-eval ev) s)
(let-values ([(s expect) (extract-to-evaluate s)]) (let-values ([(s expect) (extract-to-evaluate s)])
(if s (if (not (nothing-to-eval? s))
(let ([r (with-handlers ([(lambda (x) (let ([r (with-handlers ([(lambda (x)
(not (exn:break? x))) (not (exn:break? x)))
(lambda (e) (lambda (e)
@ -392,7 +397,7 @@
(define (do-interaction-eval ev e) (define (do-interaction-eval ev e)
(let-values ([(e expect) (extract-to-evaluate e)]) (let-values ([(e expect) (extract-to-evaluate e)])
(when e (unless (nothing-to-eval? e)
(parameterize ([current-command-line-arguments #()]) (parameterize ([current-command-line-arguments #()])
(do-plain-eval (or ev (make-base-eval)) e #f))) (do-plain-eval (or ev (make-base-eval)) e #f)))
"")) ""))