2005-02-18 20:37:01 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2004-12-13 00:13:54 -05:00
|
|
|
IN: generic
|
2005-02-18 20:37:01 -05:00
|
|
|
USING: kernel lists math vectors words ;
|
2004-12-13 00:13:54 -05:00
|
|
|
|
|
|
|
! Catch-all metaclass for providing a default method.
|
|
|
|
SYMBOL: object
|
|
|
|
|
|
|
|
object [
|
|
|
|
drop num-types count
|
2005-03-05 14:45:23 -05:00
|
|
|
] "builtin-supertypes" set-word-prop
|
2004-12-18 23:18:32 -05:00
|
|
|
|
|
|
|
object [
|
2004-12-23 23:55:22 -05:00
|
|
|
( generic vtable definition class -- )
|
2004-12-18 23:18:32 -05:00
|
|
|
drop over vector-length [
|
2005-01-23 16:47:28 -05:00
|
|
|
3dup rot set-vector-nth
|
|
|
|
] repeat 3drop
|
2005-03-05 14:45:23 -05:00
|
|
|
] "add-method" set-word-prop
|
2004-12-18 23:18:32 -05:00
|
|
|
|
2005-03-05 14:45:23 -05:00
|
|
|
object [ drop t ] "predicate" set-word-prop
|
2004-12-23 01:14:07 -05:00
|
|
|
|
2005-03-05 14:45:23 -05:00
|
|
|
object 100 "priority" set-word-prop
|
2004-12-23 02:14:40 -05:00
|
|
|
|
2005-03-05 14:45:23 -05:00
|
|
|
object [ 2drop t ] "class<" set-word-prop
|
2004-12-29 18:01:23 -05:00
|
|
|
|
2004-12-23 02:14:40 -05:00
|
|
|
object object define-class
|