Merge branch 'master' of git://github.com/slavapestov/factor

basis/bootstrap/image/image.factor

@@ -5,12 +5,13 @@ hashtables.private io io.binary io.files io.encodings.binary
 io.pathnames kernel kernel.private math namespaces make parser
 prettyprint sequences strings sbufs vectors words quotations
 assocs system layouts splitting grouping growable classes
-classes.builtin classes.tuple classes.tuple.private vocabs
-vocabs.loader source-files definitions debugger
-quotations.private combinators combinators.short-circuit
-math.order math.private accessors slots.private
-generic.single.private compiler.units compiler.constants fry
-locals bootstrap.image.syntax generalizations ;
+classes.private classes.builtin classes.tuple
+classes.tuple.private vocabs vocabs.loader source-files
+definitions debugger quotations.private combinators
+combinators.short-circuit math.order math.private accessors
+slots.private generic.single.private compiler.units
+compiler.constants fry locals bootstrap.image.syntax
+generalizations ;
 IN: bootstrap.image
 
 : arch ( os cpu -- arch )
@@ -342,9 +343,7 @@ M: float '
 
 : t, ( -- ) t t-offset fixup ;
 
-M: f '
-    #! f is #define F RETAG(0,F_TYPE)
-    drop \ f type-number ;
+M: f ' drop \ f type-number ;
 
 :  0, ( -- )  0 >bignum '  0-offset fixup ;
 :  1, ( -- )  1 >bignum '  1-offset fixup ;

basis/classes/struct/struct.factor

@@ -1,12 +1,13 @@
 ! (c)Joe Groff, Daniel Ehrenberg bsd license
-USING: accessors alien alien.c-types alien.data alien.parser arrays
-byte-arrays classes classes.parser classes.tuple classes.tuple.parser
-classes.tuple.private combinators combinators.short-circuit
-combinators.smart cpu.architecture definitions functors.backend
-fry generalizations generic.parser kernel kernel.private lexer
-libc locals macros make math math.order parser quotations
-sequences slots slots.private specialized-arrays vectors words
-summary namespaces assocs vocabs.parser math.functions
+USING: accessors alien alien.c-types alien.data alien.parser
+arrays byte-arrays classes classes.private classes.parser
+classes.tuple classes.tuple.parser classes.tuple.private
+combinators combinators.short-circuit combinators.smart
+cpu.architecture definitions functors.backend fry
+generalizations generic.parser kernel kernel.private lexer libc
+locals macros make math math.order parser quotations sequences
+slots slots.private specialized-arrays vectors words summary
+namespaces assocs vocabs.parser math.functions
 classes.struct.bit-accessors bit-arrays ;
 QUALIFIED: math
 IN: classes.struct

basis/combinators/smart/smart.factor

@@ -53,4 +53,4 @@ MACRO: smart-if ( pred true false -- )
     '[ _ preserving _ _ if ] ;
 
 MACRO: smart-apply ( quot n -- )
-    [ dup inputs ] dip '[ _ _ mnapply ] ;
+    [ dup inputs ] dip '[ _ _ _ mnapply ] ;

basis/compiler/cfg/intrinsics/simd/simd.factor

@@ -663,6 +663,7 @@ PREDICATE: fixnum-vector-rep < int-vector-rep
         { (simd-select)            [ emit-simd-select              ] }
         { alien-vector             [ emit-alien-vector             ] }
         { set-alien-vector         [ emit-set-alien-vector         ] }
+        { assert-positive          [ drop                          ] }
     } enable-intrinsics ;
 
 enable-simd

basis/compiler/tests/redefine3.factor

@@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ; inline
 : sheeple-test ( -- string ) { } sheeple ;
 
 : compiled-use? ( key word -- ? )
-    "compiled-uses" word-prop 2 <groups> key? ;
+    "definition-dependencies" word-prop member-eq? ;
 
 [ "sheeple" ] [ sheeple-test ] unit-test
 [ t ] [ \ sheeple-test optimized? ] unit-test

basis/compression/lzw/lzw.factor

@@ -26,9 +26,11 @@ TUPLE: gif-lzw < lzw ;
     dup end-of-information-code>> 1 + initial-uncompress-table >>table
     dup initial-code-size>> >>code-size ;
 
+ERROR: code-size-zero ;
+
 : <lzw-uncompress> ( input code-size class -- obj )
     new
-        swap >>code-size
+        swap [ code-size-zero ] when-zero >>code-size
         dup code-size>> >>initial-code-size
         dup code-size>> 1 - 2^ >>clear-code
         dup clear-code>> 1 + >>end-of-information-code

basis/debugger/debugger.factor

@@ -293,6 +293,9 @@ M: duplicate-slot-names summary
 M: invalid-slot-name summary
     drop "Invalid slot name" ;
 
+M: bad-inheritance summary
+    drop "Circularity in inheritance chain" ;
+
 M: not-in-a-method-error summary
     drop "call-next-method can only be called in a method definition" ;
 

basis/generalizations/generalizations-tests.factor

@@ -113,3 +113,12 @@ IN: generalizations.tests
 
 [ { 1 2 3 } { 4 5 6 } ]
 [ 1 2 3 4 5 6 [ 3array ] 3 2 mnapply ] unit-test
+
+[ { 1 2 3 } { 4 5 6 } ]
+[ 1 2 3 4 5 6 [ 3array ] [ 3array ] 3 2 nspread* ] unit-test
+
+[ ]
+[ [ 2array ] 2 0 mnapply ] unit-test
+
+[ ]
+[ 2 0 nspread* ] unit-test

basis/generalizations/generalizations.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private sequences sequences.private math
 combinators macros math.order math.ranges quotations fry effects
-memoize.private ;
+memoize.private arrays ;
 IN: generalizations
 
 <<
@@ -100,10 +100,20 @@ MACRO: nspread ( quots n -- )
 
 MACRO: spread* ( n -- )
     [ [ ] ] [
-        1 swap [a,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
+        [1,b) [ '[ [ [ _ ndip ] curry ] dip compose ] ] map [ ] concat-as
         [ call ] compose
     ] if-zero ;
 
+MACRO: nspread* ( m n -- )
+    [ drop [ ] ] [
+        [ * 0 ] [ drop neg ] 2bi
+        <range> rest >array dup length iota <reversed>
+        [
+            '[ [ [ _ ndip ] curry ] _ ndip ]
+        ] 2map dup rest-slice [ [ compose ] compose ] map! drop
+        [ ] concat-as [ call ] compose
+    ] if-zero ;
+
 MACRO: cleave* ( n -- )
     [ [ ] ]
     [ 1 - [ [ [ keep ] curry ] dip compose ] n*quot [ call ] compose ] 
@@ -112,6 +122,9 @@ MACRO: cleave* ( n -- )
 : napply ( quot n -- )
     [ dupn ] [ spread* ] bi ; inline
 
+: mnapply ( quot m n -- )
+    [ nip dupn ] [ nspread* ] 2bi ; inline
+
 : apply-curry ( ...a quot n -- )
     [ [curry] ] dip napply ; inline
 
@@ -124,10 +137,6 @@ MACRO: cleave* ( n -- )
 MACRO: mnswap ( m n -- )
     1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
 
-MACRO: mnapply ( quot m n -- )
-    swap
-    [ swap '[ _ ] replicate ] dip '[ _ _ nspread ] ;
-
 MACRO: nweave ( n -- )
     [ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
     '[ _ _ ncleave ] ;

basis/math/ranges/ranges.factor

@@ -45,3 +45,5 @@ PRIVATE>
 : [1,b] ( b -- range ) 1 swap [a,b] ; inline
 
 : [0,b) ( b -- range ) 0 swap [a,b) ; inline
+
+: [1,b) ( b -- range ) 1 swap [a,b) ; inline

basis/random/random-docs.factor

@@ -86,8 +86,9 @@ HELP: sample
 }
 { $description "Takes " { $snippet "n" } " samples at random without replacement from a sequence. Throws an error if " { $snippet "n" } " is longer than the sequence." }
 { $examples
-    { $unchecked-example "USING: random prettyprint ; { 1 2 3 } 2 sample ."
-        "{ 3 2 }"
+    { $unchecked-example "USING: random prettyprint ;"
+    "{ 1 2 3 } 2 sample ."
+    "{ 3 2 }"
     }
 } ;
 

basis/random/random.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs byte-arrays byte-vectors
-combinators fry io.backend io.binary kernel locals math
-math.bitwise math.constants math.functions math.ranges
-namespaces sequences sets summary system vocabs.loader ;
+USING: accessors alien.c-types arrays assocs byte-arrays
+byte-vectors combinators fry io.backend io.binary kernel locals
+math math.bitwise math.constants math.functions math.order
+math.ranges namespaces sequences sets summary system
+vocabs.loader ;
 IN: random
 
 SYMBOL: system-random-generator
@@ -61,29 +62,20 @@ M: sequence random
 
 : random-32 ( -- n ) random-generator get random-32* ;
 
-: randomize ( seq -- seq )
-    dup length [ dup 1 > ]
+: randomize-n-last ( seq n -- seq ) 
+    [ dup length dup ] dip - 1 max '[ dup _ > ] 
     [ [ random ] [ 1 - ] bi [ pick exchange ] keep ]
     while drop ;
 
-ERROR: too-many-samples seq n ;
-
-<PRIVATE
+: randomize ( seq -- seq ) 
+    dup length randomize-n-last ;
 
-:: next-sample ( length n seq hashtable -- elt )
-    n hashtable key? [
-        length n 1 + length mod seq hashtable next-sample
-    ] [
-        n hashtable conjoin
-        n seq nth
-    ] if ;
-
-PRIVATE>
+ERROR: too-many-samples seq n ;
 
 : sample ( seq n -- seq' )
     2dup [ length ] dip < [ too-many-samples ] when
-    swap [ length ] [ ] bi H{ } clone 
-    '[ _ dup random _ _ next-sample ] replicate ;
+    [ [ length iota >array ] dip [ randomize-n-last ] keep tail-slice* ]
+    [ drop ] 2bi nths ;
 
 : delete-random ( seq -- elt )
     [ length random-integer ] keep [ nth ] 2keep remove-nth! drop ;

basis/random/sfmt/sfmt.factor

@@ -111,7 +111,7 @@ M:: sfmt generate ( sfmt -- )
 
 : <sfmt-array> ( sfmt -- uint-array uint-4-array )
     state>>
-    [ n>> 4 * 1 swap [a,b] >uint-array ] [ seed>> ] bi
+    [ n>> 4 * [1,b] >uint-array ] [ seed>> ] bi
     [
         [
             [ -30 shift ] [ ] bi bitxor

basis/tools/deploy/shaker/shaker.factor

@@ -9,6 +9,7 @@ compiler.units definitions generic generic.standard
 generic.single tools.deploy.config combinators classes
 classes.builtin slots.private grouping command-line ;
 QUALIFIED: bootstrap.stage2
+QUALIFIED: classes.private
 QUALIFIED: compiler.crossref
 QUALIFIED: compiler.errors
 QUALIFIED: continuations
@@ -332,14 +333,14 @@ IN: tools.deploy.shaker
             {
                 gensym
                 name>char-hook
-                next-method-quot-cache
-                class-and-cache
-                class-not-cache
-                class-or-cache
-                class<=-cache
-                classes-intersect-cache
-                implementors-map
-                update-map
+                classes.private:next-method-quot-cache
+                classes.private:class-and-cache
+                classes.private:class-not-cache
+                classes.private:class-or-cache
+                classes.private:class<=-cache
+                classes.private:classes-intersect-cache
+                classes.private:implementors-map
+                classes.private:update-map
                 main-vocab-hook
                 compiler.crossref:compiled-crossref
                 compiler.crossref:compiled-generic-crossref

core/bootstrap/primitives.factor

@@ -3,11 +3,12 @@
 USING: alien alien.strings arrays byte-arrays generic hashtables
 hashtables.private io io.encodings.ascii kernel math
 math.private math.order namespaces make parser sequences strings
-vectors words quotations assocs layouts classes classes.builtin
-classes.tuple classes.tuple.private kernel.private vocabs
-vocabs.loader source-files definitions slots classes.union
-classes.intersection classes.predicate compiler.units
-bootstrap.image.private io.files accessors combinators ;
+vectors words quotations assocs layouts classes classes.private
+classes.builtin classes.tuple classes.tuple.private
+kernel.private vocabs vocabs.loader source-files definitions
+slots classes.union classes.intersection classes.predicate
+compiler.units bootstrap.image.private io.files accessors
+combinators ;
 IN: bootstrap.primitives
 
 "Creating primitives and basic runtime structures..." print flush

core/classes/algebra/algebra-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax kernel classes words
+USING: help.markup help.syntax kernel classes classes.private words
 checksums checksums.crc32 sequences math ;
 IN: classes.algebra
 

core/classes/algebra/algebra.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel classes combinators accessors sequences arrays
-vectors assocs namespaces words sorting layouts math hashtables
-kernel.private sets math.order ;
+USING: kernel classes classes.private combinators accessors
+sequences arrays vectors assocs namespaces words sorting layouts
+math hashtables kernel.private sets math.order ;
 IN: classes.algebra
 
 <PRIVATE

core/classes/builtin/builtin.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes classes.algebra classes.algebra.private
-words kernel kernel.private namespaces sequences math
-math.private combinators assocs quotations ;
+USING: accessors classes classes.private classes.algebra
+classes.algebra.private words kernel kernel.private namespaces
+sequences math math.private combinators assocs quotations ;
 IN: classes.builtin
 
 SYMBOL: builtins