basis/stack-checker/state/state.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See https://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 SYMBOL: terminated?
  10
  11 SYMBOL: input-count
  12 SYMBOL: inner-d-index
  13
  14 DEFER: commit-literals
  15
  16 SYMBOL: (meta-d)
  17 SYMBOL: (meta-r)
  18
  19 : meta-d ( -- stack ) commit-literals (meta-d) get ;
  20
  21 : meta-r ( -- stack ) (meta-r) get ;
  22
  23 SYMBOL: literals
  24
  25 : (push-literal) ( obj -- )
  26     dup <literal> make-known
  27     [ nip (meta-d) get push ] [ #push, ] 2bi ;
  28
  29 : commit-literals ( -- )
  30     literals get [ [ (push-literal) ] each ] [ delete-all ] bi ;
  31
  32 : current-stack-height ( -- n )
  33     meta-d length input-count get - ;
  34
  35 : current-effect ( -- effect )
  36     input-count get "x" <array>
  37     meta-d length "x" <array>
  38     terminated? get <terminated-effect> ;
  39
  40 : check-effect ( required-effect -- )
  41     [ current-effect ] dip 2dup effect<= [ 2drop ] [ effect-error ] if ;
  42
  43 : init-inference ( -- )
  44     terminated? off
  45     V{ } clone (meta-d) set
  46     V{ } clone literals set
  47     0 input-count set
  48     0 inner-d-index set ;