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