From bea4d80a33fb213692fbfe61add0046d862891d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 10:11:02 -0600
Subject: [PATCH 1/6] Add specialization hints from old float-arrays. These
will be replaced with a better facility soon
---
basis/specialized-arrays/double/double.factor | 68 ++++++++++++++++++-
1 file changed, 67 insertions(+), 1 deletion(-)
diff --git a/basis/specialized-arrays/double/double.factor b/basis/specialized-arrays/double/double.factor
index b7fc3a8143..0501458532 100644
--- a/basis/specialized-arrays/double/double.factor
+++ b/basis/specialized-arrays/double/double.factor
@@ -1,4 +1,70 @@
USE: specialized-arrays.functor
IN: specialized-arrays.double
-<< "double" define-array >>
\ No newline at end of file
+<< "double" define-array >>
+
+! Specializer hints. These should really be generalized, and placed
+! somewhere else
+USING: hints math.vectors arrays kernel math accessors sequences ;
+
+HINTS: <double-array> { 2 } { 3 } ;
+
+HINTS: vneg { array } { double-array } ;
+HINTS: v*n { array object } { double-array float } ;
+HINTS: n*v { array object } { float double-array } ;
+HINTS: v/n { array object } { double-array float } ;
+HINTS: n/v { object array } { float double-array } ;
+HINTS: v+ { array array } { double-array double-array } ;
+HINTS: v- { array array } { double-array double-array } ;
+HINTS: v* { array array } { double-array double-array } ;
+HINTS: v/ { array array } { double-array double-array } ;
+HINTS: vmax { array array } { double-array double-array } ;
+HINTS: vmin { array array } { double-array double-array } ;
+HINTS: v. { array array } { double-array double-array } ;
+HINTS: norm-sq { array } { double-array } ;
+HINTS: norm { array } { double-array } ;
+HINTS: normalize { array } { double-array } ;
+HINTS: distance { array array } { double-array double-array } ;
+
+! Type functions
+USING: words classes.algebra compiler.tree.propagation.info
+math.intervals ;
+
+{ v+ v- v* v/ vmax vmin } [
+ [
+ [ class>> double-array class<= ] both?
+ double-array object ? <class-info>
+ ] "outputs" set-word-prop
+] each
+
+{ n*v n/v } [
+ [
+ nip class>> double-array class<= double-array object ? <class-info>
+ ] "outputs" set-word-prop
+] each
+
+{ v*n v/n } [
+ [
+ drop class>> double-array class<= double-array object ? <class-info>
+ ] "outputs" set-word-prop
+] each
+
+{ vneg normalize } [
+ [
+ class>> double-array class<= double-array object ? <class-info>
+ ] "outputs" set-word-prop
+] each
+
+\ norm-sq [
+ class>> double-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
+] "outputs" set-word-prop
+
+\ v. [
+ [ class>> double-array class<= ] both?
+ float object ? <class-info>
+] "outputs" set-word-prop
+
+\ distance [
+ [ class>> double-array class<= ] both?
+ [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
+] "outputs" set-word-prop
From e6cb449b1980f5d8770e2707b964e24bcab487bb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 10:44:21 -0600
Subject: [PATCH 2/6] optimized. now accepts method-specs
---
basis/compiler/tree/debugger/debugger.factor | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index e9bf77b188..8d764a2833 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -125,9 +125,13 @@ M: node node>quot drop ;
: nodes>quot ( node -- quot )
[ [ node>quot ] each ] [ ] make ;
-: optimized. ( quot/word -- )
- dup word? [ specialized-def ] when
- build-tree optimize-tree nodes>quot . ;
+GENERIC: optimized. ( quot/word -- )
+
+M: method-spec optimized. first2 method optimized. ;
+
+M: word optimized. specialized-def optimized. ;
+
+M: callable optimized. build-tree optimize-tree nodes>quot . ;
SYMBOL: words-called
SYMBOL: generics-called
From 378bedd1e037a872c13415cad4ad89635eec7cf3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 10:44:41 -0600
Subject: [PATCH 3/6] Faster mersenne-twister with specialized-arrays
---
.../mersenne-twister/mersenne-twister.factor | 42 +++++++++++--------
1 file changed, 24 insertions(+), 18 deletions(-)
diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor
index 5610ef18c2..90abec68a5 100644
--- a/basis/random/mersenne-twister/mersenne-twister.factor
+++ b/basis/random/mersenne-twister/mersenne-twister.factor
@@ -2,48 +2,54 @@
! See http://factorcode.org/license.txt for BSD license.
! mersenne twister based on
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: kernel math namespaces sequences system init
-accessors math.ranges random circular math.bitwise
-combinators specialized-arrays.uint ;
+USING: kernel math namespaces sequences sequences.private system
+init accessors math.ranges random math.bitwise combinators
+specialized-arrays.uint fry ;
IN: random.mersenne-twister
<PRIVATE
-TUPLE: mersenne-twister seq i ;
+TUPLE: mersenne-twister { seq uint-array } { i fixnum } ;
: mt-n 624 ; inline
: mt-m 397 ; inline
: mt-a HEX: 9908b0df ; inline
+: wrap-nth ( n seq -- obj )
+ [ length mod ] keep nth-unsafe ; inline
+
+: set-wrap-nth ( obj n seq -- )
+ [ length mod ] keep set-nth-unsafe ; inline
+
: calculate-y ( n seq -- y )
- [ nth 31 mask-bit ]
- [ [ 1+ ] [ nth ] bi* 31 bits ] 2bi bitor ; inline
+ [ wrap-nth 31 mask-bit ]
+ [ [ 1+ ] [ wrap-nth ] bi* 31 bits ] 2bi bitor ; inline
: (mt-generate) ( n seq -- next-mt )
[
calculate-y
[ 2/ ] [ odd? mt-a 0 ? ] bi bitxor
] [
- [ mt-m + ] [ nth ] bi*
- ] 2bi bitxor ;
+ [ mt-m + ] [ wrap-nth ] bi*
+ ] 2bi bitxor ; inline
: mt-generate ( mt -- )
[
- mt-n swap seq>> [
- [ (mt-generate) ] [ set-nth ] 2bi
- ] curry each
- ] [ 0 >>i drop ] bi ;
+ mt-n swap seq>> '[
+ _ [ (mt-generate) ] [ set-wrap-nth ] 2bi
+ ] each
+ ] [ 0 >>i drop ] bi ; inline
: init-mt-formula ( i seq -- f(seq[i]) )
- dupd nth dup -30 shift bitxor 1812433253 * + 1+ 32 bits ;
+ dupd wrap-nth dup -30 shift bitxor 1812433253 * + 1+ 32 bits ; inline
: init-mt-rest ( seq -- )
mt-n 1- swap [
- [ init-mt-formula ] [ [ 1+ ] dip set-nth ] 2bi
- ] curry each ;
+ [ init-mt-formula ] [ [ 1+ ] dip set-wrap-nth ] 2bi
+ ] curry each ; inline
: init-mt-seq ( seed -- seq )
- 32 bits mt-n <uint-array> <circular>
+ 32 bits mt-n <uint-array>
[ set-first ] [ init-mt-rest ] [ ] tri ;
: mt-temper ( y -- yt )
@@ -53,7 +59,7 @@ TUPLE: mersenne-twister seq i ;
dup -18 shift bitxor ; inline
: next-index ( mt -- i )
- dup i>> dup mt-n < [ nip ] [ drop mt-generate 0 ] if ;
+ dup i>> dup mt-n < [ nip ] [ drop mt-generate 0 ] if ; inline
PRIVATE>
@@ -66,7 +72,7 @@ M: mersenne-twister seed-random ( mt seed -- )
M: mersenne-twister random-32* ( mt -- r )
[ next-index ]
- [ seq>> nth mt-temper ]
+ [ seq>> wrap-nth mt-temper ]
[ [ 1+ ] change-i drop ] tri ;
USE: init
From 4c6af1cc9f370ffc65fe2323b84ca16b8bc3800d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 10:45:06 -0600
Subject: [PATCH 4/6] Use fry instead of curry
---
basis/random/mersenne-twister/mersenne-twister.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor
index 90abec68a5..3097eafd15 100644
--- a/basis/random/mersenne-twister/mersenne-twister.factor
+++ b/basis/random/mersenne-twister/mersenne-twister.factor
@@ -44,9 +44,9 @@ TUPLE: mersenne-twister { seq uint-array } { i fixnum } ;
dupd wrap-nth dup -30 shift bitxor 1812433253 * + 1+ 32 bits ; inline
: init-mt-rest ( seq -- )
- mt-n 1- swap [
- [ init-mt-formula ] [ [ 1+ ] dip set-wrap-nth ] 2bi
- ] curry each ; inline
+ mt-n 1- swap '[
+ _ [ init-mt-formula ] [ [ 1+ ] dip set-wrap-nth ] 2bi
+ ] each ; inline
: init-mt-seq ( seed -- seq )
32 bits mt-n <uint-array>
From 8956ee0cc55a41d4a880fcefde29a2d4cccbe7a0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 12:06:16 -0600
Subject: [PATCH 5/6] Fix struct-arrays help lint
---
basis/struct-arrays/struct-arrays-docs.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/struct-arrays/struct-arrays-docs.factor b/basis/struct-arrays/struct-arrays-docs.factor
index 4a198e723c..0a627f7538 100644
--- a/basis/struct-arrays/struct-arrays-docs.factor
+++ b/basis/struct-arrays/struct-arrays-docs.factor
@@ -7,11 +7,11 @@ $nl
"The " { $slot "underlying" } " slot holds a " { $link c-ptr } " with the raw data. This pointer can be passed to C functions." } ;
HELP: <struct-array>
-{ $values { "length" integer } { "c-type" string } }
+{ $values { "length" integer } { "c-type" string } { "struct-array" struct-array } }
{ $description "Creates a new array for holding values of the specified C type." } ;
HELP: <direct-struct-array>
-{ $values { "alien" c-ptr } { "length" integer } { "c-type" string } }
+{ $values { "alien" c-ptr } { "length" integer } { "c-type" string } { "struct-array" struct-array } }
{ $description "Creates a new array for holding values of the specified C type, backed by the memory at " { $snippet "alien" } "." } ;
ARTICLE: "struct-arrays" "C struct and union arrays"
From 9354207a5f29f2a7f13a715ad812a7ee4cbf7aff Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 12:51:26 -0600
Subject: [PATCH 6/6] Fix io.mmap.ushort
---
basis/io/mmap/ushort/ushort.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/io/mmap/ushort/ushort.factor b/basis/io/mmap/ushort/ushort.factor
index e0989aa9d4..6d5ac016cf 100644
--- a/basis/io/mmap/ushort/ushort.factor
+++ b/basis/io/mmap/ushort/ushort.factor
@@ -1,4 +1,4 @@
-USE: specialized-arrays.functor
-IN: specialized-arrays.ushort
+USING: io.mmap.functor specialized-arrays.direct.ushort ;
+IN: io.mmap.ushort
-<< "ushort" define-array >>
\ No newline at end of file
+<< "ushort" define-mapped-array >>
\ No newline at end of file