From 84adb4cb553af4aebd0284b063cbde351aa92ead Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 31 Aug 2009 17:49:45 -0500
Subject: [PATCH] "struct-array-on" word to easily promote a struct over memory
 to a struct-array over the same memory. buff up the struct-arrays docs

---
 basis/struct-arrays/struct-arrays-docs.factor | 32 +++++++++++++++++--
 basis/struct-arrays/struct-arrays.factor      |  3 ++
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/basis/struct-arrays/struct-arrays-docs.factor b/basis/struct-arrays/struct-arrays-docs.factor
index 0a627f7538..7b49d6ef42 100644
--- a/basis/struct-arrays/struct-arrays-docs.factor
+++ b/basis/struct-arrays/struct-arrays-docs.factor
@@ -1,5 +1,5 @@
 IN: struct-arrays
-USING: help.markup help.syntax alien strings math ;
+USING: classes.struct help.markup help.syntax alien strings math multiline ;
 
 HELP: struct-array
 { $class-description "The class of C struct and union arrays."
@@ -14,10 +14,38 @@ HELP: <direct-struct-array>
 { $values { "alien" c-ptr } { "length" integer } { "c-type" string } { "struct-array" struct-array } }
 { $description "Creates a new array for holding values of the specified C type, backed by the memory at " { $snippet "alien" } "." } ;
 
+HELP: struct-array-on
+{ $value { "struct" struct } { "length" integer } }
+{ $description "Create a new array for holding values of " { $snippet "struct" } "'s C type, backed by the memory starting at " { $snippet "struct" } "'s address." }
+{ $examples
+"This word is useful with the FFI. When a C function has a pointer to a struct as its return type (or a C callback has a struct pointer as an argument type), Factor automatically wraps the pointer in a " { $link struct } " object. If the pointer actually references an array of objects, this word will convert the struct object to a struct array object:"
+{ $code <" USING: alien.syntax classes.struct struct-arrays ;
+IN: scratchpad
+
+STRUCT: zim { zang int } { zung int } ;
+
+FUNCTION: zim* zingle ( ) ; ! Returns a pointer to 20 zims
+
+zingle 20 struct-array-on "> }
+} ;
+
+HELP: struct-array{
+{ $syntax "struct-array{ class value value value ... }" }
+{ $description "Literal syntax for a " { $link struct-array } " containing structs of the given " { $link struct } " class." } ;
+
+HELP: struct-array@
+{ $syntax "struct-array@ class alien length" }
+{ $description "Literal syntax for a " { $link struct-array } " at a particular memory address. The prettyprinter uses this syntax when the memory backing a struct array object is invalid. This syntax should not generally be used in source code." } ;
+
+{ POSTPONE: struct-array{ POSTPONE: struct-array@ } related-words
+
 ARTICLE: "struct-arrays" "C struct and union arrays"
 "The " { $vocab-link "struct-arrays" } " vocabulary implements arrays specialized for holding C struct and union values."
 { $subsection struct-array }
 { $subsection <struct-array> }
-{ $subsection <direct-struct-array> } ;
+{ $subsection <direct-struct-array> }
+{ $subsection struct-array-on }
+"Struct arrays have literal syntax:"
+{ $subsection POSTPONE: struct-array{ } ;
 
 ABOUT: "struct-arrays"
diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor
index 3f8cba56e2..a378754590 100755
--- a/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@ -49,6 +49,9 @@ ERROR: bad-byte-array-length byte-array ;
 : <direct-struct-array> ( alien length c-type -- struct-array )
     [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
 
+: struct-array-on ( struct length -- struct-array )
+    [ [ >c-ptr ] [ class ] bi ] dip swap <direct-struct-array> ; inline    
+
 : malloc-struct-array ( length c-type -- struct-array )
     [ heap-size calloc ] 2keep <direct-struct-array> ; inline