2010-01-20 06:44:34 -05:00
|
|
|
! Copyright (C) 2004, 2010 Slava Pestov.
|
2008-04-03 22:19:20 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2010-01-31 08:48:39 -05:00
|
|
|
USING: accessors classes classes.private classes.algebra
|
|
|
|
classes.algebra.private words kernel kernel.private namespaces
|
|
|
|
sequences math math.private combinators assocs quotations ;
|
2008-04-03 22:19:20 -04:00
|
|
|
IN: classes.builtin
|
|
|
|
|
|
|
|
SYMBOL: builtins
|
|
|
|
|
|
|
|
PREDICATE: builtin-class < class
|
|
|
|
"metaclass" word-prop builtin-class eq? ;
|
|
|
|
|
2008-06-29 03:12:44 -04:00
|
|
|
: class>type ( class -- n ) "type" word-prop ; foldable
|
|
|
|
|
2008-12-06 10:16:29 -05:00
|
|
|
: type>class ( n -- class ) builtins get-global nth ;
|
|
|
|
|
2008-04-03 22:19:20 -04:00
|
|
|
: bootstrap-type>class ( n -- class ) builtins get nth ;
|
|
|
|
|
2011-10-24 07:47:42 -04:00
|
|
|
M: object class-of tag type>class ; inline
|
2008-05-02 03:51:38 -04:00
|
|
|
|
|
|
|
M: builtin-class rank-class drop 0 ;
|
2008-06-29 03:12:44 -04:00
|
|
|
|
2009-11-02 04:25:39 -05:00
|
|
|
M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ;
|
2008-07-05 01:59:39 -04:00
|
|
|
|
|
|
|
M: builtin-class (flatten-class) dup set ;
|
|
|
|
|
2010-07-29 19:57:23 -04:00
|
|
|
M: builtin-class (classes-intersect?) eq? ;
|
2008-07-05 01:59:39 -04:00
|
|
|
|
2009-11-10 18:41:47 -05:00
|
|
|
: full-cover ( -- ) builtins get [ (flatten-class) ] each ;
|
2009-08-07 23:30:57 -04:00
|
|
|
|
|
|
|
M: anonymous-complement (flatten-class) drop full-cover ;
|