diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 87e981f362..874093ed40 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -350,14 +350,34 @@ def: dst use: src1 src2 literal: rep ; +PURE-INSN: ##horizontal-add-vector +def: dst/scalar-rep +use: src +literal: rep ; + +PURE-INSN: ##abs-vector +def: dst +use: src +literal: rep ; + PURE-INSN: ##sqrt-vector def: dst use: src literal: rep ; -PURE-INSN: ##horizontal-add-vector -def: dst/scalar-rep -use: src +PURE-INSN: ##and-vector +def: dst +use: src1 src2 +literal: rep ; + +PURE-INSN: ##or-vector +def: dst +use: src1 src2 +literal: rep ; + +PURE-INSN: ##xor-vector +def: dst +use: src1 src2 literal: rep ; ! Boxing and unboxing aliens diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index b9835827fa..d2f158f06d 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -164,7 +164,11 @@ IN: compiler.cfg.intrinsics { math.vectors.simd.intrinsics:(simd-v/) [ [ ^^div-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vmin) [ [ ^^min-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-vmax) [ [ ^^max-vector ] emit-binary-vector-op ] } - { math.vectors.simd.intrinsics:(simd-vsqrt) [ [ ^^sqrt-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vabs) [ [ ^^abs-vector ] emit-unary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vsqrt) [ [ ^^sqrt-vector ] emit-unary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vbitand) [ [ ^^and-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-broadcast) [ [ ^^broadcast-vector ] emit-unary-vector-op ] } { math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] } { math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] } diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor index 1186e6b41f..45d248f8f4 100644 --- a/basis/compiler/cfg/two-operand/two-operand.factor +++ b/basis/compiler/cfg/two-operand/two-operand.factor @@ -55,7 +55,10 @@ UNION: two-operand-insn ##saturated-mul-vector ##div-vector ##min-vector - ##max-vector ; + ##max-vector + ##and-vector + ##or-vector + ##xor-vector ; GENERIC: convert-two-operand* ( insn -- ) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index e7a2548eff..43d11b5d4f 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -180,6 +180,10 @@ CODEGEN: ##min-vector %min-vector CODEGEN: ##max-vector %max-vector CODEGEN: ##sqrt-vector %sqrt-vector CODEGEN: ##horizontal-add-vector %horizontal-add-vector +CODEGEN: ##abs-vector %abs-vector +CODEGEN: ##and-vector %and-vector +CODEGEN: ##or-vector %or-vector +CODEGEN: ##xor-vector %xor-vector CODEGEN: ##box-alien %box-alien CODEGEN: ##box-displaced-alien %box-displaced-alien CODEGEN: ##unbox-alien %unbox-alien diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor index db39985c94..fadb382398 100644 --- a/basis/compiler/tree/propagation/simd/simd.factor +++ b/basis/compiler/tree/propagation/simd/simd.factor @@ -13,7 +13,12 @@ IN: compiler.tree.propagation.simd (simd-v/) (simd-vmin) (simd-vmax) + (simd-sum) + (simd-vabs) (simd-vsqrt) + (simd-vbitand) + (simd-vbitor) + (simd-vbitxor) (simd-broadcast) (simd-gather-2) (simd-gather-4) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 6bc78836cd..2dbe724f0a 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -192,6 +192,10 @@ HOOK: %min-vector cpu ( dst src1 src2 rep -- ) HOOK: %max-vector cpu ( dst src1 src2 rep -- ) HOOK: %sqrt-vector cpu ( dst src rep -- ) HOOK: %horizontal-add-vector cpu ( dst src rep -- ) +HOOK: %abs-vector cpu ( dst src rep -- ) +HOOK: %and-vector cpu ( dst src1 src2 rep -- ) +HOOK: %or-vector cpu ( dst src1 src2 rep -- ) +HOOK: %xor-vector cpu ( dst src1 src2 rep -- ) HOOK: %broadcast-vector-reps cpu ( -- reps ) HOOK: %gather-vector-2-reps cpu ( -- reps ) @@ -208,6 +212,10 @@ HOOK: %min-vector-reps cpu ( -- reps ) HOOK: %max-vector-reps cpu ( -- reps ) HOOK: %sqrt-vector-reps cpu ( -- reps ) HOOK: %horizontal-add-vector-reps cpu ( -- reps ) +HOOK: %abs-vector-reps cpu ( -- reps ) +HOOK: %and-vector-reps cpu ( -- reps ) +HOOK: %or-vector-reps cpu ( -- reps ) +HOOK: %xor-vector-reps cpu ( -- reps ) HOOK: %unbox-alien cpu ( dst src -- ) HOOK: %unbox-any-c-ptr cpu ( dst src temp -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 4850403908..1a96e93c63 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -410,30 +410,63 @@ M: x86 %div-vector-reps M: x86 %min-vector ( dst src1 src2 rep -- ) { - { float-4-rep [ MINPS ] } - { double-2-rep [ MINPD ] } + { char-16-rep [ PMINSB ] } { uchar-16-rep [ PMINUB ] } { short-8-rep [ PMINSW ] } + { ushort-8-rep [ PMINUW ] } + { int-4-rep [ PMINSD ] } + { uint-4-rep [ PMINUD ] } + { float-4-rep [ MINPS ] } + { double-2-rep [ MINPD ] } } case drop ; M: x86 %min-vector-reps { { sse? { float-4-rep } } - { sse2? { double-2-rep short-8-rep uchar-16-rep } } + { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } } + { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } } } available-reps ; M: x86 %max-vector ( dst src1 src2 rep -- ) { - { float-4-rep [ MAXPS ] } - { double-2-rep [ MAXPD ] } + { char-16-rep [ PMAXSB ] } { uchar-16-rep [ PMAXUB ] } { short-8-rep [ PMAXSW ] } + { ushort-8-rep [ PMAXUW ] } + { int-4-rep [ PMAXSD ] } + { uint-4-rep [ PMAXUD ] } + { float-4-rep [ MAXPS ] } + { double-2-rep [ MAXPD ] } } case drop ; M: x86 %max-vector-reps { { sse? { float-4-rep } } - { sse2? { double-2-rep short-8-rep uchar-16-rep } } + { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } } + { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + +M: x86 %horizontal-add-vector ( dst src rep -- ) + { + { float-4-rep [ [ MOVAPS ] [ HADDPS ] [ HADDPS ] 2tri ] } + { double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] } + } case ; + +M: x86 %horizontal-add-vector-reps + { + { sse3? { float-4-rep double-2-rep } } + } available-reps ; + +M: x86 %abs-vector ( dst src rep -- ) + { + { char-16-rep [ PABSB ] } + { short-8-rep [ PABSW ] } + { int-4-rep [ PABSD ] } + } case ; + +M: x86 %abs-vector-reps + { + { ssse3? { char-16-rep short-8-rep int-4-rep } } } available-reps ; M: x86 %sqrt-vector ( dst src rep -- ) @@ -448,15 +481,58 @@ M: x86 %sqrt-vector-reps { sse2? { double-2-rep } } } available-reps ; -M: x86 %horizontal-add-vector ( dst src rep -- ) +M: x86 %and-vector ( dst src1 src2 rep -- ) { - { float-4-rep [ [ MOVAPS ] [ HADDPS ] [ HADDPS ] 2tri ] } - { double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] } - } case ; + { float-4-rep [ ANDPS ] } + { double-2-rep [ ANDPD ] } + { char-16-rep [ PAND ] } + { uchar-16-rep [ PAND ] } + { short-8-rep [ PAND ] } + { ushort-8-rep [ PAND ] } + { int-4-rep [ PAND ] } + { uint-4-rep [ PAND ] } + } case drop ; -M: x86 %horizontal-add-vector-reps +M: x86 %and-vector-reps { - { sse3? { float-4-rep double-2-rep } } + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + +M: x86 %or-vector ( dst src1 src2 rep -- ) + { + { float-4-rep [ ORPS ] } + { double-2-rep [ ORPD ] } + { char-16-rep [ POR ] } + { uchar-16-rep [ POR ] } + { short-8-rep [ POR ] } + { ushort-8-rep [ POR ] } + { int-4-rep [ POR ] } + { uint-4-rep [ POR ] } + } case drop ; + +M: x86 %or-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + +M: x86 %xor-vector ( dst src1 src2 rep -- ) + { + { float-4-rep [ XORPS ] } + { double-2-rep [ XORPD ] } + { char-16-rep [ PXOR ] } + { uchar-16-rep [ PXOR ] } + { short-8-rep [ PXOR ] } + { ushort-8-rep [ PXOR ] } + { int-4-rep [ PXOR ] } + { uint-4-rep [ PXOR ] } + } case drop ; + +M: x86 %xor-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } } available-reps ; M: x86 %unbox-alien ( dst src -- ) diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index 7d84b18225..e934a641c4 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -4,7 +4,8 @@ USING: accessors alien.c-types assocs byte-arrays classes effects fry functors generalizations kernel literals locals math math.functions math.vectors math.vectors.simd.intrinsics math.vectors.specialization parser prettyprint.custom sequences -sequences.private strings words definitions macros cpu.architecture ; +sequences.private strings words definitions macros cpu.architecture +namespaces arrays quotations ; QUALIFIED-WITH: math m IN: math.vectors.simd.functor @@ -38,24 +39,19 @@ MACRO: simd-boa ( rep class -- simd-array ) { "simd-vector" } ; : supported-simd-ops ( assoc rep -- assoc' ) - [ - { - { v+ (simd-v+) } - { vs+ (simd-vs+) } - { v+- (simd-v+-) } - { v- (simd-v-) } - { vs- (simd-vs-) } - { v* (simd-v*) } - { vs* (simd-vs*) } - { v/ (simd-v/) } - { vmin (simd-vmin) } - { vmax (simd-vmax) } - { sum (simd-sum) } - } - ] dip + [ simd-ops get ] dip '[ nip _ swap supported-simd-op? ] assoc-filter '[ drop _ key? ] assoc-filter ; +ERROR: bad-schema schema ; + +: low-level-ops ( box-quot: ( inputs... simd-op -- outputs... ) -- alist ) + [ simd-ops get ] dip '[ + 1quotation + over word-schema _ ?at [ bad-schema ] unless + [ ] 2sequence + ] assoc-map ; + :: high-level-ops ( ctor elt-class -- assoc ) ! Some SIMD operations are defined in terms of others. { @@ -82,11 +78,17 @@ MACRO: simd-boa ( rep class -- simd-array ) } append ] when ; -:: simd-vector-words ( class ctor rep assoc -- ) +:: simd-vector-words ( class ctor rep vv->v v->v v->n -- ) rep rep-component-type c-type-boxed-class :> elt-class class elt-class - assoc rep supported-simd-ops + { + { { +vector+ +vector+ -> +vector+ } vv->v } + { { +vector+ -> +vector+ } v->v } + { { +vector+ -> +scalar+ } v->n } + { { +vector+ -> +nonnegative+ } v->n } + } low-level-ops + rep supported-simd-ops ctor elt-class high-level-ops assoc-union specialize-vector-words ; @@ -116,6 +118,7 @@ SET-NTH [ T dup c-setter array-accessor ] A-rep [ A name>> "-rep" append "cpu.architecture" lookup ] A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op +A-v->v-op DEFINES-PRIVATE ${A}-v->v-op A-v->n-op DEFINES-PRIVATE ${A}-v->n-op WHERE @@ -172,23 +175,13 @@ INSTANCE: A sequence : A-vv->v-op ( v1 v2 quot -- v3 ) [ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline +: A-v->v-op ( v1 quot -- v2 ) + [ underlying>> A-rep ] dip call \ A boa ; inline + : A-v->n-op ( v quot -- n ) [ underlying>> A-rep ] dip call ; inline -\ A \ A-with \ A-rep H{ - { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } - { vs+ [ [ (simd-vs+) ] \ A-vv->v-op execute ] } - { v+- [ [ (simd-v+-) ] \ A-vv->v-op execute ] } - { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } - { vs- [ [ (simd-vs-) ] \ A-vv->v-op execute ] } - { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } - { vs* [ [ (simd-vs*) ] \ A-vv->v-op execute ] } - { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } - { vmin [ [ (simd-vmin) ] \ A-vv->v-op execute ] } - { vmax [ [ (simd-vmax) ] \ A-vv->v-op execute ] } - { sum [ [ (simd-sum) ] \ A-v->n-op execute ] } -} simd-vector-words - +\ A \ A-with \ A-rep \ A-vv->v-op \ A-v->v-op \ A-v->n-op simd-vector-words \ A \ A-rep define-simd-128-type PRIVATE> @@ -237,6 +230,7 @@ A-deref DEFINES-PRIVATE ${A}-deref A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ] A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op +A-v->v-op DEFINES-PRIVATE ${A}-v->v-op A-v->n-op DEFINES-PRIVATE ${A}-v->n-op WHERE @@ -302,24 +296,15 @@ INSTANCE: A sequence [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi \ A boa ; inline -: A-v->n-op ( v1 combine-quot reduce-quot -- v2 ) - [ [ [ underlying1>> ] [ underlying2>> ] bi A-rep ] dip call A-rep ] - dip call ; inline +: A-v->v-op ( v1 combine-quot -- v2 ) + [ [ underlying1>> A-rep ] dip call ] + [ [ underlying2>> A-rep ] dip call ] 2bi + \ A boa ; inline -\ A \ A-with \ A-rep H{ - { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } - { vs+ [ [ (simd-vs+) ] \ A-vv->v-op execute ] } - { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } - { vs- [ [ (simd-vs-) ] \ A-vv->v-op execute ] } - { v+- [ [ (simd-v+-) ] \ A-vv->v-op execute ] } - { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } - { vs* [ [ (simd-vs*) ] \ A-vv->v-op execute ] } - { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } - { vmin [ [ (simd-vmin) ] \ A-vv->v-op execute ] } - { vmax [ [ (simd-vmax) ] \ A-vv->v-op execute ] } - { sum [ [ (simd-v+) ] [ (simd-sum) ] \ A-v->n-op execute ] } -} simd-vector-words +: A-v->n-op ( v1 combine-quot -- v2 ) + [ [ underlying1>> ] [ underlying2>> ] bi A-rep (simd-v+) A-rep ] dip call ; inline +\ A \ A-with \ A-rep \ A-vv->v-op \ A-v->v-op \ A-v->n-op simd-vector-words \ A \ A-rep define-simd-256-type ;FUNCTOR diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 63214f7da6..2c1f76cfe1 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -2,23 +2,47 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.data assocs combinators cpu.architecture fry generalizations kernel libc macros math -sequences ; +sequences effects accessors namespaces lexer parser vocabs.parser +words arrays math.vectors ; IN: math.vectors.simd.intrinsics ERROR: bad-simd-call ; -: (simd-v+) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-v-) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-v+-) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vs+) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vs-) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vs*) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-v*) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-v/) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vmin) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vmax) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-vsqrt) ( v1 v2 rep -- v3 ) bad-simd-call ; -: (simd-sum) ( v1 rep -- v2 ) bad-simd-call ; +<< + +: simd-effect ( word -- effect ) + stack-effect [ in>> "rep" suffix ] [ out>> ] bi ; + +SYMBOL: simd-ops + +V{ } clone simd-ops set-global + +SYNTAX: SIMD-OP: + scan-word dup name>> "(simd-" ")" surround create-in + [ nip [ bad-simd-call ] define ] + [ [ simd-effect ] dip set-stack-effect ] + [ 2array simd-ops get push ] + 2tri ; + +>> + +SIMD-OP: v+ +SIMD-OP: v- +SIMD-OP: v+- +SIMD-OP: vs+ +SIMD-OP: vs- +SIMD-OP: vs* +SIMD-OP: v* +SIMD-OP: v/ +SIMD-OP: vmin +SIMD-OP: vmax +SIMD-OP: vsqrt +SIMD-OP: sum +SIMD-OP: vabs +SIMD-OP: vbitand +SIMD-OP: vbitor +SIMD-OP: vbitxor + : (simd-broadcast) ( x rep -- v ) bad-simd-call ; : (simd-gather-2) ( a b rep -- v ) bad-simd-call ; : (simd-gather-4) ( a b c d rep -- v ) bad-simd-call ; @@ -82,6 +106,10 @@ M: vector-rep supported-simd-op? { \ (simd-vmax) [ %max-vector-reps ] } { \ (simd-vsqrt) [ %sqrt-vector-reps ] } { \ (simd-sum) [ %horizontal-add-vector-reps ] } + { \ (simd-vabs) [ %abs-vector-reps ] } + { \ (simd-vbitand) [ %and-vector-reps ] } + { \ (simd-vbitor) [ %or-vector-reps ] } + { \ (simd-vbitxor) [ %xor-vector-reps ] } { \ (simd-broadcast) [ %broadcast-vector-reps ] } { \ (simd-gather-2) [ %gather-vector-2-reps ] } { \ (simd-gather-4) [ %gather-vector-4-reps ] } diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 007ec338cd..db8597fc9d 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -135,7 +135,7 @@ CONSTANT: simd-classes word '[ _ declare _ execute ] ; : remove-float-words ( alist -- alist' ) - [ drop { n/v v/n v/ normalize } member? not ] assoc-filter ; + [ drop { vsqrt n/v v/n v/ normalize } member? not ] assoc-filter ; : ops-to-check ( elt-class -- alist ) [ vector-words >alist ] dip @@ -242,3 +242,5 @@ STRUCT: simd-struct { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave ] compile-call ] unit-test + +[ ] [ char-16 new 1array stack. ] unit-test diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index 2fb36d428a..bf2dac29d6 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -72,6 +72,11 @@ H{ { vneg { +vector+ -> +vector+ } } { vtruncate { +vector+ -> +vector+ } } { sum { +vector+ -> +scalar+ } } + { vabs { +vector+ -> +vector+ } } + { vsqrt { +vector+ -> +vector+ } } + { vbitand { +vector+ +vector+ -> +vector+ } } + { vbitor { +vector+ +vector+ -> +vector+ } } + { vbitxor { +vector+ +vector+ -> +vector+ } } } PREDICATE: vector-word < word vector-words key? ; diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index ce635b6d60..67ac27400e 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -30,7 +30,10 @@ $nl "Saturated arithmetic may be performed on " { $link "specialized-arrays" } "; the results are clamped to the minimum and maximum bounds of the array element type, instead of wrapping around:" { $subsection vs+ } { $subsection vs- } -{ $subsection vs* } ; +{ $subsection vs* } +"Comparing vectors:" +{ $subsection distance } +{ $subsection v~ } ; ABOUT: "math-vectors" @@ -144,6 +147,10 @@ HELP: normalize { $values { "u" "a sequence of numbers, not all zero" } { "v" "a sequence of numbers" } } { $description "Outputs a vector with the same direction as " { $snippet "u" } " but length 1." } ; +HELP: distance +{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "x" "a non-negative real number" } } +{ $description "Outputs the Euclidean distance between two vectors." } ; + HELP: set-axis { $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "axis" "a sequence of 0/1" } { "w" "a sequence of numbers" } } { $description "Using " { $snippet "w" } " as a template, creates a new sequence containing corresponding elements from " { $snippet "u" } " in place of 0, and corresponding elements from " { $snippet "v" } " in place of 1." } diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 3a1b2875a9..eb97fba663 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -1,7 +1,8 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays alien.c-types kernel sequences math math.functions -hints math.order fry ; +hints math.order fry combinators ; +QUALIFIED-WITH: alien.c-types c IN: math.vectors GENERIC: element-type ( obj -- c-type ) @@ -31,13 +32,35 @@ GENERIC: element-type ( obj -- c-type ) [ [ not ] 2dip pick [ + ] [ - ] if ] 2map nip ; + + : vs+ ( u v -- w ) [ + ] 2saturate-map ; : vs- ( u v -- w ) [ - ] 2saturate-map ; : vs* ( u v -- w ) [ * ] 2saturate-map ; +: vabs ( u -- v ) [ abs ] map ; +: vsqrt ( u -- v ) [ sqrt ] map ; + +bits ] bi@ ] dip call bits>double ] } + { c:float [ [ [ float>bits ] bi@ ] dip call bits>float ] } + [ drop call ] + } case ; inline + +PRIVATE> + +: vbitand ( u v -- w ) over '[ _ [ bitand ] fp-bitwise-op ] 2map ; +: vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ; +: vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ; + : vfloor ( v -- _v_ ) [ floor ] map ; : vceiling ( v -- ^v^ ) [ ceiling ] map ; : vtruncate ( v -- -v- ) [ truncate ] map ;