extra/fuel/fuel.factor

   1 ! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors arrays assocs classes classes.tuple
   5 combinators compiler.units continuations debugger definitions
   6 eval help io io.files io.pathnames io.streams.string kernel
   7 lexer listener listener.private make math math.order memoize
   8 namespaces parser prettyprint prettyprint.config quotations
   9 sequences sets sorting source-files strings summary tools.vocabs
  10 vectors vocabs vocabs.loader vocabs.parser words ;
  11
  12 IN: fuel
  13
  14 ! Evaluation status:
  15
  16 TUPLE: fuel-status in use restarts ;
  17
  18 SYMBOL: fuel-status-stack
  19 V{ } clone fuel-status-stack set-global
  20
  21 SYMBOL: fuel-eval-result
  22 f clone fuel-eval-result set-global
  23
  24 SYMBOL: fuel-eval-output
  25 f clone fuel-eval-result set-global
  26
  27 SYMBOL: fuel-eval-res-flag
  28 t clone fuel-eval-res-flag set-global
  29
  30 : fuel-eval-restartable? ( -- ? )
  31     fuel-eval-res-flag get-global ; inline
  32
  33 : fuel-eval-restartable ( -- )
  34     t fuel-eval-res-flag set-global ; inline
  35
  36 : fuel-eval-non-restartable ( -- )
  37     f fuel-eval-res-flag set-global ; inline
  38
  39 : push-fuel-status ( -- )
  40     in get use get clone restarts get-global clone
  41     fuel-status boa
  42     fuel-status-stack get push ;
  43
  44 : pop-fuel-status ( -- )
  45     fuel-status-stack get empty? [
  46         fuel-status-stack get pop
  47         [ in>> in set ]
  48         [ use>> clone use set ]
  49         [
  50             restarts>> fuel-eval-restartable? [ drop ] [
  51                 clone restarts set-global
  52             ] if
  53         ] tri
  54     ] unless ;
  55
  56
  57 ! Lispy pretty printing
  58
  59 GENERIC: fuel-pprint ( obj -- )
  60
  61 M: object fuel-pprint pprint ; inline
  62
  63 M: f fuel-pprint drop "nil" write ; inline
  64
  65 M: integer fuel-pprint pprint ; inline
  66
  67 M: string fuel-pprint pprint ; inline
  68
  69 M: sequence fuel-pprint
  70     dup empty? [ drop f fuel-pprint ] [
  71         "(" write
  72         [ " " write ] [ fuel-pprint ] interleave
  73         ")" write
  74     ] if ;
  75
  76 M: tuple fuel-pprint tuple>array fuel-pprint ; inline
  77
  78 M: continuation fuel-pprint drop ":continuation" write ; inline
  79
  80 M: restart fuel-pprint name>> fuel-pprint ; inline
  81
  82 SYMBOL: :restarts
  83
  84 : fuel-restarts ( obj -- seq )
  85     compute-restarts :restarts prefix ; inline
  86
  87 M: condition fuel-pprint
  88     [ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
  89
  90 M: lexer-error fuel-pprint
  91     {
  92         [ line>> ]
  93         [ column>> ]
  94         [ line-text>> ]
  95         [ fuel-restarts ]
  96     } cleave 4array lexer-error prefix fuel-pprint ;
  97
  98 M: source-file-error fuel-pprint
  99     [ file>> ] [ error>> ] bi 2array source-file-error prefix
 100     fuel-pprint ;
 101
 102 M: source-file fuel-pprint path>> fuel-pprint ;
 103
 104 ! Evaluation vocabulary
 105
 106 : fuel-eval-set-result ( obj -- )
 107     clone fuel-eval-result set-global ; inline
 108
 109 : fuel-retort ( -- )
 110     error get
 111     fuel-eval-result get-global
 112     fuel-eval-output get-global
 113     3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
 114
 115 : fuel-forget-error ( -- ) f error set-global ; inline
 116 : fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
 117 : fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
 118
 119 : (fuel-begin-eval) ( -- )
 120     push-fuel-status
 121     fuel-forget-error
 122     fuel-forget-result
 123     fuel-forget-output ;
 124
 125 : (fuel-end-eval) ( quot -- )
 126     with-string-writer fuel-eval-output set-global fuel-retort
 127     pop-fuel-status ; inline
 128
 129 : (fuel-eval) ( lines -- )
 130     [ [ parse-lines ] with-compilation-unit call ] curry
 131     [ print-error ] recover ; inline
 132
 133 : (fuel-eval-each) ( lines -- )
 134     [ 1vector (fuel-eval) ] each ; inline
 135
 136 : (fuel-eval-usings) ( usings -- )
 137     [ "USING: " prepend " ;" append ] map
 138     (fuel-eval-each) fuel-forget-error fuel-forget-output ;
 139
 140 : (fuel-eval-in) ( in -- )
 141     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
 142
 143 : fuel-eval-in-context ( lines in usings -- )
 144     (fuel-begin-eval) [
 145         (fuel-eval-usings)
 146         (fuel-eval-in)
 147         (fuel-eval)
 148     ] (fuel-end-eval) ;
 149
 150 : fuel-begin-eval ( in -- )
 151     (fuel-begin-eval)
 152     (fuel-eval-in)
 153     fuel-retort ;
 154
 155 : fuel-eval ( lines -- )
 156     (fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
 157
 158 : fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
 159
 160 : fuel-run-file ( path -- ) run-file ; inline
 161
 162 ! Edit locations
 163
 164 : fuel-get-edit-location ( defspec -- )
 165     where [
 166        first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
 167     ] when* ; inline
 168
 169 : fuel-xref-desc ( word -- str )
 170     [ name>> ]
 171     [ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
 172
 173 : fuel-format-xrefs ( seq -- seq )
 174     [ word? ] filter [
 175         [ fuel-xref-desc ]
 176         [ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
 177     ] map [ [ first ] dip first <=> ] sort ; inline
 178
 179 : fuel-callers-xref ( word -- )
 180     usage fuel-format-xrefs fuel-eval-set-result ; inline
 181
 182 : fuel-callees-xref ( word -- )
 183     uses fuel-format-xrefs fuel-eval-set-result ; inline
 184
 185 : fuel-get-vocab-location ( vocab -- )
 186     >vocab-link fuel-get-edit-location ; inline
 187
 188 ! Completion support
 189
 190 : fuel-filter-prefix ( seq prefix -- seq )
 191     [ drop-prefix nip length 0 = ] curry filter prune ; inline
 192
 193 : (fuel-get-vocabs) ( -- seq )
 194     all-vocabs-seq [ vocab-name ] map ; inline
 195
 196 : fuel-get-vocabs ( -- )
 197     (fuel-get-vocabs) fuel-eval-set-result ; inline
 198
 199 : fuel-get-vocabs/prefix ( prefix -- )
 200     (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
 201
 202 : fuel-vocab-summary ( name -- )
 203     >vocab-link summary fuel-eval-set-result ; inline
 204
 205 MEMO: (fuel-vocab-words) ( name -- seq )
 206     >vocab-link words [ name>> ] map ;
 207
 208 : fuel-current-words ( -- seq )
 209     use get [ keys ] map concat ; inline
 210
 211 : fuel-vocabs-words ( names -- seq )
 212     prune [ (fuel-vocab-words) ] map concat ; inline
 213
 214 : (fuel-get-words) ( prefix names/f -- seq )
 215     [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
 216     swap fuel-filter-prefix ;
 217
 218 : fuel-get-words ( prefix names -- )
 219     (fuel-get-words) fuel-eval-set-result ; inline
 220
 221
 222 ! -run=fuel support
 223
 224 : fuel-startup ( -- ) "listener" run-file ; inline
 225
 226 MAIN: fuel-startup