Get some db words to infer
parent
129320c65b
commit
86ed87da0c
|
@ -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
|
|
@ -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 )
|
||||
[
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
]
|
||||
] ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
Loading…
Reference in New Issue