fuel.eval: refactoring to remove the globals eval-error and eval-output
parent
e020369b13
commit
963d9da525
|
@ -14,18 +14,18 @@ IN: fuel.eval.tests
|
|||
|
||||
! push-status
|
||||
{ 1 } [
|
||||
V{ } clone [ status-stack set-global ] keep push-status
|
||||
V{ } clone [ restarts-stack set-global ] keep push-status
|
||||
length
|
||||
pop-status
|
||||
] unit-test
|
||||
|
||||
! Make sure prettyprint doesn't limit output.
|
||||
{ t } [
|
||||
1000 random-string eval-result set-global
|
||||
f 1000 random-string ""
|
||||
[ send-retort ] with-string-writer length 1000 >
|
||||
f eval-result set-global
|
||||
] unit-test
|
||||
|
||||
! eval-in-context
|
||||
{
|
||||
"(nil \"IN: kernel PRIMITIVE: dup ( x -- x x )\" \"\")\n<~FUEL~>\n"
|
||||
} [
|
||||
|
@ -34,7 +34,19 @@ IN: fuel.eval.tests
|
|||
V{ "\"dup\"" "fuel-word-synopsis" } "scratchpad"
|
||||
V{ "fuel" "kernel" "syntax" } eval-in-context
|
||||
] with-string-writer
|
||||
f eval-result set-global
|
||||
] with-manifest
|
||||
] unit-test
|
||||
|
||||
{
|
||||
"(nil \"IN: http.server : <500> ( error -- response )\" \"\")\n<~FUEL~>\n"
|
||||
} [
|
||||
USE: http.server
|
||||
[
|
||||
[
|
||||
V{ "\"<500>\"" "fuel-word-synopsis" }
|
||||
"http.server"
|
||||
V{ "fuel" "kernel" "syntax" } eval-in-context
|
||||
] with-string-writer
|
||||
] with-manifest
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -1,22 +1,16 @@
|
|||
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays continuations debugger fuel.pprint io io.streams.string
|
||||
kernel listener namespaces prettyprint.config sequences vocabs.parser
|
||||
;
|
||||
kernel listener namespaces parser.notes prettyprint.config sequences
|
||||
vocabs.parser ;
|
||||
IN: fuel.eval
|
||||
|
||||
SYMBOL: restarts-stack
|
||||
V{ } clone restarts-stack set-global
|
||||
|
||||
SYMBOL: eval-error
|
||||
f eval-error set-global
|
||||
|
||||
SYMBOL: eval-result
|
||||
f eval-result set-global
|
||||
|
||||
SYMBOL: eval-output
|
||||
f eval-output set-global
|
||||
|
||||
SYMBOL: eval-res-flag
|
||||
t eval-res-flag set-global
|
||||
|
||||
|
@ -32,25 +26,19 @@ t eval-res-flag set-global
|
|||
: pop-status ( -- )
|
||||
restarts-stack get [ pop pop-restarts ] unless-empty ;
|
||||
|
||||
: send-retort ( -- )
|
||||
eval-error get-global
|
||||
eval-result get-global
|
||||
eval-output get-global 3array
|
||||
[ fuel-pprint ] without-limits
|
||||
flush nl "<~FUEL~>" write nl flush ;
|
||||
: send-retort ( error result output -- )
|
||||
3array [ fuel-pprint ] without-limits flush nl
|
||||
"<~FUEL~>" write nl flush ;
|
||||
|
||||
: begin-eval ( -- )
|
||||
push-status
|
||||
f eval-error set-global
|
||||
f eval-result set-global
|
||||
f eval-output set-global ;
|
||||
f eval-result set-global push-status ;
|
||||
|
||||
: end-eval ( output -- )
|
||||
eval-output set-global send-retort pop-status ;
|
||||
: end-eval ( error/f output -- )
|
||||
eval-result get-global swap send-retort pop-status ;
|
||||
|
||||
: eval ( lines -- )
|
||||
[ parse-lines-interactive call( -- ) ] curry
|
||||
[ [ eval-error set-global ] [ print-error ] bi ] recover ;
|
||||
: eval ( lines -- error/f )
|
||||
[ parse-lines-interactive call( -- ) f ] curry
|
||||
[ dup print-error ] recover ;
|
||||
|
||||
: eval-usings ( usings -- )
|
||||
[ [ use-vocab ] curry ignore-errors ] each ;
|
||||
|
@ -61,7 +49,11 @@ t eval-res-flag set-global
|
|||
: eval-in-context ( lines in usings -- )
|
||||
begin-eval
|
||||
[
|
||||
{ "fuel" "syntax" } prepend
|
||||
parser-quiet? on
|
||||
! These vocabs are always needed in the manifest. syntax for
|
||||
! obvious reasons, fuel for FUEL stuff and debugger for the :N
|
||||
! words.
|
||||
{ "fuel" "syntax" "debugger" } prepend
|
||||
<manifest> manifest set
|
||||
[ eval-usings eval-in eval ] with-string-writer
|
||||
] with-scope end-eval ;
|
||||
|
|
|
@ -20,7 +20,7 @@ IN: fuel
|
|||
: fuel-eval-set-result ( obj -- )
|
||||
clone eval-result set-global ; inline
|
||||
|
||||
: fuel-retort ( -- ) send-retort ; inline
|
||||
: fuel-retort ( -- ) f f "" send-retort ; inline
|
||||
|
||||
! Loading files
|
||||
|
||||
|
|
Loading…
Reference in New Issue