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/get-addr { key env -- val-addr }
  19     env
  20     begin ( env )
  21         key over MalEnv/data @ MalMap/get-addr ( env addr-or-0 )
  22         ?dup 0= if ( env )
  23             MalEnv/outer @ dup 0= ( env-or-0 done-looping? )
  24         else ( env addr )
  25             nip -1 \ found it! ( addr -1 )
  26         endif
  27     until ;
  28
  29 MalEnv
  30   extend pr-buf { env }
  31     env MalEnv/data @ pr-buf
  32     a-space s" outer: " str-append
  33     env MalEnv/outer @ ?dup 0= if
  34         s" <none>" str-append
  35     else
  36         pr-buf
  37     endif ;;
  38 drop