From 102af9badb1a4d02a09521882710fc9b0282de67 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 19 Oct 2009 04:41:53 -0500 Subject: [PATCH] specialized-arrays, specialized-vectors: fix potential problem if two vocabularies define different C types with the same name --- basis/images/bitmap/bitmap.factor | 4 +-- basis/io/mmap/mmap-tests.factor | 3 ++- .../specialized-arrays-docs.factor | 2 +- .../specialized-arrays-tests.factor | 11 +++++--- .../specialized-arrays.factor | 24 +++++++++-------- .../specialized-vectors-docs.factor | 13 +++++++++ .../specialized-vectors-tests.factor | 3 +-- .../specialized-vectors.factor | 27 ++++++++++++++----- extra/random/cmwc/cmwc-tests.factor | 3 ++- extra/random/cmwc/cmwc.factor | 3 ++- .../lagged-fibonacci-tests.factor | 3 ++- 11 files changed, 65 insertions(+), 31 deletions(-) diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index f14dd3290c..fa12aaa320 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -6,8 +6,8 @@ images.loader images.normalization io io.binary io.encodings.binary io.encodings.string io.files io.streams.limited kernel locals macros math math.bitwise math.functions namespaces sequences specialized-arrays -specialized-arrays.instances.uint -specialized-arrays.instances.ushort strings summary ; +strings summary ; +SPECIALIZED-ARRAYS: uint ushort ; IN: images.bitmap SINGLETON: bmp-image diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index 94f8c77883..967009243e 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -1,7 +1,8 @@ USING: alien.c-types alien.data compiler.tree.debugger continuations io.directories io.encodings.ascii io.files io.files.temp io.mmap kernel math sequences sequences.private -specialized-arrays specialized-arrays.instances.uint tools.test ; +specialized-arrays tools.test ; +SPECIALIZED-ARRAY: uint IN: io.mmap.tests [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors diff --git a/basis/specialized-arrays/specialized-arrays-docs.factor b/basis/specialized-arrays/specialized-arrays-docs.factor index 50e94b65e9..68ce02e71e 100755 --- a/basis/specialized-arrays/specialized-arrays-docs.factor +++ b/basis/specialized-arrays/specialized-arrays-docs.factor @@ -86,7 +86,7 @@ ARTICLE: "specialized-array-examples" "Specialized array examples" ARTICLE: "specialized-arrays" "Specialized arrays" "The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing." $nl -"A specialized array type needs to be generated for each element type. This is done with a parsing word:" +"A specialized array type needs to be generated for each element type. This is done with parsing words:" { $subsections POSTPONE: SPECIALIZED-ARRAY: POSTPONE: SPECIALIZED-ARRAYS: diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 1ee8776085..3226557494 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -4,7 +4,7 @@ specialized-arrays.private sequences alien.c-types accessors kernel arrays combinators compiler compiler.units classes.struct combinators.smart compiler.tree.debugger math libc destructors sequences.private multiline eval words vocabs namespaces -assocs prettyprint alien.data math.vectors ; +assocs prettyprint alien.data math.vectors definitions ; FROM: alien.c-types => float ; SPECIALIZED-ARRAY: int @@ -120,9 +120,10 @@ SPECIALIZED-ARRAY: fixed-string [ "int-array@ f 100" ] [ f 100 unparse ] unit-test ! If the C type doesn't exist, don't generate a vocab +SYMBOL: __does_not_exist__ + [ ] [ - [ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit - "__does_not_exist__" c-types get delete-at + [ __does_not_exist__ specialized-array-vocab forget-vocab ] with-compilation-unit ] unit-test [ @@ -146,6 +147,8 @@ SPECIALIZED-ARRAY: __does_not_exist__ [ f ] [ "__does_not_exist__-array{" - "__does_not_exist__" specialized-array-vocab lookup + __does_not_exist__ specialized-array-vocab lookup deferred? ] unit-test + +[ \ __does_not_exist__ forget ] with-compilation-unit diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index c5de95b5b5..67c58987a1 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -6,7 +6,7 @@ libc math math.vectors math.vectors.private math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader vocabs.parser vocabs.generated -words fry combinators present ; +words fry combinators make ; IN: specialized-arrays MIXIN: specialized-array @@ -125,11 +125,13 @@ M: word (underlying-type) "c-type" word-prop ; [ drop ] } cond ; -: underlying-type-name ( c-type -- name ) - underlying-type present ; - : specialized-array-vocab ( c-type -- vocab ) - present "specialized-arrays.instances." prepend ; + [ + "specialized-arrays.instances." % + [ vocabulary>> % "." % ] + [ name>> % ] + bi + ] "" make ; PRIVATE> @@ -143,18 +145,18 @@ M: c-type-name require-c-array define-array-vocab drop ; ERROR: specialized-array-vocab-not-loaded c-type ; M: c-type-name c-array-constructor - underlying-type-name - dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: c-type-name c-(array)-constructor - underlying-type-name - dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: c-type-name c-direct-array-constructor - underlying-type-name - dup [ "" surround ] [ specialized-array-vocab ] bi lookup + underlying-type + dup [ name>> "" surround ] [ specialized-array-vocab ] bi lookup [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable SYNTAX: SPECIALIZED-ARRAYS: diff --git a/basis/specialized-vectors/specialized-vectors-docs.factor b/basis/specialized-vectors/specialized-vectors-docs.factor index 6b53885e13..e54f26ac57 100644 --- a/basis/specialized-vectors/specialized-vectors-docs.factor +++ b/basis/specialized-vectors/specialized-vectors-docs.factor @@ -6,6 +6,13 @@ HELP: SPECIALIZED-VECTOR: { $values { "type" "a C type" } } { $description "Brings a specialized vector for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ; +HELP: SPECIALIZED-VECTORS: +{ $syntax "SPECIALIZED-VECTORS: type type type ... ;" } +{ $values { "type" "a C type" } } +{ $description "Brings a set of specialized vectors for holding values of each " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ; + +{ POSTPONE: SPECIALIZED-VECTOR: POSTPONE: SPECIALIZED-VECTORS: } related-words + ARTICLE: "specialized-vector-words" "Specialized vector words" "The " { $link POSTPONE: SPECIALIZED-VECTOR: } " parsing word generates the specialized vector type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:" { $table @@ -21,6 +28,12 @@ ARTICLE: "specialized-vector-c" "Passing specialized vectors to C functions" ARTICLE: "specialized-vectors" "Specialized vectors" "The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing." +$nl +"A specialized vector type needs to be generated for each element type. This is done with parsing words:" +{ $subsections + POSTPONE: SPECIALIZED-VECTOR: + POSTPONE: SPECIALIZED-VECTORS: +} { $subsections "specialized-vector-words" "specialized-vector-c" diff --git a/basis/specialized-vectors/specialized-vectors-tests.factor b/basis/specialized-vectors/specialized-vectors-tests.factor index c7a045a7e1..1519ad415e 100644 --- a/basis/specialized-vectors/specialized-vectors-tests.factor +++ b/basis/specialized-vectors/specialized-vectors-tests.factor @@ -2,8 +2,7 @@ IN: specialized-vectors.tests USING: specialized-arrays specialized-vectors tools.test kernel sequences alien.c-types ; SPECIALIZED-ARRAY: float -SPECIALIZED-VECTOR: float -SPECIALIZED-VECTOR: double +SPECIALIZED-VECTORS: float double ; [ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 7cda026cb3..75197d9ec0 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types assocs compiler.units functors -growable kernel lexer namespaces parser prettyprint.custom -sequences specialized-arrays specialized-arrays.private strings -vocabs vocabs.parser vocabs.generated fry ; +USING: accessors alien.c-types alien.parser assocs +compiler.units functors growable kernel lexer namespaces parser +prettyprint.custom sequences specialized-arrays +specialized-arrays.private strings vocabs vocabs.parser +vocabs.generated fry make ; QUALIFIED: vectors.functor IN: specialized-vectors @@ -41,8 +42,13 @@ INSTANCE: V S ;FUNCTOR -: specialized-vector-vocab ( type -- vocab ) - "specialized-vectors.instances." prepend ; +: specialized-vector-vocab ( c-type -- vocab ) + [ + "specialized-vectors.instances." % + [ vocabulary>> % "." % ] + [ name>> % ] + bi + ] "" make ; PRIVATE> @@ -51,7 +57,14 @@ PRIVATE> [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi generate-vocab ; +SYNTAX: SPECIALIZED-VECTORS: + ";" parse-tokens [ + parse-c-type + [ define-array-vocab use-vocab ] + [ define-vector-vocab use-vocab ] bi + ] each ; + SYNTAX: SPECIALIZED-VECTOR: - scan + scan-c-type [ define-array-vocab use-vocab ] [ define-vector-vocab use-vocab ] bi ; diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor index 8dc9f8764f..d5e1fe6858 100644 --- a/extra/random/cmwc/cmwc-tests.factor +++ b/extra/random/cmwc/cmwc-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types arrays kernel random random.cmwc sequences -specialized-arrays specialized-arrays.instances.uint tools.test ; +specialized-arrays tools.test ; +SPECIALIZED-ARRAY: uint IN: random.cmwc.tests [ ] [ diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 941840f23a..3fda392d80 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types arrays fry kernel locals math math.bitwise random sequences sequences.private -specialized-arrays specialized-arrays.instances.uint ; +specialized-arrays ; +SPECIALIZED-ARRAY: uint IN: random.cmwc ! Multiply-with-carry RNG diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor b/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor index e830c466c2..df90d4d40f 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: fry kernel math.functions random random.lagged-fibonacci -sequences specialized-arrays.instances.double tools.test ; +sequences tools.test specialized-arrays alien.c-types ; +SPECIALIZED-ARRAY: double IN: random.lagged-fibonacci.tests [ t ] [