69 lines
2.2 KiB
Factor
69 lines
2.2 KiB
Factor
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
IN: words
|
|
USING: generic hashtables kernel kernel-internals lists math
|
|
namespaces strings ;
|
|
|
|
BUILTIN: word 17
|
|
|
|
M: word hashcode 1 slot %fixnum ;
|
|
|
|
: word-xt ( w -- xt ) >word 2 integer-slot ; inline
|
|
: set-word-xt ( xt w -- ) >word 2 set-integer-slot ; inline
|
|
|
|
: word-primitive ( w -- n ) >word 3 integer-slot ; inline
|
|
: set-word-primitive ( n w -- )
|
|
>word [ 3 set-integer-slot ] keep update-xt ; inline
|
|
|
|
: word-parameter ( w -- obj ) >word 4 slot ; inline
|
|
: set-word-parameter ( obj w -- ) >word 4 set-slot ; inline
|
|
|
|
: word-props ( w -- obj ) >word 5 slot ; inline
|
|
: set-word-props ( obj w -- ) >word 5 set-slot ; inline
|
|
|
|
: call-count ( w -- n ) >word 6 integer-slot ; inline
|
|
: set-call-count ( n w -- ) >word 6 set-integer-slot ; inline
|
|
|
|
: allot-count ( w -- n ) >word 7 integer-slot ; inline
|
|
: set-allot-count ( n w -- ) >word 7 set-integer-slot ; inline
|
|
|
|
SYMBOL: vocabularies
|
|
|
|
: word-property ( word pname -- pvalue )
|
|
swap word-props hash ; inline
|
|
|
|
: set-word-property ( word pvalue pname -- )
|
|
rot word-props set-hash ; inline
|
|
|
|
PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ;
|
|
PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
|
|
PREDICATE: word symbol ( obj -- ? ) word-primitive 2 = ;
|
|
PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
|
|
|
|
! These should really be somewhere in library/generic/, but
|
|
! during bootstrap, we cannot execute parsing words after they
|
|
! are defined by code loaded into the target image.
|
|
PREDICATE: compound generic ( word -- ? )
|
|
"combination" word-property ;
|
|
|
|
PREDICATE: compound promise ( obj -- ? )
|
|
"promise" word-property ;
|
|
|
|
: define ( word primitive parameter -- )
|
|
pick set-word-parameter
|
|
over set-word-primitive
|
|
f "parsing" set-word-property ;
|
|
|
|
: define-compound ( word def -- ) 1 swap define ;
|
|
: define-symbol ( word -- ) 2 over define ;
|
|
|
|
: intern-symbol ( word -- )
|
|
dup undefined? [ define-symbol ] [ drop ] ifte ;
|
|
|
|
#! The type declaration is for the benefit of stack effect
|
|
#! inference.
|
|
: word-name ( word -- str )
|
|
"name" word-property >string ;
|
|
|
|
: word-vocabulary ( word -- str ) "vocabulary" word-property ;
|