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

move racket/draw overview to the Guide and expand it

Browse Source 
--- plus some minor collateral API improvements

original commit: 8b3165d55b85cffbe3ad28be6d8bd4c218d21529
This commit is contained in:
Matthew Flatt 2010-11-27 15:53:49 -07:00
parent 90ded4003f
commit 8f876ea446
1 changed files with 43 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/scribble/eval.rkt
View File

@ -145,50 +145,56 @@
[(syntax? s) (loop (syntax-e s) ops)]
[else (loop ((car ops) s) (cdr ops))])))
(define ((do-eval ev) s)
(define (extract-to-evaluate s)
(let loop ([s s][expect #f])
(syntax-case s (code:comment eval:alts eval:check)
[(code:line v (code:comment . rest))
(loop (extract s cdr car) expect)]
[(code:comment . rest)
(list (list (void)) "" "")]
(values #f expect)]
[(eval:alts p e)
(loop (extract s cdr cdr car) expect)]
[(eval:check e expect)
(loop (extract s cdr car)
(list (syntax->datum (datum->syntax #f (extract s cdr cdr car)))))]
[else
(let ([r (with-handlers ([(lambda (x)
(not (exn:break? x)))
(lambda (e)
(list (if (exn? e)
(exn-message e)
(format "uncaught exception: ~s" e))
(get-output ev)
(get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)])
(if (call-in-sandbox-context
ev
(let ([cp (current-print)])
(lambda ()
(and (eq? (current-print) cp)
(print-as-expression)))))
(make-reader-graph (copy-value v (make-hasheq)))
(box
(call-in-sandbox-context
(values s expect)])))
(define ((do-eval ev) s)
(let-values ([(s expect) (extract-to-evaluate s)])
(if s
(let ([r (with-handlers ([(lambda (x)
(not (exn:break? x)))
(lambda (e)
(list (if (exn? e)
(exn-message e)
(format "uncaught exception: ~s" e))
(get-output ev)
(get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)])
(if (call-in-sandbox-context
ev
(lambda ()
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(map (current-print) v))
(get-output-string s)))))))
(get-output ev)
(get-error-output ev)))])
(when expect
(let ([expect (do-plain-eval ev (car expect) #t)])
(unless (equal? (car r) expect)
(raise-syntax-error 'eval "example result check failed" s))))
r)])))
(let ([cp (current-print)])
(lambda ()
(and (eq? (current-print) cp)
(print-as-expression)))))
(make-reader-graph (copy-value v (make-hasheq)))
(box
(call-in-sandbox-context
ev
(lambda ()
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(map (current-print) v))
(get-output-string s)))))))
(get-output ev)
(get-error-output ev)))])
(when expect
(let ([expect (do-plain-eval ev (car expect) #t)])
(unless (equal? (car r) expect)
(raise-syntax-error 'eval "example result check failed" s))))
r)
(values (list (list (void)) "" "")))))
(define (install ht v v2)
@ -337,9 +343,11 @@
(define-syntax-rule (quote-expr e) 'e)
(define (do-interaction-eval ev e)
(parameterize ([current-command-line-arguments #()])
(do-plain-eval (or ev (make-base-eval)) e #f))
"")
(let-values ([(e expect) (extract-to-evaluate e)])
(when e
(parameterize ([current-command-line-arguments #()])
(do-plain-eval (or ev (make-base-eval)) e #f)))
""))
(define-syntax interaction-eval
(syntax-rules ()