diff --git a/bindings-common.cabal b/bindings-common.cabal --- a/bindings-common.cabal +++ b/bindings-common.cabal @@ -2,21 +2,21 @@ name: bindings-common homepage: http://bitbucket.org/mauricio/bindings-common synopsis: - Preprocessor combinator library for low level FFI. + Preprocessor DSL for low level FFI. description: Packages named @bindings-*@ contain low level bindings to well known libraries, as a resource to be used by developers of higher level modules. This @bindings-common@ package provides @hsc2hs@ macros that allows writing code for such low level - bindings that is easy to read and maintain, while keeping names - and functionality as close as possible to the base library. - These macros can be used as a simple alternative to, say, - @c2hs@, or to @hsc2hs@ original macros. At this moment, there's - no good documentation on how to use them, so please - read the code for "Bindings.C" to understand how they work, or - just fill question\/sugestion reports in the bug tracking web - site. -version: 1.3.1 + bindings that is easy to write, read and maintain, while + keeping names and functionality as close as possible to the + base library. These macros can be used as a simple alternative + to, say, @c2hs@, or to @hsc2hs@ original macros. Bindings + for the standard C library are also provided, and its source + code shows how most macros are supposed to be used. More + examples and reference documentation can be found at project + homepage. +version: 1.3.2 license: BSD3 license-file: LICENSE maintainer: Maurício C. Antunes @@ -35,12 +35,15 @@ build-depends: base >=3 && <5 exposed-modules: Bindings.C + Bindings.C.Ctype Bindings.C.Errno + Bindings.C.Locale Bindings.C.Math Bindings.C.Signal Bindings.C.Stddef Bindings.C.Stdio Bindings.C.String Bindings.C.Time + Bindings.Utils cc-options: "-D_ISOC99_SOURCE" diff --git a/src/Bindings/C.hs b/src/Bindings/C.hs --- a/src/Bindings/C.hs +++ b/src/Bindings/C.hs @@ -1,15 +1,1 @@ -module Bindings.C ( - module Bindings.C.Errno, - module Bindings.C.Math, - module Bindings.C.Stddef, - module Bindings.C.Stdio, - module Bindings.C.String, - module Bindings.C.Time, - ) where -import Prelude () -import Bindings.C.Errno -import Bindings.C.Math -import Bindings.C.Stddef -import Bindings.C.Stdio -import Bindings.C.String -import Bindings.C.Time +module Bindings.C (module Bindings.C.Ctype,module Bindings.C.Errno,module Bindings.C.Locale,module Bindings.C.Math,module Bindings.C.Signal,module Bindings.C.Stddef,module Bindings.C.Stdio,module Bindings.C.String,module Bindings.C.Time) where {import Bindings.C.Ctype;import Bindings.C.Errno;import Bindings.C.Locale;import Bindings.C.Math;import Bindings.C.Signal;import Bindings.C.Stddef;import Bindings.C.Stdio;import Bindings.C.String;import Bindings.C.Time} diff --git a/src/Bindings/C/Ctype.hsc b/src/Bindings/C/Ctype.hsc new file mode 100644 --- /dev/null +++ b/src/Bindings/C/Ctype.hsc @@ -0,0 +1,23 @@ +#include +#include + +-- | + +module Bindings.C.Ctype where +#strict_import + +#ccall isalnum , CInt -> IO CInt +#ccall isalpha , CInt -> IO CInt +#ccall isblank , CInt -> IO CInt +#ccall iscntrl , CInt -> IO CInt +#ccall isdigit , CInt -> IO CInt +#ccall isgraph , CInt -> IO CInt +#ccall islower , CInt -> IO CInt +#ccall isprint , CInt -> IO CInt +#ccall ispunct , CInt -> IO CInt +#ccall isspace , CInt -> IO CInt +#ccall isupper , CInt -> IO CInt +#ccall isxdigit , CInt -> IO CInt +#ccall tolower , CInt -> IO CInt +#ccall toupper , CInt -> IO CInt + diff --git a/src/Bindings/C/Locale.hsc b/src/Bindings/C/Locale.hsc new file mode 100644 --- /dev/null +++ b/src/Bindings/C/Locale.hsc @@ -0,0 +1,45 @@ +#include +#include + +-- | + +module Bindings.C.Locale where +#strict_import + +#starttype struct lconv +#field currency_symbol , CString +#field decimal_point , CString +#field frac_digits , CChar +#field grouping , CString +#field int_curr_symbol , CString +#field int_frac_digits , CChar +#field int_n_cs_precedes , CChar +#field int_n_sep_by_space , CChar +#field int_n_sign_posn , CChar +#field int_p_cs_precedes , CChar +#field int_p_sep_by_space , CChar +#field int_p_sign_posn , CChar +#field mon_decimal_point , CString +#field mon_grouping , CString +#field mon_thousands_sep , CString +#field negative_sign , CString +#field n_cs_precedes , CChar +#field n_sep_by_space , CChar +#field n_sign_posn , CChar +#field positive_sign , CString +#field p_cs_precedes , CChar +#field p_sep_by_space , CChar +#field p_sign_posn , CChar +#field thousands_sep , CString +#stoptype + +#num LC_ALL +#num LC_COLLATE +#num LC_CTYPE +#num LC_MONETARY +#num LC_NUMERIC +#num LC_TIME + +#ccall localeconv , IO (Ptr ) +#ccall setlocale , CInt -> CString -> IO CString + diff --git a/src/Bindings/C/Time.hsc b/src/Bindings/C/Time.hsc --- a/src/Bindings/C/Time.hsc +++ b/src/Bindings/C/Time.hsc @@ -19,7 +19,6 @@ #stoptype #num CLOCKS_PER_SEC -#num TIMER_ABSTIME #ccall clock , IO CClock #ccall difftime , CTime -> CTime -> IO CDouble diff --git a/src/Bindings/Utils.hs b/src/Bindings/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Bindings/Utils.hs @@ -0,0 +1,27 @@ +module Bindings.Utils ( + cast666, + ) where +import Foreign + +-- | This is safe regarding use of memory. Enough space is +-- allocated to store both values, and the difference between +-- sizes, if any, is filled with zeros. The result is what you +-- would expect if you have a C pointer to the first value and +-- cast it to a pointer to the result. Of course, this can have +-- undesired effects if 'peek' implementation for +-- the result type does more than just reading memory. +-- +-- This function can be safely used with any datatype generated by +-- this package macro library. + +cast666 :: (Storable a, Storable b) => a -> b +cast666 = unsafePerformIO . genericCast + where + genericCast :: (Storable a, Storable b) => a -> IO b + genericCast v = return undefined >>= \r -> + let size = max (sizeOf v) (sizeOf r) in + allocaBytes size $ \p -> + pokeArray p (replicate size (0::Word8)) >> + poke (castPtr p) v >> + if False then return r else peek (castPtr p) + diff --git a/src/bindings.macros.h b/src/bindings.macros.h --- a/src/bindings.macros.h +++ b/src/bindings.macros.h @@ -1,3 +1,6 @@ +#ifndef __BINDINGS_MACROS_H__ +#define __BINDINGS_MACROS_H__ + #define hsc_strict_import(dummy) printf( \ "import Foreign.Ptr (Ptr,FunPtr,plusPtr)\n" \ "import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)\n" \ @@ -109,10 +112,23 @@ { \ int sign = (name)(-1)<0; \ size_t size = sizeof(name); \ - if (sign && size==sizeof(int)) printf("CInt\n"); \ - else printf("%s%zu\n",sign?"Int":"Word",8*size); \ + if (size==sizeof(int)) printf("%s",sign?"CInt":"CUInt"); \ + else if (size==sizeof(char)) printf("%s", \ + (char)(-1)<0?(sign?"CChar":"CUChar"):(sign?"CSChar":"CChar")); \ + else printf("%s%zu",sign?"Int":"Word",8*size); \ + printf("\n"); \ } \ +#define hsc_fractional_t(name) \ + printf("type ");bc_conid(# name);printf(" = "); \ + switch (sizeof(name)) \ + { \ + case sizeof(float): printf("CFloat");break; \ + case sizeof(double): printf("CDouble");break; \ + case sizeof(long double): printf("CLDouble");break; \ + } \ + printf("\n"); \ + #define hsc_opaque_t(name) \ printf("data ");bc_conid(# name); \ printf(" = "); \ @@ -209,4 +225,21 @@ } \ printf(" return ()\n"); \ } \ + +#define BC_INLINE_(name,ret) \ + ret inline_##name () {return name;} \ + +#define BC_INLINE0(name,ret) \ + ret inline_##name () {return name();} \ + +#define BC_INLINE1(name,t1,ret) \ + ret inline_##name (t1 v1) {return name(v1);} \ + +#define BC_INLINE2(name,t1,t2,ret) \ + ret inline_##name (t1 v1,t2 v2) {return name(v1,v2);} \ + +#define BC_INLINE4(name,t1,t2,t3,t4,ret) \ + ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4) {return name(v1,v2,v3,v4);} \ + +#endif /* __BINDINGS_MACROS_H__ */