fix load errors from load-all
							parent
							
								
									2ecf3fb568
								
							
						
					
					
						commit
						ef25935366
					
				| 
						 | 
					@ -46,7 +46,6 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
 | 
				
			||||||
            <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' )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -77,12 +77,15 @@ CONSTANT: homo-sapiens
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: write-repeat-fasta ( n alu desc id -- )
 | 
					: write-repeat-fasta ( n alu desc id -- )
 | 
				
			||||||
    write-description
 | 
					    write-description
 | 
				
			||||||
 | 
					    [let
 | 
				
			||||||
        0 :> k! :> alu
 | 
					        0 :> k! :> alu
 | 
				
			||||||
    [| len | k len alu make-repeat-fasta k! ] split-lines ; inline
 | 
					        [| 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
 | 
				
			||||||
 | 
					    [let
 | 
				
			||||||
        :> homo-sapiens-floats
 | 
					        :> homo-sapiens-floats
 | 
				
			||||||
        :> homo-sapiens-chars
 | 
					        :> homo-sapiens-chars
 | 
				
			||||||
        :> IUB-floats
 | 
					        :> IUB-floats
 | 
				
			||||||
| 
						 | 
					@ -95,10 +98,13 @@ CONSTANT: homo-sapiens
 | 
				
			||||||
            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
 | 
				
			||||||
 | 
					            n 5 * IUB-chars IUB-floats
 | 
				
			||||||
 | 
					            "Homo sapiens frequency" "THREE" write-random-fasta
 | 
				
			||||||
            drop
 | 
					            drop
 | 
				
			||||||
    ] with-file-writer ;
 | 
					        ] with-file-writer
 | 
				
			||||||
 | 
					    ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
 | 
					: run-fasta ( -- ) 2500000 reverse-complement-in fasta ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -151,6 +151,7 @@ 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 )
 | 
				
			||||||
 | 
					    [let
 | 
				
			||||||
        mdb-instance :> instance
 | 
					        mdb-instance :> instance
 | 
				
			||||||
        instance name>> :> instance-name
 | 
					        instance name>> :> instance-name
 | 
				
			||||||
        dup mdb-collection? [ name>> ] when
 | 
					        dup mdb-collection? [ name>> ] when
 | 
				
			||||||
| 
						 | 
					@ -158,7 +159,8 @@ M: mdb-collection create-collection
 | 
				
			||||||
        [ nip ] [ drop ] if
 | 
					        [ nip ] [ drop ] if
 | 
				
			||||||
        [ ] [ reserved-namespace? ] bi
 | 
					        [ ] [ reserved-namespace? ] bi
 | 
				
			||||||
        [ instance (ensure-collection) ] unless
 | 
					        [ instance (ensure-collection) ] unless
 | 
				
			||||||
    [ instance-name ] dip "." glue ; 
 | 
					        [ 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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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 ]
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue