Get some db words to infer

db4
Slava Pestov 2008-03-15 07:57:38 -05:00
parent 129320c65b
commit 86ed87da0c
9 changed files with 45 additions and 16 deletions

5
extra/db/db-tests.factor Executable file
View File

@ -0,0 +1,5 @@
IN: db.tests
USING: tools.test db kernel ;
{ 1 0 } [ [ drop ] query-each ] must-infer-as
{ 1 1 } [ [ ] query-map ] must-infer-as

View File

@ -119,8 +119,8 @@ M: postgresql-db bind% ( spec -- )
: postgresql-make ( class quot -- )
>r sql-props r>
[ postgresql-counter off ] swap compose
{ "" { } { } } nmake <postgresql-statement> ;
[ postgresql-counter off call ] { "" { } { } } nmake
<postgresql-statement> ; inline
: create-table-sql ( class -- statement )
[

View File

@ -98,7 +98,7 @@ M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
: sqlite-make ( class quot -- )
>r sql-props r>
{ "" { } { } } nmake <simple-statement> ;
{ "" { } { } } nmake <simple-statement> ; inline
M: sqlite-db create-sql-statement ( class -- statement )
[

View File

@ -239,3 +239,9 @@ TUPLE: exam id name score ;
;
! [ test-ranges ] test-sqlite
\ insert-tuple must-infer
\ update-tuple must-infer
\ delete-tuple must-infer
\ select-tuple must-infer
\ define-persistent must-infer

View File

@ -36,7 +36,7 @@ HOOK: <update-tuples-statement> db ( class -- obj )
HOOK: <delete-tuple-statement> db ( class -- obj )
HOOK: <delete-tuples-statement> db ( class -- obj )
HOOK: <select-by-slots-statement> db ( tuple -- tuple )
HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
HOOK: insert-tuple* db ( tuple statement -- )

View File

@ -0,0 +1,6 @@
IN: namespaces.lib.tests
USING: namespaces.lib tools.test ;
[ ] [ [ ] { } nmake ] unit-test
[ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test

22
extra/namespaces/lib/lib.factor Normal file → Executable file
View File

@ -2,7 +2,7 @@
! USING: kernel quotations namespaces sequences assocs.lib ;
USING: kernel namespaces namespaces.private quotations sequences
assocs.lib math.parser math sequences.lib ;
assocs.lib math.parser math sequences.lib locals ;
IN: namespaces.lib
@ -42,11 +42,19 @@ SYMBOL: building-seq
: 4% 4 n% ;
: 4# 4 n# ;
: nmake ( quot exemplars -- seqs )
dup length dup zero? [ 1+ ] when
MACRO:: nmake ( quot exemplars -- )
[let | n [ exemplars length ] |
[
[
[ drop 1024 swap new-resizable ] 2map
[ building-seq set call ] keep
] 2keep >r [ like ] 2map r> firstn
] with-scope ;
exemplars
[ 0 swap new-resizable ] map
building-seq set
quot call
building-seq get
exemplars [ like ] 2map
n firstn
] with-scope
]
] ;

View File

@ -79,3 +79,6 @@ IN: sequences.lib.tests
[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
[ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test
[ ] [ { } 0 firstn ] unit-test
[ "a" ] [ { "a" } 1 firstn ] unit-test

View File

@ -4,7 +4,7 @@
USING: combinators.lib kernel sequences math namespaces assocs
random sequences.private shuffle math.functions mirrors
arrays math.parser math.private sorting strings ascii macros
assocs.lib ;
assocs.lib quotations ;
IN: sequences.lib
: each-withn ( seq quot n -- ) nwith each ; inline
@ -20,8 +20,9 @@ IN: sequences.lib
: map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline
MACRO: firstn ( n -- )
[ [ swap nth ] curry
[ keep ] curry ] map concat [ drop ] compose ;
[ [ swap nth ] curry [ keep ] curry ] map
concat >quotation
[ drop ] compose ;
: prepare-index ( seq quot -- seq n quot )
>r dup length r> ; inline
@ -193,7 +194,7 @@ USE: continuations
: ?tail* ( seq n -- seq/f ) (tail) ?subseq ;
: accumulator ( quot -- quot vec )
V{ } clone [ [ push ] curry compose ] keep ;
V{ } clone [ [ push ] curry compose ] keep ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!