26 lines
757 B
Factor
26 lines
757 B
Factor
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
! 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 [
|
|
over metaclass over metaclass eq? [
|
|
>r "superclass" word-prop r> class<
|
|
] [
|
|
2drop f
|
|
] 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
|
|
[ \ dup , % , [ drop f ] , \ ifte , ] [ ] make
|
|
define-predicate ;
|
|
|
|
PREDICATE: word predicate metaclass predicate = ;
|