some cleanups
Slava Pestov
parent
cad99c8888
commit
2b26f6959b
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 >= [
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 -- ? )
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue