2008-12-05 22:34:25 -05:00
|
|
|
! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
USING: accessors arrays classes classes.tuple compiler.units
|
|
|
|
combinators continuations debugger definitions eval help
|
|
|
|
io io.files io.streams.string kernel lexer listener listener.private
|
|
|
|
make math namespaces parser prettyprint prettyprint.config
|
|
|
|
quotations sequences strings source-files vectors vocabs.loader ;
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
IN: fuel
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
! Evaluation status:
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
TUPLE: fuel-status in use ds? restarts ;
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
SYMBOL: fuel-status-stack
|
|
|
|
V{ } clone fuel-status-stack set-global
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
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
|
|
|
|
|
2008-12-05 22:34:25 -05:00
|
|
|
: push-fuel-status ( -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
in get use get clone display-stacks? get restarts get-global clone
|
2008-12-05 22:34:25 -05:00
|
|
|
fuel-status boa
|
|
|
|
fuel-status-stack get push ;
|
|
|
|
|
|
|
|
: pop-fuel-status ( -- )
|
|
|
|
fuel-status-stack get empty? [
|
2008-12-08 20:36:55 -05:00
|
|
|
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
|
2008-12-05 22:34:25 -05:00
|
|
|
] unless ;
|
|
|
|
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
! Lispy pretty printing
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
GENERIC: fuel-pprint ( obj -- )
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
M: object fuel-pprint pprint ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
M: f fuel-pprint drop "nil" write ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
M: integer fuel-pprint pprint ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
M: string fuel-pprint pprint ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
M: sequence fuel-pprint
|
|
|
|
dup empty? [ drop f fuel-pprint ] [
|
|
|
|
"(" write
|
|
|
|
[ " " write ] [ fuel-pprint ] interleave
|
|
|
|
")" write
|
|
|
|
] if ;
|
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
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
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
: fuel-restarts ( obj -- seq )
|
|
|
|
compute-restarts :restarts prefix ; inline
|
|
|
|
|
|
|
|
M: condition fuel-pprint
|
|
|
|
[ error>> ] [ fuel-restarts ] bi 2array condition 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
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: fuel-eval-set-result ( obj -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
clone fuel-eval-result set-global ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: fuel-retort ( -- )
|
|
|
|
error get
|
|
|
|
fuel-eval-result get-global
|
|
|
|
fuel-eval-output get-global
|
|
|
|
3array fuel-pprint ;
|
|
|
|
|
2008-12-09 17:37:27 -05:00
|
|
|
: 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
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: (fuel-begin-eval) ( -- )
|
|
|
|
push-fuel-status
|
|
|
|
display-stacks? off
|
|
|
|
fuel-forget-error
|
2008-12-09 17:37:27 -05:00
|
|
|
fuel-forget-result
|
|
|
|
fuel-forget-output ;
|
2008-12-08 20:36:55 -05:00
|
|
|
|
2008-12-05 22:34:25 -05:00
|
|
|
: (fuel-end-eval) ( quot -- )
|
2008-12-09 17:37:27 -05:00
|
|
|
with-string-writer fuel-eval-output set-global
|
|
|
|
fuel-retort pop-fuel-status ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: (fuel-eval) ( lines -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
[ [ parse-lines ] with-compilation-unit call ] curry
|
|
|
|
[ print-error ] recover ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: (fuel-eval-each) ( lines -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
[ 1vector (fuel-eval) ] each ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: (fuel-eval-usings) ( usings -- )
|
|
|
|
[ "USING: " prepend " ;" append ] map
|
2008-12-09 17:37:27 -05:00
|
|
|
(fuel-eval-each) fuel-forget-error fuel-forget-output ;
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: (fuel-eval-in) ( in -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
: 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 -- )
|
2008-12-08 20:36:55 -05:00
|
|
|
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-06 01:01:12 -05:00
|
|
|
: fuel-get-edit-location ( defspec -- )
|
2008-12-12 19:54:18 -05:00
|
|
|
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ]
|
|
|
|
when* ;
|
2008-12-05 22:34:25 -05:00
|
|
|
|
2008-12-08 20:36:55 -05:00
|
|
|
: fuel-run-file ( path -- ) run-file ; inline
|
|
|
|
|
|
|
|
: fuel-startup ( -- ) "listener" run ; inline
|
2008-12-05 22:34:25 -05:00
|
|
|
|
|
|
|
MAIN: fuel-startup
|