43 lines
1.1 KiB
Factor
43 lines
1.1 KiB
Factor
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
IN: generic
|
|
USING: errors hashtables kernel lists math namespaces parser
|
|
sequences strings vectors words ;
|
|
|
|
! Builtin metaclass for builtin types: fixnum, word, cons, etc.
|
|
SYMBOL: builtin
|
|
|
|
! Global vector mapping type numbers to builtin class objects.
|
|
SYMBOL: builtins
|
|
|
|
builtin [
|
|
( generic vtable definition class -- )
|
|
rot set-vtable drop
|
|
] "add-method" set-word-prop
|
|
|
|
: builtin-predicate ( class predicate -- )
|
|
[
|
|
\ type , over types first , \ eq? ,
|
|
] make-list define-predicate ;
|
|
|
|
: register-builtin ( class -- )
|
|
dup types first builtins get set-nth ;
|
|
|
|
: define-builtin ( symbol type# predicate slotspec -- )
|
|
>r >r >r
|
|
dup intern-symbol
|
|
dup r> 1vector "types" set-word-prop
|
|
dup builtin define-class
|
|
dup r> builtin-predicate
|
|
dup r> intern-slots 2dup "slots" set-word-prop
|
|
define-slots
|
|
register-builtin ;
|
|
|
|
: type>class ( n -- symbol ) builtins get nth ;
|
|
|
|
PREDICATE: word builtin metaclass builtin = ;
|
|
|
|
: type-tag ( type -- tag )
|
|
#! Given a type number, return the tag number.
|
|
dup 6 > [ drop 3 ] when ;
|