factor/core/generic/standard/standard.factor

42 lines
1.1 KiB
Factor
Raw Normal View History

2009-04-24 21:43:01 -04:00
! Copyright (C) 2009 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
2009-04-24 21:43:01 -04:00
USING: accessors definitions generic generic.single kernel
namespaces words math combinators sequences ;
2007-09-20 18:09:08 -04:00
IN: generic.standard
2009-04-24 21:43:01 -04:00
TUPLE: standard-combination < single-combination # ;
2007-09-20 18:09:08 -04:00
2008-04-02 03:44:10 -04:00
C: <standard-combination> standard-combination
2007-09-20 18:09:08 -04:00
2008-04-02 03:44:10 -04:00
PREDICATE: standard-generic < generic
"combination" word-prop standard-combination? ;
2007-09-20 18:09:08 -04:00
2008-04-02 03:44:10 -04:00
PREDICATE: simple-generic < standard-generic
2009-04-24 21:43:01 -04:00
"combination" word-prop #>> 0 = ;
2007-09-20 18:09:08 -04:00
CONSTANT: simple-combination T{ standard-combination f 0 }
: define-simple-generic ( word effect -- )
[ simple-combination ] dip define-generic ;
2008-04-02 03:44:10 -04:00
2009-04-24 21:43:01 -04:00
: (picker) ( n -- quot )
{
{ 0 [ [ dup ] ] }
{ 1 [ [ over ] ] }
{ 2 [ [ pick ] ] }
[ 1- (picker) [ dip swap ] curry ]
} case ;
2008-04-02 03:44:10 -04:00
2009-04-24 21:43:01 -04:00
M: standard-combination picker
combination get #>> (picker) ;
2007-09-20 18:09:08 -04:00
M: standard-combination dispatch# #>> ;
M: standard-generic effective-method
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
(effective-method) ;
M: standard-generic definer drop \ GENERIC# f ;
2008-01-06 11:13:44 -05:00
M: simple-generic definer drop \ GENERIC: f ;