extra/fuel/fuel.factor

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