basis/stack-checker/state/state.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs arrays namespaces sequences kernel definitions
   4 math effects accessors words fry classes.algebra
   5 compiler.units stack-checker.values stack-checker.visitor
   6 stack-checker.errors ;
   7 IN: stack-checker.state
   8
   9 ! Did the current control-flow path throw an error?
  10 SYMBOL: terminated?
  11
  12 ! Number of inputs current word expects from the stack
  13 SYMBOL: input-count
  14 SYMBOL: inner-d-index
  15
  16 DEFER: commit-literals
  17
  18 SYMBOL: (meta-d)
  19 SYMBOL: (meta-r)
  20
  21 : meta-d ( -- stack ) commit-literals (meta-d) get ;
  22
  23 : meta-r ( -- stack ) (meta-r) get ;
  24
  25 SYMBOL: literals
  26
  27 : (push-literal) ( obj -- )
  28     dup <literal> make-known
  29     [ nip (meta-d) get push ] [ #push, ] 2bi ;
  30
  31 : commit-literals ( -- )
  32     literals get [
  33         [ [ (push-literal) ] each ] [ delete-all ] bi
  34     ] unless-empty ;
  35
  36 : current-stack-height ( -- n ) meta-d length input-count get - ;
  37
  38 : current-effect ( -- effect )
  39     input-count get "x" <array>
  40     meta-d length "x" <array>
  41     terminated? get <terminated-effect> ;
  42
  43 : check-effect ( required-effect -- )
  44     [ current-effect ] dip 2dup effect<= [ 2drop ] [ effect-error ] if ;
  45
  46 : init-inference ( -- )
  47     terminated? off
  48     V{ } clone (meta-d) set
  49     V{ } clone literals set
  50     0 input-count set
  51     0 inner-d-index set ;