Support all primitive types

Closes #128

hs-bindgen/fixtures/nested_types.tree-diff.txt

@@ -10,11 +10,13 @@ WrapCHeader
             StructField {
               fieldName = "i",
               fieldOffset = 0,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
             StructField {
               fieldName = "c",
               fieldOffset = 32,
-              fieldType = TypPrim PrimChar}]},
+              fieldType = TypPrim
+                (PrimChar Nothing)}]},
       DeclStruct
         Struct {
           structTag = Just "bar",

hs-bindgen/fixtures/primitive_types.hs

@@ -1 +1 @@
-List {getList = [DeclInstance (InstanceStorable (WithStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "i" ::: "s2" ::: "si2" ::: "f" ::: VNil}) (StorableInstance {storableSizeOf = 176, storableAlignment = 16, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "i" ::: "s2" ::: "si2" ::: "f" ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 128, PeekByteOff x0 160, PeekByteOff x0 192, PeekByteOff x0 1088]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "i" ::: "s2" ::: "si2" ::: "f" ::: VNil}) (\(x1 ::: x2 ::: x3 ::: x4 ::: x5 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 128 x2, PokeByteOff x0 160 x3, PokeByteOff x0 192 x4, PokeByteOff x0 1088 x5]}))))})))]}
+List {getList = [DeclInstance (InstanceStorable (WithStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "sc" ::: "uc" ::: "s" ::: "si" ::: "ss" ::: "ssi" ::: "us" ::: "usi" ::: "i" ::: "s2" ::: "si2" ::: "u" ::: "ui" ::: "l" ::: "li" ::: "sl" ::: "sli" ::: "ul" ::: "uli" ::: "ll" ::: "lli" ::: "sll" ::: "slli" ::: "ull" ::: "ulli" ::: "f" ::: "d" ::: "ld" ::: VNil}) (StorableInstance {storableSizeOf = 176, storableAlignment = 16, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "sc" ::: "uc" ::: "s" ::: "si" ::: "ss" ::: "ssi" ::: "us" ::: "usi" ::: "i" ::: "s2" ::: "si2" ::: "u" ::: "ui" ::: "l" ::: "li" ::: "sl" ::: "sli" ::: "ul" ::: "uli" ::: "ll" ::: "lli" ::: "sll" ::: "slli" ::: "ull" ::: "ulli" ::: "f" ::: "d" ::: "ld" ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 8, PeekByteOff x0 16, PeekByteOff x0 32, PeekByteOff x0 48, PeekByteOff x0 64, PeekByteOff x0 80, PeekByteOff x0 96, PeekByteOff x0 112, PeekByteOff x0 128, PeekByteOff x0 160, PeekByteOff x0 192, PeekByteOff x0 224, PeekByteOff x0 256, PeekByteOff x0 320, PeekByteOff x0 384, PeekByteOff x0 448, PeekByteOff x0 512, PeekByteOff x0 576, PeekByteOff x0 640, PeekByteOff x0 704, PeekByteOff x0 768, PeekByteOff x0 832, PeekByteOff x0 896, PeekByteOff x0 960, PeekByteOff x0 1024, PeekByteOff x0 1088, PeekByteOff x0 1152, PeekByteOff x0 1280]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "primitive", structConstr = "Mkprimitive", structFields = "c" ::: "sc" ::: "uc" ::: "s" ::: "si" ::: "ss" ::: "ssi" ::: "us" ::: "usi" ::: "i" ::: "s2" ::: "si2" ::: "u" ::: "ui" ::: "l" ::: "li" ::: "sl" ::: "sli" ::: "ul" ::: "uli" ::: "ll" ::: "lli" ::: "sll" ::: "slli" ::: "ull" ::: "ulli" ::: "f" ::: "d" ::: "ld" ::: VNil}) (\(x1 ::: x2 ::: x3 ::: x4 ::: x5 ::: x6 ::: x7 ::: x8 ::: x9 ::: x10 ::: x11 ::: x12 ::: x13 ::: x14 ::: x15 ::: x16 ::: x17 ::: x18 ::: x19 ::: x20 ::: x21 ::: x22 ::: x23 ::: x24 ::: x25 ::: x26 ::: x27 ::: x28 ::: x29 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 8 x2, PokeByteOff x0 16 x3, PokeByteOff x0 32 x4, PokeByteOff x0 48 x5, PokeByteOff x0 64 x6, PokeByteOff x0 80 x7, PokeByteOff x0 96 x8, PokeByteOff x0 112 x9, PokeByteOff x0 128 x10, PokeByteOff x0 160 x11, PokeByteOff x0 192 x12, PokeByteOff x0 224 x13, PokeByteOff x0 256 x14, PokeByteOff x0 320 x15, PokeByteOff x0 384 x16, PokeByteOff x0 448 x17, PokeByteOff x0 512 x18, PokeByteOff x0 576 x19, PokeByteOff x0 640 x20, PokeByteOff x0 704 x21, PokeByteOff x0 768 x22, PokeByteOff x0 832 x23, PokeByteOff x0 896 x24, PokeByteOff x0 960 x25, PokeByteOff x0 1024 x26, PokeByteOff x0 1088 x27, PokeByteOff x0 1152 x28, PokeByteOff x0 1280 x29]}))))})))]}

hs-bindgen/fixtures/primitive_types.tree-diff.txt

@@ -10,21 +10,143 @@ WrapCHeader
             StructField {
               fieldName = "c",
               fieldOffset = 0,
-              fieldType = TypPrim PrimChar},
+              fieldType = TypPrim
+                (PrimChar Nothing)},
+            StructField {
+              fieldName = "sc",
+              fieldOffset = 8,
+              fieldType = TypPrim
+                (PrimChar (Just Signed))},
+            StructField {
+              fieldName = "uc",
+              fieldOffset = 16,
+              fieldType = TypPrim
+                (PrimChar (Just Unsigned))},
+            StructField {
+              fieldName = "s",
+              fieldOffset = 32,
+              fieldType = TypPrim
+                (PrimShortInt Signed)},
+            StructField {
+              fieldName = "si",
+              fieldOffset = 48,
+              fieldType = TypPrim
+                (PrimShortInt Signed)},
+            StructField {
+              fieldName = "ss",
+              fieldOffset = 64,
+              fieldType = TypPrim
+                (PrimShortInt Signed)},
+            StructField {
+              fieldName = "ssi",
+              fieldOffset = 80,
+              fieldType = TypPrim
+                (PrimShortInt Signed)},
+            StructField {
+              fieldName = "us",
+              fieldOffset = 96,
+              fieldType = TypPrim
+                (PrimShortInt Unsigned)},
+            StructField {
+              fieldName = "usi",
+              fieldOffset = 112,
+              fieldType = TypPrim
+                (PrimShortInt Unsigned)},
             StructField {
               fieldName = "i",
               fieldOffset = 128,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
             StructField {
               fieldName = "s2",
               fieldOffset = 160,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
             StructField {
               fieldName = "si2",
               fieldOffset = 192,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
+            StructField {
+              fieldName = "u",
+              fieldOffset = 224,
+              fieldType = TypPrim
+                (PrimInt Unsigned)},
+            StructField {
+              fieldName = "ui",
+              fieldOffset = 256,
+              fieldType = TypPrim
+                (PrimInt Unsigned)},
+            StructField {
+              fieldName = "l",
+              fieldOffset = 320,
+              fieldType = TypPrim
+                (PrimLong Signed)},
+            StructField {
+              fieldName = "li",
+              fieldOffset = 384,
+              fieldType = TypPrim
+                (PrimLong Signed)},
+            StructField {
+              fieldName = "sl",
+              fieldOffset = 448,
+              fieldType = TypPrim
+                (PrimLong Signed)},
+            StructField {
+              fieldName = "sli",
+              fieldOffset = 512,
+              fieldType = TypPrim
+                (PrimLong Signed)},
+            StructField {
+              fieldName = "ul",
+              fieldOffset = 576,
+              fieldType = TypPrim
+                (PrimLong Unsigned)},
+            StructField {
+              fieldName = "uli",
+              fieldOffset = 640,
+              fieldType = TypPrim
+                (PrimLong Unsigned)},
+            StructField {
+              fieldName = "ll",
+              fieldOffset = 704,
+              fieldType = TypPrim
+                (PrimLongLong Signed)},
+            StructField {
+              fieldName = "lli",
+              fieldOffset = 768,
+              fieldType = TypPrim
+                (PrimLongLong Signed)},
+            StructField {
+              fieldName = "sll",
+              fieldOffset = 832,
+              fieldType = TypPrim
+                (PrimLongLong Signed)},
+            StructField {
+              fieldName = "slli",
+              fieldOffset = 896,
+              fieldType = TypPrim
+                (PrimLongLong Signed)},
+            StructField {
+              fieldName = "ull",
+              fieldOffset = 960,
+              fieldType = TypPrim
+                (PrimLongLong Unsigned)},
+            StructField {
+              fieldName = "ulli",
+              fieldOffset = 1024,
+              fieldType = TypPrim
+                (PrimLongLong Unsigned)},
             StructField {
               fieldName = "f",
               fieldOffset = 1088,
+              fieldType = TypPrim PrimFloat},
+            StructField {
+              fieldName = "d",
+              fieldOffset = 1152,
+              fieldType = TypPrim PrimDouble},
+            StructField {
+              fieldName = "ld",
+              fieldOffset = 1280,
               fieldType = TypPrim
-                PrimFloat}]}])
+                PrimLongDouble}]}])

hs-bindgen/fixtures/simple_structs.tree-diff.txt

@@ -10,11 +10,13 @@ WrapCHeader
             StructField {
               fieldName = "a",
               fieldOffset = 0,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
             StructField {
               fieldName = "b",
               fieldOffset = 32,
-              fieldType = TypPrim PrimChar}]},
+              fieldType = TypPrim
+                (PrimChar Nothing)}]},
       DeclStruct
         Struct {
           structTag = Just "S2",
@@ -24,11 +26,13 @@ WrapCHeader
             StructField {
               fieldName = "a",
               fieldOffset = 0,
-              fieldType = TypPrim PrimChar},
+              fieldType = TypPrim
+                (PrimChar Nothing)},
             StructField {
               fieldName = "b",
               fieldOffset = 32,
-              fieldType = TypPrim PrimInt},
+              fieldType = TypPrim
+                (PrimInt Signed)},
             StructField {
               fieldName = "c",
               fieldOffset = 64,
@@ -46,11 +50,13 @@ WrapCHeader
                 StructField {
                   fieldName = "a",
                   fieldOffset = 0,
-                  fieldType = TypPrim PrimChar},
+                  fieldType = TypPrim
+                    (PrimChar Nothing)},
                 StructField {
                   fieldName = "b",
                   fieldOffset = 32,
-                  fieldType = TypPrim PrimInt},
+                  fieldType = TypPrim
+                    (PrimInt Signed)},
                 StructField {
                   fieldName = "c",
                   fieldOffset = 64,
@@ -65,7 +71,8 @@ WrapCHeader
             StructField {
               fieldName = "a",
               fieldOffset = 0,
-              fieldType = TypPrim PrimChar}]},
+              fieldType = TypPrim
+                (PrimChar Nothing)}]},
       DeclTypedef
         Typedef {
           typedefName = "S3_t",
@@ -79,7 +86,7 @@ WrapCHeader
                   fieldName = "a",
                   fieldOffset = 0,
                   fieldType = TypPrim
-                    PrimChar}]}},
+                    (PrimChar Nothing)}]}},
       DeclStruct
         Struct {
           structTag = Just "S4",
@@ -89,8 +96,10 @@ WrapCHeader
             StructField {
               fieldName = "b",
               fieldOffset = 0,
-              fieldType = TypPrim PrimChar},
+              fieldType = TypPrim
+                (PrimChar Nothing)},
             StructField {
               fieldName = "a",
               fieldOffset = 32,
-              fieldType = TypPrim PrimInt}]}])
+              fieldType = TypPrim
+                (PrimInt Signed)}]}])

hs-bindgen/src/HsBindgen/C/AST.hs

@@ -19,6 +19,7 @@ module HsBindgen.C.AST (
     -- * Types
   , Typ(..)
   , PrimType(..)
+  , PrimSign(..)
   , Typedef(..)
     -- * Macros
   , Token(..)
@@ -114,10 +115,60 @@ data Typ =
   deriving stock (Show, Eq, Generic)
   deriving anyclass (PrettyVal)
 
+-- | Primitive type
+--
+-- The interpretation of the primitive types is in many cases implementation
+-- and/or machine dependent. In @hs-bindgen@ we are dealing with one specific
+-- implementation (@libclang@), and we are generating code for one specific
+-- machine (possibly cross platform). This means we have a choice; suppose we
+-- see a field of type @int@ in a C struct:
+--
+-- 1. We could produce a field of type 'CInt' in the generated Haskell code
+-- 2. We could query @libclang@ to what choice it makes for the selected
+--    target platform, and use 'CShort' or 'CLong' (or something else again.
+--
+-- Both options have advantages; most users will probably prefer (1), so that
+-- we generate a /single/ API, independent of implementation details. However,
+-- some users may prefer (2) in some cases, if they want to take advantage of
+-- specific features of the target platform.
+--
+-- We don't force the decision here, but simply represent the C AST faithfully.
 data PrimType =
-    PrimInt   -- @int@
-  | PrimChar  -- @char@
-  | PrimFloat -- @float@
+    -- | @[signed | unsigned] char@
+    --
+    -- The C standard distinguishes between /three/ kinds of @cha@: @char@,
+    -- @signed char@ and @unsigned char@. Unlike the other integer types,
+    -- the interpretation of @char@ as either @signed char@ or @unsigned char@
+    -- is implementation defined.
+    --
+    -- See also <https://eel.is/c++draft/basic#fundamental>.
+    PrimChar (Maybe PrimSign)
+
+    -- | @[signed | unsigned] short [int]@
+  | PrimShortInt PrimSign
+
+    -- | @[signed | unsigned] int@
+  | PrimInt PrimSign
+
+    -- | @[signed | unsigned] long [int]@
+  | PrimLong PrimSign
+
+    -- | @[signed | unsigned] long long [int]@
+  | PrimLongLong PrimSign
+
+    -- | @float@
+  | PrimFloat
+
+    -- | @double@
+  | PrimDouble
+
+    -- | @long double@
+  | PrimLongDouble
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (PrettyVal)
+
+-- | Sign of a primitive type
+data PrimSign = Signed | Unsigned
   deriving stock (Show, Eq, Generic)
   deriving anyclass (PrettyVal)