forth/env.fs

   1 require types.fs
   2
   3 MalType%
   4    cell% field MalEnv/outer
   5    cell% field MalEnv/data
   6 deftype MalEnv
   7
   8 : MalEnv. { outer -- env }
   9     MalEnv new { env }
  10     outer env MalEnv/outer !
  11     MalMap/Empty env MalEnv/data !
  12     env ;
  13
  14 : env/set { key val env -- }
  15     key val env MalEnv/data @ assoc
  16     env MalEnv/data ! ;
  17
  18 : env/find { key env -- env-or-0 }
  19     env
  20     begin ( env )
  21         dup 0 key rot MalEnv/data @ get ( env val-or-0 )
  22         0= if ( env )
  23             MalEnv/outer @ dup 0= ( env-or-0 done-looping? )
  24         else
  25             -1 \ found it! ( env -1 )
  26         endif
  27     until ;
  28
  29 MalEnv
  30   extend get { not-found key env -- }
  31     key env env/find ( env-or-0 )
  32     ?dup 0= if
  33         not-found
  34     else ( env )
  35         not-found key rot MalEnv/data @ get
  36     endif ;;
  37   extend pr-buf { env }
  38     env MalEnv/data @ pr-buf
  39     a-space s" outer: " str-append
  40     env MalEnv/outer @ ?dup 0= if
  41         s" <none>" str-append
  42     else
  43         pr-buf
  44     endif ;;
  45 drop