GENERIC: support in functors
parent
a09187fbf8
commit
65b33c145c
|
@ -81,7 +81,26 @@ SYMBOL: W
|
|||
|
||||
[ blorgh ] [ blorgh ] unit-test
|
||||
|
||||
GENERIC: some-generic ( a -- b )
|
||||
<<
|
||||
|
||||
FUNCTOR: generic-test ( W -- )
|
||||
|
||||
W DEFINES ${W}
|
||||
|
||||
WHERE
|
||||
|
||||
GENERIC: W ( a -- b )
|
||||
M: object W ;
|
||||
M: integer W 1 + ;
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
"snurv" generic-test
|
||||
|
||||
>>
|
||||
|
||||
[ 2 ] [ 1 snurv ] unit-test
|
||||
[ 3.0 ] [ 3.0 snurv ] unit-test
|
||||
|
||||
! Does replacing an ordinary word with a functor-generated one work?
|
||||
[ [ ] ] [
|
||||
|
@ -89,6 +108,7 @@ GENERIC: some-generic ( a -- b )
|
|||
|
||||
TUPLE: some-tuple ;
|
||||
: some-word ( -- ) ;
|
||||
GENERIC: some-generic ( a -- b )
|
||||
M: some-tuple some-generic ;
|
||||
SYMBOL: some-symbol
|
||||
"> <string-reader> "functors-test" parse-stream
|
||||
|
@ -97,6 +117,7 @@ GENERIC: some-generic ( a -- b )
|
|||
: test-redefinition ( -- )
|
||||
[ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "some-generic" "functors.tests" lookup >boolean ] unit-test
|
||||
[ t ] [
|
||||
"some-tuple" "functors.tests" lookup
|
||||
"some-generic" "functors.tests" lookup method >boolean
|
||||
|
@ -109,13 +130,14 @@ FUNCTOR: redefine-test ( W -- )
|
|||
|
||||
W-word DEFINES ${W}-word
|
||||
W-tuple DEFINES-CLASS ${W}-tuple
|
||||
W-generic IS ${W}-generic
|
||||
W-generic DEFINES ${W}-generic
|
||||
W-symbol DEFINES ${W}-symbol
|
||||
|
||||
WHERE
|
||||
|
||||
TUPLE: W-tuple ;
|
||||
: W-word ( -- ) ;
|
||||
GENERIC: W-generic ( a -- b )
|
||||
M: W-tuple W-generic ;
|
||||
SYMBOL: W-symbol
|
||||
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel quotations classes.tuple make combinators generic
|
||||
words interpolate namespaces sequences io.streams.string fry
|
||||
classes.mixin effects lexer parser classes.tuple.parser
|
||||
effects.parser locals.types locals.parser generic.parser
|
||||
locals.rewrite.closures vocabs.parser classes.parser
|
||||
arrays accessors words.symbol ;
|
||||
USING: accessors arrays classes.mixin classes.parser
|
||||
classes.tuple classes.tuple.parser combinators effects
|
||||
effects.parser fry generic generic.parser generic.standard
|
||||
interpolate io.streams.string kernel lexer locals.parser
|
||||
locals.rewrite.closures locals.types make namespaces parser
|
||||
quotations sequences vocabs.parser words words.symbol ;
|
||||
IN: functors
|
||||
|
||||
! This is a hack
|
||||
|
@ -18,6 +18,8 @@ IN: functors
|
|||
|
||||
: define-declared* ( word def effect -- ) pick set-word define-declared ;
|
||||
|
||||
: define-simple-generic* ( word effect -- ) over set-word define-simple-generic ;
|
||||
|
||||
TUPLE: fake-call-next-method ;
|
||||
|
||||
TUPLE: fake-quotation seq ;
|
||||
|
@ -104,6 +106,11 @@ SYNTAX: `INSTANCE:
|
|||
scan-param parsed
|
||||
\ add-mixin-instance parsed ;
|
||||
|
||||
SYNTAX: `GENERIC:
|
||||
scan-param parsed
|
||||
complete-effect parsed
|
||||
\ define-simple-generic* parsed ;
|
||||
|
||||
SYNTAX: `inline [ word make-inline ] over push-all ;
|
||||
|
||||
SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
|
||||
|
@ -130,6 +137,7 @@ DEFER: ;FUNCTOR delimiter
|
|||
{ "M:" POSTPONE: `M: }
|
||||
{ "C:" POSTPONE: `C: }
|
||||
{ ":" POSTPONE: `: }
|
||||
{ "GENERIC:" POSTPONE: `GENERIC: }
|
||||
{ "INSTANCE:" POSTPONE: `INSTANCE: }
|
||||
{ "SYNTAX:" POSTPONE: `SYNTAX: }
|
||||
{ "SYMBOL:" POSTPONE: `SYMBOL: }
|
||||
|
|
Loading…
Reference in New Issue