2005-01-14 12:01:48 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
2005-02-18 20:37:01 -05:00
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2004-12-13 00:13:54 -05:00
|
|
|
IN: generic
|
2005-04-26 00:35:55 -04:00
|
|
|
USING: errors hashtables kernel lists namespaces parser
|
|
|
|
sequences strings words vectors ;
|
2004-12-13 00:13:54 -05:00
|
|
|
|
|
|
|
! Predicate metaclass for generalized predicate dispatch.
|
|
|
|
SYMBOL: predicate
|
|
|
|
|
2005-08-14 23:26:40 -04:00
|
|
|
predicate [
|
|
|
|
over metaclass over metaclass eq? [
|
|
|
|
>r "superclass" word-prop r> class<
|
|
|
|
] [
|
2005-08-15 23:09:44 -04:00
|
|
|
2drop f
|
2005-08-14 23:26:40 -04:00
|
|
|
] ifte
|
|
|
|
] "class<" set-word-prop
|
|
|
|
|
2005-08-03 18:47:32 -04:00
|
|
|
: define-predicate-class ( class predicate definition -- )
|
|
|
|
3dup nip "definition" set-word-prop
|
|
|
|
pick predicate "metaclass" set-word-prop
|
2005-03-05 14:45:23 -05:00
|
|
|
pick "superclass" word-prop "predicate" word-prop
|
2005-08-25 15:27:38 -04:00
|
|
|
[ \ dup , % , [ drop f ] , \ ifte , ] [ ] make
|
2005-08-03 18:47:32 -04:00
|
|
|
define-predicate ;
|
2005-03-26 20:12:14 -05:00
|
|
|
|
|
|
|
PREDICATE: word predicate metaclass predicate = ;
|