From ec31e23ca7e8b86a42a8527fc8a3f5bb23564603 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 19:35:03 -0500 Subject: [PATCH 1/5] trivial lint changes --- unmaintained/lint/lint.factor | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/unmaintained/lint/lint.factor b/unmaintained/lint/lint.factor index 644346d29e..ab1a67a83e 100644 --- a/unmaintained/lint/lint.factor +++ b/unmaintained/lint/lint.factor @@ -3,14 +3,15 @@ USING: accessors alien alien.accessors arrays assocs combinators.lib io kernel macros math namespaces prettyprint quotations sequences vectors vocabs words html.elements sets -slots.private combinators.short-circuit ; +slots.private combinators.short-circuit math.order hashtables +sequences.deep ; IN: lint SYMBOL: def-hash SYMBOL: def-hash-keys : set-hash-vector ( val key hash -- ) - 2dup at -rot >r >r ?push r> r> set-at ; + 2dup at -rot [ ?push ] 2dip set-at ; : add-word-def ( word quot -- ) dup callable? [ @@ -67,7 +68,7 @@ def-hash get-global [ ! Remove constants [ 1 ] [ - drop dup length 1 = swap first number? and not + drop { [ length 1 = ] [ first number? ] } 1&& not ] assoc-filter ! Remove set-alien-cell, etc. @@ -80,6 +81,13 @@ def-hash get-global [ drop trivial-defs member? not ] assoc-filter +[ + drop { + [ [ wrapper? ] deep-contains? ] + [ [ hashtable? ] deep-contains? ] + } 1|| not +] assoc-filter + ! Remove n m shift defs [ drop dup length 3 = [ From 743ec65b4fe1729fd39ab409ef7a4d105d3b3c79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:12:09 -0500 Subject: [PATCH 2/5] Move hexdump back to extra --- {basis => extra}/hexdump/authors.txt | 0 {basis => extra}/hexdump/hexdump-docs.factor | 0 {basis => extra}/hexdump/hexdump-tests.factor | 0 {basis => extra}/hexdump/hexdump.factor | 0 {basis => extra}/hexdump/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {basis => extra}/hexdump/authors.txt (100%) rename {basis => extra}/hexdump/hexdump-docs.factor (100%) rename {basis => extra}/hexdump/hexdump-tests.factor (100%) rename {basis => extra}/hexdump/hexdump.factor (100%) rename {basis => extra}/hexdump/summary.txt (100%) diff --git a/basis/hexdump/authors.txt b/extra/hexdump/authors.txt similarity index 100% rename from basis/hexdump/authors.txt rename to extra/hexdump/authors.txt diff --git a/basis/hexdump/hexdump-docs.factor b/extra/hexdump/hexdump-docs.factor similarity index 100% rename from basis/hexdump/hexdump-docs.factor rename to extra/hexdump/hexdump-docs.factor diff --git a/basis/hexdump/hexdump-tests.factor b/extra/hexdump/hexdump-tests.factor similarity index 100% rename from basis/hexdump/hexdump-tests.factor rename to extra/hexdump/hexdump-tests.factor diff --git a/basis/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor similarity index 100% rename from basis/hexdump/hexdump.factor rename to extra/hexdump/hexdump.factor diff --git a/basis/hexdump/summary.txt b/extra/hexdump/summary.txt similarity index 100% rename from basis/hexdump/summary.txt rename to extra/hexdump/summary.txt From 196c91709f4cb5e0582f5f88b21c473bece9ce1e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:12:50 -0500 Subject: [PATCH 3/5] stop-server word --- basis/io/servers/connection/connection.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 0516f24402..674ed8803c 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -105,7 +105,7 @@ M: threaded-server handle-client* handler>> call ; threaded-server get encoding>> [ started-accept-loop ] [ [ accept-loop ] with-disposal ] bi ; -\ start-accept-loop ERROR add-error-logging +\ start-accept-loop NOTICE add-error-logging : init-server ( threaded-server -- threaded-server ) dup semaphore>> [ From ce8b1e3fff3e911ba1fc199c578c23e83b2a72dc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:13:01 -0500 Subject: [PATCH 4/5] Fix permissions --- Makefile | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) mode change 100755 => 100644 Makefile diff --git a/Makefile b/Makefile old mode 100755 new mode 100644 index 769aeacb8c..aa520063e3 --- a/Makefile +++ b/Makefile @@ -149,14 +149,11 @@ macosx.app: factor ln -s Factor.app/Contents/MacOS/factor ./factor cp $(ENGINE) $(BUNDLE)/Contents/Frameworks - install_name_tool \ - -id @executable_path/../Frameworks/libfreetype.6.dylib \ - Factor.app/Contents/Frameworks/libfreetype.6.dylib install_name_tool \ -change libfactor.dylib \ @executable_path/../Frameworks/libfactor.dylib \ Factor.app/Contents/MacOS/factor - + factor: $(DLL_OBJS) $(EXE_OBJS) $(LINKER) $(ENGINE) $(DLL_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ From 56a0af9628c7817202729b881387b6da92ac2d77 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Oct 2008 02:19:03 -0500 Subject: [PATCH 5/5] initial math cleanup --- extra/math/algebra/algebra.factor | 6 ++- extra/math/analysis/analysis.factor | 12 +++-- extra/math/combinatorics/combinatorics.factor | 11 ++-- extra/math/compare/compare.factor | 1 - extra/math/derivatives/derivatives.factor | 13 +++-- extra/math/erato/erato.factor | 4 +- extra/math/fft/fft.factor | 2 +- extra/math/miller-rabin/miller-rabin.factor | 2 + .../math/newtons-method/newtons-method.factor | 14 +++-- .../numerical-integration.factor | 14 ++--- extra/math/polynomials/polynomials.factor | 4 +- extra/math/primes/primes.factor | 51 ++++++++++--------- extra/math/quaternions/quaternions.factor | 2 +- extra/math/secant-method/secant-method.factor | 24 ++++++--- extra/math/statistics/statistics.factor | 6 ++- extra/math/text/english/english.factor | 11 ++-- extra/math/trig/trig.factor | 4 +- 17 files changed, 101 insertions(+), 80 deletions(-) diff --git a/extra/math/algebra/algebra.factor b/extra/math/algebra/algebra.factor index 8bb8420d1a..8cccded26a 100644 --- a/extra/math/algebra/algebra.factor +++ b/extra/math/algebra/algebra.factor @@ -1,8 +1,10 @@ ! Copyright (c) 2007 Samuel Tardieu ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions sequences ; +USING: kernel math math.functions sequences fry ; IN: math.algebra : chinese-remainder ( aseq nseq -- x ) dup product - [ [ over / [ swap gcd drop ] keep * * ] curry 2map sum ] keep rem ; foldable + [ + '[ _ over / [ swap gcd drop ] keep * * ] 2map sum + ] keep rem ; foldable diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index a41281d779..7da1c96b61 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.constants math.functions math.intervals -math.vectors namespaces sequences ; +math.vectors namespaces sequences combinators.short-circuit ; IN: math.analysis r log * r> - - swap 6 gamma-z gamma-p6 v. log + ; + [ 0.5 + dup gamma-g6 + dup [ log * ] dip - ] + [ 6 gamma-z gamma-p6 v. log ] bi + ; : gamma-lanczos6 ( x -- gamma[x] ) #! gamma(x) = gamma(x+1) / x @@ -39,7 +41,7 @@ PRIVATE> : gamma ( x -- y ) #! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt #! gamma(n+1) = n! for n > 0 - dup 0.0 <= over 1.0 mod zero? and [ + dup { [ 0.0 <= ] [ 1.0 mod zero? ] } 1&& [ drop 1./0. ] [ dup abs gamma-lanczos6 swap dup 0 > [ drop ] [ gamma-neg ] if @@ -55,7 +57,7 @@ PRIVATE> ] if ; : nth-root ( n x -- y ) - over 0 = [ "0th root is undefined" throw ] when >r recip r> swap ^ ; + [ recip ] dip swap ^ ; ! Forth Scientific Library Algorithm #1 ! diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor index a0c6df083b..b1c49b8ab5 100644 --- a/extra/math/combinatorics/combinatorics.factor +++ b/extra/math/combinatorics/combinatorics.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel math math.order math.ranges mirrors -namespaces make sequences sequences.lib sorting ; +namespaces sequences sorting fry ; IN: math.combinatorics [ dupd - ] when ; inline ! See this article for explanation of the factoradic-based permutation methodology: -! http://msdn2.microsoft.com/en-us/library/aa302371.aspx +! http://msdn2.microsoft.com/en-us/library/aa302371.aspx : factoradic ( n -- factoradic ) 0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] [ ] produce reverse 2nip ; @@ -39,13 +39,10 @@ PRIVATE> twiddle [ nPk ] keep factorial / ; : permutation ( n seq -- seq ) - tuck permutation-indices swap nths ; + [ permutation-indices ] keep nths ; : all-permutations ( seq -- seq ) - [ - [ length factorial ] keep [ permutation , ] curry each - ] { } make ; + [ length factorial ] keep '[ _ permutation ] map ; : inverse-permutation ( seq -- permutation ) >alist sort-values keys ; - diff --git a/extra/math/compare/compare.factor b/extra/math/compare/compare.factor index 28a8eadc81..d19dac3d2b 100644 --- a/extra/math/compare/compare.factor +++ b/extra/math/compare/compare.factor @@ -19,4 +19,3 @@ IN: math.compare : clamp ( a value b -- x ) min max ; - diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index ad8d944bfe..b7612e112b 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -1,4 +1,3 @@ - USING: kernel continuations combinators sequences math math.order math.ranges accessors float-arrays ; @@ -7,11 +6,11 @@ IN: math.derivatives TUPLE: state x func h err i j errt fac hh ans a done ; : largest-float ( -- x ) HEX: 7fefffffffffffff bits>double ; foldable -: ntab ( -- val ) 8 ; -: con ( -- val ) 1.6 ; -: con2 ( -- val ) con con * ; -: big ( -- val ) largest-float ; -: safe ( -- val ) 2.0 ; +: ntab ( -- val ) 8 ; inline +: con ( -- val ) 1.6 ; inline +: con2 ( -- val ) con con * ; inline +: big ( -- val ) largest-float ; inline +: safe ( -- val ) 2.0 ; inline ! Yes, this was ported from C code. : a[i][i] ( state -- elt ) [ i>> ] [ i>> ] [ a>> ] tri nth nth ; @@ -120,4 +119,4 @@ TUPLE: state x func h err i j errt fac hh ans a done ; bi ; : derivative ( x func -- m ) 0.01 2.0 (derivative) drop ; -: derivative-func ( func -- der ) [ derivative ] curry ; \ No newline at end of file +: derivative-func ( func -- der ) [ derivative ] curry ; diff --git a/extra/math/erato/erato.factor b/extra/math/erato/erato.factor index f836d71a99..4c6675e8f1 100644 --- a/extra/math/erato/erato.factor +++ b/extra/math/erato/erato.factor @@ -11,8 +11,8 @@ TUPLE: erato limit bits latest ; : ind ( n -- i ) 2/ 1- ; inline -: is-prime ( n erato -- bool ) - >r ind r> bits>> nth ; inline +: is-prime ( n limit -- bool ) + [ ind ] [ bits>> ] bi* nth ; inline : indices ( n erato -- range ) limit>> ind over 3 * ind swap rot ; diff --git a/extra/math/fft/fft.factor b/extra/math/fft/fft.factor index 682d2a49db..b82ecb6b2c 100644 --- a/extra/math/fft/fft.factor +++ b/extra/math/fft/fft.factor @@ -9,7 +9,7 @@ IN: math.fft : odd ( seq -- seq ) 2 group 1 ; DEFER: fft : two ( seq -- seq ) fft 2 v/n dup append ; -: omega ( n -- n ) recip -2 pi i* * * exp ; +: omega ( n -- n' ) recip -2 pi i* * * exp ; : twiddle ( seq -- seq ) dup length dup omega swap n^v v* ; : (fft) ( seq -- seq ) dup odd two twiddle swap even two v+ ; : fft ( seq -- seq ) dup length 1 = [ (fft) ] unless ; diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index f1953340db..45665c701d 100755 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: combinators combinators.lib io locals kernel math math.functions math.ranges namespaces random sequences hashtables sets ; diff --git a/extra/math/newtons-method/newtons-method.factor b/extra/math/newtons-method/newtons-method.factor index 5bf71deac8..269eae2538 100644 --- a/extra/math/newtons-method/newtons-method.factor +++ b/extra/math/newtons-method/newtons-method.factor @@ -1,11 +1,17 @@ ! Copyright © 2008 Reginald Keith Ford II +! See http://factorcode.org/license.txt for BSD license. ! Newton's Method of approximating roots - USING: kernel math math.derivatives ; IN: math.newtons-method -: newtons-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ; + +: newtons-method ( guess function -- x ) + newton-precision [ [ newton-step ] keep ] times drop ; diff --git a/extra/math/numerical-integration/numerical-integration.factor b/extra/math/numerical-integration/numerical-integration.factor index 798d3a5e71..dfaa618b53 100644 --- a/extra/math/numerical-integration/numerical-integration.factor +++ b/extra/math/numerical-integration/numerical-integration.factor @@ -1,18 +1,20 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences namespaces make math math.ranges math.vectors vectors ; IN: math.numerical-integration SYMBOL: num-steps 180 num-steps set-global + : setup-simpson-range ( from to -- frange ) 2dup swap - num-steps get / ; : generate-simpson-weights ( seq -- seq ) - [ - { 1 4 } % length 2 / 2 - { 2 4 } concat % 1 , - ] { } make ; + { 1 4 } + swap length 2 / 2 - { 2 4 } concat + { 1 } 3append ; : integrate-simpson ( from to f -- x ) - >r setup-simpson-range r> - dupd map dup generate-simpson-weights + [ setup-simpson-range dup ] dip + map dup generate-simpson-weights v. swap [ third ] keep first - 6 / * ; - diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 8662bbb089..51512ca2e3 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences vectors math math.vectors namespaces make shuffle splitting sequences.lib math.order ; IN: math.polynomials @@ -82,5 +84,5 @@ PRIVATE> : polyval ( p x -- p[x] ) #! Evaluate a polynomial. - >r dup length r> powers v. ; + [ dup length ] dip powers v. ; diff --git a/extra/math/primes/primes.factor b/extra/math/primes/primes.factor index f3a515e72b..feb60c555d 100644 --- a/extra/math/primes/primes.factor +++ b/extra/math/primes/primes.factor @@ -8,44 +8,45 @@ IN: math.primes : next-prime ( n -- p ) - dup 999983 < [ - primes-under-million [ natural-search drop 1+ ] keep nth - ] [ - next-odd find-prime-miller-rabin - ] if ; foldable + dup 999983 < [ + primes-under-million [ natural-search drop 1+ ] keep nth + ] [ + next-odd find-prime-miller-rabin + ] if ; foldable : prime? ( n -- ? ) - dup 1000000 < [ - dup primes-under-million natural-search nip = - ] [ - miller-rabin - ] if ; foldable + dup 1000000 < [ + dup primes-under-million natural-search nip = + ] [ + miller-rabin + ] if ; foldable : lprimes ( -- list ) - 0 primes-under-million seq>list - 1000003 [ 2 + find-prime-miller-rabin ] lfrom-by - lappend ; + 0 primes-under-million seq>list + 1000003 [ 2 + find-prime-miller-rabin ] lfrom-by + lappend ; : lprimes-from ( n -- list ) - dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; : primes-upto ( n -- seq ) - { - { [ dup 2 < ] [ drop { } ] } - { [ dup 1000003 < ] - [ primes-under-million [ natural-search drop 1+ 0 swap ] keep ] } - [ primes-under-million 1000003 lprimes-from - rot [ <= ] curry lwhile list>array append ] - } cond ; foldable + { + { [ dup 2 < ] [ drop { } ] } + { [ dup 1000003 < ] [ + primes-under-million [ natural-search drop 1+ 0 swap ] keep + ] } + [ primes-under-million 1000003 lprimes-from + rot [ <= ] curry lwhile list>array append ] + } cond ; foldable : primes-between ( low high -- seq ) - primes-upto - [ 1- next-prime ] dip - [ natural-search drop ] keep [ length ] keep ; foldable + primes-upto + [ 1- next-prime ] dip + [ natural-search drop ] keep [ length ] keep ; foldable : coprime? ( a b -- ? ) gcd nip 1 = ; foldable diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index 3c450f1c05..65f18d3568 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -28,7 +28,7 @@ PRIVATE> : qconjugate ( u -- u' ) #! Quaternion conjugate. - first2 neg >r conjugate r> 2array ; + first2 [ conjugate ] [ neg ] bi* 2array ; : qrecip ( u -- 1/u ) #! Quaternion inverse. diff --git a/extra/math/secant-method/secant-method.factor b/extra/math/secant-method/secant-method.factor index e039b42bbd..ad52c0cd4a 100644 --- a/extra/math/secant-method/secant-method.factor +++ b/extra/math/secant-method/secant-method.factor @@ -1,14 +1,26 @@ ! Copyright © 2008 Reginald Keith Ford II +! See http://factorcode.org/license.txt for BSD license. ! Secant Method of approximating roots - USING: kernel math math.function-tools math.points math.vectors ; IN: math.secant-method -: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop + 2 / ; + +: secant-method ( left right function -- x ) + secant-precision [ secant-step ] times drop + 2 / ; + ! : close-enough? ( a b -- t/f ) - abs tiny-amount < ; -! : secant-method2 ( left right function -- x ) 2over close-enough? [ drop average ] [ secant-step secant-method ] if ; \ No newline at end of file + +! : secant-method2 ( left right function -- x ) + ! 2over close-enough? + ! [ drop average ] [ secant-step secant-method ] if ; diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 28cc05151b..8cd6d26c1c 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman, Michael Judge. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.analysis math.functions math.vectors sequences - sequences.lib sorting ; +sequences.lib sorting ; IN: math.statistics : mean ( seq -- n ) @@ -18,7 +20,7 @@ IN: math.statistics : median ( seq -- n ) #! middle number if odd, avg of two middle numbers if even natural-sort dup length dup even? [ - 1- 2 / swap [ nth ] [ >r 1+ r> nth ] 2bi + 2 / + 1- 2 / swap [ nth ] [ [ 1+ ] dip nth ] 2bi + 2 / ] [ 2 / swap nth ] if ; diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor index 387be4d791..439d0a75fe 100755 --- a/extra/math/text/english/english.factor +++ b/extra/math/text/english/english.factor @@ -1,8 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib kernel math math.functions math.parser namespaces - sequences splitting grouping sequences.lib - combinators.short-circuit ; +sequences splitting grouping combinators.short-circuit ; IN: math.text.english text) ( n -- str ) - dup negative-text swap abs 3digit-groups recombine append ; + [ negative-text ] [ abs 3digit-groups recombine ] bi append ; PRIVATE> : number>text ( n -- str ) - dup zero? [ - small-numbers - ] [ - [ (number>text) ] with-scope - ] if ; + dup zero? [ small-numbers ] [ [ (number>text) ] with-scope ] if ; diff --git a/extra/math/trig/trig.factor b/extra/math/trig/trig.factor index be9ec6a56c..3d9428adda 100644 --- a/extra/math/trig/trig.factor +++ b/extra/math/trig/trig.factor @@ -1,6 +1,6 @@ - +! Copyright (C) 2008 Eduardo Cavazos. +! See http://factorcode.org/license.txt for BSD license. USING: math math.constants ; - IN: math.trig : deg>rad pi * 180 / ; inline