From 713e71fd3c0662106cfb0d55bcc2e1fbf9f54a91 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 23:21:21 +1200 Subject: [PATCH 1/9] alien.inline: added define-c-function' and refactored existing words --- basis/alien/inline/inline.factor | 63 ++++++++++++++++++++++---------- 1 file changed, 44 insertions(+), 19 deletions(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 8e58071427..0ca67249da 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2009 Jeremy Hughes. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.inline.compiler alien.libraries -alien.parser arrays fry generalizations io.files io.files.info -io.files.temp kernel lexer math.order multiline namespaces -sequences system vocabs.loader vocabs.parser words ; +alien.parser arrays assocs effects fry generalizations grouping +io.files io.files.info io.files.temp kernel lexer math +math.order math.ranges multiline namespaces sequences splitting +strings system vocabs.loader vocabs.parser words ; IN: alien.inline params-return ( types effect -- params return ) + [ nip out>> first ] [ in>> zip ] 2bi ; + +: arg-list ( types -- params ) + CHAR: a swap length CHAR: a + [a,b] + [ 1string ] map ; + +: factorize-type ( str -- str' ) + "const-" ?head drop ; + +: cify-type ( str -- str' ) + { { CHAR: ~ CHAR: space } } substitute ; + +: factor-function ( function types effect -- ) + [ c-library get ] 3dip [ [ factorize-type ] map ] dip + types-effect>params-return factorize-type -roll make-function define-declared ; -: c-function-string ( return library function params -- str ) - [ nip ] dip - " " join "(" prepend ")" append 3array " " join +: prototype-string ( function types effect -- str ) + [ [ cify-type ] map ] dip + types-effect>params-return cify-type -rot + 2 group [ " " join "," append ] map " " join + "(" prepend ")" append 3array " " join library-is-c++ get [ "extern \"C\" " prepend ] when ; +: prototype-string' ( function types return -- str ) + [ dup arg-list ] prototype-string ; + +: append-function-body ( prototype-str -- str ) + " {\n" append parse-here append "\n}\n" append ; + + : library-path ( -- str ) "lib" c-library get library-suffix 3array concat temp-file ; @@ -53,10 +75,14 @@ PRIVATE> compile-library? [ compile-library ] when c-library get library-path "cdecl" add-library ; -: define-c-function ( return library function params -- ) - [ factor-function ] 4 nkeep c-function-string - " {\n" append parse-here append "\n}\n" append - c-strings get push ; +: define-c-function ( function types effect -- ) + [ factor-function ] 3keep prototype-string + append-function-body c-strings get push ; + +: define-c-function' ( function effect -- ) + [ in>> ] keep [ factor-function ] 3keep + out>> prototype-string' + append-function-body c-strings get push ; : define-c-link ( str -- ) "-l" prepend compiler-args get push ; @@ -82,7 +108,6 @@ SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ; SYNTAX: C-INCLUDE: scan define-c-include ; -SYNTAX: C-FUNCTION: - return-library-function-params define-c-function ; +SYNTAX: C-FUNCTION: function-types-effect define-c-function ; SYNTAX: ;C-LIBRARY compile-c-library ; From 8f8aa3051c02d30693ed81006941d132387226fe Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sat, 4 Jul 2009 11:28:31 +1200 Subject: [PATCH 2/9] alien.inline: factorize-type covers unsigned and long --- basis/alien/inline/inline.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 0ca67249da..ba540246b1 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -25,7 +25,9 @@ SYMBOL: c-strings [ 1string ] map ; : factorize-type ( str -- str' ) - "const-" ?head drop ; + "const-" ?head drop + "unsigned-" ?head [ "u" prepend ] when + "long-" ?head [ "long" prepend ] when ; : cify-type ( str -- str' ) { { CHAR: ~ CHAR: space } } substitute ; From f7ddd899c3e0fdadbe2701d8e8e668f11037cd5c Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:37:52 +1200 Subject: [PATCH 3/9] alien.inline: function-types-effect: fixed incorrect stack order --- basis/alien/inline/inline.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index ba540246b1..f9d7f06d88 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -15,7 +15,7 @@ SYMBOL: c-strings : function-types-effect ( -- function types effect ) scan scan swap ")" parse-tokens - [ "(" subseq? not ] filter parse-arglist ; + [ "(" subseq? not ] filter swap parse-arglist ; : types-effect>params-return ( types effect -- params return ) [ nip out>> first ] [ in>> zip ] 2bi ; From d2f6f99954c8434441aee0bc229cbd69c6b6b470 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:40:08 +1200 Subject: [PATCH 4/9] alien.inline: types->effect>params-return: fix for stack order and void return type --- basis/alien/inline/inline.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index f9d7f06d88..2b1e9dd186 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -18,7 +18,9 @@ SYMBOL: c-strings [ "(" subseq? not ] filter swap parse-arglist ; : types-effect>params-return ( types effect -- params return ) - [ nip out>> first ] [ in>> zip ] 2bi ; + [ in>> zip ] + [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ] + 2bi ; : arg-list ( types -- params ) CHAR: a swap length CHAR: a + [a,b] From 1a0a34fbfcb53f6ef0c1228a70d8b9b125036036 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:41:21 +1200 Subject: [PATCH 5/9] alien.inline: cify-type: fixed incorrect substitution --- basis/alien/inline/inline.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 2b1e9dd186..2500021247 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -32,7 +32,7 @@ SYMBOL: c-strings "long-" ?head [ "long" prepend ] when ; : cify-type ( str -- str' ) - { { CHAR: ~ CHAR: space } } substitute ; + { { CHAR: - CHAR: space } } substitute ; : factor-function ( function types effect -- ) [ c-library get ] 3dip [ [ factorize-type ] map ] dip From dd45949c508cacf527a22934d7dfdcfe21f3d507 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:42:35 +1200 Subject: [PATCH 6/9] alien.inline: prototype-string: fixed params --- basis/alien/inline/inline.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 2500021247..b71341ab6d 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -42,7 +42,7 @@ SYMBOL: c-strings : prototype-string ( function types effect -- str ) [ [ cify-type ] map ] dip types-effect>params-return cify-type -rot - 2 group [ " " join "," append ] map " " join + [ " " join ] map ", " join "(" prepend ")" append 3array " " join library-is-c++ get [ "extern \"C\" " prepend ] when ; From b2125884174c5b4ed2d462564adfe78da0c0f2d4 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:49:31 +1200 Subject: [PATCH 7/9] alien.inline: refactoring --- basis/alien/inline/inline.factor | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index b71341ab6d..29cc35fe27 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -34,10 +34,10 @@ SYMBOL: c-strings : cify-type ( str -- str' ) { { CHAR: - CHAR: space } } substitute ; -: factor-function ( function types effect -- ) +: factor-function ( function types effect -- word quot effect ) [ c-library get ] 3dip [ [ factorize-type ] map ] dip types-effect>params-return factorize-type -roll - make-function define-declared ; + concat make-function ; : prototype-string ( function types effect -- str ) [ [ cify-type ] map ] dip @@ -79,14 +79,12 @@ PRIVATE> compile-library? [ compile-library ] when c-library get library-path "cdecl" add-library ; -: define-c-function ( function types effect -- ) - [ factor-function ] 3keep prototype-string - append-function-body c-strings get push ; +: define-c-function ( function types effect -- prototype ) + [ factor-function define-declared ] 3keep prototype-string ; -: define-c-function' ( function effect -- ) - [ in>> ] keep [ factor-function ] 3keep - out>> prototype-string' - append-function-body c-strings get push ; +: define-c-function' ( function effect -- prototype ) + [ in>> ] keep [ factor-function define-declared ] 3keep + out>> prototype-string' ; : define-c-link ( str -- ) "-l" prepend compiler-args get push ; @@ -112,6 +110,8 @@ SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ; SYNTAX: C-INCLUDE: scan define-c-include ; -SYNTAX: C-FUNCTION: function-types-effect define-c-function ; +SYNTAX: C-FUNCTION: + function-types-effect define-c-function + append-function-body c-strings get push ; SYNTAX: ;C-LIBRARY compile-c-library ; From 3cd4bd81068c08648f2a5f3bde6b4935e660c552 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Sun, 5 Jul 2009 21:55:11 +1200 Subject: [PATCH 8/9] alien.inline: added annotate-effect word --- basis/alien/inline/inline.factor | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 29cc35fe27..7ae530a0a0 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -13,6 +13,14 @@ SYMBOL: library-is-c++ SYMBOL: compiler-args SYMBOL: c-strings +: annotate-effect ( types effect -- types effect' ) + [ in>> ] [ out>> ] bi [ + zip + [ over pointer-to-primitive? [ ">" prepend ] when ] + assoc-map unzip + ] dip ; + + : function-types-effect ( -- function types effect ) scan scan swap ")" parse-tokens [ "(" subseq? not ] filter swap parse-arglist ; @@ -35,7 +43,8 @@ SYMBOL: c-strings { { CHAR: - CHAR: space } } substitute ; : factor-function ( function types effect -- word quot effect ) - [ c-library get ] 3dip [ [ factorize-type ] map ] dip + annotate-effect [ c-library get ] 3dip + [ [ factorize-type ] map ] dip types-effect>params-return factorize-type -roll concat make-function ; From dbe19d8173f8a8be83dc7dda3e2d38d0ee8a6d03 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Mon, 6 Jul 2009 11:06:44 +1200 Subject: [PATCH 9/9] alien.inline: reverted refactoring --- basis/alien/inline/inline.factor | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 7ae530a0a0..9a9f2eb683 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -88,12 +88,14 @@ PRIVATE> compile-library? [ compile-library ] when c-library get library-path "cdecl" add-library ; -: define-c-function ( function types effect -- prototype ) - [ factor-function define-declared ] 3keep prototype-string ; +: define-c-function ( function types effect -- ) + [ factor-function define-declared ] 3keep prototype-string + append-function-body c-strings get push ; -: define-c-function' ( function effect -- prototype ) +: define-c-function' ( function effect -- ) [ in>> ] keep [ factor-function define-declared ] 3keep - out>> prototype-string' ; + out>> prototype-string' + append-function-body c-strings get push ; : define-c-link ( str -- ) "-l" prepend compiler-args get push ; @@ -120,7 +122,6 @@ SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ; SYNTAX: C-INCLUDE: scan define-c-include ; SYNTAX: C-FUNCTION: - function-types-effect define-c-function - append-function-body c-strings get push ; + function-types-effect define-c-function ; SYNTAX: ;C-LIBRARY compile-c-library ;