From 1aef8c48a0b95aef56ae7a07dd33f6298c16cf69 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 18 Oct 2004 05:37:46 +0000 Subject: [PATCH] start 0.68 by moving list-math to contrib and simplifying subset combinator --- contrib/list-math.factor | 59 ++++++++++++++++++ contrib/mandel.factor | 4 +- doc/devel-guide.tex | 6 +- factor/FactorInterpreter.java | 2 +- library/assoc.factor | 6 +- library/lists.factor | 66 +++++---------------- library/math/list-math.factor | 52 ---------------- library/math/math.factor | 12 +--- library/math/namespace-math.factor | 1 - library/platform/jvm/boot-mini.factor | 1 - library/platform/jvm/boot-sumo.factor | 1 - library/platform/native/boot-stage2.factor | 1 - library/platform/native/stack.factor | 1 - library/platform/native/vocabularies.factor | 8 ++- library/test/math/namespaces.factor | 1 - 15 files changed, 89 insertions(+), 132 deletions(-) create mode 100644 contrib/list-math.factor delete mode 100644 library/math/list-math.factor diff --git a/contrib/list-math.factor b/contrib/list-math.factor new file mode 100644 index 0000000000..b7e33d7835 --- /dev/null +++ b/contrib/list-math.factor @@ -0,0 +1,59 @@ +IN: list-math +USE: lists +USE: math +USE: stack +USE: combinators +USE: kernel +USE: logic +USE: math +USE: stack + +: 2uncons ( list1 list2 -- car1 car2 cdr1 cdr2 ) + uncons >r >r uncons r> swap r> ; + +: 2each-step ( list list quot -- cdr cdr ) + >r 2uncons r> -rot 2slip ; inline interpret-only + +: 2each ( list list quot -- ) + #! Apply the quotation to each pair of elements from the + #! two lists in turn. The quotation must have stack effect + #! ( x y -- ). + >r 2dup and [ + r> dup >r 2each-step r> 2each + ] [ + r> 3drop + ] ifte ; + +: 2map-step ( accum quot elt elt -- accum ) + 2swap swap slip cons ; + +: <2map ( list list quot -- accum quot list list ) + >r f -rot r> -rot ; + +: 2map ( list list quot -- list ) + #! Apply the quotation to each pair of elements from the + #! two lists in turn, collecting the return value into a + #! new list. The quotation must have stack effect + #! ( x y -- z ). + <2map [ pick >r 2map-step r> ] 2each drop reverse ; + +: |+ ( list -- sum ) + #! sum all elements in a list. + 0 swap [ + ] each ; + +: +| ( list list -- list ) + [ + ] 2map ; + +: |* ( list -- sum ) + #! multiply all elements in a list. + 1 swap [ * ] each ; + +: *| ( list list -- list ) + [ * ] 2map ; + +: *|+ ( list list -- dot ) + #! Dot product + *| |+ ; + +: average ( list -- avg ) + dup |+ swap length / ; diff --git a/contrib/mandel.factor b/contrib/mandel.factor index a7b75a23f7..7aa51955a1 100644 --- a/contrib/mandel.factor +++ b/contrib/mandel.factor @@ -84,10 +84,10 @@ SYMBOL: center ] with-pixels ; : mandel ( -- ) - 640 480 32 SDL_HWSURFACE SDL_SetVideoMode drop + 1280 1024 32 SDL_HWSURFACE SDL_FULLSCREEN bitor SDL_SetVideoMode drop [ - 1 zoom-fact set + 3 zoom-fact set -0.65 center set 50 nb-iter set [ render ] time diff --git a/doc/devel-guide.tex b/doc/devel-guide.tex index 4c3026d8b3..82ac4961c7 100644 --- a/doc/devel-guide.tex +++ b/doc/devel-guide.tex @@ -271,7 +271,9 @@ the second stack element. \texttt{2dup ( x y -{}- x y x y )} Duplicate the top two stack elements. A frequent use for this word is when two values have to be compared using something like \texttt{=} or \texttt{<} before being passed to another word. -\texttt{2swap ( x y z t -{}- z t x y )} Swap the top two stack elements. +\texttt{3drop ( x y z -{}- )} Discard the top three stack elements. + +\texttt{3dup ( x y z -{}- x y z x y z )} Duplicate the top three stack elements. You should try all these words out and become familiar with them. Push some numbers on the stack, execute a shuffle word, and look at how the stack contents was changed using @@ -279,7 +281,7 @@ execute a shuffle word, and look at how the stack contents was changed using Note the order of the shuffle word descriptions above. The ones at the top are used most often because they are easy to understand. The -more complex ones such as \texttt{rot} and \texttt{2swap} should be avoided unless absolutely necessary, because +more complex ones such as \texttt{rot} and \texttt{2dup} should be avoided unless absolutely necessary, because they make the flow of data in a word definition harder to understand. If you find yourself using too many shuffle words, or you're writing diff --git a/factor/FactorInterpreter.java b/factor/FactorInterpreter.java index 1091a6bae7..923d44b1bf 100644 --- a/factor/FactorInterpreter.java +++ b/factor/FactorInterpreter.java @@ -35,7 +35,7 @@ import java.io.*; public class FactorInterpreter implements FactorObject, Runnable { - public static final String VERSION = "0.67"; + public static final String VERSION = "0.68"; public static final Cons DEFAULT_USE = new Cons("builtins", new Cons("syntax",new Cons("scratchpad",null))); diff --git a/library/assoc.factor b/library/assoc.factor index f0634cbe12..ec89d8165d 100644 --- a/library/assoc.factor +++ b/library/assoc.factor @@ -43,11 +43,7 @@ USE: stack #! Looks up the key in an alist. Push the key/value pair. #! Most of the time you want to use assoc not assoc*. dup [ - 2dup car car = [ - nip car - ] [ - cdr assoc* - ] ifte + 2dup car car = [ nip car ] [ cdr assoc* ] ifte ] [ 2drop f ] ifte ; diff --git a/library/lists.factor b/library/lists.factor index 385facadaf..4538e51dc7 100644 --- a/library/lists.factor +++ b/library/lists.factor @@ -78,7 +78,7 @@ USE: vectors >r >r [ r> cons r> ] [ r> r> swapd cons ] ifte ; inline : partition-step ( ret1 ret2 ref combinator car -- ret1 ret2 ) - >r 2swap r> -rot >r >r dup >r swap call r> swap r> r> + >r rot >r rot r> r> -rot >r >r dup >r swap call r> swap r> r> partition-add ; inline : partition-iter ( ret1 ret2 ref combinator list -- ret1 ret2 ) @@ -148,13 +148,13 @@ DEFER: tree-contains? #! already contained in the list. 2dup contains? [ nip ] [ cons ] ifte ; -: each-step ( list quot -- list quot ) +: (each) ( list quot -- list quot ) >r uncons r> tuck 2slip ; inline interpret-only : each ( list quot -- ) #! Push each element of a proper list in turn, and apply a #! quotation with effect ( X -- ) to each element. - over [ each-step each ] [ 2drop ] ifte ; + over [ (each) each ] [ 2drop ] ifte ; inline interpret-only : reverse ( list -- list ) @@ -165,58 +165,20 @@ DEFER: tree-contains? #! Push each element of a proper list in turn, and collect #! return values of applying a quotation with effect #! ( X -- Y ) to each element into a new list. - over [ each-step rot >r map r> swons ] [ drop ] ifte ; + over [ (each) rot >r map r> swons ] [ drop ] ifte ; inline interpret-only -: 2uncons ( list1 list2 -- car1 car2 cdr1 cdr2 ) - uncons >r >r uncons r> swap r> ; - -: 2each-step ( list list quot -- cdr cdr ) - >r 2uncons r> -rot 2slip ; inline interpret-only - -: 2each ( list list quot -- ) - #! Apply the quotation to each pair of elements from the - #! two lists in turn. The quotation must have stack effect - #! ( x y -- ). - >r 2dup and [ - r> dup >r 2each-step r> 2each - ] [ - r> 3drop - ] ifte ; inline interpret-only - -: 2map-step ( accum quot elt elt -- accum ) - 2swap swap slip cons ; - -: <2map ( list list quot -- accum quot list list ) - >r f -rot r> -rot ; - -: 2map ( list list quot -- list ) - #! Apply the quotation to each pair of elements from the - #! two lists in turn, collecting the return value into a - #! new list. The quotation must have stack effect - #! ( x y -- z ). - <2map [ pick >r 2map-step r> ] 2each drop reverse ; - inline interpret-only - -: subset-add ( car pred accum -- accum ) - >r over >r call r> r> rot [ cons ] [ nip ] ifte ; - -: subset-iter ( accum list pred -- accum ) +: subset ( list quot -- list ) + #! Applies a quotation with effect ( X -- ? ) to each + #! element of a list; all elements for which the quotation + #! returned a value other than f are collected in a new + #! list. over [ - >r unswons r> 2swap pick - >r >r subset-add r> r> subset-iter - ] [ - 2drop - ] ifte ; - -: subset ( list pred -- list ) - #! Applies a quotation to each element of a list; all - #! elements for which the quotation returned a value other - #! than f are collected in a new list. - #! - #! In order to compile, the quotation must consume as many - #! values as it produces. - f -rot subset-iter reverse ; inline interpret-only + over car >r (each) + rot >r subset r> [ r> swons ] [ r> drop ] ifte + ] [ + drop + ] ifte ; inline interpret-only : remove ( obj list -- list ) #! Remove all occurrences of the object from the list. diff --git a/library/math/list-math.factor b/library/math/list-math.factor deleted file mode 100644 index 5fe49d3cca..0000000000 --- a/library/math/list-math.factor +++ /dev/null @@ -1,52 +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: math -USE: lists -USE: math -USE: stack - -: |+ ( list -- sum ) - #! sum all elements in a list. - 0 swap [ + ] each ; - -: +| ( list list -- list ) - [ + ] 2map ; - -: |* ( list -- sum ) - #! multiply all elements in a list. - 1 swap [ * ] each ; - -: *| ( list list -- list ) - [ * ] 2map ; - -: *|+ ( list list -- dot ) - #! Dot product - *| |+ ; - -: average ( list -- avg ) - dup |+ swap length / ; diff --git a/library/math/math.factor b/library/math/math.factor index 59e9298bb6..371019dd65 100644 --- a/library/math/math.factor +++ b/library/math/math.factor @@ -35,11 +35,7 @@ USE: stack : fib ( n -- nth fibonacci number ) ! This is the naive implementation, for benchmarking purposes. - dup 1 <= [ - drop 1 - ] [ - pred dup fib swap pred fib + - ] ifte ; + dup 1 <= [ drop 1 ] [ pred dup fib swap pred fib + ] ifte ; : fac ( n -- n! ) ! This is the naive implementation, for benchmarking purposes. @@ -51,11 +47,7 @@ USE: stack : abs ( z -- abs ) #! Compute the complex absolute value. - dup complex? [ - >rect mag2 - ] [ - dup 0 < [ neg ] when - ] ifte ; + dup complex? [ >rect mag2 ] [ dup 0 < [ neg ] when ] ifte ; : conjugate ( z -- z* ) >rect neg rect> ; diff --git a/library/math/namespace-math.factor b/library/math/namespace-math.factor index 93f7248c47..5b3ce221a4 100644 --- a/library/math/namespace-math.factor +++ b/library/math/namespace-math.factor @@ -35,6 +35,5 @@ USE: stack : -@ ( num var -- ) tuck get swap - put ; : *@ ( num var -- ) tuck get * put ; : /@ ( num var -- ) tuck get swap / put ; -: neg@ ( var -- ) dup get neg put ; : pred@ ( var -- ) dup get pred put ; : succ@ ( var -- ) dup get succ put ; diff --git a/library/platform/jvm/boot-mini.factor b/library/platform/jvm/boot-mini.factor index 76a72ccc20..b55d59e1b8 100644 --- a/library/platform/jvm/boot-mini.factor +++ b/library/platform/jvm/boot-mini.factor @@ -79,7 +79,6 @@ USE: parser "/library/math/constants.factor" run-resource ! math "/library/math/math.factor" run-resource ! math "/library/math/pow.factor" run-resource ! math -"/library/math/list-math.factor" run-resource ! math !!! Development tools. "/library/platform/jvm/processes.factor" run-resource ! processes diff --git a/library/platform/jvm/boot-sumo.factor b/library/platform/jvm/boot-sumo.factor index 9f98e574f8..2ea4fa6057 100644 --- a/library/platform/jvm/boot-sumo.factor +++ b/library/platform/jvm/boot-sumo.factor @@ -83,7 +83,6 @@ USE: parser "/library/math/pow.factor" run-resource ! math "/library/math/trig-hyp.factor" run-resource ! math "/library/math/arc-trig-hyp.factor" run-resource ! math -"/library/math/list-math.factor" run-resource ! math !!! Development tools. "/library/platform/jvm/processes.factor" run-resource ! processes diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor index 9a0dfc5895..1761250818 100644 --- a/library/platform/native/boot-stage2.factor +++ b/library/platform/native/boot-stage2.factor @@ -93,7 +93,6 @@ USE: stdio "/library/math/pow.factor" "/library/math/trig-hyp.factor" "/library/math/arc-trig-hyp.factor" - "/library/math/list-math.factor" "/library/platform/native/in-thread.factor" "/library/platform/native/network.factor" diff --git a/library/platform/native/stack.factor b/library/platform/native/stack.factor index cc8e40ab9d..d4a38db9a3 100644 --- a/library/platform/native/stack.factor +++ b/library/platform/native/stack.factor @@ -33,7 +33,6 @@ USE: vectors : 3drop ( x x x -- ) drop drop drop ; : 2dup ( x y -- x y x y ) over over ; : 3dup ( x y z -- x y z x y z ) pick pick pick ; -: 2swap ( x y z t -- z t x y ) rot >r rot r> ; : -rot ( x y z -- z x y ) rot rot ; : dupd ( x y -- x x y ) >r dup r> ; : swapd ( x y z -- y x z ) >r swap r> ; diff --git a/library/platform/native/vocabularies.factor b/library/platform/native/vocabularies.factor index 687a0b9dc5..8024607784 100644 --- a/library/platform/native/vocabularies.factor +++ b/library/platform/native/vocabularies.factor @@ -56,8 +56,12 @@ USE: stack : reveal ( word -- ) #! Add a new word to its vocabulary. - "vocabularies" get [ - dup word-vocabulary over word-name 2list set-object-path + global [ + "vocabularies" get [ + dup word-vocabulary + over word-name + 2list set-object-path + ] bind ] bind ; : create ( name vocab -- word ) diff --git a/library/test/math/namespaces.factor b/library/test/math/namespaces.factor index 951c691370..cdae40ba88 100644 --- a/library/test/math/namespaces.factor +++ b/library/test/math/namespaces.factor @@ -9,6 +9,5 @@ USE: math [ 5 ] [ 1 "x" -@ "x" get ] unit-test [ 10 ] [ 2 "x" *@ "x" get ] unit-test [ 2 ] [ 5 "x" /@ "x" get ] unit-test -[ -2 ] [ "x" neg@ "x" get ] unit-test [ -3 ] [ "x" pred@ "x" get ] unit-test [ -2 ] [ "x" succ@ "x" get ] unit-test