From 3742f1eddf6ce01eb24531d28427107a4dc32c94 Mon Sep 17 00:00:00 2001 From: slava Date: Tue, 28 Nov 2006 21:58:59 +0000 Subject: [PATCH] Interactive interpreter cleanups --- library/syntax/parse-stream.factor | 191 ++++++++++++++--------------- library/syntax/parser.factor | 1 + library/tools/listener.factor | 17 ++- library/ui/text/interactor.factor | 33 +++-- 4 files changed, 125 insertions(+), 117 deletions(-) diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor index 159e24b7fa..b97b76fd29 100644 --- a/library/syntax/parse-stream.factor +++ b/library/syntax/parse-stream.factor @@ -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? [ ] unless - rethrow - ] recover - ] with-scope ; - -: parse-lines ( lines -- quot ) - [ - dup length f [ 1+ line-number set (parse) ] 2reduce - >quotation - ] with-parser ; - -: parse ( str -- quot ) 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 -- ) - [ ] 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 ] 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? [ ] unless + rethrow + ] recover ; + +: parse-lines ( lines -- quot ) + [ f [ (parse) ] reduce >quotation ] with-parser ; + +: parse ( str -- quot ) 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 -- ) + [ ] 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 ] 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 ; diff --git a/library/syntax/parser.factor b/library/syntax/parser.factor index d9f4a74373..f84008bee7 100644 --- a/library/syntax/parser.factor +++ b/library/syntax/parser.factor @@ -57,6 +57,7 @@ TUPLE: no-word name ; : (parse) ( str -- ) line-text set + line-number inc 0 column-number set parse-loop ; diff --git a/library/tools/listener.factor b/library/tools/listener.factor index a3ec53d4da..c7ae734cc7 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -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 ; diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 67eae75343..c0465d71c4 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -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 ] }