diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,4 @@ +- 0.5.3.0: Recognize more standard library types. See pull request #19. - 0.5.2.1: Convert `signed char` to `CSChar`. See pull request #18. - 0.5.2.0: Make `bs-ptr` use `char` instead of `unsigned char`. See issue #16. diff --git a/inline-c.cabal b/inline-c.cabal --- a/inline-c.cabal +++ b/inline-c.cabal @@ -1,5 +1,5 @@ name: inline-c -version: 0.5.2.1 +version: 0.5.3.0 synopsis: Write Haskell source files including C code inline. No FFI required. description: See . license: MIT diff --git a/src/Language/C/Inline/Context.hs b/src/Language/C/Inline/Context.hs --- a/src/Language/C/Inline/Context.hs +++ b/src/Language/C/Inline/Context.hs @@ -3,6 +3,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -47,10 +48,12 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified Data.Map as Map +import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid ((<>)) import Data.Typeable (Typeable) import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable.Mutable as VM +import Data.Word (Word8, Word16, Word32, Word64) import Foreign.C.Types import Foreign.Ptr (Ptr, FunPtr) import Foreign.Storable (Storable) @@ -167,6 +170,10 @@ baseTypesTable :: Map.Map C.TypeSpecifier TH.TypeQ baseTypesTable = Map.fromList [ (C.Void, [t| () |]) + -- Types from Foreign.C.Types in the order in which they are presented there, + -- along with its documentation's section headers. + -- + -- Integral types , (C.Char Nothing, [t| CChar |]) , (C.Char (Just C.Signed), [t| CSChar |]) , (C.Char (Just C.Unsigned), [t| CUChar |]) @@ -176,10 +183,39 @@ , (C.Int C.Unsigned, [t| CUInt |]) , (C.Long C.Signed, [t| CLong |]) , (C.Long C.Unsigned, [t| CULong |]) + , (C.TypeName "ptrdiff_t", [t| CPtrdiff |]) + , (C.TypeName "size_t", [t| CSize |]) + , (C.TypeName "wchar_t", [t| CWchar |]) + , (C.TypeName "sig_atomic_t", [t| CSigAtomic |]) , (C.LLong C.Signed, [t| CLLong |]) , (C.LLong C.Unsigned, [t| CULLong |]) + , (C.TypeName "intptr_t", [t| CIntPtr |]) + , (C.TypeName "uintptr_t", [t| CUIntPtr |]) + , (C.TypeName "intmax_t", [t| CIntMax |]) + , (C.TypeName "uintmax_t", [t| CUIntMax |]) + -- Numeric types + , (C.TypeName "clock_t", [t| CClock |]) + , (C.TypeName "time_t", [t| CTime |]) + , (C.TypeName "useconds_t", [t| CUSeconds |]) + , (C.TypeName "suseconds_t", [t| CSUSeconds |]) + -- Floating types , (C.Float, [t| CFloat |]) , (C.Double, [t| CDouble |]) + -- Other types + , (C.TypeName "FILE", [t| CFile |]) + , (C.TypeName "fpos_t", [t| CFpos |]) + , (C.TypeName "jmp_buf", [t| CJmpBuf |]) + -- Types from stdint.h that can be statically mapped to their Haskell + -- equivalents. Excludes int_fast*_t and int_least*_t and the corresponding + -- unsigned types, since their sizes are platform-specific. + , (C.TypeName "int8_t", [t| Int8 |]) + , (C.TypeName "int16_t", [t| Int16 |]) + , (C.TypeName "int32_t", [t| Int32 |]) + , (C.TypeName "int64_t", [t| Int64 |]) + , (C.TypeName "uint8_t", [t| Word8 |]) + , (C.TypeName "uint16_t", [t| Word16 |]) + , (C.TypeName "uint32_t", [t| Word32 |]) + , (C.TypeName "uint64_t", [t| Word64 |]) ] -- | An alias for 'Ptr'. diff --git a/test/Language/C/Inline/ContextSpec.hs b/test/Language/C/Inline/ContextSpec.hs --- a/test/Language/C/Inline/ContextSpec.hs +++ b/test/Language/C/Inline/ContextSpec.hs @@ -9,6 +9,7 @@ module Language.C.Inline.ContextSpec (spec) where import Control.Monad.Trans.Class (lift) +import Data.Word import qualified Test.Hspec as Hspec import Text.Parser.Char import Text.Parser.Combinators @@ -31,6 +32,12 @@ shouldBeType (cty "char") [t| CChar |] Hspec.it "converts void" $ do shouldBeType (cty "void") [t| () |] + Hspec.it "converts standard library types (1)" $ do + shouldBeType (cty "FILE") [t| CFile |] + Hspec.it "converts standard library types (2)" $ do + shouldBeType (cty "uint16_t") [t| Word16 |] + Hspec.it "converts standard library types (3)" $ do + shouldBeType (cty "jmp_buf") [t| CJmpBuf |] Hspec.it "converts single ptr type" $ do shouldBeType (cty "long*") [t| Ptr CLong |] Hspec.it "converts double ptr type" $ do @@ -72,7 +79,7 @@ [t| CArray (Ptr (FunPtr (CInt -> IO (Ptr (CArray (Ptr CChar)))))) |] where goodConvert cTy = do - mbHsTy <- TH.runQ $ convertType IO (ctxTypesTable baseCtx) cTy + mbHsTy <- TH.runQ $ convertType IO baseTypes cTy case mbHsTy of Nothing -> error $ "Could not convert type (goodConvert)" Just hsTy -> return hsTy @@ -83,8 +90,10 @@ x `Hspec.shouldBe` y assertParse p s = - case C.runCParser (const False) "spec" s (lift spaces *> p <* lift eof) of + case C.runCParser (isTypeName baseTypes) "spec" s (lift spaces *> p <* lift eof) of Left err -> error $ "Parse error (assertParse): " ++ show err Right x -> x cty s = C.parameterDeclarationType $ assertParse C.parseParameterDeclaration s + + baseTypes = ctxTypesTable baseCtx diff --git a/test/tests.c b/test/tests.c --- a/test/tests.c +++ b/test/tests.c @@ -1,6 +1,10 @@ #include +#include + +#include + #include @@ -41,37 +45,62 @@ } -int inline_c_6_71dfd9b850f6e2091e021139a58b74df94cd7303(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +ptrdiff_t inline_c_6_205199db60839b9d17460a63202ca3a0d6589aa2(ptrdiff_t x_inline_c_0) { + char a[2]; return &a[1] - &a[0] + x_inline_c_0; +} + + +size_t inline_c_7_5640bf10f132d090b52c2634f9fa93226d58c551() { +return ( sizeof (char) ); +} + + +uintmax_t inline_c_8_da095360497f4bbf3922f50d0b0548c2dd7cbed9() { +return ( UINTMAX_MAX ); +} + + +int16_t inline_c_9_23a275cc563910c289d0dbf8e770ede22fe97bbb(int16_t x_inline_c_0) { +return ( 1 + x_inline_c_0 ); +} + + +uint32_t inline_c_10_02eb7fd8875e35241b9f7b725499139c4289aeab(uint32_t y_inline_c_0) { +return ( y_inline_c_0 * 7 ); +} + + +int inline_c_11_71dfd9b850f6e2091e021139a58b74df94cd7303(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int (* inline_c_7_7e6957a671db751a0a5b5e9721b3c45002fab68f())(int , int ) { +int (* inline_c_12_7e6957a671db751a0a5b5e9721b3c45002fab68f())(int , int ) { return ( &francescos_add ); } -int inline_c_8_b58cd0af8a50791fe277023774ffe88ee7e037bd(int (* ackermann__inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_13_b58cd0af8a50791fe277023774ffe88ee7e037bd(int (* ackermann__inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermann__inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int inline_c_9_71dfd9b850f6e2091e021139a58b74df94cd7303(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_14_71dfd9b850f6e2091e021139a58b74df94cd7303(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -int inline_c_10_8ef64f450bca60833a113574529facc22cb4a0a0(int (* ackermann_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { +int inline_c_15_8ef64f450bca60833a113574529facc22cb4a0a0(int (* ackermann_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { return ( ackermann_inline_c_0(x_inline_c_1, y_inline_c_2) ); } -double inline_c_11_05403b76080812d04e00ce2b31b2068dad1b2342(double (* fun_inline_c_0)(double )) { +double inline_c_16_05403b76080812d04e00ce2b31b2068dad1b2342(double (* fun_inline_c_0)(double )) { return ( fun_inline_c_0(3.0) ); } -int inline_c_12_963ff572b13b7aaee0f9f8092a567eb35a8c2088(int n_inline_c_0, int * ptr_inline_c_1) { +int inline_c_17_963ff572b13b7aaee0f9f8092a567eb35a8c2088(int n_inline_c_0, int * ptr_inline_c_1) { int i; int x = 0; @@ -83,7 +112,7 @@ } -int inline_c_13_e2ee2f14cc17b81ea1e818bb96b23439a1810c23(long vec_inline_c_0, int * vec_inline_c_1) { +int inline_c_18_e2ee2f14cc17b81ea1e818bb96b23439a1810c23(long vec_inline_c_0, int * vec_inline_c_1) { int i; int x = 0; @@ -95,7 +124,7 @@ } -int inline_c_14_17d13d6f2f87c2401476aaf41e06593689723baf(long bs_inline_c_0, char * bs_inline_c_1) { +int inline_c_19_17d13d6f2f87c2401476aaf41e06593689723baf(long bs_inline_c_0, char * bs_inline_c_1) { int i, bits = 0; for (i = 0; i < bs_inline_c_0; i++) { diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -22,6 +22,8 @@ C.context (C.baseCtx <> C.funCtx <> C.vecCtx <> C.bsCtx) C.include "" +C.include "" +C.include "" C.include "" C.verbatim [r| @@ -81,6 +83,21 @@ z `Hspec.shouldBe` x + y + 7 Hspec.it "void exp" $ do [C.exp| void { printf("Hello\n") } |] + Hspec.it "Foreign.C.Types library types" $ do + let x = 1 + pd <- [C.block| ptrdiff_t { char a[2]; return &a[1] - &a[0] + $(ptrdiff_t x); } |] + pd `Hspec.shouldBe` 2 + sz <- [C.exp| size_t { sizeof (char) } |] + sz `Hspec.shouldBe` 1 + um <- [C.exp| uintmax_t { UINTMAX_MAX } |] + um `Hspec.shouldBe` maxBound + Hspec.it "stdint.h types" $ do + let x = 2 + i16 <- [C.exp| int16_t { 1 + $(int16_t x) } |] + i16 `Hspec.shouldBe` 3 + let y = 9 + u32 <- [C.exp| uint32_t { $(uint32_t y) * 7 } |] + u32 `Hspec.shouldBe` 63 Hspec.it "function pointer argument" $ do let ackermann m n | m == 0 = n + 1