2011-11-22 05:44:58 -05:00
|
|
|
! Copyright (C) 2011 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: accessors classes classes.algebra
|
2011-11-22 17:47:52 -05:00
|
|
|
classes.algebra.private classes.private classes.union.private
|
|
|
|
effects kernel words ;
|
2011-11-22 05:44:58 -05:00
|
|
|
IN: classes.maybe
|
|
|
|
|
2011-11-23 04:43:02 -05:00
|
|
|
! The class slot has to be a union of a word and a classoid
|
|
|
|
! for TUPLE: foo { a maybe: foo } ; and maybe: union{ integer float } to work.
|
|
|
|
! In the first case, foo is not yet a tuple-class when maybe: is reached,
|
|
|
|
! thus it's not a classoid yet. union{ is a classoid, so the second case works.
|
|
|
|
! words are not generally classoids, so classoid alone is insufficient.
|
|
|
|
TUPLE: maybe { class union{ word classoid } initial: object read-only } ;
|
2011-11-22 05:44:58 -05:00
|
|
|
|
|
|
|
C: <maybe> maybe
|
|
|
|
|
2011-11-22 21:49:18 -05:00
|
|
|
INSTANCE: maybe classoid
|
|
|
|
|
2011-11-22 05:44:58 -05:00
|
|
|
M: maybe instance?
|
|
|
|
over [ class>> instance? ] [ 2drop t ] if ;
|
|
|
|
|
2011-11-22 17:47:52 -05:00
|
|
|
: maybe-class-or ( maybe -- classoid )
|
2011-11-22 05:44:58 -05:00
|
|
|
class>> \ f class-or ;
|
|
|
|
|
2011-11-22 17:47:52 -05:00
|
|
|
M: maybe normalize-class
|
|
|
|
maybe-class-or ;
|
|
|
|
|
|
|
|
M: maybe valid-classoid? class>> valid-classoid? ;
|
|
|
|
|
2011-11-22 05:44:58 -05:00
|
|
|
M: maybe rank-class drop 6 ;
|
|
|
|
|
|
|
|
M: maybe (flatten-class)
|
2011-11-22 17:47:52 -05:00
|
|
|
maybe-class-or (flatten-class) ;
|
2011-11-22 05:44:58 -05:00
|
|
|
|
|
|
|
M: maybe union-of-builtins?
|
|
|
|
class>> union-of-builtins? ;
|
|
|
|
|
2011-11-22 17:47:52 -05:00
|
|
|
M: maybe class-name
|
|
|
|
class>> name>> ;
|
2011-11-22 23:38:07 -05:00
|
|
|
|
|
|
|
M: maybe predicate-def
|
|
|
|
class>> predicate-def [ [ t ] if* ] curry ;
|