From 2b26f6959b25ddc23264f85fa831b13bb04a3e6b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 19 Dec 2004 04:35:20 +0000 Subject: [PATCH] some cleanups --- TODO.FACTOR.txt | 5 +- library/bootstrap/boot-stage2.factor | 2 - library/bootstrap/boot.factor | 1 - library/httpd/httpd.factor | 2 +- library/httpd/url-encoding.factor | 2 +- library/inference/words.factor | 1 + library/kernel.factor | 32 ++++++------ library/logic.factor | 54 ------------------- library/math/complex.factor | 33 ++++++------ library/math/math.factor | 2 + library/stack.factor | 50 ------------------ library/test/compiler/generic.factor | 77 ++++++++++++++-------------- library/test/strings.factor | 2 +- 13 files changed, 80 insertions(+), 183 deletions(-) delete mode 100644 library/logic.factor delete mode 100644 library/stack.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 19a4d2fd31..550f700aff 100644 --- a/TODO.FACTOR.txt +++ b/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 diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index b64b0c82ee..980f27f95e 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/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" diff --git a/library/bootstrap/boot.factor b/library/bootstrap/boot.factor index 3e0cc50df0..3352f82938 100644 --- a/library/bootstrap/boot.factor +++ b/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 diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor index 9623ad55c8..db94bacccc 100644 --- a/library/httpd/httpd.factor +++ b/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 ) diff --git a/library/httpd/url-encoding.factor b/library/httpd/url-encoding.factor index 96a2bf9558..8a9a6d7af5 100644 --- a/library/httpd/url-encoding.factor +++ b/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 >= [ diff --git a/library/inference/words.factor b/library/inference/words.factor index f9ec1eb31a..d067da19d9 100644 --- a/library/inference/words.factor +++ b/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 diff --git a/library/kernel.factor b/library/kernel.factor index 50daf12ddd..f1320e2f7a 100644 --- a/library/kernel.factor +++ b/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? diff --git a/library/logic.factor b/library/logic.factor deleted file mode 100644 index 566f1f5888..0000000000 --- a/library/logic.factor +++ /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 ; diff --git a/library/math/complex.factor b/library/math/complex.factor index 00aadbf662..808c60d808 100644 --- a/library/math/complex.factor +++ b/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 ; diff --git a/library/math/math.factor b/library/math/math.factor index 2c48ca9a7f..fa2306493c 100644 --- a/library/math/math.factor +++ b/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 -- ? ) diff --git a/library/stack.factor b/library/stack.factor deleted file mode 100644 index 1ab96642ab..0000000000 --- a/library/stack.factor +++ /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 ; diff --git a/library/test/compiler/generic.factor b/library/test/compiler/generic.factor index 9a91e84209..ce84439b30 100644 --- a/library/test/compiler/generic.factor +++ b/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 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 diff --git a/library/test/strings.factor b/library/test/strings.factor index 602351a11b..f549116991 100644 --- a/library/test/strings.factor +++ b/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