library/namespaces.factor

   1 !:folding=indent:collapseFolds=1:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2003, 2004 Slava Pestov.
   6 !
   7 ! Redistribution and use in source and binary forms, with or without
   8 ! modification, are permitted provided that the following conditions are met:
   9 !
  10 ! 1. Redistributions of source code must retain the above copyright notice,
  11 !    this list of conditions and the following disclaimer.
  12 !
  13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
  14 !    this list of conditions and the following disclaimer in the documentation
  15 !    and/or other materials provided with the distribution.
  16 !
  17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27
  28 IN: namespaces
  29 USE: combinators
  30 USE: kernel
  31 USE: lists
  32 USE: logic
  33 USE: stack
  34 USE: strings
  35 USE: vectors
  36
  37 !!! Other languages have classes, objects, variables, etc.
  38 !!! Factor has similar concepts.
  39 !!!
  40 !!!   5 "x" set
  41 !!!   "x" get 2 + .
  42 !!! 7
  43 !!!   7 "x" set
  44 !!!   "x" get 2 + .
  45 !!! 9
  46 !!!
  47 !!! get ( name -- value ) and set ( value name -- ) search in
  48 !!! the namespaces on the namespace stack, in top-down order.
  49 !!!
  50 !!! At the bottom of the namespace stack, is the global
  51 !!! namespace; it is always present.
  52 !!!
  53 !!! bind ( namespace quot -- ) executes a quotation with a
  54 !!! namespace pushed on the namespace stack.
  55
  56 : namestack ( -- stack )
  57     #! Push a copy of the namespace stack; same naming
  58     #! convention as the primitives datastack and callstack.
  59     namestack* clone ; inline
  60
  61 : set-namestack ( stack -- )
  62     #! Set the namespace stack to a copy of another stack; same
  63     #! naming convention as the primitives datastack and
  64     #! callstack.
  65     clone set-namestack* ; inline
  66
  67 : >n ( namespace -- n:namespace )
  68     #! Push a namespace on the namespace stack.
  69     namestack* vector-push ; inline
  70
  71 : n> ( n:namespace -- namespace )
  72     #! Pop the top of the namespace stack.
  73     namestack* vector-pop ; inline
  74
  75 : namespace ( -- namespace )
  76     #! Push the current namespace.
  77     namestack* vector-peek ; inline
  78
  79 : bind ( namespace quot -- )
  80     #! Execute a quotation with a new namespace on the namespace
  81     #! stack. Compiles if the quotation compiles.
  82     swap namespace-of >n call n> drop ; inline
  83
  84 : extend ( object code -- object )
  85     #! Used in code like this:
  86     #! : <subclass>
  87     #!      <superclass> [
  88     #!          ....
  89     #!      ] extend ;
  90     over >r bind r> ; inline
  91
  92 : lazy ( var [ a ] -- value )
  93     #! If the value of the variable is f, set the value to the
  94     #! result of evaluating [ a ].
  95     over get [ drop get ] [ dip dupd set ] ifte ;
  96
  97 : alist> ( alist namespace -- )
  98     #! Set each key in the alist to its value in the
  99     #! namespace.
 100     [ [ unswons set ] each ] bind ;
 101
 102 : alist>namespace ( alist -- namespace )
 103     <namespace> tuck alist> ;
 104
 105 : object-path-traverse ( name object -- object )
 106     dup has-namespace? [ get* ] [ 2drop f ] ifte ;
 107
 108 : object-path-iter ( object list -- object )
 109     [
 110         uncons [ swap object-path-traverse ] dip
 111         object-path-iter
 112     ] when* ;
 113
 114 : object-path ( list -- object )
 115     #! An object path is a list of strings. Each string is a
 116     #! variable name in the object namespace at that level.
 117     #! Returns f if any of the objects are not set.
 118     this swap object-path-iter ;
 119
 120 : global-object-path ( string -- object )
 121     #! An object path based from the global namespace.
 122     "'" split global [ object-path ] bind ;
 123
 124 : on ( var -- ) t put ;
 125 : off ( var -- ) f put ;
 126 : toggle ( var -- ) dup get not put ;