From 7cf4e608e5709702cb64becec9b369d904676e3b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Aug 2009 21:49:25 -0500 Subject: [PATCH 1/2] alien: move code for supporting CONSTANT: foo 123 { "int" foo } C types into one place instead of the old scattershot approach --- basis/alien/arrays/arrays.factor | 9 ++++++--- basis/alien/c-types/c-types-tests.factor | 2 +- basis/alien/c-types/c-types.factor | 11 ----------- basis/alien/structs/fields/fields.factor | 2 +- basis/alien/structs/structs.factor | 1 - basis/stack-checker/alien/alien.factor | 9 +++------ 6 files changed, 11 insertions(+), 23 deletions(-) diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index fbf59e6f11..e56f151383 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.strings alien.c-types alien.accessors alien.structs arrays words sequences math kernel namespaces fry libc cpu.architecture -io.encodings.utf8 ; +io.encodings.utf8 accessors ; IN: alien.arrays UNION: value-type array struct-type ; @@ -13,7 +13,10 @@ M: array c-type-class drop object ; M: array c-type-boxed-class drop object ; -M: array heap-size unclip [ product ] [ heap-size ] bi* * ; +: array-length ( seq -- n ) + [ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ; + +M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ; M: array c-type-align first c-type-align ; @@ -31,7 +34,7 @@ M: array stack-size drop "void*" stack-size ; M: array c-type-boxer-quot unclip - [ product ] + [ array-length ] [ [ require-c-type-arrays ] keep ] bi* [ ] 2curry ; diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 0de26aad20..bfeff5f1de 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -4,7 +4,7 @@ IN: alien.c-types.tests CONSTANT: xyz 123 -[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test +[ 492 ] [ { "int" xyz } heap-size ] unit-test [ -1 ] [ -1 *char ] unit-test [ -1 ] [ -1 *short ] unit-test diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 400af25373..4c3c8d1668 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -326,17 +326,6 @@ M: long-long-type box-return ( type -- ) [ define-out ] tri ; -: expand-constants ( c-type -- c-type' ) - dup array? [ - unclip [ - [ - dup word? [ - def>> call( -- object ) - ] when - ] map - ] dip prefix - ] when ; - : malloc-file-contents ( path -- alien len ) binary file-contents [ malloc-byte-array ] [ length ] bi ; diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor index 7e2d4615b5..25c595b864 100644 --- a/basis/alien/structs/fields/fields.factor +++ b/basis/alien/structs/fields/fields.factor @@ -16,7 +16,7 @@ TUPLE: field-spec name offset type reader writer ; field-spec new 0 >>offset swap >>name - swap expand-constants >>type + swap >>type 3dup name>> swap reader-word >>reader 3dup name>> swap writer-word >>writer 2nip ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 85b55f2cbc..3cc4857ecb 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -58,7 +58,6 @@ M: struct-type stack-size [ define-field ] each ; : define-union ( name members -- ) - [ expand-constants ] map [ [ heap-size ] [ max ] map-reduce ] keep compute-struct-align f struct-type (define-struct) ; diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 0b135319ff..da559abd78 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -14,9 +14,6 @@ TUPLE: alien-indirect-params < alien-node-params ; TUPLE: alien-callback-params < alien-node-params quot xt ; -: pop-parameters ( -- seq ) - pop-literal nip [ expand-constants ] map ; - : param-prep-quot ( node -- quot ) parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ; @@ -31,7 +28,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; : infer-alien-invoke ( -- ) alien-invoke-params new ! Compile-time parameters - pop-parameters >>parameters + pop-literal nip >>parameters pop-literal nip >>function pop-literal nip >>library pop-literal nip >>return @@ -50,7 +47,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; alien-indirect-params new ! Compile-time parameters pop-literal nip >>abi - pop-parameters >>parameters + pop-literal nip >>parameters pop-literal nip >>return ! Quotation which coerces parameters to required types dup param-prep-quot [ dip ] curry infer-quot-here @@ -71,7 +68,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; alien-callback-params new pop-literal nip >>quot pop-literal nip >>abi - pop-parameters >>parameters + pop-literal nip >>parameters pop-literal nip >>return gensym >>xt dup callback-bottom From e85925153cc6812420b8a0a770a3e4fc0839a881 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 27 Aug 2009 21:51:08 -0500 Subject: [PATCH 2/2] deprecate C-STRUCT:, C-UNION:, and old-school struct accessors --- basis/alien/structs/fields/fields.factor | 4 ++-- basis/alien/structs/structs-docs.factor | 2 +- basis/alien/structs/structs.factor | 4 ++-- basis/alien/syntax/syntax-docs.factor | 4 +++- basis/alien/syntax/syntax.factor | 4 ++-- 5 files changed, 10 insertions(+), 8 deletions(-) diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor index 7e2d4615b5..f958847abd 100644 --- a/basis/alien/structs/fields/fields.factor +++ b/basis/alien/structs/fields/fields.factor @@ -7,10 +7,10 @@ IN: alien.structs.fields TUPLE: field-spec name offset type reader writer ; : reader-word ( class name vocab -- word ) - [ "-" glue ] dip create ; + [ "-" glue ] dip create dup make-deprecated ; : writer-word ( class name vocab -- word ) - [ [ swap "set-" % % "-" % % ] "" make ] dip create ; + [ [ swap "set-" % % "-" % % ] "" make ] dip create dup make-deprecated ; : ( struct-name vocab type field-name -- spec ) field-spec new diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor index c74fe22dfd..c2a7d43387 100644 --- a/basis/alien/structs/structs-docs.factor +++ b/basis/alien/structs/structs-docs.factor @@ -30,4 +30,4 @@ ARTICLE: "c-unions" "C unions" { $subsection POSTPONE: C-UNION: } "C union objects can be allocated by calling " { $link } " or " { $link malloc-object } "." $nl -"Arrays of C unions can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ; \ No newline at end of file +"Arrays of C unions can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 85b55f2cbc..fed3ce801b 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -55,12 +55,12 @@ M: struct-type stack-size [ struct-offsets ] keep [ [ type>> ] map compute-struct-align ] keep [ struct-type (define-struct) ] keep - [ define-field ] each ; + [ define-field ] each ; deprecated : define-union ( name members -- ) [ expand-constants ] map [ [ heap-size ] [ max ] map-reduce ] keep - compute-struct-align f struct-type (define-struct) ; + compute-struct-align f struct-type (define-struct) ; deprecated : offset-of ( field struct -- offset ) c-types get at fields>> diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index a3215cd8c6..c9e03724f5 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/basis/alien/syntax/syntax-docs.factor @@ -1,6 +1,6 @@ IN: alien.syntax USING: alien alien.c-types alien.parser alien.structs -help.markup help.syntax ; +classes.struct help.markup help.syntax ; HELP: DLL" { $syntax "DLL\" path\"" } @@ -55,12 +55,14 @@ HELP: TYPEDEF: { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ; HELP: C-STRUCT: +{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: STRUCT: } " word." } { $syntax "C-STRUCT: name pairs... ;" } { $values { "name" "a new C type name" } { "pairs" "C type / field name string pairs" } } { $description "Defines a C struct layout and accessor words." } { $notes "C type names are documented in " { $link "c-types-specs" } "." } ; HELP: C-UNION: +{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: UNION-STRUCT: } " word." } { $syntax "C-UNION: name members... ;" } { $values { "name" "a new C type name" } { "members" "a sequence of C types" } } { $description "Defines a new C type sized to fit its largest member." } diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index b70aa3557c..2b0270d5f5 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -22,10 +22,10 @@ SYNTAX: TYPEDEF: scan scan typedef ; SYNTAX: C-STRUCT: - scan current-vocab parse-definition define-struct ; + scan current-vocab parse-definition define-struct ; deprecated SYNTAX: C-UNION: - scan parse-definition define-union ; + scan parse-definition define-union ; deprecated SYNTAX: C-ENUM: ";" parse-tokens