diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 9ffe4a6aa0..4b521725fe 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -55,7 +55,7 @@ GENERIC: emit-node ( node -- next ) : begin-word ( -- ) #! We store the basic block after the prologue as a loop - #! labelled by the current word, so that self-recursive + #! labeled by the current word, so that self-recursive #! calls can skip an epilogue/prologue. ##prologue ##branch diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index a5951a5080..eea30a3040 100755 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -85,10 +85,10 @@ image-link = "[[image:" link-content "|" link-content "]]" simple-link = "[[" link-content "]]" => [[ second >string dup simple-link-title link boa ]] -labelled-link = "[[" link-content "|" link-content "]]" +labeled-link = "[[" link-content "|" link-content "]]" => [[ [ second >string ] [ fourth >string ] bi link boa ]] -link = image-link | labelled-link | simple-link +link = image-link | labeled-link | simple-link escaped-char = "\" . => [[ second 1string ]] diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index c91edbae39..c3505ebec4 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io io.binary io.encodings.ascii io.encodings.binary io.encodings.string io.encodings.utf8 io.files kernel math math.bitwise math.order math.parser pack prettyprint sequences -strings math.vectors ; +strings math.vectors specialized-arrays.float ; IN: images.tiff TUPLE: tiff-image < image ; @@ -343,6 +343,27 @@ ERROR: unknown-component-order ifd ; [ unknown-component-order ] } case ; +: handle-alpha-data ( ifd -- ifd ) + dup extra-samples find-tag { + { extra-samples-associated-alpha-data [ + [ + B{ } like dup + byte-array>float-array + 4 + [ + dup fourth dup 0 = [ + 2drop + ] [ + [ 3 head-slice ] dip '[ _ / ] change-each + ] if + ] each + ] change-bitmap + ] } + { extra-samples-unspecified-alpha-data [ + ] } + [ bad-extra-samples ] + } case ; + : ifd>image ( ifd -- image ) { [ [ image-width find-tag ] [ image-length find-tag ] bi 2array ] @@ -364,6 +385,7 @@ ERROR: unknown-component-order ifd ; strips>bitmap fix-bitmap-endianness strips-predictor + dup extra-samples tag? [ handle-alpha-data ] when drop ] each ] with-endianness diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 01b389c19c..c7600a731f 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -57,6 +57,13 @@ HELP: with-system-random { with-random with-secure-random with-system-random } related-words +HELP: randomize +{ $values + { "seq" sequence } + { "seq" sequence } +} +{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ; + HELP: delete-random { $values { "seq" sequence } @@ -83,6 +90,8 @@ $nl { $subsection with-secure-random } "Implementation:" { $subsection "random-protocol" } +"Randomizing a sequence:" +{ $subsection randomize } "Deleting a random element from a sequence:" { $subsection delete-random } ; diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index e686dd7301..9607627b3d 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -1,5 +1,5 @@ USING: random sequences tools.test kernel math math.functions -sets ; +sets grouping random.private ; IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test @@ -17,3 +17,9 @@ IN: random.tests [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test [ f ] [ 0 random ] unit-test + +[ { } ] [ { } randomize ] unit-test +[ { 1 } ] [ { 1 } randomize ] unit-test + +[ f ] +[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test diff --git a/basis/random/random.factor b/basis/random/random.factor index e0ce59dc87..c277ef8dbc 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -52,8 +52,10 @@ PRIVATE> [ length random-integer ] keep nth ] if-empty ; -: randomize ( seq -- seq' ) - dup length 1 (a,b] [ dup random pick exchange ] each ; +: randomize ( seq -- seq ) + dup length [ dup 1 > ] + [ [ random ] [ 1- ] bi [ pick exchange ] keep ] + [ ] while drop ; : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ;