! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.structs byte-arrays
-classes.struct kernel libc math parser sequences sequences.private ;
+classes.struct kernel libc math parser sequences
+sequences.private words fry memoize compiler.units ;
IN: struct-arrays
: c-type-struct-class ( c-type -- class )
{ underlying c-ptr read-only }
{ length array-capacity read-only }
{ element-size array-capacity read-only }
-{ class read-only } ;
+{ class read-only }
+{ ctor read-only } ;
M: struct-array length length>> ; inline
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
[ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
M: struct-array nth-unsafe
- [ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline
+ [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
M: struct-array set-nth-unsafe
[ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
+: (struct-element-constructor) ( c-type -- word )
+ [
+ "struct-array-ctor" f <word>
+ [
+ swap dup struct-class?
+ [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
+ (( alien -- object )) define-inline
+ ] keep
+ ] with-compilation-unit ;
+
+! Foldable memo word. This is an optimization; by precompiling a
+! constructor for array elements, we avoid memory>struct's slow path.
+MEMO: struct-element-constructor ( c-type -- word )
+ (struct-element-constructor) ; foldable
+
+: <direct-struct-array> ( alien length c-type -- struct-array )
+ [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
+ tri struct-array boa ; inline
+
M: struct-array new-sequence
- [ element-size>> [ * (byte-array) ] 2keep ]
- [ class>> ] bi struct-array boa ; inline
+ [ element-size>> * (byte-array) ] [ length>> ] [ class>> ] tri
+ <direct-struct-array> ; inline
M: struct-array resize ( n seq -- newseq )
- [ [ element-size>> * ] [ underlying>> ] bi resize ]
- [ [ element-size>> ] [ class>> ] bi ] 2bi
- struct-array boa ;
+ [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
+ <direct-struct-array> ; inline
: <struct-array> ( length c-type -- struct-array )
- [ heap-size [ * <byte-array> ] 2keep ]
- [ c-type-struct-class ] bi struct-array boa ; inline
+ [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; inline
ERROR: bad-byte-array-length byte-array ;
: byte-array>struct-array ( byte-array c-type -- struct-array )
- [ heap-size [
+ [
+ heap-size
[ dup length ] dip /mod 0 =
[ drop bad-byte-array-length ] unless
- ] keep ] [ c-type-struct-class ] bi struct-array boa ; inline
-
-: <direct-struct-array> ( alien length c-type -- struct-array )
- [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
+ ] keep <direct-struct-array> ; inline
: malloc-struct-array ( length c-type -- struct-array )
[ heap-size calloc ] 2keep <direct-struct-array> ; inline
] when ;
: strip-destructors ( -- )
- "libc" vocab [
- "Stripping destructor debug code" show
- "vocab:tools/deploy/shaker/strip-destructors.factor"
+ "Stripping destructor debug code" show
+ "vocab:tools/deploy/shaker/strip-destructors.factor"
+ run-file ;
+
+: strip-struct-arrays ( -- )
+ "struct-arrays" vocab [
+ "Stripping dynamic struct array code" show
+ "vocab:tools/deploy/shaker/strip-struct-arrays.factor"
run-file
] when ;
: strip ( -- )
init-stripper
strip-libc
+ strip-struct-arrays
strip-destructors
strip-call
strip-cocoa
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-IN: tools.deploy.shaker.call
-
+USING: combinators.private kernel ;
IN: combinators
-USE: combinators.private
-: call-effect ( word effect -- ) call-effect-unsafe ; inline
+: call-effect ( word effect -- ) call-effect-unsafe ;
+
+: execute-effect ( word effect -- ) execute-effect-unsafe ;
+
+IN: compiler.tree.propagation.call-effect
+
+: call-effect-unsafe? ( quot effect -- ? ) 2drop t ; inline
-: execute-effect ( word effect -- ) execute-effect-unsafe ; inline
\ No newline at end of file
+: execute-effect-unsafe? ( word effect -- ? ) 2drop t ; inline
\ No newline at end of file
--- /dev/null
+USING: kernel stack-checker.transforms ;
+IN: struct-arrays
+
+: struct-element-constructor ( c-type -- word )
+ "Struct array usages must be compiled" throw ;
+
+<<
+
+\ struct-element-constructor [
+ (struct-element-constructor) [ ] curry
+] 1 define-transform
+
+>>
\ No newline at end of file
"The simplest combinators do not take an effect declaration. The compiler checks the stack effect at compile time, rejecting the program if this cannot be done:"
{ $subsection call }
{ $subsection execute }
-"The second set of combinators takes an effect declaration. The stack effect of the quotation or word is checked at runtime:"
+"The second set of combinators takes an effect declaration. Note that the opening parenthesis is actually part of the word name; these are parsing words, and they read a stack effect until the corresponding closing parenthesis. The stack effect of the quotation or word is then checked at runtime:"
{ $subsection POSTPONE: call( }
{ $subsection POSTPONE: execute( }
"The above are syntax sugar. The underlying words are a bit more verbose but allow non-constant effects to be passed in:"
HELP: call-effect
{ $values { "quot" quotation } { "effect" effect } }
-{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." }
+{ $examples
+ "The following two lines are equivalent:"
+ { $code
+ "call( a b -- c )"
+ "(( a b -- c )) call-effect"
+ }
+} ;
HELP: execute-effect
{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
+{ $examples
+ "The following two lines are equivalent:"
+ { $code
+ "execute( a b -- c )"
+ "(( a b -- c )) execute-effect"
+ }
+} ;
HELP: execute-effect-unsafe
{ $values { "word" word } { "effect" effect } }
HELP: execute(
{ $syntax "execute( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." }
+{ $examples
+ { $code
+ "IN: scratchpad"
+ ""
+ ": eat ( -- ) ; : sleep ( -- ) ; : hack ( -- ) ;"
+ "{ eat sleep hack } [ execute( -- ) ] each"
+ }
+} ;
{ POSTPONE: call( POSTPONE: execute( } related-words
projects / factor.git / commitdiff