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

stack-checker: add inputs and outputs words, since 'infer (in>>|out>>) length' was coming up a lot

db4
Slava Pestov 2010-01-15 08:04:14 +13:00
parent a483261bed
commit 7155447aed
9 changed files with 18 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,14 +4,6 @@ USING: accessors fry generalizations kernel macros math.order
stack-checker math sequences ; stack-checker math sequences ;
IN: combinators.smart IN: combinators.smart
<PRIVATE
: inputs ( quot -- n ) infer in>> length ;
: outputs ( quot -- n ) infer out>> length ;
PRIVATE>
MACRO: drop-outputs ( quot -- quot' ) MACRO: drop-outputs ( quot -- quot' )
dup outputs '[ @ _ ndrop ] ; dup outputs '[ @ _ ndrop ] ;

4
basis/compiler/cfg/intrinsics/simd/backend/backend.factor
View File

@ -110,7 +110,7 @@ MACRO: vvvv-vector-op ( trials -- )
blub ; blub ;
MACRO: can-has-case ( cases -- ) MACRO: can-has-case ( cases -- )
dup first second infer in>> length 1 + dup first second inputs 1 +
'[ _ ndrop f ] suffix '[ _ case ] ; '[ _ ndrop f ] suffix '[ _ case ] ;
GENERIC# >can-has-trial 1 ( obj #pick -- quot ) GENERIC# >can-has-trial 1 ( obj #pick -- quot )
@ -118,7 +118,7 @@ GENERIC# >can-has-trial 1 ( obj #pick -- quot )
M: callable >can-has-trial M: callable >can-has-trial
drop '[ _ can-has? ] ; drop '[ _ can-has? ] ;
M: pair >can-has-trial M: pair >can-has-trial
swap first2 dup infer in>> length swap first2 dup inputs
'[ _ npick _ instance? [ _ can-has? ] [ _ ndrop blub ] if ] ; '[ _ npick _ instance? [ _ can-has? ] [ _ ndrop blub ] if ] ;
MACRO: can-has-vector-op ( trials #pick #dup -- ) MACRO: can-has-vector-op ( trials #pick #dup -- )

2
basis/inverse/inverse.factor
View File

@ -68,7 +68,7 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
: enough? ( stack word -- ? ) : enough? ( stack word -- ? )
dup deferred? [ 2drop f ] [ dup deferred? [ 2drop f ] [
[ [ length ] [ 1quotation infer in>> length ] bi* >= ] [ [ length ] [ 1quotation inputs ] bi* >= ]
[ 3drop f ] recover [ 3drop f ] recover
] if ; ] if ;

3
basis/models/arrow/smart/smart.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2009, 2010 Slava Pestov. ! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: models.arrow models.product stack-checker accessors fry USING: models.arrow models.product stack-checker accessors fry
generalizations combinators.smart combinators.smart.private generalizations combinators.smart macros kernel ;
macros kernel ;
IN: models.arrow.smart IN: models.arrow.smart
MACRO: <smart-arrow> ( quot -- quot' ) MACRO: <smart-arrow> ( quot -- quot' )

2
basis/roman/roman.factor
View File

@ -48,7 +48,7 @@ PRIVATE>
<PRIVATE <PRIVATE
MACRO: binary-roman-op ( quot -- quot' ) MACRO: binary-roman-op ( quot -- quot' )
[ infer in>> length ] [ ] [ infer out>> length ] tri [ inputs ] [ ] [ outputs ] tri
'[ [ roman> ] _ napply @ [ >roman ] _ napply ] ; '[ [ roman> ] _ napply @ [ >roman ] _ napply ] ;
PRIVATE> PRIVATE>

11
basis/stack-checker/stack-checker.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2004, 2009 Slava Pestov. ! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel io effects namespaces sequences quotations vocabs USING: accessors kernel io effects namespaces sequences
vocabs.loader generic words stack-checker.backend stack-checker.state quotations vocabs vocabs.loader generic words
stack-checker.backend stack-checker.state
stack-checker.known-words stack-checker.transforms stack-checker.known-words stack-checker.transforms
stack-checker.errors stack-checker.inlining stack-checker.errors stack-checker.inlining
stack-checker.visitor.dummy ; stack-checker.visitor.dummy ;
@ -15,3 +16,7 @@ M: callable infer ( quot -- effect )
: infer. ( quot -- ) : infer. ( quot -- )
#! Safe to call from inference transforms. #! Safe to call from inference transforms.
infer effect>string print ; infer effect>string print ;
: inputs ( quot -- n ) infer in>> length ;
: outputs ( quot -- n ) infer out>> length ;

2
basis/tuple-arrays/tuple-arrays.factor
View File

@ -10,7 +10,7 @@ IN: tuple-arrays
MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ; MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
MACRO: infer-in ( class -- quot ) infer in>> length '[ _ ] ; MACRO: infer-in ( class -- quot ) inputs '[ _ ] ;
: tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline : tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline

7
basis/unix/unix.factor
View File

@ -3,10 +3,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax kernel libc sequences USING: alien alien.c-types alien.syntax kernel libc sequences
continuations byte-arrays strings math namespaces system continuations byte-arrays strings math namespaces system
combinators combinators.smart combinators.smart.private combinators combinators.smart vocabs.loader accessors
vocabs.loader accessors stack-checker macros locals stack-checker macros locals generalizations unix.types io vocabs
generalizations unix.types io vocabs classes.struct unix.time classes.struct unix.time alien.libraries ;
alien.libraries ;
IN: unix IN: unix
CONSTANT: PROT_NONE 0 CONSTANT: PROT_NONE 0

2
basis/xml/tests/xmltest.factor
View File

@ -21,7 +21,7 @@ TUPLE: xml-test id uri sections description type ;
CONSTANT: base "vocab:xml/tests/xmltest/" CONSTANT: base "vocab:xml/tests/xmltest/"
MACRO: drop-inputs ( quot -- newquot ) MACRO: drop-inputs ( quot -- newquot )
infer in>> length '[ _ ndrop ] ; inputs '[ _ ndrop ] ;
: fails? ( quot -- ? ) : fails? ( quot -- ? )
[ drop-outputs f ] [ nip drop-inputs t ] bi-curry recover ; inline [ drop-outputs f ] [ nip drop-inputs t ] bi-curry recover ; inline