Interactive interpreter cleanups

slava 2006-11-28 21:58:59 +00:00
parent bae6713aa9
commit 3742f1eddf
4 changed files with 125 additions and 117 deletions

View File

@ -35,18 +35,13 @@ C: source-file ( path -- source-file )
"scratchpad" set-in { "syntax" "scratchpad" } set-use ;
: with-parser ( quot -- )
[
[
0 line-number set [
dup [ parse-error? ] is? [ <parse-error> ] unless
rethrow
] recover
] with-scope ;
] recover ;
: parse-lines ( lines -- quot )
[
dup length f [ 1+ line-number set (parse) ] 2reduce
>quotation
] with-parser ;
[ f [ (parse) ] reduce >quotation ] with-parser ;
: parse ( str -- quot ) <string-reader> lines parse-lines ;

View File

@ -57,6 +57,7 @@ TUPLE: no-word name ;
: (parse) ( str -- )
line-text set
line-number inc
0 column-number set
parse-loop ;

View File

@ -15,21 +15,20 @@ TUPLE: interactive-stream ;
C: interactive-stream ( stream -- stream )
[ set-delegate ] keep ;
: (parse-interactive) ( quot depth -- quot/f )
>r readln dup [
(parse) depth r> dup >r <= [
>quotation r> drop
: (parse-interactive) ( stream stack -- quot/f )
over stream-readln dup [
over push \ (parse) with-datastack
dup length 1 = [
nip first >quotation
] [
r> (parse-interactive)
(parse-interactive)
] if
] [
r> 3drop f
3drop f
] if ;
M: interactive-stream parse-interactive
delegate [
[ f depth (parse-interactive) in get ] with-parser
] with-stream* in set ;
[ V{ f } clone (parse-interactive) ] with-parser ;
M: duplex-stream parse-interactive
duplex-stream-in parse-interactive ;

View File

@ -25,12 +25,12 @@ M: interactor graft*
dup string? [
dup print-input
] [
5 line-limit set .
short.
] if
] with-stream* ;
: interactor-finish ( obj interactor -- )
2dup interactor-input.
dup editor-text over interactor-input.
dup control-model clear-doc
interactor-continuation schedule-thread-with ;
@ -38,7 +38,7 @@ M: interactor graft*
[ editor-text ] keep dup interactor-quot call ;
: interactor-eof ( interactor -- )
f swap dup interactor-quot call ;
f swap interactor-continuation schedule-thread-with ;
: interactor-commit ( interactor -- )
dup interactor-busy? [ drop ] [ interactor-eval ] if ;
@ -46,13 +46,13 @@ M: interactor graft*
: interactor-yield ( interactor quot -- )
over set-interactor-quot
f over set-interactor-busy?
[ swap set-interactor-continuation stop ] callcc1 ;
[ swap set-interactor-continuation stop ] callcc1 nip ;
M: interactor stream-readln
[
over empty? [ 2dup interactor-history push-new ] unless
interactor-finish
] interactor-yield nip ;
] interactor-yield ;
: interactor-call ( quot interactor -- )
2dup interactor-input.
@ -62,15 +62,26 @@ M: interactor stream-read
swap dup zero?
[ 2drop "" ] [ >r stream-readln r> head ] if ;
: try-parse ( str -- quot ? )
: save-in/use ( interactor -- )
use get over set-interactor-use
in get swap set-interactor-in ;
: restore-in/use ( interactor -- )
dup interactor-use use set
interactor-in in set ;
: try-parse ( str interactor -- quot ? )
[
[
restore-in/use
1array \ parse with-datastack
dup length 1 = [ first t ] [ drop f f ] if
] keep save-in/use
] with-scope ;
: handle-interactive ( str/f interactor -- )
over [
>r try-parse [
dup >r try-parse [
r> interactor-finish
] [
"\n" r> user-input drop
@ -80,7 +91,9 @@ M: interactor stream-read
] if ;
M: interactor parse-interactive
[ handle-interactive ] interactor-yield nip ;
[ save-in/use ] keep
[ [ handle-interactive ] interactor-yield ] keep
restore-in/use ;
interactor "interactor" {
{ "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }