some cleanups

TODO.FACTOR.txt

@@ -23,10 +23,6 @@
 
 + oop:
 
-- union metaclass
-- 2generic
-- move generic, 2generic from kernel vocabulary
-- generic = hashcode and math ops
 - make see work with generics
 - doc comments of generics
 
@@ -40,6 +36,7 @@
 
 + listener/plugin:
 
+- faster completion
 - word added >1 if external instance dies
 - sidekick: still parsing too much
 - errors don't always disappear

library/bootstrap/boot-stage2.factor

@@ -45,7 +45,6 @@ USE: stdio
     "/library/stack.factor"
     "/library/combinators.factor"
     "/library/kernel.factor"
-    "/library/logic.factor"
     "/library/cons.factor"
     "/library/assoc.factor"
     "/library/math/math.factor"
@@ -74,7 +73,6 @@ USE: stdio
     "/library/syntax/parser.factor"
     "/library/syntax/parse-stream.factor"
     "/library/bootstrap/init.factor"
-!    "/library/syntax/parse-syntax.factor"
 
     "/library/format.factor"
     "/library/syntax/unparser.factor"

library/bootstrap/boot.factor

@@ -40,7 +40,6 @@ USE: hashtables
 "/library/stack.factor" run-resource
 "/library/combinators.factor" run-resource
 "/library/kernel.factor" run-resource
-"/library/logic.factor" run-resource
 "/library/cons.factor" run-resource
 "/library/assoc.factor" run-resource
 "/library/math/math.factor" run-resource

library/httpd/httpd.factor

@@ -48,7 +48,7 @@ USE: url-encoding
 
 : url>path ( uri -- path )
     url-decode "http://" ?str-head [
-        "/" split1 f "" replace nip
+        "/" split1 dup "" ? nip
     ] when ;
 
 : secure-path ( path -- path )

library/httpd/url-encoding.factor

@@ -55,7 +55,7 @@ USE: unparser
     2dup url-decode-hex >r 3 + r> ;
 
 : url-decode-+-or-other ( index str ch -- index str )
-    CHAR: + CHAR: \s replace , >r succ r> ;
+    dup CHAR: + = [ drop CHAR: \s ] when , >r succ r> ;
 
 : url-decode-iter ( index str -- )
     2dup str-length >= [

library/inference/words.factor

@@ -190,4 +190,5 @@ USE: prettyprint
 \ - [ 2 | 1 ] "infer-effect" set-word-property
 \ * [ 2 | 1 ] "infer-effect" set-word-property
 \ / [ 2 | 1 ] "infer-effect" set-word-property
+\ gcd [ 2 | 1 ] "infer-effect" set-word-property
 \ hashcode [ 1 | 1 ] "infer-effect" set-word-property

library/kernel.factor

@@ -27,14 +27,14 @@
 
 IN: kernel
 USE: generic
-USE: lists
-USE: math
-USE: math-internals
-USE: strings
-USE: vectors
-USE: words
 USE: vectors
 
+GENERIC: hashcode ( obj -- n )
+M: object hashcode drop 0 ;
+
+GENERIC: = ( obj obj -- ? )
+M: object = eq? ;
+
 : cpu ( -- arch )
     #! Returns one of "x86" or "unknown".
     7 getenv ;
@@ -46,15 +46,6 @@ USE: vectors
 : dispatch ( n vtable -- )
     vector-nth call ;
 
-: 2generic ( n n vtable -- )
-    >r arithmetic-type r> dispatch ; inline
-
-GENERIC: hashcode
-M: object hashcode drop 0 ;
-
-GENERIC: =
-M: object = eq? ;
-
 : set-boot ( quot -- )
     #! Set the boot quotation.
     8 setenv ;
@@ -63,6 +54,17 @@ M: object = eq? ;
     #! One more than the maximum value from type primitive.
     17 ;
 
+: ? ( cond t f -- t/f )
+    #! Push t if cond is true, otherwise push f.
+    rot [ drop ] [ nip ] ifte ; inline
+
+: >boolean t f ? ; inline
+
+: and ( a b -- a&b ) f ? ; inline
+: not ( a -- ~a ) f t ? ; inline
+: or ( a b -- a|b) t swap ? ; inline
+: xor ( a b -- a^b ) dup not swap ? ; inline
+
 IN: syntax
 BUILTIN: f 6 FORGET: f?
 BUILTIN: t 7 FORGET: t?

library/logic.factor

@@ -1,54 +0,0 @@
-! :folding=indent:collapseFolds=0:
-
-! $Id$
-!
-! Copyright (C) 2003, 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: kernel
-
-: ? ( cond t f -- t/f )
-    #! Push t if cond is true, otherwise push f.
-    rot [ drop ] [ nip ] ifte ; inline
-
-: and ( a b -- a&b )
-    #! Logical and.
-    f ? ; inline
-
-: not ( a -- a )
-    #! Pushes f is the object is not f, t if the object is f.
-    f t ? ; inline
-
-: or ( a b -- a|b) 
-    #! Logical or.
-    t swap ? ; inline
-
-: xor ( a b -- a^b )
-    #! Logical exclusive or.
-    dup not swap ? ; inline
-
-: >boolean t f ? ; inline
-
-: replace ( obj old new -- obj/new )
-    #! If obj is equal to old, drop it and push new.
-    >r dupd = [ drop r> ] [ r> drop ] ifte ;

library/math/complex.factor

@@ -29,9 +29,26 @@ IN: math
 USE: generic
 USE: kernel
 USE: math
+USE: math-internals
 
 : >rect ( x -- xr xi ) dup real swap imaginary ;
 
+: conjugate ( z -- z* )
+    >rect neg rect> ;
+
+: arg ( z -- arg )
+    #! Compute the complex argument.
+    >rect swap fatan2 ;
+
+: >polar ( z -- abs arg )
+    >rect 2dup swap fatan2 >r mag2 r> ;
+
+: cis ( theta -- cis )
+    dup fcos swap fsin rect> ;
+
+: polar> ( abs arg -- z )
+    cis * ;
+
 IN: math-internals
 
 : 2>rect ( x y -- xr yr xi yi )
@@ -58,21 +75,5 @@ M: complex /f ( x y -- x/y ) complex/ tuck /f >r /f r> rect> ;
 
 M: complex abs ( z -- |z| ) >rect mag2 ;
 
-: conjugate ( z -- z* )
-    >rect neg rect> ;
-
-: arg ( z -- arg )
-    #! Compute the complex argument.
-    >rect swap fatan2 ;
-
-: >polar ( z -- abs arg )
-    >rect 2dup swap fatan2 >r mag2 r> ;
-
-: cis ( theta -- cis )
-    dup fcos swap fsin rect> ;
-
-: polar> ( abs arg -- z )
-    cis * ;
-
 M: complex hashcode ( n -- n )
     >rect >fixnum swap >fixnum bitxor ;

library/math/math.factor

@@ -32,6 +32,8 @@ USE: math-internals
 
 ! Math operations
 2GENERIC: number= ( x y -- ? )
+M: object number= 2drop f ;
+
 2GENERIC: <  ( x y -- ? )
 2GENERIC: <= ( x y -- ? )
 2GENERIC: >  ( x y -- ? )

library/stack.factor

@@ -1,50 +0,0 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: kernel
-USE: vectors
-
-: 2drop ( x x -- ) drop drop ; inline
-: 3drop ( x x x -- ) drop drop drop ; inline
-: 2dup ( x y -- x y x y ) over over ; inline
-: 3dup ( x y z -- x y z x y z ) pick pick pick ; inline
-: rot ( x y z -- y z x ) >r swap r> swap ; inline
-: -rot ( x y z -- z x y ) swap >r swap r> ; inline
-: dupd ( x y -- x x y ) >r dup r> ; inline
-: swapd ( x y z -- y x z ) >r swap r> ; inline
-: nip ( x y -- y ) swap drop ; inline
-: tuck ( x y -- y x y ) dup >r swap r> ; inline
-
-: clear ( -- )
-    #! Clear the datastack. For interactive use only; invoking
-    #! this from a word definition will clobber any values left
-    #! on the data stack by the caller.
-    { } set-datastack ;
-
-: depth ( -- n )
-    #! Push the number of elements on the datastack.
-    datastack vector-length ;

library/test/compiler/generic.factor

@@ -1,11 +1,12 @@
 IN: scratchpad
 USE: compiler
+USE: generic
 USE: test
 USE: math
 USE: kernel
 USE: words
 
-: generic-test
+: single-combination-test
     {
         [ drop ]
         [ drop ]
@@ -24,13 +25,13 @@ USE: words
         [ drop ]
         [ drop ]
         [ drop ]
-    } generic ; compiled
+    } single-combination ; compiled
 
-[ 2 3 ] [ 2 3 t generic-test ] unit-test
+[ 2 3 ] [ 2 3 t single-combination-test ] unit-test
-[ 2 3 ] [ 2 3 4 generic-test ] unit-test
+[ 2 3 ] [ 2 3 4 single-combination-test ] unit-test
-[ 2 f ] [ 2 3 f generic-test ] unit-test
+[ 2 f ] [ 2 3 f single-combination-test ] unit-test
 
-: generic-literal-test
+: single-combination-literal-test
     4 {
         [ drop ]
         [ nip  ]
@@ -49,11 +50,11 @@ USE: words
         [ nip  ]
         [ nip  ]
         [ nip  ]
-    } generic ; compiled
+    } single-combination ; compiled
 
-[ ] [ generic-literal-test ] unit-test
+[ ] [ single-combination-literal-test ] unit-test
 
-: generic-test-alt
+: single-combination-test-alt
     {
         [ drop ]
         [ drop ]
@@ -72,40 +73,40 @@ USE: words
         [ drop ]
         [ drop ]
         [ drop ]
-    } generic + ; compiled
+    } single-combination + ; compiled
 
-[ 5 ] [ 2 3 4 generic-test-alt ] unit-test
+[ 5 ] [ 2 3 4 single-combination-test-alt ] unit-test
-[ 7/2 ] [ 2 3 3/2 generic-test-alt ] unit-test
+[ 7/2 ] [ 2 3 3/2 single-combination-test-alt ] unit-test
 
-DEFER: generic-test-2
+DEFER: single-combination-test-2
 
-: generic-test-4
+: single-combination-test-4
-    not generic-test-2 ;
+    not single-combination-test-2 ;
 
-: generic-test-3
+: single-combination-test-3
     drop 3 ;
 
-: generic-test-2
+: single-combination-test-2
     {
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-4 ]
+        [ single-combination-test-4 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-        [ generic-test-3 ]
+        [ single-combination-test-3 ]
-    } generic ;
+    } single-combination ;
 
-[ 3 ] [ t generic-test-2 ] unit-test
+[ 3 ] [ t single-combination-test-2 ] unit-test
-[ 3 ] [ 3 generic-test-2 ] unit-test
+[ 3 ] [ 3 single-combination-test-2 ] unit-test
-[ 3 ] [ f generic-test-2 ] unit-test
+[ 3 ] [ f single-combination-test-2 ] unit-test

library/test/strings.factor

@@ -98,6 +98,6 @@ unit-test
 [ "Replacing+spaces+with+plus" ]
 [
     "Replacing spaces with plus"
-    [ CHAR: \s CHAR: + replace ] str-map
+    [ dup CHAR: \s = [ drop CHAR: + ] when ] str-map
 ]
 unit-test