library/platform/jvm/words.factor

   1 !:folding=indent:collapseFolds=1:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2003 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: words
  29 USE: combinators
  30 USE: kernel
  31 USE: lists
  32 USE: logic
  33 USE: namespaces
  34 USE: stack
  35 USE: vocabularies
  36
  37 : worddef? ( obj -- boolean )
  38     "factor.FactorWordDefinition" is ;
  39
  40 : worddef ( word -- worddef )
  41     dup worddef? [
  42         intern dup [ [ "def" get ] bind ] when
  43     ] unless ;
  44
  45 : word-property ( pname word -- pvalue )
  46     [ get ] bind ;
  47
  48 : set-word-property ( pvalue pname word -- )
  49     [ set ] bind ;
  50
  51 : redefine ( word def -- )
  52     swap [ "def" set ] bind ;
  53
  54 : word? ( obj -- boolean )
  55     "factor.FactorWord" is ;
  56
  57 : compiled? ( worddef -- boolean )
  58     "factor.compiler.CompiledDefinition" is ;
  59
  60 : compound? ( worddef -- boolean )
  61     "factor.FactorCompoundDefinition" is ;
  62
  63 : compound-or-compiled? ( worddef -- ? )
  64     dup compiled? swap compound? or ;
  65
  66 : comment? ( obj -- ? )
  67     "factor.FactorDocComment" is ;
  68
  69 : gensym ( -- word )
  70     [ ] "factor.FactorWord" "gensym" jinvoke-static ;
  71
  72 : <compound> ( word def -- worddef )
  73     swap intern swap interpreter
  74     [ "factor.FactorWord" "factor.Cons" "factor.FactorInterpreter" ]
  75     "factor.FactorCompoundDefinition"
  76     jnew ;
  77
  78 : no-name ( list -- word )
  79     ! Generates an uninternalized word and gives it a compound
  80     ! definition created from the given list.
  81     [ gensym dup dup ] dip <compound> redefine ;
  82
  83 : primitive? ( worddef -- boolean )
  84     "factor.FactorPrimitiveDefinition" is ;
  85
  86 : shuffle? ( worddef -- boolean )
  87     "factor.FactorShuffleDefinition" is ;
  88
  89 : word-of-worddef ( worddef -- word )
  90     interpreter swap
  91     [ "factor.FactorInterpreter" ]
  92     "factor.FactorWordDefinition" "getWord" jinvoke ;
  93
  94 : defined? ( obj -- ? )
  95     dup word? [ worddef ] [ drop f ] ifte ;
  96
  97 : worddef>list ( worddef -- list )
  98     worddef interpreter swap
  99     [ "factor.FactorInterpreter" ] "factor.FactorWordDefinition"
 100     "toList" jinvoke ;
 101
 102 : skip-docs ( list -- list )
 103     dup [ dup car comment? [ cdr skip-docs ] when ] when ;
 104
 105 : compound>list ( worddef -- list )
 106     worddef>list dup [ skip-docs ] when ;