extra/fuel/fuel.factor

   1 ! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs compiler.units continuations fry fuel.eval
   4 fuel.help fuel.xref help.topics io.pathnames kernel namespaces parser
   5 parser.notes sequences source-files tools.scaffold vocabs vocabs.files
   6 vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.parser words ;
   7 IN: fuel
   8
   9 ! Evaluation
  10
  11 : fuel-eval-restartable ( -- )
  12     t eval-res-flag set-global ; inline
  13
  14 : fuel-eval-non-restartable ( -- )
  15     f eval-res-flag set-global ; inline
  16
  17 : fuel-eval-in-context ( lines in usings -- )
  18     eval-in-context ;
  19
  20 : fuel-eval-set-result ( obj -- )
  21     clone eval-result set-global ; inline
  22
  23 : fuel-retort ( -- ) f f "" send-retort ; inline
  24
  25 ! Loading files
  26
  27 <PRIVATE
  28
  29 SYMBOL: :uses
  30 SYMBOL: :uses-suggestions
  31
  32 : is-use-restart? ( restart -- ? )
  33     name>> [ "Use the " head? ] [ " vocabulary" tail? ] bi and ;
  34
  35 : get-restart-vocab ( restart -- vocab/f )
  36     obj>> dup word? [ vocabulary>> ] [ drop f ] if ;
  37
  38 : is-suggested-restart? ( restart -- ? )
  39     dup is-use-restart? [
  40         get-restart-vocab :uses-suggestions get member?
  41     ] [ drop f ] if ;
  42
  43 : try-suggested-restarts ( -- )
  44     restarts get [ is-suggested-restart? ] filter
  45     dup length 1 = [ first continue-restart ] [ drop ] if ;
  46
  47 : set-use-hook ( -- )
  48     [ manifest get auto-used>> clone :uses prefix fuel-eval-set-result ]
  49     print-use-hook set ;
  50
  51 PRIVATE>
  52
  53 : fuel-use-suggested-vocabs ( ..a suggestions quot: ( ..a -- ..b ) -- ..b )
  54     [ :uses-suggestions set ] dip
  55     [ try-suggested-restarts rethrow ] recover ; inline
  56
  57 : fuel-run-file ( path -- )
  58     '[ _ set-use-hook run-file ] with-scope ; inline
  59
  60 : fuel-with-autouse ( ..a quot: ( ..a -- ..b ) -- ..b )
  61     '[ _ set-use-hook call ] with-scope ; inline
  62
  63 : fuel-get-uses ( name lines -- )
  64     '[
  65         [
  66             _ [
  67                 parser-quiet? on
  68                 _ parse-fresh drop
  69             ] with-source-file
  70         ] with-compilation-unit
  71     ] fuel-with-autouse ;
  72
  73 ! Edit locations
  74
  75 : fuel-get-word-location ( word -- )
  76     word-location fuel-eval-set-result ;
  77
  78 : fuel-get-vocab-location ( vocab -- )
  79     vocab-location fuel-eval-set-result ;
  80
  81 : fuel-get-doc-location ( word -- )
  82     doc-location fuel-eval-set-result ;
  83
  84 : fuel-get-article-location ( name -- )
  85     article-location fuel-eval-set-result ;
  86
  87 : fuel-get-vocabs ( -- )
  88     all-disk-vocab-names fuel-eval-set-result ;
  89
  90 : fuel-get-vocabs/prefix ( prefix -- )
  91     get-vocabs/prefix fuel-eval-set-result ;
  92
  93 : fuel-get-words ( prefix names -- )
  94     get-vocabs-words/prefix fuel-eval-set-result ;
  95
  96 ! Cross-references
  97
  98 : fuel-callers-xref ( word -- ) callers-xref fuel-eval-set-result ;
  99
 100 : fuel-callees-xref ( word -- ) callees-xref fuel-eval-set-result ;
 101
 102 : fuel-apropos-xref ( str -- ) apropos-xref fuel-eval-set-result ;
 103
 104 : fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ;
 105
 106 : fuel-vocab-uses-xref ( vocab -- ) vocab-uses-xref fuel-eval-set-result ;
 107
 108 : fuel-vocab-usage-xref ( vocab -- ) vocab-usage-xref fuel-eval-set-result ;
 109
 110 ! Help support
 111
 112 : fuel-get-article ( name -- ) fuel.help:get-article fuel-eval-set-result ;
 113
 114 : fuel-get-article-title ( name -- )
 115     articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;
 116
 117 : fuel-word-help ( name -- ) word-help fuel-eval-set-result ;
 118
 119 : fuel-word-def ( name -- ) word-def fuel-eval-set-result ;
 120
 121 : fuel-vocab-help ( name -- ) fuel.help:vocab-help fuel-eval-set-result ;
 122
 123 : fuel-word-synopsis ( word -- ) word-synopsis fuel-eval-set-result ;
 124
 125 : fuel-vocab-summary ( name -- )
 126     fuel.help:vocab-summary fuel-eval-set-result ;
 127
 128 : fuel-index ( quot -- ) call( -- seq ) format-index fuel-eval-set-result ;
 129
 130 : fuel-get-vocabs/tag ( tag -- )
 131     get-vocabs/tag fuel-eval-set-result ;
 132
 133 : fuel-get-vocabs/author ( author -- )
 134     get-vocabs/author fuel-eval-set-result ;
 135
 136 ! Scaffold support
 137
 138 : scaffold-name ( devname -- )
 139     [ developer-name set ] when* ;
 140
 141 : fuel-scaffold-vocab ( root name devname -- )
 142     [ scaffold-name dup [ scaffold-vocab ] dip ] with-scope
 143     dup require vocab-source-path absolute-path fuel-eval-set-result ;
 144
 145 : fuel-scaffold-help ( name devname -- )
 146     [ scaffold-name dup require dup scaffold-docs ] with-scope
 147     vocab-docs-path absolute-path fuel-eval-set-result ;
 148
 149 : fuel-scaffold-tests ( name devname -- )
 150     [ scaffold-name dup require dup scaffold-tests ] with-scope
 151     vocab-tests-file absolute-path fuel-eval-set-result ;
 152
 153 : fuel-scaffold-authors ( name devname -- )
 154     [ scaffold-name dup require dup scaffold-authors ] with-scope
 155     [ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
 156
 157 : fuel-scaffold-tags ( name tags -- )
 158     [ scaffold-tags ]
 159     [
 160         drop [ vocab-tags-path ] keep swap
 161         vocab-append-path absolute-path fuel-eval-set-result
 162     ] 2bi ;
 163
 164 : fuel-scaffold-summary ( name summary -- )
 165     [ scaffold-summary ]
 166     [
 167         drop [ vocab-summary-path ] keep swap
 168         vocab-append-path absolute-path fuel-eval-set-result
 169     ] 2bi ;
 170
 171 : fuel-scaffold-platforms ( name platforms -- )
 172     [ scaffold-platforms ]
 173     [
 174         drop [ vocab-platforms-path ] keep swap
 175         vocab-append-path absolute-path fuel-eval-set-result
 176     ] 2bi ;
 177
 178 : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;