steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

combinators.smart: Enable a unit test, handle M: object infer-known*, make sum-outputs a macro. 

Fixes inverse but still needs work, once I figure out how.
db4
Doug Coleman 2011-11-28 14:36:57 -08:00
parent 41e4c48647
commit 8b18af0335
2 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/combinators/smart/smart-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators.smart kernel math USING: accessors arrays combinators.smart kernel math
tools.test ; stack-checker tools.test ;
IN: combinators.smart.tests IN: combinators.smart.tests
: test-bi ( -- 9 11 ) : test-bi ( -- 9 11 )
@ -77,4 +77,4 @@ IN: combinators.smart.tests
[ -1 ] [ 1 2 [ + odd? ] [ - ] smart-when* ] unit-test [ -1 ] [ 1 2 [ + odd? ] [ - ] smart-when* ] unit-test
[ ] [ 2 2 [ + odd? ] [ ] smart-unless* ] unit-test [ ] [ 2 2 [ + odd? ] [ ] smart-unless* ] unit-test
! [ [ ] [ call ] curry output>array ] infer [ ( -- x ) ] [ [ [ ] [ call ] curry output>array ] infer ] unit-test

18
basis/combinators/smart/smart.factor
View File

@ -21,11 +21,17 @@ GENERIC: infer-known* ( known -- effect )
: outputs ( quot -- n ) inputs/outputs nip ; inline : outputs ( quot -- n ) inputs/outputs nip ; inline
\ inputs/outputs [ \ inputs/outputs [
pop-d peek-d
[ 1array #drop, ] [ infer-known ] bi infer-known [
[ in>> ] [ out>> ] bi [ length apply-object ] bi@ [ pop-d 1array #drop, ]
[ [ in>> ] [ out>> ] bi [ length apply-object ] bi@ ] bi*
] [
\ inputs/outputs dup required-stack-effect apply-word/effect
] if*
] "special" set-word-prop ] "special" set-word-prop
! TODO: Handle the case where a nested call to infer-known returns f
M: curried infer-known* M: curried infer-known*
quot>> infer-known curry-effect ; quot>> infer-known curry-effect ;
@ -38,7 +44,7 @@ M: declared-effect infer-known*
M: input-parameter infer-known* \ inputs/outputs unknown-macro-input ; M: input-parameter infer-known* \ inputs/outputs unknown-macro-input ;
M: object infer-known* \ inputs/outputs bad-macro-input ; M: object infer-known* drop f ;
: drop-inputs ( quot -- newquot ) : drop-inputs ( quot -- newquot )
inputs ndrop ; inline inputs ndrop ; inline
@ -64,8 +70,8 @@ M: object infer-known* \ inputs/outputs bad-macro-input ;
MACRO: reduce-outputs ( quot operation -- newquot ) MACRO: reduce-outputs ( quot operation -- newquot )
[ [ ] [ outputs 1 [-] ] bi ] dip swap '[ @ _ _ call-n ] ; [ [ ] [ outputs 1 [-] ] bi ] dip swap '[ @ _ _ call-n ] ;
: sum-outputs ( quot -- n ) MACRO: sum-outputs ( quot -- n )
[ + ] reduce-outputs ; inline '[ _ [ + ] reduce-outputs ] ;
: map-outputs ( quot mapper -- ) : map-outputs ( quot mapper -- )
[ drop call ] [ swap outputs ] 2bi napply ; inline [ drop call ] [ swap outputs ] 2bi napply ; inline