steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

classes.algebra: removing valid-classoid? (enforced in constructors).

locals-and-roots
John Benediktsson 2016-04-13 14:29:24 -07:00
parent ed22ef8ee7
commit 331483ab98
4 changed files with 7 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/compiler.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2010 Slava Pestov. ! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes.algebra combinators USING: accessors assocs classes classes.algebra combinators
combinators.short-circuit compiler.cfg compiler.cfg.builder combinators.short-circuit compiler.cfg compiler.cfg.builder
compiler.cfg.builder.alien compiler.cfg.finalization compiler.cfg.builder.alien compiler.cfg.finalization
compiler.cfg.optimizer compiler.codegen compiler.crossref compiler.cfg.optimizer compiler.codegen compiler.crossref
@ -141,7 +141,7 @@ M: optimizing-compiler update-call-sites ( class generic -- words )
! Words containing call sites with inferred type 'class' ! Words containing call sites with inferred type 'class'
! which inlined a method on 'generic' ! which inlined a method on 'generic'
generic-call-sites-of keys swap '[ generic-call-sites-of keys swap '[
_ 2dup [ valid-classoid? ] both? _ 2dup [ classoid? ] both?
[ classes-intersect? ] [ 2drop f ] if [ classes-intersect? ] [ 2drop f ] if
] filter ; ] filter ;

8
basis/stack-checker/dependencies/dependencies.factor
View File

@ -79,8 +79,8 @@ TUPLE: depends-on-class-predicate class1 class2 result ;
M: depends-on-class-predicate satisfied? M: depends-on-class-predicate satisfied?
{ {
[ class1>> valid-classoid? ] [ class1>> classoid? ]
[ class2>> valid-classoid? ] [ class2>> classoid? ]
[ [ [ class1>> ] [ class2>> ] bi evaluate-class-predicate ] [ result>> ] bi eq? ] [ [ [ class1>> ] [ class2>> ] bi evaluate-class-predicate ] [ result>> ] bi eq? ]
} 1&& ; } 1&& ;
@ -91,7 +91,7 @@ TUPLE: depends-on-instance-predicate object class result ;
M: depends-on-instance-predicate satisfied? M: depends-on-instance-predicate satisfied?
{ {
[ class>> valid-classoid? ] [ class>> classoid? ]
[ [ [ object>> ] [ class>> ] bi instance? ] [ result>> ] bi eq? ] [ [ [ object>> ] [ class>> ] bi instance? ] [ result>> ] bi eq? ]
} 1&& ; } 1&& ;
@ -103,7 +103,7 @@ TUPLE: depends-on-next-method class generic next-method ;
M: depends-on-next-method satisfied? M: depends-on-next-method satisfied?
{ {
[ class>> valid-classoid? ] [ class>> classoid? ]
[ [ [ class>> ] [ generic>> ] bi next-method ] [ next-method>> ] bi eq? ] [ [ [ class>> ] [ generic>> ] bi next-method ] [ next-method>> ] bi eq? ]
} 1&& ; } 1&& ;

11
core/classes/algebra/algebra.factor
View File

@ -47,8 +47,7 @@ TUPLE: anonymous-complement { class read-only } ;
INSTANCE: anonymous-complement classoid INSTANCE: anonymous-complement classoid
: <anonymous-complement> ( object -- classoid ) : <anonymous-complement> ( object -- classoid )
dup classoid? [ 1array not-classoids ] unless check-classoid anonymous-complement boa ;
anonymous-complement boa ;
M: anonymous-complement rank-class drop 3 ; M: anonymous-complement rank-class drop 3 ;
@ -79,14 +78,6 @@ M: object normalize-class ;
PRIVATE> PRIVATE>
GENERIC: valid-classoid? ( obj -- ? )
M: word valid-classoid? class? ;
M: anonymous-union valid-classoid? members>> [ valid-classoid? ] all? ;
M: anonymous-intersection valid-classoid? participants>> [ valid-classoid? ] all? ;
M: anonymous-complement valid-classoid? class>> valid-classoid? ;
M: object valid-classoid? drop f ;
: only-classoid? ( obj -- ? ) : only-classoid? ( obj -- ? )
dup classoid? [ class? not ] [ drop f ] if ; dup classoid? [ class? not ] [ drop f ] if ;

2
core/classes/maybe/maybe.factor
View File

@ -20,8 +20,6 @@ M: maybe instance?
M: maybe normalize-class M: maybe normalize-class
maybe-class-or ; maybe-class-or ;
M: maybe valid-classoid? class>> valid-classoid? ;
M: maybe rank-class drop 6 ; M: maybe rank-class drop 6 ;
M: maybe (flatten-class) M: maybe (flatten-class)