fix load errors from load-all

db4
Joe Groff 2009-10-28 13:56:15 -05:00
parent 2ecf3fb568
commit ef25935366
4 changed files with 44 additions and 37 deletions

View File

@ -36,17 +36,16 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
new-leaf new-leaf
] [ ] [
idx nodes nth :> n idx nodes nth :> n
shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n' shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
n n' eq? [ n n' eq? [
bitmap-node bitmap-node
] [ ] [
bitmap bitmap
n' idx nodes new-nth n' idx nodes new-nth
shift shift
<bitmap-node> <bitmap-node>
] if ] if
new-leaf new-leaf
]
] if ; ] if ;
M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )

View File

@ -77,28 +77,34 @@ CONSTANT: homo-sapiens
: write-repeat-fasta ( n alu desc id -- ) : write-repeat-fasta ( n alu desc id -- )
write-description write-description
0 :> k! :> alu [let
[| len | k len alu make-repeat-fasta k! ] split-lines ; inline 0 :> k! :> alu
[| len | k len alu make-repeat-fasta k! ] split-lines
] ; inline
: fasta ( n out -- ) : fasta ( n out -- )
homo-sapiens make-cumulative homo-sapiens make-cumulative
IUB make-cumulative IUB make-cumulative
:> homo-sapiens-floats [let
:> homo-sapiens-chars :> homo-sapiens-floats
:> IUB-floats :> homo-sapiens-chars
:> IUB-chars :> IUB-floats
:> out :> IUB-chars
:> n :> out
initial-seed :> seed :> n
initial-seed :> seed
out ascii [ out ascii [
n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
initial-seed initial-seed
n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta n 3 * homo-sapiens-chars homo-sapiens-floats
n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta "IUB ambiguity codes" "TWO" write-random-fasta
drop n 5 * IUB-chars IUB-floats
] with-file-writer ; "Homo sapiens frequency" "THREE" write-random-fasta
drop
] with-file-writer
] ;
: run-fasta ( -- ) 2500000 reverse-complement-in fasta ; : run-fasta ( -- ) 2500000 reverse-complement-in fasta ;

View File

@ -151,14 +151,16 @@ M: mdb-collection create-collection
[ "$cmd" = ] [ "system" head? ] bi or ; [ "$cmd" = ] [ "system" head? ] bi or ;
: check-collection ( collection -- fq-collection ) : check-collection ( collection -- fq-collection )
mdb-instance :> instance [let
instance name>> :> instance-name mdb-instance :> instance
dup mdb-collection? [ name>> ] when instance name>> :> instance-name
"." split1 over instance-name = dup mdb-collection? [ name>> ] when
[ nip ] [ drop ] if "." split1 over instance-name =
[ ] [ reserved-namespace? ] bi [ nip ] [ drop ] if
[ instance (ensure-collection) ] unless [ ] [ reserved-namespace? ] bi
[ instance-name ] dip "." glue ; [ instance (ensure-collection) ] unless
[ instance-name ] dip "." glue
] ;
: fix-query-collection ( mdb-query -- mdb-query ) : fix-query-collection ( mdb-query -- mdb-query )
[ check-collection ] change-collection ; inline [ check-collection ] change-collection ; inline

View File

@ -105,9 +105,9 @@ USE: tools.walker
! [ dump-to-file ] keep ! [ dump-to-file ] keep
write flush ; inline write flush ; inline
: build-query-object ( query -- selector ) :: build-query-object ( query -- selector )
H{ } clone :> selector H{ } clone :> selector
{ [ orderby>> [ "orderby" selector set-at ] when* ] query { [ orderby>> [ "orderby" selector set-at ] when* ]
[ explain>> [ "$explain" selector set-at ] when* ] [ explain>> [ "$explain" selector set-at ] when* ]
[ hint>> [ "$hint" selector set-at ] when* ] [ hint>> [ "$hint" selector set-at ] when* ]
[ query>> "query" selector set-at ] [ query>> "query" selector set-at ]