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 memoize namespaces
   8 parser prettyprint prettyprint.config quotations sequences sets
   9 sorting source-files strings tools.vocabs vectors vocabs
  10 vocabs.loader vocabs.parser ;
  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             ]
  54         } cleave
  55     ] unless ;
  56
  57
  58 ! Lispy pretty printing
  59
  60 GENERIC: fuel-pprint ( obj -- )
  61
  62 M: object fuel-pprint pprint ; inline
  63
  64 M: f fuel-pprint drop "nil" write ; inline
  65
  66 M: integer fuel-pprint pprint ; inline
  67
  68 M: string fuel-pprint pprint ; inline
  69
  70 M: sequence fuel-pprint
  71     dup empty? [ drop f fuel-pprint ] [
  72         "(" write
  73         [ " " write ] [ fuel-pprint ] interleave
  74         ")" write
  75     ] if ;
  76
  77 M: tuple fuel-pprint tuple>array fuel-pprint ; inline
  78
  79 M: continuation fuel-pprint drop ":continuation" write ; inline
  80
  81 M: restart fuel-pprint name>> fuel-pprint ; inline
  82
  83 SYMBOL: :restarts
  84
  85 : fuel-restarts ( obj -- seq )
  86     compute-restarts :restarts prefix ; inline
  87
  88 M: condition fuel-pprint
  89     [ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
  90
  91 M: lexer-error fuel-pprint
  92     {
  93         [ line>> ]
  94         [ column>> ]
  95         [ line-text>> ]
  96         [ fuel-restarts ]
  97     } cleave 4array lexer-error prefix fuel-pprint ;
  98
  99 M: source-file-error fuel-pprint
 100     [ file>> ] [ error>> ] bi 2array source-file-error prefix
 101     fuel-pprint ;
 102
 103 M: source-file fuel-pprint path>> fuel-pprint ;
 104
 105 ! Evaluation vocabulary
 106
 107 : fuel-eval-set-result ( obj -- )
 108     clone fuel-eval-result set-global ; inline
 109
 110 : fuel-retort ( -- )
 111     error get
 112     fuel-eval-result get-global
 113     fuel-eval-output get-global
 114     3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
 115
 116 : fuel-forget-error ( -- ) f error set-global ; inline
 117 : fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
 118 : fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
 119
 120 : (fuel-begin-eval) ( -- )
 121     push-fuel-status
 122     fuel-forget-error
 123     fuel-forget-result
 124     fuel-forget-output ;
 125
 126 : (fuel-end-eval) ( quot -- )
 127     with-string-writer fuel-eval-output set-global fuel-retort
 128     pop-fuel-status ; inline
 129
 130 : (fuel-eval) ( lines -- )
 131     [ [ parse-lines ] with-compilation-unit call ] curry
 132     [ print-error ] recover ; inline
 133
 134 : (fuel-eval-each) ( lines -- )
 135     [ 1vector (fuel-eval) ] each ; inline
 136
 137 : (fuel-eval-usings) ( usings -- )
 138     [ "USING: " prepend " ;" append ] map
 139     (fuel-eval-each) fuel-forget-error fuel-forget-output ;
 140
 141 : (fuel-eval-in) ( in -- )
 142     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
 143
 144 : fuel-eval-in-context ( lines in usings -- )
 145     (fuel-begin-eval) [
 146         (fuel-eval-usings)
 147         (fuel-eval-in)
 148         (fuel-eval)
 149     ] (fuel-end-eval) ;
 150
 151 : fuel-begin-eval ( in -- )
 152     (fuel-begin-eval)
 153     (fuel-eval-in)
 154     fuel-retort ;
 155
 156 : fuel-eval ( lines -- )
 157     (fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
 158
 159 : fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
 160
 161 : fuel-run-file ( path -- ) run-file ; inline
 162
 163 ! Edit locations
 164
 165 : fuel-get-edit-location ( defspec -- )
 166     where [
 167        first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
 168     ] when* ; inline
 169
 170 : fuel-get-vocab-location ( vocab -- )
 171     >vocab-link fuel-get-edit-location ; inline
 172
 173 ! Completion support
 174
 175 : fuel-filter-prefix ( seq prefix -- seq )
 176     [ drop-prefix nip length 0 = ] curry filter prune ; inline
 177
 178 : (fuel-get-vocabs) ( -- seq )
 179     all-vocabs-seq [ vocab-name ] map ; inline
 180
 181 : fuel-get-vocabs ( -- )
 182     (fuel-get-vocabs) fuel-eval-set-result ; inline
 183
 184 : fuel-get-vocabs/prefix ( prefix -- )
 185     (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
 186
 187 : fuel-vocab-summary ( name -- )
 188     >vocab-link summary fuel-eval-set-result ; inline
 189
 190 MEMO: (fuel-vocab-words) ( name -- seq )
 191     >vocab-link words [ name>> ] map ;
 192
 193 : fuel-current-words ( -- seq )
 194     use get [ keys ] map concat ; inline
 195
 196 : fuel-vocabs-words ( names -- seq )
 197     prune [ (fuel-vocab-words) ] map concat ; inline
 198
 199 : (fuel-get-words) ( prefix names/f -- seq )
 200     [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
 201     swap fuel-filter-prefix ;
 202
 203 : fuel-get-words ( prefix names -- )
 204     (fuel-get-words) fuel-eval-set-result ; inline
 205
 206
 207 ! -run=fuel support
 208
 209 : fuel-startup ( -- ) "listener" run-file ; inline
 210
 211 MAIN: fuel-startup