From 3a1bb22618147bf2dfa7cc9cf21ad5d6fb342b5e Mon Sep 17 00:00:00 2001 From: Joe Groff <arcata@gmail.com> Date: Wed, 7 Oct 2009 19:30:06 -0500 Subject: [PATCH 1/3] delete malloc-file-contents 'cause it sucks and nobody likes it --- basis/alien/data/data-docs.factor | 1 - basis/alien/data/data.factor | 4 +--- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor index 68d5022630..0536d15736 100644 --- a/basis/alien/data/data-docs.factor +++ b/basis/alien/data/data-docs.factor @@ -56,7 +56,6 @@ $nl { $subsections malloc-object malloc-byte-array - malloc-file-contents } "The " { $vocab-link "libc" } " vocabulary defines several words which directly call C standard library memory management functions:" { $subsections diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index 372f3e5f98..fc18921ef1 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -56,9 +56,6 @@ M: word <c-direct-array> : malloc-string ( string encoding -- alien ) string>alien malloc-byte-array ; -: malloc-file-contents ( path -- alien len ) - binary file-contents [ malloc-byte-array ] [ length ] bi ; - M: memory-stream stream-read [ [ index>> ] [ alien>> ] bi <displaced-alien> @@ -81,3 +78,4 @@ M: value-type c-type-setter ( type -- quot ) [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri '[ @ swap @ _ memcpy ] ; + From 5a2a99128bbc7ba7f54a0da4b03426dbb83bd91e Mon Sep 17 00:00:00 2001 From: Joe Groff <arcata@gmail.com> Date: Thu, 8 Oct 2009 11:34:20 -0500 Subject: [PATCH 2/3] add an "nspin" generalization --- basis/generalizations/generalizations-docs.factor | 7 +++++++ basis/generalizations/generalizations-tests.factor | 2 ++ basis/generalizations/generalizations.factor | 3 +++ 3 files changed, 12 insertions(+) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index e05d871323..e3a7c2d7e4 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -303,6 +303,12 @@ HELP: ntuck } { $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ; +HELP: nspin +{ $values + { "n" integer } +} +{ $description "A generalization of " { $link spin } " that can work for any stack depth. The top " { $snippet "n" } " items will be reversed in order." } ; + ARTICLE: "sequence-generalizations" "Generalized sequence operations" { $subsections narray @@ -321,6 +327,7 @@ ARTICLE: "shuffle-generalizations" "Generalized shuffle words" nnip ndrop ntuck + nspin mnswap nweave } ; diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index ec5c1ecc2d..f95ba63228 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -26,6 +26,8 @@ IN: generalizations.tests { 0 } [ 0 1 2 3 4 4 ndrop ] unit-test [ [ 1 ] 5 ndip ] must-infer [ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test +[ 5 nspin ] must-infer +[ 1 5 4 3 2 ] [ 1 2 3 4 5 4 nspin ] unit-test [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 03d4512196..a39d549d3b 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -104,3 +104,6 @@ MACRO: nbi-curry ( n -- ) [ narray concat ] dip like ; inline : nappend ( n -- seq ) narray concat ; inline + +MACRO: nspin ( n -- ) + [ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ; From 531cfa1c33d657fc28b45d2da7e72f59629f5ff5 Mon Sep 17 00:00:00 2001 From: Joe Groff <arcata@gmail.com> Date: Thu, 8 Oct 2009 11:35:40 -0500 Subject: [PATCH 3/3] refactor math.vectors.conversion --- .../math/vectors/conversion/conversion.factor | 31 +++++++++++++------ 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index 863cb9fea5..f70dfc9b27 100644 --- a/basis/math/vectors/conversion/conversion.factor +++ b/basis/math/vectors/conversion/conversion.factor @@ -39,32 +39,45 @@ ERROR: bad-vconvert-input value expected-type ; } cond [ from-type check-vconvert-type ] prepose ; -:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot ) - from-size to-size /i log2 :> steps - +:: check-vpack ( from-element to-element from-type to-type steps -- ) { [ steps 1 = not ] [ from-element to-element [ float-type? ] bi@ xor ] [ from-element unsigned-type? to-element unsigned-type? not and ] - } 0|| [ from-type to-type bad-vconvert ] when + } 0|| [ from-type to-type bad-vconvert ] when ; - to-element unsigned-type? [ to-type (vpack-unsigned) ] [ to-type (vpack-signed) ] ? - [ [ from-type check-vconvert-type ] bi@ ] prepose ; +:: [[vpack-unsigned]] ( from-type to-type -- quot ) + [ [ from-type check-vconvert-type ] bi@ to-type (vpack-unsigned) ] ; -:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot ) - to-size from-size /i log2 :> steps +:: [[vpack-signed]] ( from-type to-type -- quot ) + [ [ from-type check-vconvert-type ] bi@ to-type (vpack-signed) ] ; +:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot ) + from-size to-size /i log2 :> steps + + from-element to-element from-type to-type steps check-vpack + + from-type to-type to-element unsigned-type? + [ [[vpack-unsigned]] ] [ [[vpack-signed]] ] if ; + +:: check-vunpack ( from-element to-element from-type to-type steps -- ) { [ steps 1 = not ] [ from-element to-element [ float-type? ] bi@ xor ] [ from-element unsigned-type? not to-element unsigned-type? and ] - } 0|| [ from-type to-type bad-vconvert ] when + } 0|| [ from-type to-type bad-vconvert ] when ; +:: [[vunpack]] ( from-type to-type -- quot ) [ from-type check-vconvert-type [ to-type (vunpack-head) ] [ to-type (vunpack-tail) ] bi ] ; +:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot ) + to-size from-size /i log2 :> steps + from-element to-element from-type to-type steps check-vunpack + from-type to-type [[vunpack]] ; + PRIVATE> MACRO:: vconvert ( from-type to-type -- )