extra/fuel/eval/eval.factor

   1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays compiler.units continuations debugger
   4 fuel.pprint io io.streams.string kernel namespaces parser sequences
   5 vectors vocabs.parser ;
   6
   7 IN: fuel.eval
   8
   9 TUPLE: fuel-status in use restarts ;
  10
  11 SYMBOL: fuel-status-stack
  12 V{ } clone fuel-status-stack set-global
  13
  14 SYMBOL: fuel-eval-result
  15 f fuel-eval-result set-global
  16
  17 SYMBOL: fuel-eval-output
  18 f fuel-eval-result set-global
  19
  20 SYMBOL: fuel-eval-res-flag
  21 t fuel-eval-res-flag set-global
  22
  23 : fuel-eval-restartable? ( -- ? )
  24     fuel-eval-res-flag get-global ; inline
  25
  26 : fuel-push-status ( -- )
  27     in get use get clone restarts get-global clone
  28     fuel-status boa
  29     fuel-status-stack get push ;
  30
  31 : fuel-pop-restarts ( restarts -- )
  32     fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
  33
  34 : fuel-pop-status ( -- )
  35     fuel-status-stack get empty? [
  36         fuel-status-stack get pop
  37         [ in>> in set ]
  38         [ use>> clone use set ]
  39         [ restarts>> fuel-pop-restarts ] tri
  40     ] unless ;
  41
  42 : fuel-forget-error ( -- ) f error set-global ; inline
  43 : fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
  44 : fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
  45 : fuel-forget-status ( -- )
  46     fuel-forget-error fuel-forget-result fuel-forget-output ; inline
  47
  48 : fuel-send-retort ( -- )
  49     error get fuel-eval-result get-global fuel-eval-output get-global
  50     3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
  51
  52 : (fuel-begin-eval) ( -- )
  53     fuel-push-status fuel-forget-status ; inline
  54
  55 : (fuel-end-eval) ( output -- )
  56     fuel-eval-output set-global fuel-send-retort fuel-pop-status ; inline
  57
  58 : (fuel-eval) ( lines -- )
  59     [ [ parse-lines ] with-compilation-unit call ] curry
  60     [ print-error ] recover ; inline
  61
  62 : (fuel-eval-each) ( lines -- )
  63     [ 1vector (fuel-eval) ] each ; inline
  64
  65 : (fuel-eval-usings) ( usings -- )
  66     [ "USING: " prepend " ;" append ] map
  67     (fuel-eval-each) fuel-forget-error fuel-forget-output ;
  68
  69 : (fuel-eval-in) ( in -- )
  70     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
  71
  72 : (fuel-eval-in-context) ( lines in usings -- )
  73     (fuel-begin-eval)
  74     [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
  75     (fuel-end-eval) ;