]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/fuel/eval/eval.factor
FUEL: refactoring to eliminate the eval-result variable
[factor.git] / extra / fuel / eval / eval.factor
index b4a138459fd0256205b8fe7852cde9ce84bb2c62..3e3da114bf8aa0d919ee6b403439775cd31c2755 100644 (file)
@@ -1,74 +1,64 @@
 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays compiler.units continuations debugger
-fuel.pprint io io.streams.string kernel namespaces parser sequences
-vectors vocabs.parser eval fry ;
-
+USING: accessors arrays continuations debugger fry fuel.pprint io
+io.streams.string kernel listener namespaces parser.notes
+prettyprint.config sequences sets vocabs.parser ;
 IN: fuel.eval
 
-TUPLE: fuel-status in use restarts ;
-
-SYMBOL: fuel-status-stack
-V{ } clone fuel-status-stack set-global
-
-SYMBOL: fuel-eval-result
-f fuel-eval-result set-global
-
-SYMBOL: fuel-eval-output
-f fuel-eval-result set-global
-
-SYMBOL: fuel-eval-res-flag
-t fuel-eval-res-flag set-global
-
-: fuel-eval-restartable? ( -- ? )
-    fuel-eval-res-flag get-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? [
-        fuel-status-stack get pop
-        [ in>> in set ]
-        [ use>> clone use set ]
-        [ restarts>> fuel-pop-restarts ] tri
-    ] unless ;
-
-: 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-forget-status ( -- )
-    fuel-forget-error fuel-forget-result fuel-forget-output ; inline
-
-: fuel-send-retort ( -- )
-    error get fuel-eval-result get-global fuel-eval-output get-global
-    3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
-
-: (fuel-begin-eval) ( -- )
-    fuel-push-status fuel-forget-status ; inline
-
-: (fuel-end-eval) ( output -- )
-    fuel-eval-output set-global fuel-send-retort fuel-pop-status ; inline
-
-: (fuel-eval) ( string -- )
-    '[ _ eval( -- ) ] try ;
-
-: (fuel-eval-each) ( lines -- )
-    [ (fuel-eval) ] each ;
-
-: (fuel-eval-usings) ( usings -- )
-    [ "USE: " prepend ] map
-    (fuel-eval-each) fuel-forget-error fuel-forget-output ;
-
-: (fuel-eval-in) ( in -- )
-    [ dup "IN: " prepend (fuel-eval) in set ] when* ;
-
-: (fuel-eval-in-context) ( lines in usings -- )
-    (fuel-begin-eval)
-    [ (fuel-eval-usings) (fuel-eval-in) "\n" join (fuel-eval) ] with-string-writer
-    (fuel-end-eval) ;
+SYMBOL: restarts-stack
+V{ } clone restarts-stack set-global
+
+SYMBOL: eval-res-flag
+t eval-res-flag set-global
+
+: eval-restartable? ( -- ? )
+    eval-res-flag get-global ;
+
+: push-status ( -- )
+    restarts get-global clone restarts-stack get push ;
+
+: pop-restarts ( restarts -- )
+    eval-restartable? [ drop ] [ clone restarts set-global ] if ;
+
+: pop-status ( -- )
+    restarts-stack get [ pop pop-restarts ] unless-empty ;
+
+: send-retort ( error result output -- )
+    3array [ fuel-pprint ] without-limits flush nl
+    "<~FUEL~>" write nl flush ;
+
+: begin-eval ( -- )
+    push-status ;
+
+: end-eval ( result error/f output -- )
+    swapd send-retort pop-status ;
+
+: eval ( lines -- result error/f )
+    '[ _ parse-lines-interactive call( -- x ) f ]
+    [ dup print-error f swap ] recover ;
+
+: eval-usings ( usings -- )
+    [ [ use-vocab ] curry ignore-errors ] each ;
+
+: eval-in ( in -- )
+    [ set-current-vocab ] when* ;
+
+: eval-in-context ( lines in usings/f -- )
+    begin-eval
+    [
+        parser-quiet? on
+        [
+            ! The idea is that a correct usings list should always be
+            ! specified. But a lot of code in FUEL sends empty usings
+            ! lists so then we have to use the current manifests
+            ! vocabs instead.
+            manifest get search-vocab-names>> members
+        ] [
+            ! These vocabs are always needed in the manifest. syntax for
+            ! obvious reasons, fuel for FUEL stuff and debugger for the :N
+            ! words.
+            { "fuel" "syntax" "debugger" } prepend
+        ] if-empty
+        <manifest> manifest namespaces:set
+        [ eval-usings eval-in eval ] with-string-writer
+    ] with-scope end-eval ;