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 classes classes.tuple compiler.units
   5 combinators continuations debugger definitions eval help
   6 io io.files io.streams.string kernel lexer listener listener.private
   7 make math namespaces parser prettyprint prettyprint.config
   8 quotations sequences strings source-files tools.vocabs
   9 vectors vocabs vocabs.loader ;
  10
  11 IN: fuel
  12
  13 ! Evaluation status:
  14
  15 TUPLE: fuel-status in use ds? restarts ;
  16
  17 SYMBOL: fuel-status-stack
  18 V{ } clone fuel-status-stack set-global
  19
  20 SYMBOL: fuel-eval-result
  21 f clone fuel-eval-result set-global
  22
  23 SYMBOL: fuel-eval-output
  24 f clone fuel-eval-result set-global
  25
  26 SYMBOL: fuel-eval-res-flag
  27 t clone fuel-eval-res-flag set-global
  28
  29 : fuel-eval-restartable? ( -- ? )
  30     fuel-eval-res-flag get-global ; inline
  31
  32 : fuel-eval-restartable ( -- )
  33     t fuel-eval-res-flag set-global ; inline
  34
  35 : fuel-eval-non-restartable ( -- )
  36     f fuel-eval-res-flag set-global ; inline
  37
  38 : push-fuel-status ( -- )
  39     in get use get clone display-stacks? get restarts get-global clone
  40     fuel-status boa
  41     fuel-status-stack get push ;
  42
  43 : pop-fuel-status ( -- )
  44     fuel-status-stack get empty? [
  45         fuel-status-stack get pop {
  46             [ in>> in set ]
  47             [ use>> clone use set ]
  48             [ ds?>> display-stacks? swap [ on ] [ off ] if ]
  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: source-file-error fuel-pprint
  92     [ file>> ] [ error>> ] bi 2array source-file-error prefix
  93     fuel-pprint ;
  94
  95 M: source-file fuel-pprint path>> fuel-pprint ;
  96
  97 ! Evaluation vocabulary
  98
  99 : fuel-eval-set-result ( obj -- )
 100     clone fuel-eval-result set-global ; inline
 101
 102 : fuel-retort ( -- )
 103     error get
 104     fuel-eval-result get-global
 105     fuel-eval-output get-global
 106     3array fuel-pprint ;
 107
 108 : fuel-forget-error ( -- ) f error set-global ; inline
 109 : fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
 110 : fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
 111
 112 : (fuel-begin-eval) ( -- )
 113     push-fuel-status
 114     display-stacks? off
 115     fuel-forget-error
 116     fuel-forget-result
 117     fuel-forget-output ;
 118
 119 : (fuel-end-eval) ( quot -- )
 120     with-string-writer fuel-eval-output set-global
 121     fuel-retort pop-fuel-status ; inline
 122
 123 : (fuel-eval) ( lines -- )
 124     [ [ parse-lines ] with-compilation-unit call ] curry
 125     [ print-error ] recover ; inline
 126
 127 : (fuel-eval-each) ( lines -- )
 128     [ 1vector (fuel-eval) ] each ; inline
 129
 130 : (fuel-eval-usings) ( usings -- )
 131     [ "USING: " prepend " ;" append ] map
 132     (fuel-eval-each) fuel-forget-error fuel-forget-output ;
 133
 134 : (fuel-eval-in) ( in -- )
 135     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
 136
 137 : fuel-eval-in-context ( lines in usings -- )
 138     (fuel-begin-eval) [
 139         (fuel-eval-usings)
 140         (fuel-eval-in)
 141         (fuel-eval)
 142     ] (fuel-end-eval) ;
 143
 144 : fuel-begin-eval ( in -- )
 145     (fuel-begin-eval)
 146     (fuel-eval-in)
 147     fuel-retort ;
 148
 149 : fuel-eval ( lines -- )
 150     (fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
 151
 152 : fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
 153
 154 : fuel-get-edit-location ( defspec -- )
 155     where [
 156        first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
 157     ] when* ;
 158
 159 : fuel-get-vocab-location ( vocab -- )
 160     >vocab-link fuel-get-edit-location ;
 161
 162 : fuel-get-vocabs ( -- )
 163     all-vocabs-seq [ vocab-name ] map fuel-eval-set-result ; inline
 164
 165 : fuel-run-file ( path -- ) run-file ; inline
 166
 167 : fuel-startup ( -- ) "listener" run ; inline
 168
 169 MAIN: fuel-startup