basis/typed/namespaces/namespaces.factor

   1 USING: arrays classes fry kernel kernel.private locals macros
   2 namespaces ;
   3 IN: typed.namespaces
   4
   5 ERROR: variable-type-error variable value type ;
   6
   7 <PRIVATE
   8
   9 MACRO: declare1 ( type -- quot: ( value -- value ) )
  10     1array '[ _ declare ] ;
  11
  12 : typed-get-unsafe ( name type -- value )
  13     [ get ] dip declare1 ; inline
  14
  15 : typed-get-global-unsafe ( name type -- value )
  16     [ get-global ] dip declare1 ; inline
  17
  18 PRIVATE>
  19
  20 :: (typed-get) ( name type getter: ( name -- value ) -- value )
  21     name getter call :> value
  22     value type instance? [ name value type throw-variable-type-error ] unless
  23     value type declare1 ; inline
  24
  25 : typed-get ( name type -- value )
  26     [ get ] (typed-get) ; inline
  27
  28 : typed-get-global ( name type -- value )
  29     [ get-global ] (typed-get) ; inline
  30
  31 :: (typed-set) ( value name type setter: ( value name -- ) -- )
  32     value type instance? [ name value type throw-variable-type-error ] unless
  33     value name setter call ; inline
  34
  35 : typed-set ( value name type -- )
  36     [ set ] (typed-set) ; inline
  37
  38 : typed-set-global ( value name type -- )
  39     [ set-global ] (typed-set) ; inline