steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

191
library/syntax/parse-stream.factor
View File

@ -1,98 +1,93 @@
! Copyright (C) 2004, 2006 Slava Pestov. ! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: parser IN: parser
USING: arrays errors generic hashtables io kernel math USING: arrays errors generic hashtables io kernel math
namespaces sequences words ; namespaces sequences words ;
SYMBOL: source-files SYMBOL: source-files
TUPLE: source-file path modified definitions ; TUPLE: source-file path modified definitions ;
: source-file-modified* ( source-file -- n ) : source-file-modified* ( source-file -- n )
source-file-path ?resource-path source-file-path ?resource-path
file-modified [ 0 ] unless* ; file-modified [ 0 ] unless* ;
: record-modified ( file -- ) : record-modified ( file -- )
dup source-file-modified* swap set-source-file-modified ; dup source-file-modified* swap set-source-file-modified ;
: reset-modified ( -- ) : reset-modified ( -- )
source-files get hash-values [ record-modified ] each ; source-files get hash-values [ record-modified ] each ;
C: source-file ( path -- source-file ) C: source-file ( path -- source-file )
[ set-source-file-path ] keep [ set-source-file-path ] keep
V{ } clone over set-source-file-definitions V{ } clone over set-source-file-definitions
dup record-modified ; dup record-modified ;
: source-modified? ( file -- ? ) : source-modified? ( file -- ? )
source-files get hash [ source-files get hash [
dup source-file-modified swap source-file-modified* dup source-file-modified swap source-file-modified*
[ < ] [ drop f ] if* [ < ] [ drop f ] if*
] [ ] [
t t
] if* ; ] if* ;
: file-vocabs ( -- ) : file-vocabs ( -- )
"scratchpad" set-in { "syntax" "scratchpad" } set-use ; "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
: with-parser ( quot -- ) : with-parser ( quot -- )
[ 0 line-number set [
[ dup [ parse-error? ] is? [ <parse-error> ] unless
dup [ parse-error? ] is? [ <parse-error> ] unless rethrow
rethrow ] recover ;
] recover
] with-scope ; : parse-lines ( lines -- quot )
[ f [ (parse) ] reduce >quotation ] with-parser ;
: parse-lines ( lines -- quot )
[ : parse ( str -- quot ) <string-reader> lines parse-lines ;
dup length f [ 1+ line-number set (parse) ] 2reduce
>quotation : eval ( str -- ) parse call ;
] with-parser ;
SYMBOL: parse-hook
: parse ( str -- quot ) <string-reader> lines parse-lines ;
: do-parse-hook ( -- ) parse-hook get call ;
: eval ( str -- ) parse call ;
: parse-stream ( stream name -- quot )
SYMBOL: parse-hook [
file set file-vocabs
: do-parse-hook ( -- ) parse-hook get call ; lines parse-lines
do-parse-hook
: parse-stream ( stream name -- quot ) ] with-scope ;
[
file set file-vocabs : parsing-file ( file -- )
lines parse-lines "Loading " write write-pathname terpri flush ;
do-parse-hook
] with-scope ; : record-file ( file -- )
[ <source-file> ] keep source-files get set-hash ;
: parsing-file ( file -- )
"Loading " write write-pathname terpri flush ; : parse-file-restarts ( file -- restarts )
"Load " swap " again" append3 t 2array 1array ;
: record-file ( file -- )
[ <source-file> ] keep source-files get set-hash ; : parse-file ( file -- quot )
[
: parse-file-restarts ( file -- restarts ) dup parsing-file dup record-file
"Load " swap " again" append3 t 2array 1array ; [ ?resource-path <file-reader> ] keep parse-stream
] [
: parse-file ( file -- quot ) over parse-file-restarts condition drop parse-file
[ ] recover ;
dup parsing-file dup record-file
[ ?resource-path <file-reader> ] keep parse-stream : run-file ( file -- ) parse-file call ;
] [
over parse-file-restarts condition drop parse-file : no-parse-hook ( quot -- )
] recover ; [ parse-hook off call ] with-scope ; inline
: run-file ( file -- ) parse-file call ; : run-files ( seq -- )
[
: no-parse-hook ( quot -- ) bootstrapping? get
[ parse-hook off call ] with-scope ; inline [ parse-file % ] [ run-file ] ? each
] no-parse-hook ;
: run-files ( seq -- )
[ : ?run-file ( file -- )
bootstrapping? get dup exists? [ [ [ run-file ] keep ] try ] when drop ;
[ parse-file % ] [ run-file ] ? each
] no-parse-hook ; : eval>string ( str -- str )
[ [ [ eval ] keep ] try drop ] string-out ;
: ?run-file ( file -- )
dup exists? [ [ [ run-file ] keep ] try ] when drop ;
: eval>string ( str -- str )
[ [ [ eval ] keep ] try drop ] string-out ;

1
library/syntax/parser.factor
View File

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

17
library/tools/listener.factor
View File

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

33
library/ui/text/interactor.factor
View File

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