factor/library/generic/predicate.factor

46 lines
1.3 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2005 Slava Pestov.
2005-02-18 20:37:01 -05:00
! See http://factor.sf.net/license.txt for BSD license.
IN: generic
USING: errors hashtables kernel lists namespaces parser
sequences strings words vectors ;
! Predicate metaclass for generalized predicate dispatch.
SYMBOL: predicate
: predicate-dispatch ( existing definition class -- dispatch )
[
2005-04-16 00:23:27 -04:00
\ dup , "predicate" word-prop % , , \ ifte ,
] make-list ;
2004-12-19 03:04:03 -05:00
: predicate-method ( vtable definition class type# -- )
>r rot r> swap [
nth
( vtable definition class existing )
-rot predicate-dispatch
] 2keep set-nth ;
predicate [
( generic vtable definition class -- )
2005-08-14 18:13:16 -04:00
dup types [
( vtable definition class type# )
2004-12-19 03:04:03 -05:00
>r 3dup r> predicate-method
] each 2drop 2drop
] "add-method" set-word-prop
2005-08-14 23:26:40 -04:00
predicate [
over metaclass over metaclass eq? [
>r "superclass" word-prop r> class<
] [
drop types empty?
] ifte
] "class<" set-word-prop
: define-predicate-class ( class predicate definition -- )
3dup nip "definition" set-word-prop
pick predicate "metaclass" set-word-prop
pick "superclass" word-prop "predicate" word-prop
2005-04-16 00:23:27 -04:00
[ \ dup , % , [ drop f ] , \ ifte , ] make-list
define-predicate ;
PREDICATE: word predicate metaclass predicate = ;