]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/fuel/fuel.factor
FUEL: improved fuel-get-uses
[factor.git] / extra / fuel / fuel.factor
index a8c2adc3e1a3ccc8b10f58ed308c99163fe3ad77..81b0022dc1792831ec68db92110e81f68fd4c113 100644 (file)
@@ -1,27 +1,26 @@
 ! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
-
-USING: accessors assocs compiler.units continuations fuel.eval fuel.help
-fuel.remote fuel.xref help.topics io.pathnames kernel math namespaces parser
-sequences tools.scaffold vocabs.loader ;
-
+USING: accessors assocs compiler.units continuations fry fuel.eval
+fuel.help fuel.xref help.topics io.pathnames kernel namespaces parser
+parser.notes sequences source-files tools.scaffold vocabs vocabs.files
+vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.parser words ;
 IN: fuel
 
 ! Evaluation
 
 : fuel-eval-restartable ( -- )
-    t fuel-eval-res-flag set-global ; inline
+    t eval-res-flag set-global ; inline
 
 : fuel-eval-non-restartable ( -- )
-    f fuel-eval-res-flag set-global ; inline
+    f eval-res-flag set-global ; inline
 
 : fuel-eval-in-context ( lines in usings -- )
-    (fuel-eval-in-context) ;
+    eval-in-context ;
 
 : fuel-eval-set-result ( obj -- )
-    clone fuel-eval-result set-global ; inline
+    clone eval-result set-global ; inline
 
-: fuel-retort ( -- ) fuel-send-retort ; inline
+: fuel-retort ( -- ) f f "" send-retort ; inline
 
 ! Loading files
 
@@ -30,44 +29,46 @@ IN: fuel
 SYMBOL: :uses
 SYMBOL: :uses-suggestions
 
-: is-use-restart ( restart -- ? )
+: is-use-restart? ( restart -- ? )
     name>> [ "Use the " head? ] [ " vocabulary" tail? ] bi and ;
 
-: get-restart-vocab ( restart -- vocab )
-    [ "Use the " length ] dip
-    name>> [ length " vocabulary" length - ] keep
-    subseq ;
+: get-restart-vocab ( restart -- vocab/f )
+    obj>> dup word? [ vocabulary>> ] [ drop f ] if ;
 
-: is-suggested-restart ( restart -- ? )
-    dup is-use-restart [
+: is-suggested-restart? ( restart -- ? )
+    dup is-use-restart? [
         get-restart-vocab :uses-suggestions get member?
     ] [ drop f ] if ;
 
 : try-suggested-restarts ( -- )
-    restarts get [ is-suggested-restart ] filter
-    dup length 1 = [ first restart ] [ drop ] if ;
+    restarts get [ is-suggested-restart? ] filter
+    dup length 1 = [ first continue-restart ] [ drop ] if ;
 
-: fuel-set-use-hook ( -- )
-    [ amended-use get clone :uses prefix fuel-eval-set-result ]
+: set-use-hook ( -- )
+    [ manifest get auto-used>> clone :uses prefix fuel-eval-set-result ]
     print-use-hook set ;
 
-: (fuel-get-uses) ( lines -- )
-    [ parse-fresh drop ] curry with-compilation-unit ; inline
-
 PRIVATE>
 
-: fuel-use-suggested-vocabs ( ... suggestions quot: ( ... -- ... ) -- ... )
+: fuel-use-suggested-vocabs ( ..a suggestions quot: ( ..a -- ..b ) -- ..b )
     [ :uses-suggestions set ] dip
-    [ try-suggested-restarts rethrow ] recover ;
+    [ try-suggested-restarts rethrow ] recover ; inline
 
 : fuel-run-file ( path -- )
-    [ fuel-set-use-hook run-file ] curry with-scope ; inline
+    '[ _ set-use-hook run-file ] with-scope ; inline
 
-: fuel-with-autouse ( ... quot: ( ... -- ... ) -- ... )
-    [ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline
+: fuel-with-autouse ( ..a quot: ( ..a -- ..b ) -- ..b )
+    '[ _ set-use-hook call ] with-scope ; inline
 
-: fuel-get-uses ( lines -- )
-    [ (fuel-get-uses) ] curry fuel-with-autouse ;
+: fuel-get-uses ( name lines -- )
+    '[
+        [
+            _ [
+                parser-quiet? on
+                _ parse-fresh drop
+            ] with-source-file
+        ] with-compilation-unit
+    ] fuel-with-autouse ;
 
 ! Edit locations
 
@@ -84,7 +85,7 @@ PRIVATE>
     article-location fuel-eval-set-result ;
 
 : fuel-get-vocabs ( -- )
-    get-vocabs fuel-eval-set-result ;
+    all-disk-vocab-names fuel-eval-set-result ;
 
 : fuel-get-vocabs/prefix ( prefix -- )
     get-vocabs/prefix fuel-eval-set-result ;
@@ -108,45 +109,70 @@ PRIVATE>
 
 ! Help support
 
-: fuel-get-article ( name -- ) article fuel-eval-set-result ;
+: fuel-get-article ( name -- ) fuel.help:get-article fuel-eval-set-result ;
 
 : fuel-get-article-title ( name -- )
     articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;
 
-: fuel-word-help ( name -- ) (fuel-word-help) fuel-eval-set-result ;
-
-: fuel-word-see ( name -- ) (fuel-word-see) fuel-eval-set-result ;
+: fuel-word-help ( name -- ) word-help fuel-eval-set-result ;
 
-: fuel-word-def ( name -- ) (fuel-word-def) fuel-eval-set-result ;
+: fuel-word-def ( name -- ) word-def fuel-eval-set-result ;
 
-: fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ;
+: fuel-vocab-help ( name -- ) fuel.help:vocab-help fuel-eval-set-result ;
 
-: fuel-word-synopsis ( word usings -- ) (fuel-word-synopsis) fuel-eval-set-result ;
+: fuel-word-synopsis ( word -- ) word-synopsis fuel-eval-set-result ;
 
 : fuel-vocab-summary ( name -- )
-    (fuel-vocab-summary) fuel-eval-set-result ;
+    fuel.help:vocab-summary fuel-eval-set-result ;
 
-: fuel-index ( quot -- ) call format-index fuel-eval-set-result ;
+: fuel-index ( quot -- ) call( -- seq ) format-index fuel-eval-set-result ;
 
 : fuel-get-vocabs/tag ( tag -- )
-    (fuel-get-vocabs/tag) fuel-eval-set-result ;
+    get-vocabs/tag fuel-eval-set-result ;
 
 : fuel-get-vocabs/author ( author -- )
-    (fuel-get-vocabs/author) fuel-eval-set-result ;
+    get-vocabs/author fuel-eval-set-result ;
 
 ! Scaffold support
 
+: scaffold-name ( devname -- )
+    [ developer-name set ] when* ;
+
 : fuel-scaffold-vocab ( root name devname -- )
-    developer-name set dup [ scaffold-vocab ] dip
-    dup require vocab-source-path (normalize-path) fuel-eval-set-result ;
+    [ scaffold-name dup [ scaffold-vocab ] dip ] with-scope
+    dup require vocab-source-path absolute-path fuel-eval-set-result ;
 
 : fuel-scaffold-help ( name devname -- )
-    developer-name set
-    dup require dup scaffold-help vocab-docs-path
-    (normalize-path) fuel-eval-set-result ;
+    [ scaffold-name dup require dup scaffold-docs ] with-scope
+    vocab-docs-path absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-tests ( name devname -- )
+    [ scaffold-name dup require dup scaffold-tests ] with-scope
+    vocab-tests-file absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-authors ( name devname -- )
+    [ scaffold-name dup require dup scaffold-authors ] with-scope
+    [ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-tags ( name tags -- )
+    [ scaffold-tags ]
+    [
+        drop [ vocab-tags-path ] keep swap
+        vocab-append-path absolute-path fuel-eval-set-result
+    ] 2bi ;
+
+: fuel-scaffold-summary ( name summary -- )
+    [ scaffold-summary ]
+    [
+        drop [ vocab-summary-path ] keep swap
+        vocab-append-path absolute-path fuel-eval-set-result
+    ] 2bi ;
+
+: fuel-scaffold-platforms ( name platforms -- )
+    [ scaffold-platforms ]
+    [
+        drop [ vocab-platforms-path ] keep swap
+        vocab-append-path absolute-path fuel-eval-set-result
+    ] 2bi ;
 
 : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
-
-! Remote connection
-
-MAIN: fuel-start-remote-listener*