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

move some words to private vocabs

db4
Doug Coleman 2009-05-25 15:35:50 -05:00
parent 95837d53bc
commit 3722c0ad62
4 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/hints/hints.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: parser words definitions kernel sequences assocs arrays USING: accessors arrays assocs byte-arrays byte-vectors classes
kernel.private fry combinators accessors vectors strings sbufs combinators definitions fry generic generic.single
byte-arrays byte-vectors io.binary io.streams.string splitting math generic.standard hashtables io.binary io.streams.string kernel
math.parser generic generic.single generic.standard classes kernel.private math math.parser namespaces parser sbufs
hashtables namespaces ; sequences splitting splitting.private strings vectors words ;
IN: hints IN: hints
GENERIC: specializer-predicate ( spec -- quot ) GENERIC: specializer-predicate ( spec -- quot )

2
core/combinators/combinators-tests.factor
View File

@ -1,6 +1,6 @@
USING: alien strings kernel math tools.test io prettyprint USING: alien strings kernel math tools.test io prettyprint
namespaces combinators words classes sequences accessors namespaces combinators words classes sequences accessors
math.functions arrays ; math.functions arrays combinators.private ;
IN: combinators.tests IN: combinators.tests
[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test [ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test

5
core/combinators/combinators.factor
View File

@ -101,6 +101,8 @@ ERROR: no-case object ;
[ \ drop prefix ] bi* [ \ drop prefix ] bi*
] assoc-map alist>quot ; ] assoc-map alist>quot ;
<PRIVATE
: (distribute-buckets) ( buckets pair keys -- ) : (distribute-buckets) ( buckets pair keys -- )
dup t eq? [ dup t eq? [
drop [ swap adjoin ] curry each drop [ swap adjoin ] curry each
@ -150,6 +152,8 @@ ERROR: no-case object ;
] [ ] make , , \ if , ] [ ] make , , \ if ,
] [ ] make ; ] [ ] make ;
PRIVATE>
: case>quot ( default assoc -- quot ) : case>quot ( default assoc -- quot )
dup keys { dup keys {
{ [ dup empty? ] [ 2drop ] } { [ dup empty? ] [ 2drop ] }
@ -160,7 +164,6 @@ ERROR: no-case object ;
[ drop linear-case-quot ] [ drop linear-case-quot ]
} cond ; } cond ;
! recursive-hashcode
: recursive-hashcode ( n obj quot -- code ) : recursive-hashcode ( n obj quot -- code )
pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline pick 0 <= [ 3drop 0 ] [ [ 1 - ] 2dip call ] if ; inline

4
core/splitting/splitting.factor
View File

@ -53,6 +53,8 @@ PRIVATE>
[ <reversed> ] bi@ split1-slice [ <reversed> ] bi@ [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
[ f ] [ swap ] if-empty ; [ f ] [ swap ] if-empty ;
<PRIVATE
: (split) ( separators n seq -- ) : (split) ( separators n seq -- )
3dup rot [ member? ] curry find-from drop 3dup rot [ member? ] curry find-from drop
[ [ swap subseq , ] 2keep 1 + swap (split) ] [ [ swap subseq , ] 2keep 1 + swap (split) ]
@ -60,6 +62,8 @@ PRIVATE>
: split, ( seq separators -- ) 0 rot (split) ; : split, ( seq separators -- ) 0 rot (split) ;
PRIVATE>
: split ( seq separators -- pieces ) : split ( seq separators -- pieces )
[ split, ] { } make ; [ split, ] { } make ;