Merge branch 'master' of git://factorcode.org/git/factor into bleeding_edge

db4
Jon Harper 2009-10-01 20:25:48 +09:00
commit 2dafa24383
26 changed files with 366 additions and 95 deletions

View File

@ -44,6 +44,9 @@ M: word test-cfg
nl
] each ;
: test-mr. ( quot -- )
test-mr mr. ; inline
! Prettyprinting
: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
@ -79,4 +82,4 @@ M: rs-loc pprint* \ R pprint-loc ;
[ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ]
bi [ suffix ] when*
] map concat
] map concat >hashtable representations set ;
] map concat >hashtable representations set ;

View File

@ -404,12 +404,12 @@ literal: rep ;
PURE-INSN: ##shl-vector
def: dst
use: src1 src2/scalar-rep
use: src1 src2/int-scalar-rep
literal: rep ;
PURE-INSN: ##shr-vector
def: dst
use: src1 src2/scalar-rep
use: src1 src2/int-scalar-rep
literal: rep ;
! Scalar/vector conversion

View File

@ -74,7 +74,9 @@ MACRO: if-literals-match ( quots -- )
: shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ;
: emit-shuffle-vector ( node -- )
[ ^^shuffle-vector ] [unary/param]
! Pad the permutation with zeroes if its too short, since we
! can't throw an error at this point.
[ [ rep-components 0 pad-tail ] keep ^^shuffle-vector ] [unary/param]
{ [ shuffle? ] [ representation? ] } if-literals-match ;
: ^^broadcast-vector ( src n rep -- dst )

View File

@ -386,24 +386,24 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-cl
"end" resolve-label
] with-scope ;
M: ppc %alien-unsigned-1 0 LBZ ;
M: ppc %alien-unsigned-2 0 LHZ ;
M: ppc %alien-unsigned-1 LBZ ;
M: ppc %alien-unsigned-2 LHZ ;
M: ppc %alien-signed-1 dupd 0 LBZ dup EXTSB ;
M: ppc %alien-signed-2 0 LHA ;
M: ppc %alien-signed-1 [ dup ] 2dip LBZ dup EXTSB ;
M: ppc %alien-signed-2 LHA ;
M: ppc %alien-cell 0 LWZ ;
M: ppc %alien-cell LWZ ;
M: ppc %alien-float 0 LFS ;
M: ppc %alien-double 0 LFD ;
M: ppc %alien-float LFS ;
M: ppc %alien-double LFD ;
M: ppc %set-alien-integer-1 swap 0 STB ;
M: ppc %set-alien-integer-2 swap 0 STH ;
M: ppc %set-alien-integer-1 swapd STB ;
M: ppc %set-alien-integer-2 swapd STH ;
M: ppc %set-alien-cell swap 0 STW ;
M: ppc %set-alien-cell swapd STW ;
M: ppc %set-alien-float swap 0 STFS ;
M: ppc %set-alien-double swap 0 STFD ;
M: ppc %set-alien-float swapd STFS ;
M: ppc %set-alien-double swapd STFD ;
: load-zone-ptr ( reg -- )
"nursery" %load-vm-field-addr ;

View File

@ -317,13 +317,19 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
: %alien-unsigned-getter ( dst src offset size -- )
[ MOVZX ] %alien-integer-getter ; inline
: %alien-signed-getter ( dst src offset size -- )
[ MOVSX ] %alien-integer-getter ; inline
:: %alien-integer-setter ( ptr offset value size -- )
value { ptr } size [| new-value |
new-value value int-rep %copy
ptr offset [+] new-value size n-bit-version-of MOV
] with-small-register ; inline
M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
: %alien-signed-getter ( dst src offset size -- )
[ MOVSX ] %alien-integer-getter ; inline
M: x86 %alien-signed-1 8 %alien-signed-getter ;
M: x86 %alien-signed-2 16 %alien-signed-getter ;
M: x86 %alien-signed-4 32 %alien-signed-getter ;
@ -333,12 +339,6 @@ M: x86 %alien-float [+] MOVSS ;
M: x86 %alien-double [+] MOVSD ;
M: x86 %alien-vector [ [+] ] dip %copy ;
:: %alien-integer-setter ( ptr offset value size -- )
value { ptr } size [| new-value |
new-value value int-rep %copy
ptr offset [+] new-value size n-bit-version-of MOV
] with-small-register ; inline
M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
@ -1045,8 +1045,20 @@ M: x86 %shr-vector-reps
: scalar-sized-reg ( reg rep -- reg' )
rep-size 8 * n-bit-version-of ;
M: x86 %integer>scalar scalar-sized-reg MOVD ;
M: x86 %scalar>integer swap [ scalar-sized-reg ] dip MOVD ;
M: x86 %integer>scalar drop MOVD ;
M:: x86 %scalar>integer ( dst src rep -- )
rep {
{ int-scalar-rep [
dst 32-bit-version-of src MOVD
dst dst 32-bit-version-of
2dup eq? [ 2drop ] [ MOVSX ] if
] }
{ uint-scalar-rep [
dst 32-bit-version-of src MOVD
] }
} case ;
M: x86 %vector>scalar %copy ;
M: x86 %scalar>vector %copy ;

View File

@ -181,20 +181,22 @@ M: word link-long-text
: >topic ( obj -- topic ) dup topic? [ >link ] unless ;
: topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline
PRIVATE>
: ($link) ( topic -- ) >topic link-text ;
: ($link) ( topic -- ) [ link-text ] topic-span ;
: $link ( element -- ) first ($link) ;
: ($long-link) ( topic -- ) >topic link-long-text ;
: ($long-link) ( topic -- ) [ link-long-text ] topic-span ;
: $long-link ( element -- ) first ($long-link) ;
: ($pretty-link) ( topic -- )
>topic [ link-icon ] [ drop bl ] [ link-text ] tri ;
[ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ;
: $pretty-link ( element -- ) first ($pretty-link) ;
: ($long-pretty-link) ( topic -- )
>topic [ link-icon ] [ drop bl ] [ link-long-text ] tri ;
[ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ;
: <$pretty-link> ( definition -- element )
1array \ $pretty-link prefix ;

View File

@ -6,7 +6,7 @@ tools.test vocabs assocs compiler.cfg.debugger words
locals math.vectors.specialization combinators cpu.architecture
math.vectors.simd.intrinsics namespaces byte-arrays alien
specialized-arrays classes.struct eval classes.algebra sets
quotations math.constants ;
quotations math.constants compiler.units ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
SIMD: c:char
@ -216,12 +216,27 @@ simd-classes&reps [
[ int-4{ 256 512 1024 2048 } ]
[ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
[ int-4{ 256 512 1024 2048 } ]
[ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
[ int-4{ 1 2 4 8 } ]
[ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
[ int-4{ 1 2 4 8 } ]
[ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
[ int-4{ 1 2 4 8 } ]
[ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
! Invalid inputs should not cause the compiler to throw errors
[ ] [
[ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
] unit-test
[ ] [
[ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
] unit-test
! Shuffles
: shuffles-for ( n -- shuffles )
{
@ -278,6 +293,7 @@ simd-classes [
[ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
[ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
[ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
[ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
[ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
@ -313,6 +329,9 @@ simd-classes [
[ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
[ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
! Make sure we use the fallback in the correct situations
[ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
"== Checking alien operations" print
[ float-4{ 1 2 3 4 } ] [

View File

@ -14,7 +14,7 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ +literal+ ;
{ +vector+ [ drop ] }
{ +scalar+ [ nip ] }
{ +nonnegative+ [ nip ] }
{ +literal+ [ 2drop object ] }
{ +literal+ [ 2drop f ] }
} case
] with with map ;
@ -136,7 +136,7 @@ ERROR: bad-vector-word word ;
[ { } ]
} cond
! Don't specialize horizontal shifts or shuffles at all, they're only for SIMD
{ hlshift hrshift vshuffle } diff
{ hlshift hrshift vshuffle vbroadcast } diff
nip ;
:: specialize-vector-words ( array-type elt-type simd -- )
@ -147,13 +147,16 @@ ERROR: bad-vector-word word ;
tri add-specialization
] each ;
: specialization-matches? ( value-infos signature -- ? )
[ [ [ class>> ] dip class<= ] [ literal?>> ] if* ] 2all? ;
: find-specialization ( classes word -- word/f )
specializations
[ first [ class<= ] 2all? ] with find
[ first specialization-matches? ] with find
swap [ second ] when ;
: vector-word-custom-inlining ( #call -- word/f )
[ in-d>> [ value-info class>> ] map ] [ word>> ] bi
[ in-d>> [ value-info ] map ] [ word>> ] bi
find-specialization ;
vector-words keys [

View File

@ -1,10 +1,21 @@
USING: help.markup help.syntax math math.functions sequences ;
IN: math.vectors
ARTICLE: "math-vectors" "Vector arithmetic"
"Any Factor sequence can be used to represent a mathematical vector, however for best performance, the sequences defined by the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "math.vectors.simd" } " vocabularies should be used."
$nl
"Acting on vectors by a scalar:"
ARTICLE: "math-vectors-arithmetic" "Vector arithmetic"
"Vector/vector binary operations:"
{ $subsection v+ }
{ $subsection v- }
{ $subsection v+- }
{ $subsection v* }
{ $subsection v/ }
"Vector unary operations:"
{ $subsection vneg }
{ $subsection vabs }
{ $subsection vsqrt }
{ $subsection vfloor }
{ $subsection vceiling }
{ $subsection vtruncate }
"Vector/scalar and scalar/vector binary operations:"
{ $subsection vneg }
{ $subsection v*n }
{ $subsection n*v }
@ -14,24 +25,21 @@ $nl
{ $subsection n+v }
{ $subsection v-n }
{ $subsection n-v }
"Vector unary operations:"
{ $subsection vneg }
{ $subsection vabs }
{ $subsection vsqrt }
{ $subsection vfloor }
{ $subsection vceiling }
{ $subsection vtruncate }
"Vector/vector binary operations:"
{ $subsection v+ }
{ $subsection v- }
{ $subsection v+- }
{ $subsection v* }
{ $subsection v/ }
"Saturated arithmetic (only on " { $link "specialized-arrays" } "):"
{ $subsection vs+ }
{ $subsection vs- }
{ $subsection vs* }
"Componentwise vector operations:"
"Inner product and norm:"
{ $subsection v. }
{ $subsection norm }
{ $subsection norm-sq }
{ $subsection normalize }
"Comparing entire vectors:"
{ $subsection distance }
{ $subsection v~ } ;
ARTICLE: "math-vectors-logic" "Vector componentwise logic"
"Element comparisons:"
{ $subsection v< }
{ $subsection v<= }
{ $subsection v= }
@ -40,6 +48,8 @@ $nl
{ $subsection vunordered? }
{ $subsection vmax }
{ $subsection vmin }
{ $subsection vsupremum }
{ $subsection vinfimum }
"Bitwise operations:"
{ $subsection vbitand }
{ $subsection vbitandn }
@ -47,31 +57,29 @@ $nl
{ $subsection vbitxor }
{ $subsection vlshift }
{ $subsection vrshift }
"Componentwise logical operations:"
"Element logical operations:"
{ $subsection vand }
{ $subsection vor }
{ $subsection vxor }
{ $subsection vmask }
{ $subsection v? }
"Shuffling:"
{ $subsection vshuffle }
"Inner product and norm:"
{ $subsection v. }
{ $subsection norm }
{ $subsection norm-sq }
{ $subsection normalize }
"Comparing entire vectors:"
{ $subsection distance }
{ $subsection v~ }
"Other functions:"
{ $subsection vsupremum }
{ $subsection vinfimum }
"Element shuffling:"
{ $subsection vshuffle } ;
ARTICLE: "math-vectors-misc" "Miscellaneous vector functions"
{ $subsection trilerp }
{ $subsection bilerp }
{ $subsection vlerp }
{ $subsection vnlerp }
{ $subsection vbilerp } ;
ARTICLE: "math-vectors" "Vector operations"
"Any Factor sequence can be used to represent a mathematical vector, however for best performance, the sequences defined by the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "math.vectors.simd" } " vocabularies should be used."
{ $subsection "math-vectors-arithmetic" }
{ $subsection "math-vectors-logic" }
{ $subsection "math-vectors-misc" } ;
ABOUT: "math-vectors"
HELP: vneg

View File

@ -0,0 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: random random.dummy tools.test ;
IN: random.dummy.tests
[ 10 ] [ 10 <random-dummy> random-32* ] unit-test
[ 100 ] [ 10 <random-dummy> 100 seed-random random-32* ] unit-test

View File

@ -4,8 +4,8 @@ IN: random.dummy
TUPLE: random-dummy i ;
C: <random-dummy> random-dummy
M: random-dummy seed-random ( seed obj -- )
(>>i) ;
M: random-dummy seed-random ( obj seed -- obj )
>>i ;
M: random-dummy random-32* ( obj -- r )
[ dup 1 + ] change-i drop ;

View File

@ -27,3 +27,9 @@ IN: random.mersenne-twister.tests
[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test
[ t ]
[
1234 <mersenne-twister>
[ random-32* ] [ 1234 seed-random random-32* ] bi =
] unit-test

View File

@ -62,15 +62,21 @@ PRIVATE>
init-mt-seq 0 mersenne-twister boa
dup mt-generate ;
M: mersenne-twister seed-random ( mt seed -- )
init-mt-seq >>seq drop ;
M: mersenne-twister seed-random ( mt seed -- mt' )
init-mt-seq >>seq
[ mt-generate ]
[ 0 >>i drop ]
[ ] tri ;
M: mersenne-twister random-32* ( mt -- r )
[ next-index ]
[ seq>> nth-unsafe mt-temper ]
[ [ 1 + ] change-i drop ] tri ;
[
: default-mersenne-twister ( -- mersenne-twister )
[ 32 random-bits ] with-system-random
<mersenne-twister> random-generator set-global
<mersenne-twister> ;
[
default-mersenne-twister random-generator set-global
] "bootstrap.random" add-init-hook

View File

@ -2,8 +2,12 @@ USING: help.markup help.syntax math kernel sequences ;
IN: random
HELP: seed-random
{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } }
{ $description "Seed the random number generator." }
{ $values
{ "tuple" "a random number generator" }
{ "seed" "a seed specific to the random number generator" }
{ "tuple'" "a random number generator" }
}
{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." }
{ $notes "Not supported on all random number generators." } ;
HELP: random-32*
@ -29,6 +33,10 @@ HELP: random
"heads" }
} ;
HELP: random-32
{ $values { "n" "a 32-bit random integer" } }
{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ;
HELP: random-bytes
{ $values { "n" "an integer" } { "byte-array" "a random integer" } }
{ $description "Outputs an integer with n bytes worth of bits." }
@ -104,6 +112,8 @@ $nl
$nl
"Generate a random object:"
{ $subsection random }
"Efficient 32-bit random numbers:"
{ $subsection random-32 }
"Combinators to change the random number generator:"
{ $subsection with-random }
{ $subsection with-system-random }

View File

@ -10,7 +10,7 @@ SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator
GENERIC: seed-random ( tuple seed -- )
GENERIC# seed-random 1 ( tuple seed -- tuple' )
GENERIC: random-32* ( tuple -- r )
GENERIC: random-bytes* ( n tuple -- byte-array )
@ -55,6 +55,8 @@ PRIVATE>
[ length random-integer ] keep nth
] if-empty ;
: random-32 ( -- n ) random-generator get random-32* ;
: randomize ( seq -- seq )
dup length [ dup 1 > ]
[ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ]

View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax unix.types unix.stat classes.struct ;
USING: alien.c-types alien.syntax unix.types classes.struct
unix.stat ;
IN: unix.statfs.openbsd
CONSTANT: MFSNAMELEN 16
@ -30,4 +31,4 @@ STRUCT: statfs
{ f_mntfromname { char MNAMELEN } }
{ mount_info char[160] } ;
FUNCTION: int statfs ( char* path, statvfs* buf ) ;
FUNCTION: int statfs ( char* path, statfs* buf ) ;

View File

@ -37,13 +37,13 @@ TUPLE: test-implementation x ;
C: <test-implementation> test-implementation
{
{ "IInherited" {
{ IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
{ "IUnrelated" {
{ IUnrelated {
[ swap x>> + ] ! IUnrelated::xPlus
[ spin x>> * + ] ! IUnrelated::xMulAdd
} }
@ -85,7 +85,7 @@ dup +test-wrapper+ set [
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
"void*" heap-size +guinea-pig-implementation+ get <displaced-alien>
void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface

View File

@ -52,13 +52,13 @@ unless
swap GUID memory>struct
_ case
[
"void*" heap-size * rot <displaced-alien> com-add-ref
void* heap-size * rot <displaced-alien> com-add-ref
swap 0 set-alien-cell S_OK
] [ nip f swap 0 set-alien-cell E_NOINTERFACE ] if*
] ;
: (make-add-ref) ( interfaces -- quot )
length "void*" heap-size * '[
length void* heap-size * '[
_
[ alien-unsigned-4 1 + dup ]
[ set-alien-unsigned-4 ]
@ -66,7 +66,7 @@ unless
] ;
: (make-release) ( interfaces -- quot )
length "void*" heap-size * '[
length void* heap-size * '[
_
[ drop ]
[ alien-unsigned-4 1 - dup ]
@ -84,7 +84,7 @@ unless
: (thunk) ( n -- quot )
dup 0 =
[ drop [ ] ]
[ "void*" heap-size neg * '[ _ swap <displaced-alien> ] ]
[ void* heap-size neg * '[ _ swap <displaced-alien> ] ]
if ;
: (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
@ -97,15 +97,15 @@ unless
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
with-compilation-unit ;
: (callback-word) ( function-name interface-name counter -- word )
[ "::" rot 3append "-callback-" ] dip number>string 3append
: (callback-word) ( function-name interface counter -- word )
[ name>> "::" rot 3append "-callback-" ] dip number>string 3append
"windows.com.wrapper.callbacks" create ;
: (finish-thunk) ( param-count thunk quot -- thunked-quot )
[ [ drop [ ] ] [ swap 1 - '[ _ _ ndip ] ] if-empty ]
dip compose ;
: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
: (make-interface-callbacks) ( interface quots iunknown-methods n -- words )
(thunk) (thunked-quots)
swap [ find-com-interface-definition family-tree-functions ]
keep (next-vtbl-counter) '[
@ -128,8 +128,8 @@ unless
curry map-index ;
: (malloc-wrapped-object) ( wrapper -- wrapped-object )
vtbls>> length "void*" heap-size *
[ "ulong" heap-size + malloc ] keep
vtbls>> length void* heap-size *
[ ulong heap-size + malloc ] keep
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
: (callbacks>vtbl) ( callbacks -- vtbl )

View File

@ -20,15 +20,39 @@ HELP: checksum-stream
HELP: checksum-bytes
{ $values { "bytes" "a sequence of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a sequence." } ;
{ $contract "Computes the checksum of all data in a sequence." }
{ $examples
{ $example
"USING: checksums checksums.crc32 prettyprint ;"
"B{ 1 10 100 } crc32 checksum-bytes ."
"B{ 78 179 254 238 }"
}
} ;
HELP: checksum-lines
{ $values { "lines" "a sequence of sequences of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a sequence." } ;
{ $contract "Computes the checksum of all data in a sequence." }
{ $examples
{ $example
"USING: checksums checksums.crc32 prettyprint ;"
"""{
"Take me out to the ball game"
"Take me out with the crowd"
} crc32 checksum-lines ."""
"B{ 111 205 9 27 }"
}
} ;
HELP: checksum-file
{ $values { "path" "a pathname specifier" } { "checksum" "a checksum specifier" } { "value" byte-array } }
{ $contract "Computes the checksum of all data in a file." } ;
{ $contract "Computes the checksum of all data in a file." }
{ $examples
{ $example
"USING: checksums checksums.crc32 prettyprint ;"
""""resource:license.txt" crc32 checksum-file ."""
"B{ 100 139 199 92 }"
}
} ;
ARTICLE: "checksums" "Checksums"
"A " { $emphasis "checksum" } " is a function mapping sequences of bytes to fixed-length strings. While checksums are not one-to-one, a good checksum should have a low probability of collision. Additionally, some checksum algorithms are designed to be hard to reverse, in the sense that finding an input string which hashes to a given checksum string requires a brute-force search."

View File

@ -0,0 +1,23 @@
USING: kernel locals math math.matrices math.order math.vectors
prettyprint sequences ;
IN: benchmark.3d-matrix-scalar
:: p-matrix ( dim fov near far -- matrix )
dim dup first2 min v/n fov v*n near v*n
near far frustum-matrix4 ;
:: mv-matrix ( pitch yaw location -- matrix )
{ 1.0 0.0 0.0 } pitch rotation-matrix4
{ 0.0 1.0 0.0 } yaw rotation-matrix4
location vneg translation-matrix4 m. m. ;
:: 3d-matrix ( -- )
f :> result!
100000 [
{ 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix :> p
3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix :> mv
mv p m. result!
] times
result . ;
MAIN: 3d-matrix

View File

@ -0,0 +1,28 @@
USING: kernel locals math math.matrices.simd math.order math.vectors
math.vectors.simd prettyprint sequences typed ;
QUALIFIED-WITH: alien.c-types c
SIMD: c:float
IN: benchmark.3d-matrix-vector
: v2min ( xy -- xx )
dup { 1 0 2 3 } vshuffle vmin ; inline
TYPED:: p-matrix ( dim: float-4 fov: float near: float far: float -- matrix: matrix4 )
dim dup v2min v/ fov v*n near v*n
near far frustum-matrix4 ;
TYPED:: mv-matrix ( pitch: float yaw: float location: float-4 -- matrix: matrix4 )
float-4{ 1.0 0.0 0.0 0.0 } pitch rotation-matrix4
float-4{ 0.0 1.0 0.0 0.0 } yaw rotation-matrix4
location vneg translation-matrix4 m4. m4. ;
:: 3d-matrix ( -- )
f :> result!
100000 [
float-4{ 1024.0 768.0 0.0 0.0 } 0.7 0.25 1024.0 p-matrix :> p
3.0 1.0 float-4{ 10.0 -0.0 2.0 0.0 } mv-matrix :> mv
mv p m4. result!
] times
result . ;
MAIN: 3d-matrix

View File

@ -0,0 +1,24 @@
USING: locals math math.combinatorics math.matrices
prettyprint sequences typed ;
IN: benchmark.matrix-exponential-scalar
:: e^m ( m iterations -- e^m )
{
{ 0.0 0.0 0.0 0.0 }
{ 0.0 0.0 0.0 0.0 }
{ 0.0 0.0 0.0 0.0 }
{ 0.0 0.0 0.0 0.0 }
}
iterations iota [| i |
m i m^n i factorial >float m/n m+
] each ;
:: matrix-e ( -- )
f :> result!
4 identity-matrix :> i4
10000 [
i4 20 e^m result!
] times
result . ;
MAIN: matrix-e

View File

@ -0,0 +1,18 @@
USING: locals math math.combinatorics math.matrices.simd
prettyprint sequences typed ;
IN: benchmark.matrix-exponential-simd
TYPED:: e^m4 ( m: matrix4 iterations: fixnum -- e^m: matrix4 )
zero-matrix4
iterations iota [| i |
m i m4^n i factorial >float m4/n m4+
] each ;
:: matrix-e ( -- )
f :> result!
10000 [
identity-matrix4 20 e^m4 result!
] times
result . ;
MAIN: matrix-e

View File

@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: accessors classes.struct generalizations kernel locals
math math.functions math.matrices.simd math.vectors
math math.combinatorics math.functions math.matrices.simd math.vectors
math.vectors.simd sequences sequences.private specialized-arrays
typed ;
QUALIFIED-WITH: alien.c-types c
@ -105,6 +105,19 @@ CONSTANT: identity-matrix4
}
}
CONSTANT: zero-matrix4
S{ matrix4 f
float-4-array{
float-4{ 0.0 0.0 0.0 0.0 }
float-4{ 0.0 0.0 0.0 0.0 }
float-4{ 0.0 0.0 0.0 0.0 }
float-4{ 0.0 0.0 0.0 0.0 }
}
}
TYPED:: m4^n ( m: matrix4 n: fixnum -- m^n: matrix4 )
identity-matrix4 n [ m m4. ] times ;
TYPED:: scale-matrix4 ( factors: float-4 -- matrix: matrix4 )
matrix4 (struct) :> c

View File

@ -0,0 +1,58 @@
! Copyright (C) 2009 Jon Harper.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math math.combinatorics math.functions
math.parser math.primes namespaces project-euler.common
sequences sets strings grouping math.ranges arrays ;
IN: project-euler.051
SYMBOL: family-count
SYMBOL: large-families
: reset-globals ( -- )
H{ } clone family-count set
H{ } clone large-families set ;
: append-or-create ( value seq/f -- seq )
dup [ swap suffix ] [ drop 1array ] if ;
: append-at ( value key assoc -- )
[ at append-or-create ] 2keep set-at ;
: digits-positions ( str -- positions )
H{ } clone swap over [ swapd append-at ] curry each-index ;
: *-if-index ( char combination index -- char )
member? [ drop CHAR: * ] when ;
: replace-positions-with-* ( str positions -- str )
[ *-if-index ] curry map-index ;
: all-size-combinations ( seq -- combinations )
dup length [1,b] [ all-combinations ] with map concat ;
: families ( stra -- seq )
dup digits-positions values
[ all-size-combinations [ replace-positions-with-* ] with map ] with map concat ;
: save-family ( family -- )
family-count get dupd at 8 = [ large-families get conjoin ] [ drop ] if ;
: increment-family ( family -- )
family-count get dupd at* [ 1 + ] [ drop 1 ] if swap family-count get set-at ;
: handle-family ( family -- )
[ increment-family ] [ save-family ] bi ;
! Test all primes that have length n
: n-digits-primes ( n -- primes )
[ 1 - 10^ ] [ 10^ ] bi primes-between ;
: test-n-digits-primes ( n -- seq )
reset-globals
n-digits-primes
[ number>string families [ handle-family ] each ] each
large-families get ;
: fill-*-with-ones ( str -- str )
[ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
! recursively test all primes by length until we find an answer
: (euler051) ( i -- answer )
dup test-n-digits-primes
dup assoc-size 0 >
[ nip values [ fill-*-with-ones string>number ] map infimum ]
[ drop 1 + (euler051) ] if ;
: euler051 ( -- answer )
2 (euler051) ;

View File

@ -4,5 +4,7 @@ IN: typed.debugger
: typed-test-mr ( word -- mrs )
"typed-word" word-prop test-mr ; inline
: typed-test-mr. ( word -- )
"typed-word" word-prop test-mr mr. ; inline
: typed-optimized. ( word -- )
"typed-word" word-prop optimized. ; inline