Merge branch 'master' of git://factorcode.org/git/factor

basis/help/handbook/handbook.factor

@@ -162,8 +162,7 @@ ARTICLE: "encodings-introduction" "An introduction to encodings"
 { $code "\"file.txt\" utf16 file-contents" }
 "Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text."
 $nl
-"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text."
+"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ;
-{ $see-also "stream-elements" } ;
 
 ARTICLE: "io" "Input and output"
 { $heading "Streams" }

basis/math/partial-dispatch/partial-dispatch-tests.factor

@@ -26,3 +26,8 @@ tools.test math kernel sequences ;
 [ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test
 [ fixnum+fast ] [ \ fixnum+ modular-variant ] unit-test
 [ fixnum+fast ] [ \ fixnum+fast modular-variant ] unit-test
+
+[ 3 ] [ 1 2 +-integer-integer ] unit-test
+[ 3 ] [ 1 >bignum 2 +-integer-integer ] unit-test
+[ 3 ] [ 1 2 >bignum +-integer-integer ] unit-test
+[ 3 ] [ 1 >bignum 2 >bignum +-integer-integer ] unit-test

basis/math/partial-dispatch/partial-dispatch.factor

@@ -45,31 +45,41 @@ M: word integer-op-input-classes
         { bitnot fixnum-bitnot }
     } at swap or ;
 
+: bignum-fixnum-op-quot ( big-word -- quot )
+    '[ fixnum>bignum _ execute ] ;
+
+: fixnum-bignum-op-quot ( big-word -- quot )
+    '[ [ fixnum>bignum ] dip _ execute ] ;
+
 : integer-fixnum-op-quot ( fix-word big-word -- quot )
     [
         [ over fixnum? ] %
-        [ '[ _ execute ] , ]
+        [ '[ _ execute ] , ] [ bignum-fixnum-op-quot , ] bi* \ if ,
-        [ '[ fixnum>bignum _ execute ] , ] bi*
-        \ if ,
     ] [ ] make ;
 
 : fixnum-integer-op-quot ( fix-word big-word -- quot )
     [
         [ dup fixnum? ] %
-        [ '[ _ execute ] , ]
+        [ '[ _ execute ] , ] [ fixnum-bignum-op-quot , ] bi* \ if ,
-        [ '[ [ fixnum>bignum ] dip _ execute ] , ] bi*
+    ] [ ] make ;
-        \ if ,
+
+: integer-bignum-op-quot ( big-word -- quot )
+    [
+        [ over fixnum? ] %
+        [ fixnum-bignum-op-quot , ] [ '[ _ execute ] , ] bi \ if ,
     ] [ ] make ;
 
 : integer-integer-op-quot ( fix-word big-word -- quot )
     [
-        [ dup fixnum? ] %
+        [ 2dup both-fixnums? ] %
-        2dup integer-fixnum-op-quot ,
+        [ '[ _ execute ] , ]
         [
-            [ over fixnum? [ [ fixnum>bignum ] dip ] when ] %
+            [
-            nip ,
+                [ dup fixnum? ] %
-        ] [ ] make ,
+                [ bignum-fixnum-op-quot , ]
-        \ if ,
+                [ integer-bignum-op-quot , ] bi \ if ,
+            ] [ ] make ,
+        ] bi* \ if ,
     ] [ ] make ;
 
 : integer-op-word ( triple -- word )

core/classes/mixin/mixin.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes classes.union words kernel sequences
 definitions combinators arrays assocs generic accessors ;
@@ -21,8 +21,9 @@ M: mixin-class rank-class drop 3 ;
         drop
     ] [
         [ { } redefine-mixin-class ]
+        [ H{ } clone "instances" set-word-prop ]
         [ update-classes ]
-        bi
+        tri
     ] if ;
 
 TUPLE: check-mixin-class class ;
@@ -44,6 +45,11 @@ TUPLE: check-mixin-class class ;
     [ [ update-class ] each ]
     [ implementors [ remake-generic ] each ] bi ;
 
+: (add-mixin-instance) ( class mixin -- )
+    [ [ suffix ] change-mixin-class ]
+    [ [ f ] 2dip "instances" word-prop set-at ]
+    2bi ;
+
 : add-mixin-instance ( class mixin -- )
     #! Note: we call update-classes on the new member, not the
     #! mixin. This ensures that we only have to update the
@@ -53,20 +59,22 @@ TUPLE: check-mixin-class class ;
     #! updated by transitivity; the mixins usages appear in
     #! class-usages of the member, now that it's been added.
     [ 2drop ] [
-        [ [ suffix ] change-mixin-class ] 2keep
+        [ (add-mixin-instance) ] 2keep
-        [ nip ] [ [ new-class? ] either? ] 2bi [
+        [ nip ] [ [ new-class? ] either? ] 2bi
-            update-classes/new
+        [ update-classes/new ] [ update-classes ] if
-        ] [
-            update-classes
-        ] if
     ] if-mixin-member? ;
 
+: (remove-mixin-instance) ( class mixin -- )
+    [ [ swap remove ] change-mixin-class ]
+    [ "instances" word-prop delete-at ]
+    2bi ;
+
 : remove-mixin-instance ( class mixin -- )
     #! The order of the three clauses is important here. The last
     #! one must come after the other two so that the entries it
     #! adds to changed-generics are not overwritten.
     [
-        [ [ swap remove ] change-mixin-class ]
+        [ (remove-mixin-instance) ]
         [ nip update-classes ]
         [ class-usages update-methods ]
         2tri
@@ -76,32 +84,21 @@ M: mixin-class class-forgotten remove-mixin-instance ;
 
 ! Definition protocol implementation ensures that removing an
 ! INSTANCE: declaration from a source file updates the mixin.
-TUPLE: mixin-instance loc class mixin ;
+TUPLE: mixin-instance class mixin ;
 
-M: mixin-instance equal?
+C: <mixin-instance> mixin-instance
-    {
-        { [ over mixin-instance? not ] [ f ] }
-        { [ 2dup [ class>> ] bi@ = not ] [ f ] }
-        { [ 2dup [ mixin>> ] bi@ = not ] [ f ] }
-        [ t ]
-    } cond 2nip ;
 
-M: mixin-instance hashcode*
+: >mixin-instance< ( mixin-instance -- class mixin )
-    [ class>> ] [ mixin>> ] bi 2array hashcode* ;
+    [ class>> ] [ mixin>> ] bi ; inline
 
-: <mixin-instance> ( class mixin -- definition )
+M: mixin-instance where >mixin-instance< "instances" word-prop at ;
-    mixin-instance new
-        swap >>mixin
-        swap >>class ;
 
-M: mixin-instance where loc>> ;
+M: mixin-instance set-where >mixin-instance< "instances" word-prop set-at ;
-
-M: mixin-instance set-where (>>loc) ;
 
 M: mixin-instance definer drop \ INSTANCE: f ;
 
 M: mixin-instance definition drop f ;
 
 M: mixin-instance forget*
-    [ class>> ] [ mixin>> ] bi
+    >mixin-instance<
     dup mixin-class? [ remove-mixin-instance ] [ 2drop ] if ;

core/generic/generic-tests.factor

@@ -247,4 +247,4 @@ GENERIC: move-method-generic ( a -- b )
 
 [ ] [ "IN: generic.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
 
-[ { string } ] [ move-method-generic order ] unit-test
+[ { string } ] [ \ move-method-generic order ] unit-test

core/io/encodings/encodings-docs.factor

@@ -124,6 +124,6 @@ ARTICLE: "io.encodings" "I/O encodings"
 "Combinators to change the encoding:"
 { $subsection with-encoded-output }
 { $subsection with-decoded-input }
-{ $see-also "encodings-introduction" "stream-elements" } ;
+{ $see-also "encodings-introduction" } ;
 
 ABOUT: "io.encodings"

core/io/io-docs.factor

@@ -262,7 +262,6 @@ $nl
 { $subsection stream-nl }
 "This word is for streams that allow seeking:"
 { $subsection stream-seek }
-"For a discussion of the distinction between binary and string streams, see " { $link "stream-elements" } "."
 { $see-also "io.timeouts" } ;
 
 ARTICLE: "stdio-motivation" "Motivation for default streams"
@@ -313,7 +312,7 @@ $nl
 { $subsection read }
 { $subsection read-until }
 { $subsection read-partial }
-"If the default input stream is a string stream (" { $link "stream-elements" } "), lines of text can be read:"
+"If the default input stream is a character stream (" { $link stream-element-type } " outputs " { $link +character+ } "), lines of text can be read:"
 { $subsection readln }
 "Seeking on the default input stream:"
 { $subsection seek-input }
@@ -328,7 +327,7 @@ $nl
 { $subsection flush }
 { $subsection write1 }
 { $subsection write }
-"If the default output stream is a string stream (" { $link "stream-elements" } "), lines of text can be written:"
+"If the default output stream is a character stream (" { $link stream-element-type } " outputs " { $link +character+ } "), lines of text can be written:"
 { $subsection readln }
 { $subsection print }
 { $subsection nl }

core/parser/parser-tests.factor

@@ -3,7 +3,7 @@ io.streams.string namespaces classes effects source-files assocs
 sequences strings io.files io.pathnames definitions
 continuations sorting classes.tuple compiler.units debugger
 vocabs vocabs.loader accessors eval combinators lexer
-vocabs.parser words.symbol ;
+vocabs.parser words.symbol multiline ;
 IN: parser.tests
 
 \ run-file must-infer
@@ -560,7 +560,7 @@ EXCLUDE: qualified.tests.bar => x ;
 ! Two similar bugs
 
 ! Replace : def with something in << >>
-[ [ ] ] [
+/* [ [ ] ] [
     "IN: parser.tests : was-once-a-word-bug ( -- ) ;"
     <string-reader> "was-once-a-word-test" parse-stream
 ] unit-test
@@ -572,7 +572,7 @@ EXCLUDE: qualified.tests.bar => x ;
     <string-reader> "was-once-a-word-test" parse-stream
 ] unit-test
 
-[ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test
+[ t ] [ "was-once-a-word-bug" "parser.tests" lookup >boolean ] unit-test */
 
 ! Replace : def with DEFER:
 [ [ ] ] [

extra/benchmark/benchmark.factor

@@ -24,10 +24,10 @@ IN: benchmark
         [
             [
                 [ [ 1array $vocab-link ] with-cell ]
-                [ [ 1000000 /f pprint-cell ] [ "failed" write ] if* ] bi*
+                [ [ 1000000 /f pprint-cell ] [ [ "failed" write ] with-cell ] if* ] bi*
             ] with-row
         ] assoc-each
-    ] tabular-output ;
+    ] tabular-output nl ;
 
 : benchmarks ( -- )
     run-benchmarks benchmarks. ;

extra/game-input/game-input-tests.factor

@@ -1,7 +1,8 @@
 IN: game-input.tests
-USING: game-input tools.test kernel system ;
+USING: game-input tools.test kernel system threads ;
 
 os windows? os macosx? or [
     [ ] [ open-game-input ] unit-test
+    [ ] [ yield ] unit-test
     [ ] [ close-game-input ] unit-test
 ] when

extra/method-chains/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/method-chains/method-chains-tests.factor

@@ -0,0 +1,13 @@
+IN: method-chains.tests
+USING: method-chains tools.test arrays strings sequences kernel namespaces ;
+
+GENERIC: testing ( a b -- c )
+
+M: sequence testing nip reverse ;
+AFTER: string testing append ;
+BEFORE: array testing over prefix "a" set ;
+
+[ V{ 3 2 1 } ] [ 3 V{ 1 2 3 } testing ] unit-test
+[ "heyyeh" ] [ 4 "yeh" testing ] unit-test
+[ { 4 2 0 } ] [ 5 { 0 2 4 } testing ] unit-test
+[ { 5 0 2 4 } ] [ "a" get ] unit-test

extra/method-chains/method-chains.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel generic generic.parser words fry ;
+IN: method-chains
+
+: AFTER: (M:) dupd '[ [ _ (call-next-method) ] _ bi ] define ; parsing
+: BEFORE: (M:) over '[ _ [ _ (call-next-method) ] bi ] define ; parsing