52 lines
1.4 KiB
Factor
52 lines
1.4 KiB
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-dispatch ( existing definition class -- dispatch )
|
|
[
|
|
\ dup , "predicate" word-prop % , , \ ifte ,
|
|
] make-list ;
|
|
|
|
: predicate-method ( vtable definition class type# -- )
|
|
>r rot r> swap [
|
|
nth
|
|
( vtable definition class existing )
|
|
-rot predicate-dispatch
|
|
] 2keep set-nth ;
|
|
|
|
predicate [
|
|
"superclass" word-prop builtin-supertypes
|
|
] "builtin-supertypes" set-word-prop
|
|
|
|
predicate [
|
|
( generic vtable definition class -- )
|
|
dup builtin-supertypes [
|
|
( vtable definition class type# )
|
|
>r 3dup r> predicate-method
|
|
] each 2drop 2drop
|
|
] "add-method" set-word-prop
|
|
|
|
predicate 25 "priority" set-word-prop
|
|
|
|
predicate [
|
|
2dup = [
|
|
2drop t
|
|
] [
|
|
>r "superclass" word-prop r> class<
|
|
] ifte
|
|
] "class<" set-word-prop
|
|
|
|
: define-predicate ( class predicate definition -- )
|
|
pick over "definition" set-word-prop
|
|
pick "superclass" word-prop "predicate" word-prop
|
|
[ \ dup , % , [ drop f ] , \ ifte , ] make-list
|
|
define-compound
|
|
predicate "metaclass" set-word-prop ;
|
|
|
|
PREDICATE: word predicate metaclass predicate = ;
|