factor/extra/fuel/fuel.factor

214 lines
5.8 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 math.order memoize
namespaces parser prettyprint prettyprint.config quotations
sequences sets sorting source-files strings summary tools.vocabs
vectors vocabs vocabs.loader vocabs.parser words ;
IN: fuel
! Evaluation status:
TUPLE: fuel-status in use 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
: fuel-push-status ( -- )
in get use get clone restarts get-global clone
fuel-status boa
fuel-status-stack get push ;
: fuel-pop-restarts ( restarts -- )
fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
: fuel-pop-status ( -- )
fuel-status-stack get empty? [
2008-12-20 10:51:05 -05:00
fuel-status-stack get pop
[ in>> in set ]
[ use>> clone use set ]
[ restarts>> fuel-pop-restarts ] tri
] 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
"(" write [ " " write ] [ fuel-pprint ] interleave ")" write ; inline
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 "<~FUEL~>" write nl flush ;
: 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) ( -- )
fuel-push-status
fuel-forget-error
fuel-forget-result
fuel-forget-output ;
: (fuel-end-eval) ( output -- )
fuel-eval-output set-global fuel-retort fuel-pop-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 -- )
2008-12-21 16:12:46 -05:00
(fuel-begin-eval)
[ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
(fuel-end-eval) ;
: fuel-run-file ( path -- ) run-file ; inline
! Edit locations
: fuel-normalize-loc ( seq -- path line )
dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
: fuel-get-edit-location ( defspec -- )
where fuel-normalize-loc 2array fuel-eval-set-result ; inline
: fuel-get-vocab-location ( vocab -- )
>vocab-link fuel-get-edit-location ; inline
: fuel-get-doc-location ( defspec -- )
props>> "help-loc" swap at
fuel-normalize-loc 2array fuel-eval-set-result ;
! Cross-references
: fuel-word>xref ( word -- xref )
[ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ;
: fuel-sort-xrefs ( seq -- seq' )
[ [ first ] dip first <=> ] sort ; inline
: fuel-format-xrefs ( seq -- seq' )
[ word? ] filter [ fuel-word>xref ] map fuel-sort-xrefs ;
: fuel-callers-xref ( word -- )
usage fuel-format-xrefs fuel-eval-set-result ; inline
: fuel-callees-xref ( word -- )
uses fuel-format-xrefs fuel-eval-set-result ; 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