]> gitweb.factorcode.org Git - factor.git/commitdiff
some cleanups
authorSlava Pestov <slava@factorcode.org>
Sun, 19 Dec 2004 04:35:20 +0000 (04:35 +0000)
committerSlava Pestov <slava@factorcode.org>
Sun, 19 Dec 2004 04:35:20 +0000 (04:35 +0000)
13 files changed:
TODO.FACTOR.txt
library/bootstrap/boot-stage2.factor
library/bootstrap/boot.factor
library/httpd/httpd.factor
library/httpd/url-encoding.factor
library/inference/words.factor
library/kernel.factor
library/logic.factor [deleted file]
library/math/complex.factor
library/math/math.factor
library/stack.factor [deleted file]
library/test/compiler/generic.factor
library/test/strings.factor

index 19a4d2fd3183ff1dadbe80fac0e61a275e29e2b5..550f700affb6fb7df6caf371030d72ea17d6473f 100644 (file)
 \r
 + oop:\r
 \r
-- union metaclass\r
-- 2generic\r
-- move generic, 2generic from kernel vocabulary\r
-- generic = hashcode and math ops\r
 - make see work with generics\r
 - doc comments of generics\r
 \r
@@ -40,6 +36,7 @@
 \r
 + listener/plugin:\r
 \r
+- faster completion\r
 - word added >1 if external instance dies\r
 - sidekick: still parsing too much\r
 - errors don't always disappear\r
index b64b0c82ee8711f6fe489a43798a4bb1da610e5f..980f27f95ece89661a88614bddbcf31e292dc50f 100644 (file)
@@ -45,7 +45,6 @@ USE: stdio
     "/library/stack.factor"\r
     "/library/combinators.factor"\r
     "/library/kernel.factor"\r
-    "/library/logic.factor"\r
     "/library/cons.factor"\r
     "/library/assoc.factor"\r
     "/library/math/math.factor"\r
@@ -74,7 +73,6 @@ USE: stdio
     "/library/syntax/parser.factor"\r
     "/library/syntax/parse-stream.factor"\r
     "/library/bootstrap/init.factor"\r
-!    "/library/syntax/parse-syntax.factor"\r
 \r
     "/library/format.factor"\r
     "/library/syntax/unparser.factor"\r
index 3e0cc50df038fd4f92f92e743ea06a763535a6b7..3352f829380d0ccc848dae8d542389a720e4af9a 100644 (file)
@@ -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
index 9623ad55c8238fd5eb7f06a9a8c553dd98a428e9..db94bacccca990a224cefbfc3fc1dcf2c0ca6496 100644 (file)
@@ -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 )
index 96a2bf955890282c279618726b2432aa3b25496e..8a9a6d7af5b4602c27a54938e3bbafb61f5efb69 100644 (file)
@@ -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 >= [
index f9ec1eb31a10fa3ec3960bfacaf205dc02e6cd02..d067da19d9ccc2f12183c97a7c316f44f7205a18 100644 (file)
@@ -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
index 50daf12ddd2dcde891714e23043b9575f92194ec..f1320e2f7a1dc8b452adcb2a5933ae99892b2001 100644 (file)
 
 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?
diff --git a/library/logic.factor b/library/logic.factor
deleted file mode 100644 (file)
index 566f1f5..0000000
+++ /dev/null
@@ -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 ;
index 00aadbf66279bfac9e9f9b28e84632be2d273f9f..808c60d808ad41a9f4fb9dc08dccbe475e6997cd 100644 (file)
@@ -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 ;
index 2c48ca9a7f9d5cd2c2fcaf7e28f01f0bfd215336..fa2306493ce4176d3698b87f4477edb8505e357e 100644 (file)
@@ -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 -- ? )
diff --git a/library/stack.factor b/library/stack.factor
deleted file mode 100644 (file)
index 1ab9664..0000000
+++ /dev/null
@@ -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 ;
index 9a91e8420996df37c139f32e8fce825f91d61efe..ce84439b305d1e71c056958a2bfdac7ba3f9f17a 100644 (file)
@@ -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 4 generic-test ] unit-test
-[ 2 f ] [ 2 3 f generic-test ] unit-test
+[ 2 3 ] [ 2 3 t single-combination-test ] unit-test
+[ 2 3 ] [ 2 3 4 single-combination-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
-[ 7/2 ] [ 2 3 3/2 generic-test-alt ] unit-test
+[ 5 ] [ 2 3 4 single-combination-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
-    not generic-test-2 ;
+: single-combination-test-4
+    not single-combination-test-2 ;
 
-: generic-test-3
+: single-combination-test-3
     drop 3 ;
 
-: generic-test-2
+: single-combination-test-2
     {
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-4 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-        [ generic-test-3 ]
-    } generic ;
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-4 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+        [ single-combination-test-3 ]
+    } single-combination ;
 
-[ 3 ] [ t generic-test-2 ] unit-test
-[ 3 ] [ 3 generic-test-2 ] unit-test
-[ 3 ] [ f generic-test-2 ] unit-test
+[ 3 ] [ t single-combination-test-2 ] unit-test
+[ 3 ] [ 3 single-combination-test-2 ] unit-test
+[ 3 ] [ f single-combination-test-2 ] unit-test
index 602351a11b65d0c04be83bee5acb9597395c36a7..f5491169917793c6bd895d764ca3098e620ad43b 100644 (file)
@@ -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