\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
\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
"/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
"/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
"/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
: url>path ( uri -- path )
url-decode "http://" ?str-head [
- "/" split1 f "" replace nip
+ "/" split1 dup "" ? nip
] when ;
: secure-path ( path -- path )
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 >= [
\ - [ 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
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 ;
: 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 ;
#! 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?
+++ /dev/null
-! :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 ;
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 )
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 ;
! Math operations
2GENERIC: number= ( x y -- ? )
+M: object number= 2drop f ;
+
2GENERIC: < ( x y -- ? )
2GENERIC: <= ( x y -- ? )
2GENERIC: > ( x y -- ? )
+++ /dev/null
-! :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 ;
IN: scratchpad
USE: compiler
+USE: generic
USE: test
USE: math
USE: kernel
USE: words
-: generic-test
+: single-combination-test
{
[ drop ]
[ drop ]
[ 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 ]
[ 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 ]
[ 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
[ "Replacing+spaces+with+plus" ]
[
"Replacing spaces with plus"
- [ CHAR: \s CHAR: + replace ] str-map
+ [ dup CHAR: \s = [ drop CHAR: + ] when ] str-map
]
unit-test