factor/extra/fuel/fuel.factor

214 lines
5.5 KiB
Factor
Raw Normal View History

! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.tuple
combinators compiler.units continuations debugger definitions
eval help io io.files io.pathnames io.streams.string kernel
lexer listener listener.private make math memoize namespaces
parser prettyprint prettyprint.config quotations sequences sets
sorting source-files strings summary tools.vocabs vectors
vocabs vocabs.loader ;
IN: fuel
! Evaluation status:
TUPLE: fuel-status in use ds? restarts ;
SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
SYMBOL: fuel-eval-result
f clone fuel-eval-result set-global
SYMBOL: fuel-eval-output
f clone fuel-eval-result set-global
SYMBOL: fuel-eval-res-flag
t clone fuel-eval-res-flag set-global
: fuel-eval-restartable? ( -- ? )
fuel-eval-res-flag get-global ; inline
: fuel-eval-restartable ( -- )
t fuel-eval-res-flag set-global ; inline
: fuel-eval-non-restartable ( -- )
f fuel-eval-res-flag set-global ; inline
: push-fuel-status ( -- )
in get use get clone display-stacks? get restarts get-global clone
fuel-status boa
fuel-status-stack get push ;
: pop-fuel-status ( -- )
fuel-status-stack get empty? [
fuel-status-stack get pop {
[ in>> in set ]
[ use>> clone use set ]
[ ds?>> display-stacks? swap [ on ] [ off ] if ]
[
restarts>> fuel-eval-restartable? [ drop ] [
clone restarts set-global
] if
]
} cleave
] unless ;
! Lispy pretty printing
GENERIC: fuel-pprint ( obj -- )
M: object fuel-pprint pprint ; inline
M: f fuel-pprint drop "nil" write ; inline
M: integer fuel-pprint pprint ; inline
M: string fuel-pprint pprint ; inline
M: sequence fuel-pprint
dup empty? [ drop f fuel-pprint ] [
"(" write
[ " " write ] [ fuel-pprint ] interleave
")" write
] if ;
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
M: continuation fuel-pprint drop ":continuation" write ; inline
M: restart fuel-pprint name>> fuel-pprint ; inline
SYMBOL: :restarts
: fuel-restarts ( obj -- seq )
compute-restarts :restarts prefix ; inline
M: condition fuel-pprint
[ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
M: lexer-error fuel-pprint
{
[ line>> ]
[ column>> ]
[ line-text>> ]
[ fuel-restarts ]
} cleave 4array lexer-error prefix fuel-pprint ;
M: source-file-error fuel-pprint
[ file>> ] [ error>> ] bi 2array source-file-error prefix
fuel-pprint ;
M: source-file fuel-pprint path>> fuel-pprint ;
! Evaluation vocabulary
: fuel-eval-set-result ( obj -- )
clone fuel-eval-result set-global ; inline
: fuel-retort ( -- )
error get
fuel-eval-result get-global
fuel-eval-output get-global
3array fuel-pprint flush nl "EOT:" write ;
: fuel-forget-error ( -- ) f error set-global ; inline
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
: (fuel-begin-eval) ( -- )
push-fuel-status
display-stacks? off
fuel-forget-error
fuel-forget-result
fuel-forget-output ;
: (fuel-end-eval) ( quot -- )
with-string-writer fuel-eval-output set-global
fuel-retort pop-fuel-status ; inline
: (fuel-eval) ( lines -- )
[ [ parse-lines ] with-compilation-unit call ] curry
[ print-error ] recover ; inline
: (fuel-eval-each) ( lines -- )
[ 1vector (fuel-eval) ] each ; inline
: (fuel-eval-usings) ( usings -- )
[ "USING: " prepend " ;" append ] map
(fuel-eval-each) fuel-forget-error fuel-forget-output ;
: (fuel-eval-in) ( in -- )
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
: fuel-eval-in-context ( lines in usings -- )
(fuel-begin-eval) [
(fuel-eval-usings)
(fuel-eval-in)
(fuel-eval)
] (fuel-end-eval) ;
: fuel-begin-eval ( in -- )
(fuel-begin-eval)
(fuel-eval-in)
fuel-retort ;
: fuel-eval ( lines -- )
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
: fuel-run-file ( path -- ) run-file ; inline
! Edit locations
: fuel-get-edit-location ( defspec -- )
where [
first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
] when* ; inline
: fuel-get-vocab-location ( vocab -- )
>vocab-link fuel-get-edit-location ; inline
! Completion support
: fuel-filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter prune ; inline
: (fuel-get-vocabs) ( -- seq )
all-vocabs-seq [ vocab-name ] map ; inline
: fuel-get-vocabs ( -- )
(fuel-get-vocabs) fuel-eval-set-result ; inline
: fuel-get-vocabs/prefix ( prefix -- )
(fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
: fuel-vocab-summary ( name -- )
>vocab-link summary fuel-eval-set-result ; inline
MEMO: (fuel-vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ;
: fuel-current-words ( -- seq )
use get [ keys ] map concat ; inline
: fuel-vocabs-words ( names -- seq )
prune [ (fuel-vocab-words) ] map concat ; inline
: (fuel-get-words) ( prefix names/f -- seq )
[ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
swap fuel-filter-prefix ;
: fuel-get-words ( prefix names -- )
(fuel-get-words) fuel-eval-set-result ; inline
! -run=fuel support
: fuel-startup ( -- ) "listener" run-file ; inline
MAIN: fuel-startup