From 69519d37c5468bb642992b24532976f3df982d39 Mon Sep 17 00:00:00 2001 From: Travis Cardwell Date: Mon, 9 Dec 2024 06:19:47 +0900 Subject: [PATCH] Implement minimal default name mangling (#331) This commit changes name mangling so that there are minimal changes by default, not attempting to create Haskell-style names. One significant difference with the previous implementation is that it can now add a prefix if/when the first character is not valid, used to handle leading underscores when creating type constructors. `MkHsName` is removed, replaced by `mkHsNamePrefixInvalid` and `mkHsNameDropInvalid` functions that are now passed to `translateName` like other options. `ctxFieldVarSingleConstr` is removed since constructors now have the same name as types by default, and we do not generate sum types anyway. If we do so in the future, we need to decide how to do name mangling for constructors as well as accessors. `HsBindgen.C.Fold.Type.mkDefnName` is changed to follow the conventions of the new defaults. --- hs-bindgen/fixtures/anonymous.hs | 20 +- hs-bindgen/fixtures/anonymous.pp.hs | 74 ++--- hs-bindgen/fixtures/anonymous.th.txt | 50 +-- hs-bindgen/fixtures/anonymous.tree-diff.txt | 12 +- hs-bindgen/fixtures/bool.hs | 14 +- hs-bindgen/fixtures/bool.pp.hs | 52 ++-- hs-bindgen/fixtures/bool.th.txt | 32 +- hs-bindgen/fixtures/distilled_lib_1.hs | 62 ++-- hs-bindgen/fixtures/distilled_lib_1.pp.hs | 190 ++++++------ hs-bindgen/fixtures/distilled_lib_1.th.txt | 150 ++++----- hs-bindgen/fixtures/enums.hs | 72 ++--- hs-bindgen/fixtures/enums.pp.hs | 158 +++++----- hs-bindgen/fixtures/enums.th.txt | 140 ++++----- hs-bindgen/fixtures/fixedarray.hs | 4 +- hs-bindgen/fixtures/fixedarray.pp.hs | 6 +- hs-bindgen/fixtures/fixedarray.th.txt | 4 +- hs-bindgen/fixtures/fixedwidth.hs | 12 +- hs-bindgen/fixtures/fixedwidth.pp.hs | 28 +- hs-bindgen/fixtures/fixedwidth.th.txt | 20 +- hs-bindgen/fixtures/forward_declaration.hs | 12 +- hs-bindgen/fixtures/forward_declaration.pp.hs | 26 +- .../fixtures/forward_declaration.th.txt | 20 +- hs-bindgen/fixtures/nested_types.hs | 8 +- hs-bindgen/fixtures/nested_types.pp.hs | 32 +- hs-bindgen/fixtures/nested_types.th.txt | 20 +- hs-bindgen/fixtures/opaque_declaration.hs | 12 +- hs-bindgen/fixtures/opaque_declaration.pp.hs | 28 +- hs-bindgen/fixtures/opaque_declaration.th.txt | 23 +- hs-bindgen/fixtures/primitive_types.hs | 4 +- hs-bindgen/fixtures/primitive_types.pp.hs | 182 +++++------ hs-bindgen/fixtures/primitive_types.th.txt | 122 ++++---- hs-bindgen/fixtures/recursive_struct.hs | 12 +- hs-bindgen/fixtures/recursive_struct.pp.hs | 38 +-- hs-bindgen/fixtures/recursive_struct.th.txt | 34 +- hs-bindgen/fixtures/simple_structs.hs | 28 +- hs-bindgen/fixtures/simple_structs.pp.hs | 108 +++---- hs-bindgen/fixtures/simple_structs.th.txt | 67 ++-- hs-bindgen/fixtures/typedef_vs_macro.hs | 16 +- hs-bindgen/fixtures/typedef_vs_macro.pp.hs | 44 +-- hs-bindgen/fixtures/typedef_vs_macro.th.txt | 34 +- hs-bindgen/fixtures/typedefs.hs | 8 +- hs-bindgen/fixtures/typedefs.pp.hs | 12 +- hs-bindgen/fixtures/typedefs.th.txt | 8 +- hs-bindgen/fixtures/typenames.hs | 12 +- hs-bindgen/fixtures/typenames.pp.hs | 24 +- hs-bindgen/fixtures/typenames.th.txt | 20 +- hs-bindgen/fixtures/uses_utf8.hs | 8 +- hs-bindgen/fixtures/uses_utf8.pp.hs | 18 +- hs-bindgen/fixtures/uses_utf8.th.txt | 16 +- hs-bindgen/src/HsBindgen/C/Fold/Type.hs | 2 +- hs-bindgen/src/HsBindgen/Hs/AST/Name.hs | 293 ++++++++++-------- hs-bindgen/src/HsBindgen/Hs/Translation.hs | 2 +- .../test-th/HsBindgen/TestTH/Spliced.hs | 10 +- hs-bindgen/test-th/TestTH.hs | 4 +- 54 files changed, 1218 insertions(+), 1189 deletions(-) diff --git a/hs-bindgen/fixtures/anonymous.hs b/hs-bindgen/fixtures/anonymous.hs index 71dbecd9..cb549e75 100644 --- a/hs-bindgen/fixtures/anonymous.hs +++ b/hs-bindgen/fixtures/anonymous.hs @@ -1,10 +1,10 @@ -DeclData (Struct {structName = "CS1c", structConstr = "MkCS1c", structFields = Field {fieldName = "cS1c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS1c", structConstr = "MkCS1c", structFields = Field {fieldName = "cS1c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS1c", structConstr = "MkCS1c", structFields = Field {fieldName = "cS1c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS1c", structConstr = "MkCS1c", structFields = Field {fieldName = "cS1c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclData (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_c", fieldType = HsTypRef "CS1c"} ::: Field {fieldName = "cS1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_c", fieldType = HsTypRef "CS1c"} ::: Field {fieldName = "cS1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_c", fieldType = HsTypRef "CS1c"} ::: Field {fieldName = "cS1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_c", fieldType = HsTypRef "CS1c"} ::: Field {fieldName = "cS1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) -DeclData (Struct {structName = "CS2innerdeep", structConstr = "MkCS2innerdeep", structFields = Field {fieldName = "cS2innerdeep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS2innerdeep", structConstr = "MkCS2innerdeep", structFields = Field {fieldName = "cS2innerdeep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS2innerdeep", structConstr = "MkCS2innerdeep", structFields = Field {fieldName = "cS2innerdeep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS2innerdeep", structConstr = "MkCS2innerdeep", structFields = Field {fieldName = "cS2innerdeep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclData (Struct {structName = "CS2inner", structConstr = "MkCS2inner", structFields = Field {fieldName = "cS2inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2inner_deep", fieldType = HsTypRef "CS2innerdeep"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS2inner", structConstr = "MkCS2inner", structFields = Field {fieldName = "cS2inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2inner_deep", fieldType = HsTypRef "CS2innerdeep"} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS2inner", structConstr = "MkCS2inner", structFields = Field {fieldName = "cS2inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2inner_deep", fieldType = HsTypRef "CS2innerdeep"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS2inner", structConstr = "MkCS2inner", structFields = Field {fieldName = "cS2inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2inner_deep", fieldType = HsTypRef "CS2innerdeep"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclData (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_inner", fieldType = HsTypRef "CS2inner"} ::: Field {fieldName = "cS2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_inner", fieldType = HsTypRef "CS2inner"} ::: Field {fieldName = "cS2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_inner", fieldType = HsTypRef "CS2inner"} ::: Field {fieldName = "cS2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_inner", fieldType = HsTypRef "CS2inner"} ::: Field {fieldName = "cS2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclData (Struct {structName = "S1_c", structConstr = "S1_c", structFields = Field {fieldName = "s1_c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S1_c", structConstr = "S1_c", structFields = Field {fieldName = "s1_c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S1_c", structConstr = "S1_c", structFields = Field {fieldName = "s1_c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S1_c", structConstr = "S1_c", structFields = Field {fieldName = "s1_c_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_c_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_c", fieldType = HsTypRef "S1_c"} ::: Field {fieldName = "s1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_c", fieldType = HsTypRef "S1_c"} ::: Field {fieldName = "s1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_c", fieldType = HsTypRef "S1_c"} ::: Field {fieldName = "s1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_c", fieldType = HsTypRef "S1_c"} ::: Field {fieldName = "s1_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclData (Struct {structName = "S2_inner_deep", structConstr = "S2_inner_deep", structFields = Field {fieldName = "s2_inner_deep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S2_inner_deep", structConstr = "S2_inner_deep", structFields = Field {fieldName = "s2_inner_deep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S2_inner_deep", structConstr = "S2_inner_deep", structFields = Field {fieldName = "s2_inner_deep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S2_inner_deep", structConstr = "S2_inner_deep", structFields = Field {fieldName = "s2_inner_deep_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclData (Struct {structName = "S2_inner", structConstr = "S2_inner", structFields = Field {fieldName = "s2_inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_inner_deep", fieldType = HsTypRef "S2_inner_deep"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S2_inner", structConstr = "S2_inner", structFields = Field {fieldName = "s2_inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_inner_deep", fieldType = HsTypRef "S2_inner_deep"} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S2_inner", structConstr = "S2_inner", structFields = Field {fieldName = "s2_inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_inner_deep", fieldType = HsTypRef "S2_inner_deep"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S2_inner", structConstr = "S2_inner", structFields = Field {fieldName = "s2_inner_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_inner_deep", fieldType = HsTypRef "S2_inner_deep"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_inner", fieldType = HsTypRef "S2_inner"} ::: Field {fieldName = "s2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_inner", fieldType = HsTypRef "S2_inner"} ::: Field {fieldName = "s2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_inner", fieldType = HsTypRef "S2_inner"} ::: Field {fieldName = "s2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_inner", fieldType = HsTypRef "S2_inner"} ::: Field {fieldName = "s2_d", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) diff --git a/hs-bindgen/fixtures/anonymous.pp.hs b/hs-bindgen/fixtures/anonymous.pp.hs index b2129c5b..c09abb0b 100644 --- a/hs-bindgen/fixtures/anonymous.pp.hs +++ b/hs-bindgen/fixtures/anonymous.pp.hs @@ -6,12 +6,12 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -data CS1c = MkCS1c - { cS1c_a :: FC.CInt - , cS1c_b :: FC.CInt +data S1_c = S1_c + { s1_c_a :: FC.CInt + , s1_c_b :: FC.CInt } -instance F.Storable CS1c where +instance F.Storable S1_c where sizeOf = \_ -> 8 @@ -19,7 +19,7 @@ instance F.Storable CS1c where peek = \ptr0 -> - pure MkCS1c + pure S1_c <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -27,16 +27,16 @@ instance F.Storable CS1c where \ptr0 -> \s1 -> case s1 of - MkCS1c cS1c_a2 cS1c_b3 -> - F.pokeByteOff ptr0 0 cS1c_a2 - >> F.pokeByteOff ptr0 4 cS1c_b3 + S1_c s1_c_a2 s1_c_b3 -> + F.pokeByteOff ptr0 0 s1_c_a2 + >> F.pokeByteOff ptr0 4 s1_c_b3 -data CS1 = MkCS1 - { cS1_c :: CS1c - , cS1_d :: FC.CInt +data S1 = S1 + { s1_c :: S1_c + , s1_d :: FC.CInt } -instance F.Storable CS1 where +instance F.Storable S1 where sizeOf = \_ -> 12 @@ -44,7 +44,7 @@ instance F.Storable CS1 where peek = \ptr0 -> - pure MkCS1 + pure S1 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -52,15 +52,15 @@ instance F.Storable CS1 where \ptr0 -> \s1 -> case s1 of - MkCS1 cS1_c2 cS1_d3 -> - F.pokeByteOff ptr0 0 cS1_c2 - >> F.pokeByteOff ptr0 8 cS1_d3 + S1 s1_c2 s1_d3 -> + F.pokeByteOff ptr0 0 s1_c2 + >> F.pokeByteOff ptr0 8 s1_d3 -data CS2innerdeep = MkCS2innerdeep - { cS2innerdeep_b :: FC.CInt +data S2_inner_deep = S2_inner_deep + { s2_inner_deep_b :: FC.CInt } -instance F.Storable CS2innerdeep where +instance F.Storable S2_inner_deep where sizeOf = \_ -> 4 @@ -68,21 +68,21 @@ instance F.Storable CS2innerdeep where peek = \ptr0 -> - pure MkCS2innerdeep + pure S2_inner_deep <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCS2innerdeep cS2innerdeep_b2 -> F.pokeByteOff ptr0 0 cS2innerdeep_b2 + S2_inner_deep s2_inner_deep_b2 -> F.pokeByteOff ptr0 0 s2_inner_deep_b2 -data CS2inner = MkCS2inner - { cS2inner_a :: FC.CInt - , cS2inner_deep :: CS2innerdeep +data S2_inner = S2_inner + { s2_inner_a :: FC.CInt + , s2_inner_deep :: S2_inner_deep } -instance F.Storable CS2inner where +instance F.Storable S2_inner where sizeOf = \_ -> 8 @@ -90,7 +90,7 @@ instance F.Storable CS2inner where peek = \ptr0 -> - pure MkCS2inner + pure S2_inner <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -98,16 +98,16 @@ instance F.Storable CS2inner where \ptr0 -> \s1 -> case s1 of - MkCS2inner cS2inner_a2 cS2inner_deep3 -> - F.pokeByteOff ptr0 0 cS2inner_a2 - >> F.pokeByteOff ptr0 4 cS2inner_deep3 + S2_inner s2_inner_a2 s2_inner_deep3 -> + F.pokeByteOff ptr0 0 s2_inner_a2 + >> F.pokeByteOff ptr0 4 s2_inner_deep3 -data CS2 = MkCS2 - { cS2_inner :: CS2inner - , cS2_d :: FC.CInt +data S2 = S2 + { s2_inner :: S2_inner + , s2_d :: FC.CInt } -instance F.Storable CS2 where +instance F.Storable S2 where sizeOf = \_ -> 12 @@ -115,7 +115,7 @@ instance F.Storable CS2 where peek = \ptr0 -> - pure MkCS2 + pure S2 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -123,6 +123,6 @@ instance F.Storable CS2 where \ptr0 -> \s1 -> case s1 of - MkCS2 cS2_inner2 cS2_d3 -> - F.pokeByteOff ptr0 0 cS2_inner2 - >> F.pokeByteOff ptr0 8 cS2_d3 + S2 s2_inner2 s2_d3 -> + F.pokeByteOff ptr0 0 s2_inner2 + >> F.pokeByteOff ptr0 8 s2_d3 diff --git a/hs-bindgen/fixtures/anonymous.th.txt b/hs-bindgen/fixtures/anonymous.th.txt index 584d8c28..2a0d68ab 100644 --- a/hs-bindgen/fixtures/anonymous.th.txt +++ b/hs-bindgen/fixtures/anonymous.th.txt @@ -1,40 +1,40 @@ -data CS1c = MkCS1c {cS1c_a :: CInt, cS1c_b :: CInt} -instance Storable CS1c +data S1_c = S1_c {s1_c_a :: CInt, s1_c_b :: CInt} +instance Storable S1_c where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS1c <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure S1_c <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS1c cS1c_a_3 - cS1c_b_4 -> pokeByteOff ptr_1 0 cS1c_a_3 >> pokeByteOff ptr_1 4 cS1c_b_4}} -data CS1 = MkCS1 {cS1_c :: CS1c, cS1_d :: CInt} -instance Storable CS1 + {S1_c s1_c_a_3 + s1_c_b_4 -> pokeByteOff ptr_1 0 s1_c_a_3 >> pokeByteOff ptr_1 4 s1_c_b_4}} +data S1 = S1 {s1_c :: S1_c, s1_d :: CInt} +instance Storable S1 where {sizeOf = \_ -> 12; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure S1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS1 cS1_c_3 - cS1_d_4 -> pokeByteOff ptr_1 0 cS1_c_3 >> pokeByteOff ptr_1 8 cS1_d_4}} -data CS2innerdeep = MkCS2innerdeep {cS2innerdeep_b :: CInt} -instance Storable CS2innerdeep + {S1 s1_c_3 + s1_d_4 -> pokeByteOff ptr_1 0 s1_c_3 >> pokeByteOff ptr_1 8 s1_d_4}} +data S2_inner_deep = S2_inner_deep {s2_inner_deep_b :: CInt} +instance Storable S2_inner_deep where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCS2innerdeep <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure S2_inner_deep <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS2innerdeep cS2innerdeep_b_3 -> pokeByteOff ptr_1 0 cS2innerdeep_b_3}} -data CS2inner - = MkCS2inner {cS2inner_a :: CInt, cS2inner_deep :: CS2innerdeep} -instance Storable CS2inner + {S2_inner_deep s2_inner_deep_b_3 -> pokeByteOff ptr_1 0 s2_inner_deep_b_3}} +data S2_inner + = S2_inner {s2_inner_a :: CInt, s2_inner_deep :: S2_inner_deep} +instance Storable S2_inner where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS2inner <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure S2_inner <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS2inner cS2inner_a_3 - cS2inner_deep_4 -> pokeByteOff ptr_1 0 cS2inner_a_3 >> pokeByteOff ptr_1 4 cS2inner_deep_4}} -data CS2 = MkCS2 {cS2_inner :: CS2inner, cS2_d :: CInt} -instance Storable CS2 + {S2_inner s2_inner_a_3 + s2_inner_deep_4 -> pokeByteOff ptr_1 0 s2_inner_a_3 >> pokeByteOff ptr_1 4 s2_inner_deep_4}} +data S2 = S2 {s2_inner :: S2_inner, s2_d :: CInt} +instance Storable S2 where {sizeOf = \_ -> 12; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure S2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS2 cS2_inner_3 - cS2_d_4 -> pokeByteOff ptr_1 0 cS2_inner_3 >> pokeByteOff ptr_1 8 cS2_d_4}} + {S2 s2_inner_3 + s2_d_4 -> pokeByteOff ptr_1 0 s2_inner_3 >> pokeByteOff ptr_1 8 s2_d_4}} diff --git a/hs-bindgen/fixtures/anonymous.tree-diff.txt b/hs-bindgen/fixtures/anonymous.tree-diff.txt index a1a659cf..9fce8991 100644 --- a/hs-bindgen/fixtures/anonymous.tree-diff.txt +++ b/hs-bindgen/fixtures/anonymous.tree-diff.txt @@ -4,7 +4,7 @@ WrapCHeader DeclStruct Struct { structTag = DefnName - (CName "S1c"), + (CName "S1_c"), structSizeof = 8, structAlignment = 4, structFields = [ @@ -47,7 +47,7 @@ WrapCHeader fieldName = CName "c", fieldOffset = 0, fieldType = TypeStruct - (DefnName (CName "S1c")), + (DefnName (CName "S1_c")), fieldSourceLoc = SingleLoc { singleLocPath = [ "examples", @@ -74,7 +74,7 @@ WrapCHeader DeclStruct Struct { structTag = DefnName - (CName "S2innerdeep"), + (CName "S2_inner_deep"), structSizeof = 4, structAlignment = 4, structFields = [ @@ -98,7 +98,7 @@ WrapCHeader DeclStruct Struct { structTag = DefnName - (CName "S2inner"), + (CName "S2_inner"), structSizeof = 8, structAlignment = 4, structFields = [ @@ -118,7 +118,7 @@ WrapCHeader fieldOffset = 32, fieldType = TypeStruct (DefnName - (CName "S2innerdeep")), + (CName "S2_inner_deep")), fieldSourceLoc = SingleLoc { singleLocPath = [ "examples", @@ -142,7 +142,7 @@ WrapCHeader fieldName = CName "inner", fieldOffset = 0, fieldType = TypeStruct - (DefnName (CName "S2inner")), + (DefnName (CName "S2_inner")), fieldSourceLoc = SingleLoc { singleLocPath = [ "examples", diff --git a/hs-bindgen/fixtures/bool.hs b/hs-bindgen/fixtures/bool.hs index 05774d53..b024c748 100644 --- a/hs-bindgen/fixtures/bool.hs +++ b/hs-bindgen/fixtures/bool.hs @@ -1,7 +1,7 @@ -DeclNewtype (Newtype {newtypeName = "CBOOL", newtypeConstr = "MkCBOOL", newtypeField = Field {fieldName = "unCBOOL", fieldType = HsPrimType HsPrimCBool}}) -DeclData (Struct {structName = "CBools1", structConstr = "MkCBools1", structFields = Field {fieldName = "cBools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBools1", structConstr = "MkCBools1", structFields = Field {fieldName = "cBools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBools1", structConstr = "MkCBools1", structFields = Field {fieldName = "cBools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBools1", structConstr = "MkCBools1", structFields = Field {fieldName = "cBools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) -DeclData (Struct {structName = "CBools2", structConstr = "MkCBools2", structFields = Field {fieldName = "cBools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBools2", structConstr = "MkCBools2", structFields = Field {fieldName = "cBools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBools2", structConstr = "MkCBools2", structFields = Field {fieldName = "cBools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBools2", structConstr = "MkCBools2", structFields = Field {fieldName = "cBools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cBools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) -DeclData (Struct {structName = "CBools3", structConstr = "MkCBools3", structFields = Field {fieldName = "cBools3_x", fieldType = HsTypRef "CBOOL"} ::: Field {fieldName = "cBools3_y", fieldType = HsTypRef "CBOOL"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBools3", structConstr = "MkCBools3", structFields = Field {fieldName = "cBools3_x", fieldType = HsTypRef "CBOOL"} ::: Field {fieldName = "cBools3_y", fieldType = HsTypRef "CBOOL"} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBools3", structConstr = "MkCBools3", structFields = Field {fieldName = "cBools3_x", fieldType = HsTypRef "CBOOL"} ::: Field {fieldName = "cBools3_y", fieldType = HsTypRef "CBOOL"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBools3", structConstr = "MkCBools3", structFields = Field {fieldName = "cBools3_x", fieldType = HsTypRef "CBOOL"} ::: Field {fieldName = "cBools3_y", fieldType = HsTypRef "CBOOL"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) +DeclNewtype (Newtype {newtypeName = "BOOL", newtypeConstr = "BOOL", newtypeField = Field {fieldName = "unBOOL", fieldType = HsPrimType HsPrimCBool}}) +DeclData (Struct {structName = "Bools1", structConstr = "Bools1", structFields = Field {fieldName = "bools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Bools1", structConstr = "Bools1", structFields = Field {fieldName = "bools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Bools1", structConstr = "Bools1", structFields = Field {fieldName = "bools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Bools1", structConstr = "Bools1", structFields = Field {fieldName = "bools1_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools1_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) +DeclData (Struct {structName = "Bools2", structConstr = "Bools2", structFields = Field {fieldName = "bools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Bools2", structConstr = "Bools2", structFields = Field {fieldName = "bools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Bools2", structConstr = "Bools2", structFields = Field {fieldName = "bools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Bools2", structConstr = "Bools2", structFields = Field {fieldName = "bools2_x", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "bools2_y", fieldType = HsPrimType HsPrimCBool} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) +DeclData (Struct {structName = "Bools3", structConstr = "Bools3", structFields = Field {fieldName = "bools3_x", fieldType = HsTypRef "BOOL"} ::: Field {fieldName = "bools3_y", fieldType = HsTypRef "BOOL"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Bools3", structConstr = "Bools3", structFields = Field {fieldName = "bools3_x", fieldType = HsTypRef "BOOL"} ::: Field {fieldName = "bools3_y", fieldType = HsTypRef "BOOL"} ::: VNil}) (StorableInstance {storableSizeOf = 2, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Bools3", structConstr = "Bools3", structFields = Field {fieldName = "bools3_x", fieldType = HsTypRef "BOOL"} ::: Field {fieldName = "bools3_y", fieldType = HsTypRef "BOOL"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Bools3", structConstr = "Bools3", structFields = Field {fieldName = "bools3_x", fieldType = HsTypRef "BOOL"} ::: Field {fieldName = "bools3_y", fieldType = HsTypRef "BOOL"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 1 1])))})) diff --git a/hs-bindgen/fixtures/bool.pp.hs b/hs-bindgen/fixtures/bool.pp.hs index 1162ad0b..df7fa6c9 100644 --- a/hs-bindgen/fixtures/bool.pp.hs +++ b/hs-bindgen/fixtures/bool.pp.hs @@ -6,16 +6,16 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -newtype CBOOL = MkCBOOL - { unCBOOL :: FC.CBool +newtype BOOL = BOOL + { unBOOL :: FC.CBool } -data CBools1 = MkCBools1 - { cBools1_x :: FC.CBool - , cBools1_y :: FC.CBool +data Bools1 = Bools1 + { bools1_x :: FC.CBool + , bools1_y :: FC.CBool } -instance F.Storable CBools1 where +instance F.Storable Bools1 where sizeOf = \_ -> 2 @@ -23,7 +23,7 @@ instance F.Storable CBools1 where peek = \ptr0 -> - pure MkCBools1 + pure Bools1 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 1 @@ -31,16 +31,16 @@ instance F.Storable CBools1 where \ptr0 -> \s1 -> case s1 of - MkCBools1 cBools1_x2 cBools1_y3 -> - F.pokeByteOff ptr0 0 cBools1_x2 - >> F.pokeByteOff ptr0 1 cBools1_y3 + Bools1 bools1_x2 bools1_y3 -> + F.pokeByteOff ptr0 0 bools1_x2 + >> F.pokeByteOff ptr0 1 bools1_y3 -data CBools2 = MkCBools2 - { cBools2_x :: FC.CBool - , cBools2_y :: FC.CBool +data Bools2 = Bools2 + { bools2_x :: FC.CBool + , bools2_y :: FC.CBool } -instance F.Storable CBools2 where +instance F.Storable Bools2 where sizeOf = \_ -> 2 @@ -48,7 +48,7 @@ instance F.Storable CBools2 where peek = \ptr0 -> - pure MkCBools2 + pure Bools2 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 1 @@ -56,16 +56,16 @@ instance F.Storable CBools2 where \ptr0 -> \s1 -> case s1 of - MkCBools2 cBools2_x2 cBools2_y3 -> - F.pokeByteOff ptr0 0 cBools2_x2 - >> F.pokeByteOff ptr0 1 cBools2_y3 + Bools2 bools2_x2 bools2_y3 -> + F.pokeByteOff ptr0 0 bools2_x2 + >> F.pokeByteOff ptr0 1 bools2_y3 -data CBools3 = MkCBools3 - { cBools3_x :: CBOOL - , cBools3_y :: CBOOL +data Bools3 = Bools3 + { bools3_x :: BOOL + , bools3_y :: BOOL } -instance F.Storable CBools3 where +instance F.Storable Bools3 where sizeOf = \_ -> 2 @@ -73,7 +73,7 @@ instance F.Storable CBools3 where peek = \ptr0 -> - pure MkCBools3 + pure Bools3 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 1 @@ -81,6 +81,6 @@ instance F.Storable CBools3 where \ptr0 -> \s1 -> case s1 of - MkCBools3 cBools3_x2 cBools3_y3 -> - F.pokeByteOff ptr0 0 cBools3_x2 - >> F.pokeByteOff ptr0 1 cBools3_y3 + Bools3 bools3_x2 bools3_y3 -> + F.pokeByteOff ptr0 0 bools3_x2 + >> F.pokeByteOff ptr0 1 bools3_y3 diff --git a/hs-bindgen/fixtures/bool.th.txt b/hs-bindgen/fixtures/bool.th.txt index 2ef728dd..82f0a7d5 100644 --- a/hs-bindgen/fixtures/bool.th.txt +++ b/hs-bindgen/fixtures/bool.th.txt @@ -1,25 +1,25 @@ -newtype CBOOL = MkCBOOL {unCBOOL :: CBool} -data CBools1 = MkCBools1 {cBools1_x :: CBool, cBools1_y :: CBool} -instance Storable CBools1 +newtype BOOL = BOOL {unBOOL :: CBool} +data Bools1 = Bools1 {bools1_x :: CBool, bools1_y :: CBool} +instance Storable Bools1 where {sizeOf = \_ -> 2; alignment = \_ -> 1; - peek = \ptr_0 -> (pure MkCBools1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; + peek = \ptr_0 -> (pure Bools1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBools1 cBools1_x_3 - cBools1_y_4 -> pokeByteOff ptr_1 0 cBools1_x_3 >> pokeByteOff ptr_1 1 cBools1_y_4}} -data CBools2 = MkCBools2 {cBools2_x :: CBool, cBools2_y :: CBool} -instance Storable CBools2 + {Bools1 bools1_x_3 + bools1_y_4 -> pokeByteOff ptr_1 0 bools1_x_3 >> pokeByteOff ptr_1 1 bools1_y_4}} +data Bools2 = Bools2 {bools2_x :: CBool, bools2_y :: CBool} +instance Storable Bools2 where {sizeOf = \_ -> 2; alignment = \_ -> 1; - peek = \ptr_0 -> (pure MkCBools2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; + peek = \ptr_0 -> (pure Bools2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBools2 cBools2_x_3 - cBools2_y_4 -> pokeByteOff ptr_1 0 cBools2_x_3 >> pokeByteOff ptr_1 1 cBools2_y_4}} -data CBools3 = MkCBools3 {cBools3_x :: CBOOL, cBools3_y :: CBOOL} -instance Storable CBools3 + {Bools2 bools2_x_3 + bools2_y_4 -> pokeByteOff ptr_1 0 bools2_x_3 >> pokeByteOff ptr_1 1 bools2_y_4}} +data Bools3 = Bools3 {bools3_x :: BOOL, bools3_y :: BOOL} +instance Storable Bools3 where {sizeOf = \_ -> 2; alignment = \_ -> 1; - peek = \ptr_0 -> (pure MkCBools3 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; + peek = \ptr_0 -> (pure Bools3 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBools3 cBools3_x_3 - cBools3_y_4 -> pokeByteOff ptr_1 0 cBools3_x_3 >> pokeByteOff ptr_1 1 cBools3_y_4}} + {Bools3 bools3_x_3 + bools3_y_4 -> pokeByteOff ptr_1 0 bools3_x_3 >> pokeByteOff ptr_1 1 bools3_y_4}} diff --git a/hs-bindgen/fixtures/distilled_lib_1.hs b/hs-bindgen/fixtures/distilled_lib_1.hs index 2570de8c..95acf6e3 100644 --- a/hs-bindgen/fixtures/distilled_lib_1.hs +++ b/hs-bindgen/fixtures/distilled_lib_1.hs @@ -5,34 +5,34 @@ DeclVar (VarDecl {varDeclName = "a_DEFINE_0", varDeclType = ForallTy {forallTySi DeclVar (VarDecl {varDeclName = "a_DEFINE_1", varDeclType = ForallTy {forallTySize = 0, forallTyBinders = VNil, forallTy = QuantTy {quantTyCts = [], quantTyBody = TyConAppTy (TyConApp UInt VNil)}}, varDeclBody = VarDeclIntegral 20560 HsPrimCUInt}) DeclVar (VarDecl {varDeclName = "a_DEFINE_2", varDeclType = ForallTy {forallTySize = 1, forallTyBinders = "a" ::: VNil, forallTy = QuantTy {quantTyCts = [ClassTy Integral (TyVarTy 0 ::: VNil)], quantTyBody = TyVarTy 0}}, varDeclBody = VarDeclIntegral 2 HsPrimCInt}) DeclVar (VarDecl {varDeclName = "tWO_ARGS", varDeclType = ForallTy {forallTySize = 1, forallTyBinders = "a" ::: VNil, forallTy = QuantTy {quantTyCts = [ClassTy Integral (TyVarTy 0 ::: VNil)], quantTyBody = TyVarTy 0}}, varDeclBody = VarDeclIntegral 13398 HsPrimCInt}) -DeclForeignImport (ForeignImportDecl {foreignImportName = "some_fun", foreignImportType = HsFun (HsPtr (HsTypRef "CATypeT")) (HsFun (HsTypRef "CUint32T") (HsFun (HsPrimType HsPrimVoid) (HsIO (HsTypRef "CInt32T")))), foreignImportOrigName = "some_fun", foreignImportHeader = "distilled_lib_1.h"}) -DeclData (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = Field {fieldName = "cAnotherTypedefStructT_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cAnotherTypedefStructT_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = Field {fieldName = "cAnotherTypedefStructT_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cAnotherTypedefStructT_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = Field {fieldName = "cAnotherTypedefStructT_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cAnotherTypedefStructT_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = Field {fieldName = "cAnotherTypedefStructT_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cAnotherTypedefStructT_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclNewtype (Newtype {newtypeName = "CAnotherTypedefEnumE", newtypeConstr = "MkCAnotherTypedefEnumE", newtypeField = Field {fieldName = "unCAnotherTypedefEnumE", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = Field {fieldName = "unCAnotherTypedefEnumE", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = Field {fieldName = "unCAnotherTypedefEnumE", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = Field {fieldName = "unCAnotherTypedefEnumE", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCFOO", patSynType = "CAnotherTypedefEnumE", patSynConstr = "MkCAnotherTypedefEnumE", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCBAR", patSynType = "CAnotherTypedefEnumE", patSynConstr = "MkCAnotherTypedefEnumE", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CATypeT", newtypeConstr = "MkCATypeT", newtypeField = Field {fieldName = "unCATypeT", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtypeInstance Storable "CATypeT" -DeclNewtype (Newtype {newtypeName = "CVarT", newtypeConstr = "MkCVarT", newtypeField = Field {fieldName = "unCVarT", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtypeInstance Storable "CVarT" -DeclNewtype (Newtype {newtypeName = "CUint8T", newtypeConstr = "MkCUint8T", newtypeField = Field {fieldName = "unCUint8T", fieldType = HsPrimType HsPrimCSChar}}) -DeclNewtypeInstance Storable "CUint8T" -DeclNewtype (Newtype {newtypeName = "CUint16T", newtypeConstr = "MkCUint16T", newtypeField = Field {fieldName = "unCUint16T", fieldType = HsPrimType HsPrimCUShort}}) -DeclNewtypeInstance Storable "CUint16T" -DeclNewtype (Newtype {newtypeName = "CUint32T", newtypeConstr = "MkCUint32T", newtypeField = Field {fieldName = "unCUint32T", fieldType = HsPrimType HsPrimCUInt}}) -DeclNewtypeInstance Storable "CUint32T" -DeclData (Struct {structName = "CATypedefStruct", structConstr = "MkCATypedefStruct", structFields = Field {fieldName = "cATypedefStruct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cATypedefStruct_field_1", fieldType = HsTypRef "CUint8T"} ::: Field {fieldName = "cATypedefStruct_field_2", fieldType = HsTypRef "CUint16T"} ::: Field {fieldName = "cATypedefStruct_field_3", fieldType = HsTypRef "CUint32T"} ::: Field {fieldName = "cATypedefStruct_field_4", fieldType = HsTypRef "CAnotherTypedefStructT"} ::: Field {fieldName = "cATypedefStruct_field_5", fieldType = HsPtr (HsTypRef "CAnotherTypedefStructT")} ::: Field {fieldName = "cATypedefStruct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "cATypedefStruct_field_7", fieldType = HsConstArray 7 (HsTypRef "CUint32T")} ::: Field {fieldName = "cATypedefStruct_field_8", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_9", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_10", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CATypedefStruct", structConstr = "MkCATypedefStruct", structFields = Field {fieldName = "cATypedefStruct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cATypedefStruct_field_1", fieldType = HsTypRef "CUint8T"} ::: Field {fieldName = "cATypedefStruct_field_2", fieldType = HsTypRef "CUint16T"} ::: Field {fieldName = "cATypedefStruct_field_3", fieldType = HsTypRef "CUint32T"} ::: Field {fieldName = "cATypedefStruct_field_4", fieldType = HsTypRef "CAnotherTypedefStructT"} ::: Field {fieldName = "cATypedefStruct_field_5", fieldType = HsPtr (HsTypRef "CAnotherTypedefStructT")} ::: Field {fieldName = "cATypedefStruct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "cATypedefStruct_field_7", fieldType = HsConstArray 7 (HsTypRef "CUint32T")} ::: Field {fieldName = "cATypedefStruct_field_8", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_9", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_10", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: VNil}) (StorableInstance {storableSizeOf = 140, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CATypedefStruct", structConstr = "MkCATypedefStruct", structFields = Field {fieldName = "cATypedefStruct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cATypedefStruct_field_1", fieldType = HsTypRef "CUint8T"} ::: Field {fieldName = "cATypedefStruct_field_2", fieldType = HsTypRef "CUint16T"} ::: Field {fieldName = "cATypedefStruct_field_3", fieldType = HsTypRef "CUint32T"} ::: Field {fieldName = "cATypedefStruct_field_4", fieldType = HsTypRef "CAnotherTypedefStructT"} ::: Field {fieldName = "cATypedefStruct_field_5", fieldType = HsPtr (HsTypRef "CAnotherTypedefStructT")} ::: Field {fieldName = "cATypedefStruct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "cATypedefStruct_field_7", fieldType = HsConstArray 7 (HsTypRef "CUint32T")} ::: Field {fieldName = "cATypedefStruct_field_8", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_9", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_10", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1,PeekByteOff 0 2,PeekByteOff 0 4,PeekByteOff 0 8,PeekByteOff 0 16,PeekByteOff 0 24,PeekByteOff 0 32,PeekByteOff 0 60,PeekByteOff 0 64,PeekByteOff 0 80]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CATypedefStruct", structConstr = "MkCATypedefStruct", structFields = Field {fieldName = "cATypedefStruct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "cATypedefStruct_field_1", fieldType = HsTypRef "CUint8T"} ::: Field {fieldName = "cATypedefStruct_field_2", fieldType = HsTypRef "CUint16T"} ::: Field {fieldName = "cATypedefStruct_field_3", fieldType = HsTypRef "CUint32T"} ::: Field {fieldName = "cATypedefStruct_field_4", fieldType = HsTypRef "CAnotherTypedefStructT"} ::: Field {fieldName = "cATypedefStruct_field_5", fieldType = HsPtr (HsTypRef "CAnotherTypedefStructT")} ::: Field {fieldName = "cATypedefStruct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "cATypedefStruct_field_7", fieldType = HsConstArray 7 (HsTypRef "CUint32T")} ::: Field {fieldName = "cATypedefStruct_field_8", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_9", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: Field {fieldName = "cATypedefStruct_field_10", fieldType = HsTypRef "CAnotherTypedefEnumE"} ::: VNil}) 11 (Seq [PokeByteOff 12 0 0,PokeByteOff 12 1 1,PokeByteOff 12 2 2,PokeByteOff 12 4 3,PokeByteOff 12 8 4,PokeByteOff 12 16 5,PokeByteOff 12 24 6,PokeByteOff 12 32 7,PokeByteOff 12 60 8,PokeByteOff 12 64 9,PokeByteOff 12 80 10])))})) -DeclNewtype (Newtype {newtypeName = "CATypedefStructT", newtypeConstr = "MkCATypedefStructT", newtypeField = Field {fieldName = "unCATypedefStructT", fieldType = HsTypRef "CATypedefStruct"}}) -DeclNewtypeInstance Storable "CATypedefStructT" -DeclNewtype (Newtype {newtypeName = "CATypedefEnumE", newtypeConstr = "MkCATypedefEnumE", newtypeField = Field {fieldName = "unCATypedefEnumE", fieldType = HsPrimType HsPrimCSChar}}) -DeclInstance (InstanceStorable (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = Field {fieldName = "unCATypedefEnumE", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = Field {fieldName = "unCATypedefEnumE", fieldType = HsPrimType HsPrimCSChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = Field {fieldName = "unCATypedefEnumE", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCENUMCASE0", patSynType = "CATypedefEnumE", patSynConstr = "MkCATypedefEnumE", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCENUMCASE1", patSynType = "CATypedefEnumE", patSynConstr = "MkCATypedefEnumE", patSynValue = 1}) -DeclPatSyn (PatSyn {patSynName = "MkCENUMCASE2", patSynType = "CATypedefEnumE", patSynConstr = "MkCATypedefEnumE", patSynValue = 2}) -DeclPatSyn (PatSyn {patSynName = "MkCENUMCASE3", patSynType = "CATypedefEnumE", patSynConstr = "MkCATypedefEnumE", patSynValue = 3}) -DeclNewtype (Newtype {newtypeName = "CInt32T", newtypeConstr = "MkCInt32T", newtypeField = Field {fieldName = "unCInt32T", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtypeInstance Storable "CInt32T" -DeclNewtype (Newtype {newtypeName = "CCallbackT", newtypeConstr = "MkCCallbackT", newtypeField = Field {fieldName = "unCCallbackT", fieldType = HsFunPtr (HsFun (HsPtr (HsPrimType HsPrimVoid)) (HsFun (HsTypRef "CUint32T") (HsIO (HsTypRef "CUint32T"))))}}) -DeclNewtypeInstance Storable "CCallbackT" +DeclForeignImport (ForeignImportDecl {foreignImportName = "some_fun", foreignImportType = HsFun (HsPtr (HsTypRef "A_type_t")) (HsFun (HsTypRef "Uint32_t") (HsFun (HsPrimType HsPrimVoid) (HsIO (HsTypRef "Int32_t")))), foreignImportOrigName = "some_fun", foreignImportHeader = "distilled_lib_1.h"}) +DeclData (Struct {structName = "Another_typedef_struct_t", structConstr = "Another_typedef_struct_t", structFields = Field {fieldName = "another_typedef_struct_t_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "another_typedef_struct_t_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Another_typedef_struct_t", structConstr = "Another_typedef_struct_t", structFields = Field {fieldName = "another_typedef_struct_t_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "another_typedef_struct_t_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Another_typedef_struct_t", structConstr = "Another_typedef_struct_t", structFields = Field {fieldName = "another_typedef_struct_t_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "another_typedef_struct_t_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Another_typedef_struct_t", structConstr = "Another_typedef_struct_t", structFields = Field {fieldName = "another_typedef_struct_t_foo", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "another_typedef_struct_t_bar", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclNewtype (Newtype {newtypeName = "Another_typedef_enum_e", newtypeConstr = "Another_typedef_enum_e", newtypeField = Field {fieldName = "unAnother_typedef_enum_e", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "Another_typedef_enum_e", structConstr = "Another_typedef_enum_e", structFields = Field {fieldName = "unAnother_typedef_enum_e", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Another_typedef_enum_e", structConstr = "Another_typedef_enum_e", structFields = Field {fieldName = "unAnother_typedef_enum_e", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Another_typedef_enum_e", structConstr = "Another_typedef_enum_e", structFields = Field {fieldName = "unAnother_typedef_enum_e", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "FOO", patSynType = "Another_typedef_enum_e", patSynConstr = "Another_typedef_enum_e", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "BAR", patSynType = "Another_typedef_enum_e", patSynConstr = "Another_typedef_enum_e", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "A_type_t", newtypeConstr = "A_type_t", newtypeField = Field {fieldName = "unA_type_t", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtypeInstance Storable "A_type_t" +DeclNewtype (Newtype {newtypeName = "Var_t", newtypeConstr = "Var_t", newtypeField = Field {fieldName = "unVar_t", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtypeInstance Storable "Var_t" +DeclNewtype (Newtype {newtypeName = "Uint8_t", newtypeConstr = "Uint8_t", newtypeField = Field {fieldName = "unUint8_t", fieldType = HsPrimType HsPrimCSChar}}) +DeclNewtypeInstance Storable "Uint8_t" +DeclNewtype (Newtype {newtypeName = "Uint16_t", newtypeConstr = "Uint16_t", newtypeField = Field {fieldName = "unUint16_t", fieldType = HsPrimType HsPrimCUShort}}) +DeclNewtypeInstance Storable "Uint16_t" +DeclNewtype (Newtype {newtypeName = "Uint32_t", newtypeConstr = "Uint32_t", newtypeField = Field {fieldName = "unUint32_t", fieldType = HsPrimType HsPrimCUInt}}) +DeclNewtypeInstance Storable "Uint32_t" +DeclData (Struct {structName = "A_typedef_struct", structConstr = "A_typedef_struct", structFields = Field {fieldName = "a_typedef_struct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "a_typedef_struct_field_1", fieldType = HsTypRef "Uint8_t"} ::: Field {fieldName = "a_typedef_struct_field_2", fieldType = HsTypRef "Uint16_t"} ::: Field {fieldName = "a_typedef_struct_field_3", fieldType = HsTypRef "Uint32_t"} ::: Field {fieldName = "a_typedef_struct_field_4", fieldType = HsTypRef "Another_typedef_struct_t"} ::: Field {fieldName = "a_typedef_struct_field_5", fieldType = HsPtr (HsTypRef "Another_typedef_struct_t")} ::: Field {fieldName = "a_typedef_struct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "a_typedef_struct_field_7", fieldType = HsConstArray 7 (HsTypRef "Uint32_t")} ::: Field {fieldName = "a_typedef_struct_field_8", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_9", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_10", fieldType = HsTypRef "Another_typedef_enum_e"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "A_typedef_struct", structConstr = "A_typedef_struct", structFields = Field {fieldName = "a_typedef_struct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "a_typedef_struct_field_1", fieldType = HsTypRef "Uint8_t"} ::: Field {fieldName = "a_typedef_struct_field_2", fieldType = HsTypRef "Uint16_t"} ::: Field {fieldName = "a_typedef_struct_field_3", fieldType = HsTypRef "Uint32_t"} ::: Field {fieldName = "a_typedef_struct_field_4", fieldType = HsTypRef "Another_typedef_struct_t"} ::: Field {fieldName = "a_typedef_struct_field_5", fieldType = HsPtr (HsTypRef "Another_typedef_struct_t")} ::: Field {fieldName = "a_typedef_struct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "a_typedef_struct_field_7", fieldType = HsConstArray 7 (HsTypRef "Uint32_t")} ::: Field {fieldName = "a_typedef_struct_field_8", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_9", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_10", fieldType = HsTypRef "Another_typedef_enum_e"} ::: VNil}) (StorableInstance {storableSizeOf = 140, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "A_typedef_struct", structConstr = "A_typedef_struct", structFields = Field {fieldName = "a_typedef_struct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "a_typedef_struct_field_1", fieldType = HsTypRef "Uint8_t"} ::: Field {fieldName = "a_typedef_struct_field_2", fieldType = HsTypRef "Uint16_t"} ::: Field {fieldName = "a_typedef_struct_field_3", fieldType = HsTypRef "Uint32_t"} ::: Field {fieldName = "a_typedef_struct_field_4", fieldType = HsTypRef "Another_typedef_struct_t"} ::: Field {fieldName = "a_typedef_struct_field_5", fieldType = HsPtr (HsTypRef "Another_typedef_struct_t")} ::: Field {fieldName = "a_typedef_struct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "a_typedef_struct_field_7", fieldType = HsConstArray 7 (HsTypRef "Uint32_t")} ::: Field {fieldName = "a_typedef_struct_field_8", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_9", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_10", fieldType = HsTypRef "Another_typedef_enum_e"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1,PeekByteOff 0 2,PeekByteOff 0 4,PeekByteOff 0 8,PeekByteOff 0 16,PeekByteOff 0 24,PeekByteOff 0 32,PeekByteOff 0 60,PeekByteOff 0 64,PeekByteOff 0 80]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "A_typedef_struct", structConstr = "A_typedef_struct", structFields = Field {fieldName = "a_typedef_struct_field_0", fieldType = HsPrimType HsPrimCBool} ::: Field {fieldName = "a_typedef_struct_field_1", fieldType = HsTypRef "Uint8_t"} ::: Field {fieldName = "a_typedef_struct_field_2", fieldType = HsTypRef "Uint16_t"} ::: Field {fieldName = "a_typedef_struct_field_3", fieldType = HsTypRef "Uint32_t"} ::: Field {fieldName = "a_typedef_struct_field_4", fieldType = HsTypRef "Another_typedef_struct_t"} ::: Field {fieldName = "a_typedef_struct_field_5", fieldType = HsPtr (HsTypRef "Another_typedef_struct_t")} ::: Field {fieldName = "a_typedef_struct_field_6", fieldType = HsPtr (HsPrimType HsPrimVoid)} ::: Field {fieldName = "a_typedef_struct_field_7", fieldType = HsConstArray 7 (HsTypRef "Uint32_t")} ::: Field {fieldName = "a_typedef_struct_field_8", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_9", fieldType = HsTypRef "Another_typedef_enum_e"} ::: Field {fieldName = "a_typedef_struct_field_10", fieldType = HsTypRef "Another_typedef_enum_e"} ::: VNil}) 11 (Seq [PokeByteOff 12 0 0,PokeByteOff 12 1 1,PokeByteOff 12 2 2,PokeByteOff 12 4 3,PokeByteOff 12 8 4,PokeByteOff 12 16 5,PokeByteOff 12 24 6,PokeByteOff 12 32 7,PokeByteOff 12 60 8,PokeByteOff 12 64 9,PokeByteOff 12 80 10])))})) +DeclNewtype (Newtype {newtypeName = "A_typedef_struct_t", newtypeConstr = "A_typedef_struct_t", newtypeField = Field {fieldName = "unA_typedef_struct_t", fieldType = HsTypRef "A_typedef_struct"}}) +DeclNewtypeInstance Storable "A_typedef_struct_t" +DeclNewtype (Newtype {newtypeName = "A_typedef_enum_e", newtypeConstr = "A_typedef_enum_e", newtypeField = Field {fieldName = "unA_typedef_enum_e", fieldType = HsPrimType HsPrimCSChar}}) +DeclInstance (InstanceStorable (Struct {structName = "A_typedef_enum_e", structConstr = "A_typedef_enum_e", structFields = Field {fieldName = "unA_typedef_enum_e", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "A_typedef_enum_e", structConstr = "A_typedef_enum_e", structFields = Field {fieldName = "unA_typedef_enum_e", fieldType = HsPrimType HsPrimCSChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "A_typedef_enum_e", structConstr = "A_typedef_enum_e", structFields = Field {fieldName = "unA_typedef_enum_e", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "ENUM_CASE_0", patSynType = "A_typedef_enum_e", patSynConstr = "A_typedef_enum_e", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "ENUM_CASE_1", patSynType = "A_typedef_enum_e", patSynConstr = "A_typedef_enum_e", patSynValue = 1}) +DeclPatSyn (PatSyn {patSynName = "ENUM_CASE_2", patSynType = "A_typedef_enum_e", patSynConstr = "A_typedef_enum_e", patSynValue = 2}) +DeclPatSyn (PatSyn {patSynName = "ENUM_CASE_3", patSynType = "A_typedef_enum_e", patSynConstr = "A_typedef_enum_e", patSynValue = 3}) +DeclNewtype (Newtype {newtypeName = "Int32_t", newtypeConstr = "Int32_t", newtypeField = Field {fieldName = "unInt32_t", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtypeInstance Storable "Int32_t" +DeclNewtype (Newtype {newtypeName = "Callback_t", newtypeConstr = "Callback_t", newtypeField = Field {fieldName = "unCallback_t", fieldType = HsFunPtr (HsFun (HsPtr (HsPrimType HsPrimVoid)) (HsFun (HsTypRef "Uint32_t") (HsIO (HsTypRef "Uint32_t"))))}}) +DeclNewtypeInstance Storable "Callback_t" diff --git a/hs-bindgen/fixtures/distilled_lib_1.pp.hs b/hs-bindgen/fixtures/distilled_lib_1.pp.hs index be848219..93d842aa 100644 --- a/hs-bindgen/fixtures/distilled_lib_1.pp.hs +++ b/hs-bindgen/fixtures/distilled_lib_1.pp.hs @@ -30,14 +30,14 @@ a_DEFINE_2 = 2 tWO_ARGS :: forall a0. P.Integral a0 => a0 tWO_ARGS = 13398 -foreign import capi safe "distilled_lib_1.h some_fun" some_fun :: (F.Ptr CATypeT) -> CUint32T -> Void -> IO CInt32T +foreign import capi safe "distilled_lib_1.h some_fun" some_fun :: (F.Ptr A_type_t) -> Uint32_t -> Void -> IO Int32_t -data CAnotherTypedefStructT = MkCAnotherTypedefStructT - { cAnotherTypedefStructT_foo :: FC.CInt - , cAnotherTypedefStructT_bar :: FC.CChar +data Another_typedef_struct_t = Another_typedef_struct_t + { another_typedef_struct_t_foo :: FC.CInt + , another_typedef_struct_t_bar :: FC.CChar } -instance F.Storable CAnotherTypedefStructT where +instance F.Storable Another_typedef_struct_t where sizeOf = \_ -> 8 @@ -45,7 +45,7 @@ instance F.Storable CAnotherTypedefStructT where peek = \ptr0 -> - pure MkCAnotherTypedefStructT + pure Another_typedef_struct_t <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -53,15 +53,15 @@ instance F.Storable CAnotherTypedefStructT where \ptr0 -> \s1 -> case s1 of - MkCAnotherTypedefStructT cAnotherTypedefStructT_foo2 cAnotherTypedefStructT_bar3 -> - F.pokeByteOff ptr0 0 cAnotherTypedefStructT_foo2 - >> F.pokeByteOff ptr0 4 cAnotherTypedefStructT_bar3 + Another_typedef_struct_t another_typedef_struct_t_foo2 another_typedef_struct_t_bar3 -> + F.pokeByteOff ptr0 0 another_typedef_struct_t_foo2 + >> F.pokeByteOff ptr0 4 another_typedef_struct_t_bar3 -newtype CAnotherTypedefEnumE = MkCAnotherTypedefEnumE - { unCAnotherTypedefEnumE :: FC.CUInt +newtype Another_typedef_enum_e = Another_typedef_enum_e + { unAnother_typedef_enum_e :: FC.CUInt } -instance F.Storable CAnotherTypedefEnumE where +instance F.Storable Another_typedef_enum_e where sizeOf = \_ -> 4 @@ -69,67 +69,67 @@ instance F.Storable CAnotherTypedefEnumE where peek = \ptr0 -> - pure MkCAnotherTypedefEnumE + pure Another_typedef_enum_e <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCAnotherTypedefEnumE unCAnotherTypedefEnumE2 -> - F.pokeByteOff ptr0 0 unCAnotherTypedefEnumE2 + Another_typedef_enum_e unAnother_typedef_enum_e2 -> + F.pokeByteOff ptr0 0 unAnother_typedef_enum_e2 -pattern MkCFOO :: CAnotherTypedefEnumE -pattern MkCFOO = MkCAnotherTypedefEnumE 0 +pattern FOO :: Another_typedef_enum_e +pattern FOO = Another_typedef_enum_e 0 -pattern MkCBAR :: CAnotherTypedefEnumE -pattern MkCBAR = MkCAnotherTypedefEnumE 1 +pattern BAR :: Another_typedef_enum_e +pattern BAR = Another_typedef_enum_e 1 -newtype CATypeT = MkCATypeT - { unCATypeT :: FC.CInt +newtype A_type_t = A_type_t + { unA_type_t :: FC.CInt } -deriving newtype instance F.Storable CATypeT +deriving newtype instance F.Storable A_type_t -newtype CVarT = MkCVarT - { unCVarT :: FC.CInt +newtype Var_t = Var_t + { unVar_t :: FC.CInt } -deriving newtype instance F.Storable CVarT +deriving newtype instance F.Storable Var_t -newtype CUint8T = MkCUint8T - { unCUint8T :: FC.CSChar +newtype Uint8_t = Uint8_t + { unUint8_t :: FC.CSChar } -deriving newtype instance F.Storable CUint8T +deriving newtype instance F.Storable Uint8_t -newtype CUint16T = MkCUint16T - { unCUint16T :: FC.CUShort +newtype Uint16_t = Uint16_t + { unUint16_t :: FC.CUShort } -deriving newtype instance F.Storable CUint16T +deriving newtype instance F.Storable Uint16_t -newtype CUint32T = MkCUint32T - { unCUint32T :: FC.CUInt +newtype Uint32_t = Uint32_t + { unUint32_t :: FC.CUInt } -deriving newtype instance F.Storable CUint32T - -data CATypedefStruct = MkCATypedefStruct - { cATypedefStruct_field_0 :: FC.CBool - , cATypedefStruct_field_1 :: CUint8T - , cATypedefStruct_field_2 :: CUint16T - , cATypedefStruct_field_3 :: CUint32T - , cATypedefStruct_field_4 :: CAnotherTypedefStructT - , cATypedefStruct_field_5 :: F.Ptr CAnotherTypedefStructT - , cATypedefStruct_field_6 :: F.Ptr Void - , cATypedefStruct_field_7 :: (HsBindgen.ConstantArray.ConstantArray 7) CUint32T - , cATypedefStruct_field_8 :: CAnotherTypedefEnumE - , cATypedefStruct_field_9 :: CAnotherTypedefEnumE - , cATypedefStruct_field_10 :: CAnotherTypedefEnumE +deriving newtype instance F.Storable Uint32_t + +data A_typedef_struct = A_typedef_struct + { a_typedef_struct_field_0 :: FC.CBool + , a_typedef_struct_field_1 :: Uint8_t + , a_typedef_struct_field_2 :: Uint16_t + , a_typedef_struct_field_3 :: Uint32_t + , a_typedef_struct_field_4 :: Another_typedef_struct_t + , a_typedef_struct_field_5 :: F.Ptr Another_typedef_struct_t + , a_typedef_struct_field_6 :: F.Ptr Void + , a_typedef_struct_field_7 :: (HsBindgen.ConstantArray.ConstantArray 7) Uint32_t + , a_typedef_struct_field_8 :: Another_typedef_enum_e + , a_typedef_struct_field_9 :: Another_typedef_enum_e + , a_typedef_struct_field_10 :: Another_typedef_enum_e } -instance F.Storable CATypedefStruct where +instance F.Storable A_typedef_struct where sizeOf = \_ -> 140 @@ -137,7 +137,7 @@ instance F.Storable CATypedefStruct where peek = \ptr0 -> - pure MkCATypedefStruct + pure A_typedef_struct <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 1 <*> F.peekByteOff ptr0 2 @@ -154,41 +154,41 @@ instance F.Storable CATypedefStruct where \ptr0 -> \s1 -> case s1 of - MkCATypedefStruct - cATypedefStruct_field_02 - cATypedefStruct_field_13 - cATypedefStruct_field_24 - cATypedefStruct_field_35 - cATypedefStruct_field_46 - cATypedefStruct_field_57 - cATypedefStruct_field_68 - cATypedefStruct_field_79 - cATypedefStruct_field_810 - cATypedefStruct_field_911 - cATypedefStruct_field_1012 -> - F.pokeByteOff ptr0 0 cATypedefStruct_field_02 - >> F.pokeByteOff ptr0 1 cATypedefStruct_field_13 - >> F.pokeByteOff ptr0 2 cATypedefStruct_field_24 - >> F.pokeByteOff ptr0 4 cATypedefStruct_field_35 - >> F.pokeByteOff ptr0 8 cATypedefStruct_field_46 - >> F.pokeByteOff ptr0 16 cATypedefStruct_field_57 - >> F.pokeByteOff ptr0 24 cATypedefStruct_field_68 - >> F.pokeByteOff ptr0 32 cATypedefStruct_field_79 - >> F.pokeByteOff ptr0 60 cATypedefStruct_field_810 - >> F.pokeByteOff ptr0 64 cATypedefStruct_field_911 - >> F.pokeByteOff ptr0 80 cATypedefStruct_field_1012 - -newtype CATypedefStructT = MkCATypedefStructT - { unCATypedefStructT :: CATypedefStruct + A_typedef_struct + a_typedef_struct_field_02 + a_typedef_struct_field_13 + a_typedef_struct_field_24 + a_typedef_struct_field_35 + a_typedef_struct_field_46 + a_typedef_struct_field_57 + a_typedef_struct_field_68 + a_typedef_struct_field_79 + a_typedef_struct_field_810 + a_typedef_struct_field_911 + a_typedef_struct_field_1012 -> + F.pokeByteOff ptr0 0 a_typedef_struct_field_02 + >> F.pokeByteOff ptr0 1 a_typedef_struct_field_13 + >> F.pokeByteOff ptr0 2 a_typedef_struct_field_24 + >> F.pokeByteOff ptr0 4 a_typedef_struct_field_35 + >> F.pokeByteOff ptr0 8 a_typedef_struct_field_46 + >> F.pokeByteOff ptr0 16 a_typedef_struct_field_57 + >> F.pokeByteOff ptr0 24 a_typedef_struct_field_68 + >> F.pokeByteOff ptr0 32 a_typedef_struct_field_79 + >> F.pokeByteOff ptr0 60 a_typedef_struct_field_810 + >> F.pokeByteOff ptr0 64 a_typedef_struct_field_911 + >> F.pokeByteOff ptr0 80 a_typedef_struct_field_1012 + +newtype A_typedef_struct_t = A_typedef_struct_t + { unA_typedef_struct_t :: A_typedef_struct } -deriving newtype instance F.Storable CATypedefStructT +deriving newtype instance F.Storable A_typedef_struct_t -newtype CATypedefEnumE = MkCATypedefEnumE - { unCATypedefEnumE :: FC.CSChar +newtype A_typedef_enum_e = A_typedef_enum_e + { unA_typedef_enum_e :: FC.CSChar } -instance F.Storable CATypedefEnumE where +instance F.Storable A_typedef_enum_e where sizeOf = \_ -> 1 @@ -196,35 +196,35 @@ instance F.Storable CATypedefEnumE where peek = \ptr0 -> - pure MkCATypedefEnumE + pure A_typedef_enum_e <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCATypedefEnumE unCATypedefEnumE2 -> F.pokeByteOff ptr0 0 unCATypedefEnumE2 + A_typedef_enum_e unA_typedef_enum_e2 -> F.pokeByteOff ptr0 0 unA_typedef_enum_e2 -pattern MkCENUMCASE0 :: CATypedefEnumE -pattern MkCENUMCASE0 = MkCATypedefEnumE 0 +pattern ENUM_CASE_0 :: A_typedef_enum_e +pattern ENUM_CASE_0 = A_typedef_enum_e 0 -pattern MkCENUMCASE1 :: CATypedefEnumE -pattern MkCENUMCASE1 = MkCATypedefEnumE 1 +pattern ENUM_CASE_1 :: A_typedef_enum_e +pattern ENUM_CASE_1 = A_typedef_enum_e 1 -pattern MkCENUMCASE2 :: CATypedefEnumE -pattern MkCENUMCASE2 = MkCATypedefEnumE 2 +pattern ENUM_CASE_2 :: A_typedef_enum_e +pattern ENUM_CASE_2 = A_typedef_enum_e 2 -pattern MkCENUMCASE3 :: CATypedefEnumE -pattern MkCENUMCASE3 = MkCATypedefEnumE 3 +pattern ENUM_CASE_3 :: A_typedef_enum_e +pattern ENUM_CASE_3 = A_typedef_enum_e 3 -newtype CInt32T = MkCInt32T - { unCInt32T :: FC.CInt +newtype Int32_t = Int32_t + { unInt32_t :: FC.CInt } -deriving newtype instance F.Storable CInt32T +deriving newtype instance F.Storable Int32_t -newtype CCallbackT = MkCCallbackT - { unCCallbackT :: F.FunPtr ((F.Ptr Void) -> CUint32T -> IO CUint32T) +newtype Callback_t = Callback_t + { unCallback_t :: F.FunPtr ((F.Ptr Void) -> Uint32_t -> IO Uint32_t) } -deriving newtype instance F.Storable CCallbackT +deriving newtype instance F.Storable Callback_t diff --git a/hs-bindgen/fixtures/distilled_lib_1.th.txt b/hs-bindgen/fixtures/distilled_lib_1.th.txt index 4165a8d2..aea706d4 100644 --- a/hs-bindgen/fixtures/distilled_lib_1.th.txt +++ b/hs-bindgen/fixtures/distilled_lib_1.th.txt @@ -12,90 +12,90 @@ a_DEFINE_2 :: forall a_0 . Integral a_0 => a_0 a_DEFINE_2 = 2 tWO_ARGS :: forall a_0 . Integral a_0 => a_0 tWO_ARGS = 13398 -foreign import capi safe "distilled_lib_1.h some_fun" some_fun :: Ptr CATypeT -> - CUint32T -> Void -> IO CInt32T -data CAnotherTypedefStructT - = MkCAnotherTypedefStructT {cAnotherTypedefStructT_foo :: CInt, - cAnotherTypedefStructT_bar :: CChar} -instance Storable CAnotherTypedefStructT +foreign import capi safe "distilled_lib_1.h some_fun" some_fun :: Ptr A_type_t -> + Uint32_t -> Void -> IO Int32_t +data Another_typedef_struct_t + = Another_typedef_struct_t {another_typedef_struct_t_foo :: CInt, + another_typedef_struct_t_bar :: CChar} +instance Storable Another_typedef_struct_t where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCAnotherTypedefStructT <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure Another_typedef_struct_t <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCAnotherTypedefStructT cAnotherTypedefStructT_foo_3 - cAnotherTypedefStructT_bar_4 -> pokeByteOff ptr_1 0 cAnotherTypedefStructT_foo_3 >> pokeByteOff ptr_1 4 cAnotherTypedefStructT_bar_4}} -newtype CAnotherTypedefEnumE - = MkCAnotherTypedefEnumE {unCAnotherTypedefEnumE :: CUInt} -instance Storable CAnotherTypedefEnumE + {Another_typedef_struct_t another_typedef_struct_t_foo_3 + another_typedef_struct_t_bar_4 -> pokeByteOff ptr_1 0 another_typedef_struct_t_foo_3 >> pokeByteOff ptr_1 4 another_typedef_struct_t_bar_4}} +newtype Another_typedef_enum_e + = Another_typedef_enum_e {unAnother_typedef_enum_e :: CUInt} +instance Storable Another_typedef_enum_e where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCAnotherTypedefEnumE <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure Another_typedef_enum_e <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCAnotherTypedefEnumE unCAnotherTypedefEnumE_3 -> pokeByteOff ptr_1 0 unCAnotherTypedefEnumE_3}} -pattern MkCFOO :: CAnotherTypedefEnumE -pattern MkCFOO = MkCAnotherTypedefEnumE 0 -pattern MkCBAR :: CAnotherTypedefEnumE -pattern MkCBAR = MkCAnotherTypedefEnumE 1 -newtype CATypeT = MkCATypeT {unCATypeT :: CInt} -deriving newtype instance Storable CATypeT -newtype CVarT = MkCVarT {unCVarT :: CInt} -deriving newtype instance Storable CVarT -newtype CUint8T = MkCUint8T {unCUint8T :: CSChar} -deriving newtype instance Storable CUint8T -newtype CUint16T = MkCUint16T {unCUint16T :: CUShort} -deriving newtype instance Storable CUint16T -newtype CUint32T = MkCUint32T {unCUint32T :: CUInt} -deriving newtype instance Storable CUint32T -data CATypedefStruct - = MkCATypedefStruct {cATypedefStruct_field_0 :: CBool, - cATypedefStruct_field_1 :: CUint8T, - cATypedefStruct_field_2 :: CUint16T, - cATypedefStruct_field_3 :: CUint32T, - cATypedefStruct_field_4 :: CAnotherTypedefStructT, - cATypedefStruct_field_5 :: (Ptr CAnotherTypedefStructT), - cATypedefStruct_field_6 :: (Ptr Void), - cATypedefStruct_field_7 :: (ConstantArray 7 CUint32T), - cATypedefStruct_field_8 :: CAnotherTypedefEnumE, - cATypedefStruct_field_9 :: CAnotherTypedefEnumE, - cATypedefStruct_field_10 :: CAnotherTypedefEnumE} -instance Storable CATypedefStruct + {Another_typedef_enum_e unAnother_typedef_enum_e_3 -> pokeByteOff ptr_1 0 unAnother_typedef_enum_e_3}} +pattern FOO :: Another_typedef_enum_e +pattern FOO = Another_typedef_enum_e 0 +pattern BAR :: Another_typedef_enum_e +pattern BAR = Another_typedef_enum_e 1 +newtype A_type_t = A_type_t {unA_type_t :: CInt} +deriving newtype instance Storable A_type_t +newtype Var_t = Var_t {unVar_t :: CInt} +deriving newtype instance Storable Var_t +newtype Uint8_t = Uint8_t {unUint8_t :: CSChar} +deriving newtype instance Storable Uint8_t +newtype Uint16_t = Uint16_t {unUint16_t :: CUShort} +deriving newtype instance Storable Uint16_t +newtype Uint32_t = Uint32_t {unUint32_t :: CUInt} +deriving newtype instance Storable Uint32_t +data A_typedef_struct + = A_typedef_struct {a_typedef_struct_field_0 :: CBool, + a_typedef_struct_field_1 :: Uint8_t, + a_typedef_struct_field_2 :: Uint16_t, + a_typedef_struct_field_3 :: Uint32_t, + a_typedef_struct_field_4 :: Another_typedef_struct_t, + a_typedef_struct_field_5 :: (Ptr Another_typedef_struct_t), + a_typedef_struct_field_6 :: (Ptr Void), + a_typedef_struct_field_7 :: (ConstantArray 7 Uint32_t), + a_typedef_struct_field_8 :: Another_typedef_enum_e, + a_typedef_struct_field_9 :: Another_typedef_enum_e, + a_typedef_struct_field_10 :: Another_typedef_enum_e} +instance Storable A_typedef_struct where {sizeOf = \_ -> 140; alignment = \_ -> 1; - peek = \ptr_0 -> ((((((((((pure MkCATypedefStruct <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1) <*> peekByteOff ptr_0 2) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 16) <*> peekByteOff ptr_0 24) <*> peekByteOff ptr_0 32) <*> peekByteOff ptr_0 60) <*> peekByteOff ptr_0 64) <*> peekByteOff ptr_0 80; + peek = \ptr_0 -> ((((((((((pure A_typedef_struct <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1) <*> peekByteOff ptr_0 2) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 16) <*> peekByteOff ptr_0 24) <*> peekByteOff ptr_0 32) <*> peekByteOff ptr_0 60) <*> peekByteOff ptr_0 64) <*> peekByteOff ptr_0 80; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCATypedefStruct cATypedefStruct_field_0_3 - cATypedefStruct_field_1_4 - cATypedefStruct_field_2_5 - cATypedefStruct_field_3_6 - cATypedefStruct_field_4_7 - cATypedefStruct_field_5_8 - cATypedefStruct_field_6_9 - cATypedefStruct_field_7_10 - cATypedefStruct_field_8_11 - cATypedefStruct_field_9_12 - cATypedefStruct_field_10_13 -> pokeByteOff ptr_1 0 cATypedefStruct_field_0_3 >> (pokeByteOff ptr_1 1 cATypedefStruct_field_1_4 >> (pokeByteOff ptr_1 2 cATypedefStruct_field_2_5 >> (pokeByteOff ptr_1 4 cATypedefStruct_field_3_6 >> (pokeByteOff ptr_1 8 cATypedefStruct_field_4_7 >> (pokeByteOff ptr_1 16 cATypedefStruct_field_5_8 >> (pokeByteOff ptr_1 24 cATypedefStruct_field_6_9 >> (pokeByteOff ptr_1 32 cATypedefStruct_field_7_10 >> (pokeByteOff ptr_1 60 cATypedefStruct_field_8_11 >> (pokeByteOff ptr_1 64 cATypedefStruct_field_9_12 >> pokeByteOff ptr_1 80 cATypedefStruct_field_10_13)))))))))}} -newtype CATypedefStructT - = MkCATypedefStructT {unCATypedefStructT :: CATypedefStruct} -deriving newtype instance Storable CATypedefStructT -newtype CATypedefEnumE - = MkCATypedefEnumE {unCATypedefEnumE :: CSChar} -instance Storable CATypedefEnumE + {A_typedef_struct a_typedef_struct_field_0_3 + a_typedef_struct_field_1_4 + a_typedef_struct_field_2_5 + a_typedef_struct_field_3_6 + a_typedef_struct_field_4_7 + a_typedef_struct_field_5_8 + a_typedef_struct_field_6_9 + a_typedef_struct_field_7_10 + a_typedef_struct_field_8_11 + a_typedef_struct_field_9_12 + a_typedef_struct_field_10_13 -> pokeByteOff ptr_1 0 a_typedef_struct_field_0_3 >> (pokeByteOff ptr_1 1 a_typedef_struct_field_1_4 >> (pokeByteOff ptr_1 2 a_typedef_struct_field_2_5 >> (pokeByteOff ptr_1 4 a_typedef_struct_field_3_6 >> (pokeByteOff ptr_1 8 a_typedef_struct_field_4_7 >> (pokeByteOff ptr_1 16 a_typedef_struct_field_5_8 >> (pokeByteOff ptr_1 24 a_typedef_struct_field_6_9 >> (pokeByteOff ptr_1 32 a_typedef_struct_field_7_10 >> (pokeByteOff ptr_1 60 a_typedef_struct_field_8_11 >> (pokeByteOff ptr_1 64 a_typedef_struct_field_9_12 >> pokeByteOff ptr_1 80 a_typedef_struct_field_10_13)))))))))}} +newtype A_typedef_struct_t + = A_typedef_struct_t {unA_typedef_struct_t :: A_typedef_struct} +deriving newtype instance Storable A_typedef_struct_t +newtype A_typedef_enum_e + = A_typedef_enum_e {unA_typedef_enum_e :: CSChar} +instance Storable A_typedef_enum_e where {sizeOf = \_ -> 1; alignment = \_ -> 1; - peek = \ptr_0 -> pure MkCATypedefEnumE <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure A_typedef_enum_e <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCATypedefEnumE unCATypedefEnumE_3 -> pokeByteOff ptr_1 0 unCATypedefEnumE_3}} -pattern MkCENUMCASE0 :: CATypedefEnumE -pattern MkCENUMCASE0 = MkCATypedefEnumE 0 -pattern MkCENUMCASE1 :: CATypedefEnumE -pattern MkCENUMCASE1 = MkCATypedefEnumE 1 -pattern MkCENUMCASE2 :: CATypedefEnumE -pattern MkCENUMCASE2 = MkCATypedefEnumE 2 -pattern MkCENUMCASE3 :: CATypedefEnumE -pattern MkCENUMCASE3 = MkCATypedefEnumE 3 -newtype CInt32T = MkCInt32T {unCInt32T :: CInt} -deriving newtype instance Storable CInt32T -newtype CCallbackT - = MkCCallbackT {unCCallbackT :: (FunPtr (Ptr Void -> - CUint32T -> IO CUint32T))} -deriving newtype instance Storable CCallbackT + {A_typedef_enum_e unA_typedef_enum_e_3 -> pokeByteOff ptr_1 0 unA_typedef_enum_e_3}} +pattern ENUM_CASE_0 :: A_typedef_enum_e +pattern ENUM_CASE_0 = A_typedef_enum_e 0 +pattern ENUM_CASE_1 :: A_typedef_enum_e +pattern ENUM_CASE_1 = A_typedef_enum_e 1 +pattern ENUM_CASE_2 :: A_typedef_enum_e +pattern ENUM_CASE_2 = A_typedef_enum_e 2 +pattern ENUM_CASE_3 :: A_typedef_enum_e +pattern ENUM_CASE_3 = A_typedef_enum_e 3 +newtype Int32_t = Int32_t {unInt32_t :: CInt} +deriving newtype instance Storable Int32_t +newtype Callback_t + = Callback_t {unCallback_t :: (FunPtr (Ptr Void -> + Uint32_t -> IO Uint32_t))} +deriving newtype instance Storable Callback_t diff --git a/hs-bindgen/fixtures/enums.hs b/hs-bindgen/fixtures/enums.hs index 60af5ae0..773e3f6d 100644 --- a/hs-bindgen/fixtures/enums.hs +++ b/hs-bindgen/fixtures/enums.hs @@ -1,36 +1,36 @@ -DeclNewtype (Newtype {newtypeName = "CFirst", newtypeConstr = "MkCFirst", newtypeField = Field {fieldName = "unCFirst", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = Field {fieldName = "unCFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = Field {fieldName = "unCFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = Field {fieldName = "unCFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCFIRST1", patSynType = "CFirst", patSynConstr = "MkCFirst", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCFIRST2", patSynType = "CFirst", patSynConstr = "MkCFirst", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CSecond", newtypeConstr = "MkCSecond", newtypeField = Field {fieldName = "unCSecond", fieldType = HsPrimType HsPrimCInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = Field {fieldName = "unCSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = Field {fieldName = "unCSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = Field {fieldName = "unCSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCSECONDA", patSynType = "CSecond", patSynConstr = "MkCSecond", patSynValue = -1}) -DeclPatSyn (PatSyn {patSynName = "MkCSECONDB", patSynType = "CSecond", patSynConstr = "MkCSecond", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCSECONDC", patSynType = "CSecond", patSynConstr = "MkCSecond", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CSame", newtypeConstr = "MkCSame", newtypeField = Field {fieldName = "unCSame", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CSame", structConstr = "MkCSame", structFields = Field {fieldName = "unCSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CSame", structConstr = "MkCSame", structFields = Field {fieldName = "unCSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CSame", structConstr = "MkCSame", structFields = Field {fieldName = "unCSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCSAMEA", patSynType = "CSame", patSynConstr = "MkCSame", patSynValue = 1}) -DeclPatSyn (PatSyn {patSynName = "MkCSAMEB", patSynType = "CSame", patSynConstr = "MkCSame", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CPackad", newtypeConstr = "MkCPackad", newtypeField = Field {fieldName = "unCPackad", fieldType = HsPrimType HsPrimCSChar}}) -DeclInstance (InstanceStorable (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = Field {fieldName = "unCPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = Field {fieldName = "unCPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = Field {fieldName = "unCPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCPACKEDA", patSynType = "CPackad", patSynConstr = "MkCPackad", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCPACKEDB", patSynType = "CPackad", patSynConstr = "MkCPackad", patSynValue = 1}) -DeclPatSyn (PatSyn {patSynName = "MkCPACKEDC", patSynType = "CPackad", patSynConstr = "MkCPackad", patSynValue = 2}) -DeclNewtype (Newtype {newtypeName = "CEnumA", newtypeConstr = "MkCEnumA", newtypeField = Field {fieldName = "unCEnumA", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = Field {fieldName = "unCEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = Field {fieldName = "unCEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = Field {fieldName = "unCEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCAFOO", patSynType = "CEnumA", patSynConstr = "MkCEnumA", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCABAR", patSynType = "CEnumA", patSynConstr = "MkCEnumA", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CEnumB", newtypeConstr = "MkCEnumB", newtypeField = Field {fieldName = "unCEnumB", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = Field {fieldName = "unCEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = Field {fieldName = "unCEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = Field {fieldName = "unCEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCBFOO", patSynType = "CEnumB", patSynConstr = "MkCEnumB", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCBBAR", patSynType = "CEnumB", patSynConstr = "MkCEnumB", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CEnumC", newtypeConstr = "MkCEnumC", newtypeField = Field {fieldName = "unCEnumC", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = Field {fieldName = "unCEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = Field {fieldName = "unCEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = Field {fieldName = "unCEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCCFOO", patSynType = "CEnumC", patSynConstr = "MkCEnumC", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCCBAR", patSynType = "CEnumC", patSynConstr = "MkCEnumC", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CEnumD", newtypeConstr = "MkCEnumD", newtypeField = Field {fieldName = "unCEnumD", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = Field {fieldName = "unCEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = Field {fieldName = "unCEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = Field {fieldName = "unCEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCDFOO", patSynType = "CEnumD", patSynConstr = "MkCEnumD", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCDBAR", patSynType = "CEnumD", patSynConstr = "MkCEnumD", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CEnumDT", newtypeConstr = "MkCEnumDT", newtypeField = Field {fieldName = "unCEnumDT", fieldType = HsTypRef "CEnumD"}}) -DeclNewtypeInstance Storable "CEnumDT" +DeclNewtype (Newtype {newtypeName = "First", newtypeConstr = "First", newtypeField = Field {fieldName = "unFirst", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "First", structConstr = "First", structFields = Field {fieldName = "unFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "First", structConstr = "First", structFields = Field {fieldName = "unFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "First", structConstr = "First", structFields = Field {fieldName = "unFirst", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "FIRST1", patSynType = "First", patSynConstr = "First", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "FIRST2", patSynType = "First", patSynConstr = "First", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "Second", newtypeConstr = "Second", newtypeField = Field {fieldName = "unSecond", fieldType = HsPrimType HsPrimCInt}}) +DeclInstance (InstanceStorable (Struct {structName = "Second", structConstr = "Second", structFields = Field {fieldName = "unSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Second", structConstr = "Second", structFields = Field {fieldName = "unSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Second", structConstr = "Second", structFields = Field {fieldName = "unSecond", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "SECOND_A", patSynType = "Second", patSynConstr = "Second", patSynValue = -1}) +DeclPatSyn (PatSyn {patSynName = "SECOND_B", patSynType = "Second", patSynConstr = "Second", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "SECOND_C", patSynType = "Second", patSynConstr = "Second", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "Same", newtypeConstr = "Same", newtypeField = Field {fieldName = "unSame", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "Same", structConstr = "Same", structFields = Field {fieldName = "unSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Same", structConstr = "Same", structFields = Field {fieldName = "unSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Same", structConstr = "Same", structFields = Field {fieldName = "unSame", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "SAME_A", patSynType = "Same", patSynConstr = "Same", patSynValue = 1}) +DeclPatSyn (PatSyn {patSynName = "SAME_B", patSynType = "Same", patSynConstr = "Same", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "Packad", newtypeConstr = "Packad", newtypeField = Field {fieldName = "unPackad", fieldType = HsPrimType HsPrimCSChar}}) +DeclInstance (InstanceStorable (Struct {structName = "Packad", structConstr = "Packad", structFields = Field {fieldName = "unPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Packad", structConstr = "Packad", structFields = Field {fieldName = "unPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Packad", structConstr = "Packad", structFields = Field {fieldName = "unPackad", fieldType = HsPrimType HsPrimCSChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "PACKED_A", patSynType = "Packad", patSynConstr = "Packad", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "PACKED_B", patSynType = "Packad", patSynConstr = "Packad", patSynValue = 1}) +DeclPatSyn (PatSyn {patSynName = "PACKED_C", patSynType = "Packad", patSynConstr = "Packad", patSynValue = 2}) +DeclNewtype (Newtype {newtypeName = "EnumA", newtypeConstr = "EnumA", newtypeField = Field {fieldName = "unEnumA", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "EnumA", structConstr = "EnumA", structFields = Field {fieldName = "unEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "EnumA", structConstr = "EnumA", structFields = Field {fieldName = "unEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "EnumA", structConstr = "EnumA", structFields = Field {fieldName = "unEnumA", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "A_FOO", patSynType = "EnumA", patSynConstr = "EnumA", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "A_BAR", patSynType = "EnumA", patSynConstr = "EnumA", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "EnumB", newtypeConstr = "EnumB", newtypeField = Field {fieldName = "unEnumB", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "EnumB", structConstr = "EnumB", structFields = Field {fieldName = "unEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "EnumB", structConstr = "EnumB", structFields = Field {fieldName = "unEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "EnumB", structConstr = "EnumB", structFields = Field {fieldName = "unEnumB", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "B_FOO", patSynType = "EnumB", patSynConstr = "EnumB", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "B_BAR", patSynType = "EnumB", patSynConstr = "EnumB", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "EnumC", newtypeConstr = "EnumC", newtypeField = Field {fieldName = "unEnumC", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "EnumC", structConstr = "EnumC", structFields = Field {fieldName = "unEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "EnumC", structConstr = "EnumC", structFields = Field {fieldName = "unEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "EnumC", structConstr = "EnumC", structFields = Field {fieldName = "unEnumC", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "C_FOO", patSynType = "EnumC", patSynConstr = "EnumC", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "C_BAR", patSynType = "EnumC", patSynConstr = "EnumC", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "EnumD", newtypeConstr = "EnumD", newtypeField = Field {fieldName = "unEnumD", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "EnumD", structConstr = "EnumD", structFields = Field {fieldName = "unEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "EnumD", structConstr = "EnumD", structFields = Field {fieldName = "unEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "EnumD", structConstr = "EnumD", structFields = Field {fieldName = "unEnumD", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "D_FOO", patSynType = "EnumD", patSynConstr = "EnumD", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "D_BAR", patSynType = "EnumD", patSynConstr = "EnumD", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "EnumD_t", newtypeConstr = "EnumD_t", newtypeField = Field {fieldName = "unEnumD_t", fieldType = HsTypRef "EnumD"}}) +DeclNewtypeInstance Storable "EnumD_t" diff --git a/hs-bindgen/fixtures/enums.pp.hs b/hs-bindgen/fixtures/enums.pp.hs index d7106585..cdfbf99f 100644 --- a/hs-bindgen/fixtures/enums.pp.hs +++ b/hs-bindgen/fixtures/enums.pp.hs @@ -6,11 +6,11 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), pure) -newtype CFirst = MkCFirst - { unCFirst :: FC.CUInt +newtype First = First + { unFirst :: FC.CUInt } -instance F.Storable CFirst where +instance F.Storable First where sizeOf = \_ -> 4 @@ -18,26 +18,26 @@ instance F.Storable CFirst where peek = \ptr0 -> - pure MkCFirst + pure First <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCFirst unCFirst2 -> F.pokeByteOff ptr0 0 unCFirst2 + First unFirst2 -> F.pokeByteOff ptr0 0 unFirst2 -pattern MkCFIRST1 :: CFirst -pattern MkCFIRST1 = MkCFirst 0 +pattern FIRST1 :: First +pattern FIRST1 = First 0 -pattern MkCFIRST2 :: CFirst -pattern MkCFIRST2 = MkCFirst 1 +pattern FIRST2 :: First +pattern FIRST2 = First 1 -newtype CSecond = MkCSecond - { unCSecond :: FC.CInt +newtype Second = Second + { unSecond :: FC.CInt } -instance F.Storable CSecond where +instance F.Storable Second where sizeOf = \_ -> 4 @@ -45,29 +45,29 @@ instance F.Storable CSecond where peek = \ptr0 -> - pure MkCSecond + pure Second <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCSecond unCSecond2 -> F.pokeByteOff ptr0 0 unCSecond2 + Second unSecond2 -> F.pokeByteOff ptr0 0 unSecond2 -pattern MkCSECONDA :: CSecond -pattern MkCSECONDA = MkCSecond -1 +pattern SECOND_A :: Second +pattern SECOND_A = Second -1 -pattern MkCSECONDB :: CSecond -pattern MkCSECONDB = MkCSecond 0 +pattern SECOND_B :: Second +pattern SECOND_B = Second 0 -pattern MkCSECONDC :: CSecond -pattern MkCSECONDC = MkCSecond 1 +pattern SECOND_C :: Second +pattern SECOND_C = Second 1 -newtype CSame = MkCSame - { unCSame :: FC.CUInt +newtype Same = Same + { unSame :: FC.CUInt } -instance F.Storable CSame where +instance F.Storable Same where sizeOf = \_ -> 4 @@ -75,26 +75,26 @@ instance F.Storable CSame where peek = \ptr0 -> - pure MkCSame + pure Same <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCSame unCSame2 -> F.pokeByteOff ptr0 0 unCSame2 + Same unSame2 -> F.pokeByteOff ptr0 0 unSame2 -pattern MkCSAMEA :: CSame -pattern MkCSAMEA = MkCSame 1 +pattern SAME_A :: Same +pattern SAME_A = Same 1 -pattern MkCSAMEB :: CSame -pattern MkCSAMEB = MkCSame 1 +pattern SAME_B :: Same +pattern SAME_B = Same 1 -newtype CPackad = MkCPackad - { unCPackad :: FC.CSChar +newtype Packad = Packad + { unPackad :: FC.CSChar } -instance F.Storable CPackad where +instance F.Storable Packad where sizeOf = \_ -> 1 @@ -102,29 +102,29 @@ instance F.Storable CPackad where peek = \ptr0 -> - pure MkCPackad + pure Packad <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCPackad unCPackad2 -> F.pokeByteOff ptr0 0 unCPackad2 + Packad unPackad2 -> F.pokeByteOff ptr0 0 unPackad2 -pattern MkCPACKEDA :: CPackad -pattern MkCPACKEDA = MkCPackad 0 +pattern PACKED_A :: Packad +pattern PACKED_A = Packad 0 -pattern MkCPACKEDB :: CPackad -pattern MkCPACKEDB = MkCPackad 1 +pattern PACKED_B :: Packad +pattern PACKED_B = Packad 1 -pattern MkCPACKEDC :: CPackad -pattern MkCPACKEDC = MkCPackad 2 +pattern PACKED_C :: Packad +pattern PACKED_C = Packad 2 -newtype CEnumA = MkCEnumA - { unCEnumA :: FC.CUInt +newtype EnumA = EnumA + { unEnumA :: FC.CUInt } -instance F.Storable CEnumA where +instance F.Storable EnumA where sizeOf = \_ -> 4 @@ -132,26 +132,26 @@ instance F.Storable CEnumA where peek = \ptr0 -> - pure MkCEnumA + pure EnumA <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCEnumA unCEnumA2 -> F.pokeByteOff ptr0 0 unCEnumA2 + EnumA unEnumA2 -> F.pokeByteOff ptr0 0 unEnumA2 -pattern MkCAFOO :: CEnumA -pattern MkCAFOO = MkCEnumA 0 +pattern A_FOO :: EnumA +pattern A_FOO = EnumA 0 -pattern MkCABAR :: CEnumA -pattern MkCABAR = MkCEnumA 1 +pattern A_BAR :: EnumA +pattern A_BAR = EnumA 1 -newtype CEnumB = MkCEnumB - { unCEnumB :: FC.CUInt +newtype EnumB = EnumB + { unEnumB :: FC.CUInt } -instance F.Storable CEnumB where +instance F.Storable EnumB where sizeOf = \_ -> 4 @@ -159,26 +159,26 @@ instance F.Storable CEnumB where peek = \ptr0 -> - pure MkCEnumB + pure EnumB <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCEnumB unCEnumB2 -> F.pokeByteOff ptr0 0 unCEnumB2 + EnumB unEnumB2 -> F.pokeByteOff ptr0 0 unEnumB2 -pattern MkCBFOO :: CEnumB -pattern MkCBFOO = MkCEnumB 0 +pattern B_FOO :: EnumB +pattern B_FOO = EnumB 0 -pattern MkCBBAR :: CEnumB -pattern MkCBBAR = MkCEnumB 1 +pattern B_BAR :: EnumB +pattern B_BAR = EnumB 1 -newtype CEnumC = MkCEnumC - { unCEnumC :: FC.CUInt +newtype EnumC = EnumC + { unEnumC :: FC.CUInt } -instance F.Storable CEnumC where +instance F.Storable EnumC where sizeOf = \_ -> 4 @@ -186,26 +186,26 @@ instance F.Storable CEnumC where peek = \ptr0 -> - pure MkCEnumC + pure EnumC <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCEnumC unCEnumC2 -> F.pokeByteOff ptr0 0 unCEnumC2 + EnumC unEnumC2 -> F.pokeByteOff ptr0 0 unEnumC2 -pattern MkCCFOO :: CEnumC -pattern MkCCFOO = MkCEnumC 0 +pattern C_FOO :: EnumC +pattern C_FOO = EnumC 0 -pattern MkCCBAR :: CEnumC -pattern MkCCBAR = MkCEnumC 1 +pattern C_BAR :: EnumC +pattern C_BAR = EnumC 1 -newtype CEnumD = MkCEnumD - { unCEnumD :: FC.CUInt +newtype EnumD = EnumD + { unEnumD :: FC.CUInt } -instance F.Storable CEnumD where +instance F.Storable EnumD where sizeOf = \_ -> 4 @@ -213,23 +213,23 @@ instance F.Storable CEnumD where peek = \ptr0 -> - pure MkCEnumD + pure EnumD <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCEnumD unCEnumD2 -> F.pokeByteOff ptr0 0 unCEnumD2 + EnumD unEnumD2 -> F.pokeByteOff ptr0 0 unEnumD2 -pattern MkCDFOO :: CEnumD -pattern MkCDFOO = MkCEnumD 0 +pattern D_FOO :: EnumD +pattern D_FOO = EnumD 0 -pattern MkCDBAR :: CEnumD -pattern MkCDBAR = MkCEnumD 1 +pattern D_BAR :: EnumD +pattern D_BAR = EnumD 1 -newtype CEnumDT = MkCEnumDT - { unCEnumDT :: CEnumD +newtype EnumD_t = EnumD_t + { unEnumD_t :: EnumD } -deriving newtype instance F.Storable CEnumDT +deriving newtype instance F.Storable EnumD_t diff --git a/hs-bindgen/fixtures/enums.th.txt b/hs-bindgen/fixtures/enums.th.txt index 3dec28d7..78c4f39a 100644 --- a/hs-bindgen/fixtures/enums.th.txt +++ b/hs-bindgen/fixtures/enums.th.txt @@ -1,94 +1,94 @@ -newtype CFirst = MkCFirst {unCFirst :: CUInt} -instance Storable CFirst +newtype First = First {unFirst :: CUInt} +instance Storable First where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCFirst <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure First <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCFirst unCFirst_3 -> pokeByteOff ptr_1 0 unCFirst_3}} -pattern MkCFIRST1 :: CFirst -pattern MkCFIRST1 = MkCFirst 0 -pattern MkCFIRST2 :: CFirst -pattern MkCFIRST2 = MkCFirst 1 -newtype CSecond = MkCSecond {unCSecond :: CInt} -instance Storable CSecond + {First unFirst_3 -> pokeByteOff ptr_1 0 unFirst_3}} +pattern FIRST1 :: First +pattern FIRST1 = First 0 +pattern FIRST2 :: First +pattern FIRST2 = First 1 +newtype Second = Second {unSecond :: CInt} +instance Storable Second where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCSecond <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure Second <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCSecond unCSecond_3 -> pokeByteOff ptr_1 0 unCSecond_3}} -pattern MkCSECONDA :: CSecond -pattern MkCSECONDA = MkCSecond (-1) -pattern MkCSECONDB :: CSecond -pattern MkCSECONDB = MkCSecond 0 -pattern MkCSECONDC :: CSecond -pattern MkCSECONDC = MkCSecond 1 -newtype CSame = MkCSame {unCSame :: CUInt} -instance Storable CSame + {Second unSecond_3 -> pokeByteOff ptr_1 0 unSecond_3}} +pattern SECOND_A :: Second +pattern SECOND_A = Second (-1) +pattern SECOND_B :: Second +pattern SECOND_B = Second 0 +pattern SECOND_C :: Second +pattern SECOND_C = Second 1 +newtype Same = Same {unSame :: CUInt} +instance Storable Same where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCSame <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure Same <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCSame unCSame_3 -> pokeByteOff ptr_1 0 unCSame_3}} -pattern MkCSAMEA :: CSame -pattern MkCSAMEA = MkCSame 1 -pattern MkCSAMEB :: CSame -pattern MkCSAMEB = MkCSame 1 -newtype CPackad = MkCPackad {unCPackad :: CSChar} -instance Storable CPackad + {Same unSame_3 -> pokeByteOff ptr_1 0 unSame_3}} +pattern SAME_A :: Same +pattern SAME_A = Same 1 +pattern SAME_B :: Same +pattern SAME_B = Same 1 +newtype Packad = Packad {unPackad :: CSChar} +instance Storable Packad where {sizeOf = \_ -> 1; alignment = \_ -> 1; - peek = \ptr_0 -> pure MkCPackad <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure Packad <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCPackad unCPackad_3 -> pokeByteOff ptr_1 0 unCPackad_3}} -pattern MkCPACKEDA :: CPackad -pattern MkCPACKEDA = MkCPackad 0 -pattern MkCPACKEDB :: CPackad -pattern MkCPACKEDB = MkCPackad 1 -pattern MkCPACKEDC :: CPackad -pattern MkCPACKEDC = MkCPackad 2 -newtype CEnumA = MkCEnumA {unCEnumA :: CUInt} -instance Storable CEnumA + {Packad unPackad_3 -> pokeByteOff ptr_1 0 unPackad_3}} +pattern PACKED_A :: Packad +pattern PACKED_A = Packad 0 +pattern PACKED_B :: Packad +pattern PACKED_B = Packad 1 +pattern PACKED_C :: Packad +pattern PACKED_C = Packad 2 +newtype EnumA = EnumA {unEnumA :: CUInt} +instance Storable EnumA where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCEnumA <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure EnumA <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCEnumA unCEnumA_3 -> pokeByteOff ptr_1 0 unCEnumA_3}} -pattern MkCAFOO :: CEnumA -pattern MkCAFOO = MkCEnumA 0 -pattern MkCABAR :: CEnumA -pattern MkCABAR = MkCEnumA 1 -newtype CEnumB = MkCEnumB {unCEnumB :: CUInt} -instance Storable CEnumB + {EnumA unEnumA_3 -> pokeByteOff ptr_1 0 unEnumA_3}} +pattern A_FOO :: EnumA +pattern A_FOO = EnumA 0 +pattern A_BAR :: EnumA +pattern A_BAR = EnumA 1 +newtype EnumB = EnumB {unEnumB :: CUInt} +instance Storable EnumB where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCEnumB <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure EnumB <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCEnumB unCEnumB_3 -> pokeByteOff ptr_1 0 unCEnumB_3}} -pattern MkCBFOO :: CEnumB -pattern MkCBFOO = MkCEnumB 0 -pattern MkCBBAR :: CEnumB -pattern MkCBBAR = MkCEnumB 1 -newtype CEnumC = MkCEnumC {unCEnumC :: CUInt} -instance Storable CEnumC + {EnumB unEnumB_3 -> pokeByteOff ptr_1 0 unEnumB_3}} +pattern B_FOO :: EnumB +pattern B_FOO = EnumB 0 +pattern B_BAR :: EnumB +pattern B_BAR = EnumB 1 +newtype EnumC = EnumC {unEnumC :: CUInt} +instance Storable EnumC where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCEnumC <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure EnumC <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCEnumC unCEnumC_3 -> pokeByteOff ptr_1 0 unCEnumC_3}} -pattern MkCCFOO :: CEnumC -pattern MkCCFOO = MkCEnumC 0 -pattern MkCCBAR :: CEnumC -pattern MkCCBAR = MkCEnumC 1 -newtype CEnumD = MkCEnumD {unCEnumD :: CUInt} -instance Storable CEnumD + {EnumC unEnumC_3 -> pokeByteOff ptr_1 0 unEnumC_3}} +pattern C_FOO :: EnumC +pattern C_FOO = EnumC 0 +pattern C_BAR :: EnumC +pattern C_BAR = EnumC 1 +newtype EnumD = EnumD {unEnumD :: CUInt} +instance Storable EnumD where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCEnumD <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure EnumD <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCEnumD unCEnumD_3 -> pokeByteOff ptr_1 0 unCEnumD_3}} -pattern MkCDFOO :: CEnumD -pattern MkCDFOO = MkCEnumD 0 -pattern MkCDBAR :: CEnumD -pattern MkCDBAR = MkCEnumD 1 -newtype CEnumDT = MkCEnumDT {unCEnumDT :: CEnumD} -deriving newtype instance Storable CEnumDT + {EnumD unEnumD_3 -> pokeByteOff ptr_1 0 unEnumD_3}} +pattern D_FOO :: EnumD +pattern D_FOO = EnumD 0 +pattern D_BAR :: EnumD +pattern D_BAR = EnumD 1 +newtype EnumD_t = EnumD_t {unEnumD_t :: EnumD} +deriving newtype instance Storable EnumD_t diff --git a/hs-bindgen/fixtures/fixedarray.hs b/hs-bindgen/fixtures/fixedarray.hs index 327f7846..805eccb5 100644 --- a/hs-bindgen/fixtures/fixedarray.hs +++ b/hs-bindgen/fixtures/fixedarray.hs @@ -1,2 +1,2 @@ -DeclNewtype (Newtype {newtypeName = "CTriple", newtypeConstr = "MkCTriple", newtypeField = Field {fieldName = "unCTriple", fieldType = HsConstArray 3 (HsPrimType HsPrimCInt)}}) -DeclNewtypeInstance Storable "CTriple" +DeclNewtype (Newtype {newtypeName = "Triple", newtypeConstr = "Triple", newtypeField = Field {fieldName = "unTriple", fieldType = HsConstArray 3 (HsPrimType HsPrimCInt)}}) +DeclNewtypeInstance Storable "Triple" diff --git a/hs-bindgen/fixtures/fixedarray.pp.hs b/hs-bindgen/fixtures/fixedarray.pp.hs index e7588db0..2c50826a 100644 --- a/hs-bindgen/fixtures/fixedarray.pp.hs +++ b/hs-bindgen/fixtures/fixedarray.pp.hs @@ -6,8 +6,8 @@ import qualified Foreign as F import qualified Foreign.C as FC import qualified HsBindgen.ConstantArray -newtype CTriple = MkCTriple - { unCTriple :: (HsBindgen.ConstantArray.ConstantArray 3) FC.CInt +newtype Triple = Triple + { unTriple :: (HsBindgen.ConstantArray.ConstantArray 3) FC.CInt } -deriving newtype instance F.Storable CTriple +deriving newtype instance F.Storable Triple diff --git a/hs-bindgen/fixtures/fixedarray.th.txt b/hs-bindgen/fixtures/fixedarray.th.txt index 76ea5fc3..b71b50c9 100644 --- a/hs-bindgen/fixtures/fixedarray.th.txt +++ b/hs-bindgen/fixtures/fixedarray.th.txt @@ -1,2 +1,2 @@ -newtype CTriple = MkCTriple {unCTriple :: (ConstantArray 3 CInt)} -deriving newtype instance Storable CTriple +newtype Triple = Triple {unTriple :: (ConstantArray 3 CInt)} +deriving newtype instance Storable Triple diff --git a/hs-bindgen/fixtures/fixedwidth.hs b/hs-bindgen/fixtures/fixedwidth.hs index b78d7216..c30e18dc 100644 --- a/hs-bindgen/fixtures/fixedwidth.hs +++ b/hs-bindgen/fixtures/fixedwidth.hs @@ -1,6 +1,6 @@ -DeclNewtype (Newtype {newtypeName = "CUint64T", newtypeConstr = "MkCUint64T", newtypeField = Field {fieldName = "unCUint64T", fieldType = HsPrimType HsPrimCULong}}) -DeclNewtypeInstance Storable "CUint64T" -DeclNewtype (Newtype {newtypeName = "CUint32T", newtypeConstr = "MkCUint32T", newtypeField = Field {fieldName = "unCUint32T", fieldType = HsPrimType HsPrimCUInt}}) -DeclNewtypeInstance Storable "CUint32T" -DeclData (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_sixty_four", fieldType = HsTypRef "CUint64T"} ::: Field {fieldName = "cFoo_thirty_two", fieldType = HsTypRef "CUint32T"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_sixty_four", fieldType = HsTypRef "CUint64T"} ::: Field {fieldName = "cFoo_thirty_two", fieldType = HsTypRef "CUint32T"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_sixty_four", fieldType = HsTypRef "CUint64T"} ::: Field {fieldName = "cFoo_thirty_two", fieldType = HsTypRef "CUint32T"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_sixty_four", fieldType = HsTypRef "CUint64T"} ::: Field {fieldName = "cFoo_thirty_two", fieldType = HsTypRef "CUint32T"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclNewtype (Newtype {newtypeName = "Uint64_t", newtypeConstr = "Uint64_t", newtypeField = Field {fieldName = "unUint64_t", fieldType = HsPrimType HsPrimCULong}}) +DeclNewtypeInstance Storable "Uint64_t" +DeclNewtype (Newtype {newtypeName = "Uint32_t", newtypeConstr = "Uint32_t", newtypeField = Field {fieldName = "unUint32_t", fieldType = HsPrimType HsPrimCUInt}}) +DeclNewtypeInstance Storable "Uint32_t" +DeclData (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_sixty_four", fieldType = HsTypRef "Uint64_t"} ::: Field {fieldName = "foo_thirty_two", fieldType = HsTypRef "Uint32_t"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_sixty_four", fieldType = HsTypRef "Uint64_t"} ::: Field {fieldName = "foo_thirty_two", fieldType = HsTypRef "Uint32_t"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_sixty_four", fieldType = HsTypRef "Uint64_t"} ::: Field {fieldName = "foo_thirty_two", fieldType = HsTypRef "Uint32_t"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_sixty_four", fieldType = HsTypRef "Uint64_t"} ::: Field {fieldName = "foo_thirty_two", fieldType = HsTypRef "Uint32_t"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) diff --git a/hs-bindgen/fixtures/fixedwidth.pp.hs b/hs-bindgen/fixtures/fixedwidth.pp.hs index 2764a8ff..fe93b1bd 100644 --- a/hs-bindgen/fixtures/fixedwidth.pp.hs +++ b/hs-bindgen/fixtures/fixedwidth.pp.hs @@ -6,24 +6,24 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -newtype CUint64T = MkCUint64T - { unCUint64T :: FC.CULong +newtype Uint64_t = Uint64_t + { unUint64_t :: FC.CULong } -deriving newtype instance F.Storable CUint64T +deriving newtype instance F.Storable Uint64_t -newtype CUint32T = MkCUint32T - { unCUint32T :: FC.CUInt +newtype Uint32_t = Uint32_t + { unUint32_t :: FC.CUInt } -deriving newtype instance F.Storable CUint32T +deriving newtype instance F.Storable Uint32_t -data CFoo = MkCFoo - { cFoo_sixty_four :: CUint64T - , cFoo_thirty_two :: CUint32T +data Foo = Foo + { foo_sixty_four :: Uint64_t + , foo_thirty_two :: Uint32_t } -instance F.Storable CFoo where +instance F.Storable Foo where sizeOf = \_ -> 16 @@ -31,7 +31,7 @@ instance F.Storable CFoo where peek = \ptr0 -> - pure MkCFoo + pure Foo <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -39,6 +39,6 @@ instance F.Storable CFoo where \ptr0 -> \s1 -> case s1 of - MkCFoo cFoo_sixty_four2 cFoo_thirty_two3 -> - F.pokeByteOff ptr0 0 cFoo_sixty_four2 - >> F.pokeByteOff ptr0 8 cFoo_thirty_two3 + Foo foo_sixty_four2 foo_thirty_two3 -> + F.pokeByteOff ptr0 0 foo_sixty_four2 + >> F.pokeByteOff ptr0 8 foo_thirty_two3 diff --git a/hs-bindgen/fixtures/fixedwidth.th.txt b/hs-bindgen/fixtures/fixedwidth.th.txt index 6e8a5573..4e790ff0 100644 --- a/hs-bindgen/fixtures/fixedwidth.th.txt +++ b/hs-bindgen/fixtures/fixedwidth.th.txt @@ -1,13 +1,13 @@ -newtype CUint64T = MkCUint64T {unCUint64T :: CULong} -deriving newtype instance Storable CUint64T -newtype CUint32T = MkCUint32T {unCUint32T :: CUInt} -deriving newtype instance Storable CUint32T -data CFoo - = MkCFoo {cFoo_sixty_four :: CUint64T, cFoo_thirty_two :: CUint32T} -instance Storable CFoo +newtype Uint64_t = Uint64_t {unUint64_t :: CULong} +deriving newtype instance Storable Uint64_t +newtype Uint32_t = Uint32_t {unUint32_t :: CUInt} +deriving newtype instance Storable Uint32_t +data Foo + = Foo {foo_sixty_four :: Uint64_t, foo_thirty_two :: Uint32_t} +instance Storable Foo where {sizeOf = \_ -> 16; alignment = \_ -> 8; - peek = \ptr_0 -> (pure MkCFoo <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure Foo <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCFoo cFoo_sixty_four_3 - cFoo_thirty_two_4 -> pokeByteOff ptr_1 0 cFoo_sixty_four_3 >> pokeByteOff ptr_1 8 cFoo_thirty_two_4}} + {Foo foo_sixty_four_3 + foo_thirty_two_4 -> pokeByteOff ptr_1 0 foo_sixty_four_3 >> pokeByteOff ptr_1 8 foo_thirty_two_4}} diff --git a/hs-bindgen/fixtures/forward_declaration.hs b/hs-bindgen/fixtures/forward_declaration.hs index 6d85d015..788005b2 100644 --- a/hs-bindgen/fixtures/forward_declaration.hs +++ b/hs-bindgen/fixtures/forward_declaration.hs @@ -1,6 +1,6 @@ -DeclData (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclNewtype (Newtype {newtypeName = "CS1T", newtypeConstr = "MkCS1T", newtypeField = Field {fieldName = "unCS1T", fieldType = HsTypRef "CS1"}}) -DeclNewtypeInstance Storable "CS1T" -DeclData (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclData (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclNewtype (Newtype {newtypeName = "S1_t", newtypeConstr = "S1_t", newtypeField = Field {fieldName = "unS1_t", fieldType = HsTypRef "S1"}}) +DeclNewtypeInstance Storable "S1_t" +DeclData (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) diff --git a/hs-bindgen/fixtures/forward_declaration.pp.hs b/hs-bindgen/fixtures/forward_declaration.pp.hs index 645e7769..5d71695b 100644 --- a/hs-bindgen/fixtures/forward_declaration.pp.hs +++ b/hs-bindgen/fixtures/forward_declaration.pp.hs @@ -6,11 +6,11 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), pure) -data CS1 = MkCS1 - { cS1_a :: FC.CInt +data S1 = S1 + { s1_a :: FC.CInt } -instance F.Storable CS1 where +instance F.Storable S1 where sizeOf = \_ -> 4 @@ -18,26 +18,26 @@ instance F.Storable CS1 where peek = \ptr0 -> - pure MkCS1 + pure S1 <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCS1 cS1_a2 -> F.pokeByteOff ptr0 0 cS1_a2 + S1 s1_a2 -> F.pokeByteOff ptr0 0 s1_a2 -newtype CS1T = MkCS1T - { unCS1T :: CS1 +newtype S1_t = S1_t + { unS1_t :: S1 } -deriving newtype instance F.Storable CS1T +deriving newtype instance F.Storable S1_t -data CS2 = MkCS2 - { cS2_a :: FC.CInt +data S2 = S2 + { s2_a :: FC.CInt } -instance F.Storable CS2 where +instance F.Storable S2 where sizeOf = \_ -> 4 @@ -45,11 +45,11 @@ instance F.Storable CS2 where peek = \ptr0 -> - pure MkCS2 + pure S2 <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCS2 cS2_a2 -> F.pokeByteOff ptr0 0 cS2_a2 + S2 s2_a2 -> F.pokeByteOff ptr0 0 s2_a2 diff --git a/hs-bindgen/fixtures/forward_declaration.th.txt b/hs-bindgen/fixtures/forward_declaration.th.txt index bcf95e9a..fd043113 100644 --- a/hs-bindgen/fixtures/forward_declaration.th.txt +++ b/hs-bindgen/fixtures/forward_declaration.th.txt @@ -1,16 +1,16 @@ -data CS1 = MkCS1 {cS1_a :: CInt} -instance Storable CS1 +data S1 = S1 {s1_a :: CInt} +instance Storable S1 where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCS1 <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure S1 <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS1 cS1_a_3 -> pokeByteOff ptr_1 0 cS1_a_3}} -newtype CS1T = MkCS1T {unCS1T :: CS1} -deriving newtype instance Storable CS1T -data CS2 = MkCS2 {cS2_a :: CInt} -instance Storable CS2 + {S1 s1_a_3 -> pokeByteOff ptr_1 0 s1_a_3}} +newtype S1_t = S1_t {unS1_t :: S1} +deriving newtype instance Storable S1_t +data S2 = S2 {s2_a :: CInt} +instance Storable S2 where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCS2 <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure S2 <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS2 cS2_a_3 -> pokeByteOff ptr_1 0 cS2_a_3}} + {S2 s2_a_3 -> pokeByteOff ptr_1 0 s2_a_3}} diff --git a/hs-bindgen/fixtures/nested_types.hs b/hs-bindgen/fixtures/nested_types.hs index 8eaab241..d220fe09 100644 --- a/hs-bindgen/fixtures/nested_types.hs +++ b/hs-bindgen/fixtures/nested_types.hs @@ -1,4 +1,4 @@ -DeclData (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cFoo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cFoo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cFoo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "cFoo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cFoo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclData (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_foo1", fieldType = HsTypRef "CFoo"} ::: Field {fieldName = "cBar_foo2", fieldType = HsTypRef "CFoo"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_foo1", fieldType = HsTypRef "CFoo"} ::: Field {fieldName = "cBar_foo2", fieldType = HsTypRef "CFoo"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_foo1", fieldType = HsTypRef "CFoo"} ::: Field {fieldName = "cBar_foo2", fieldType = HsTypRef "CFoo"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_foo1", fieldType = HsTypRef "CFoo"} ::: Field {fieldName = "cBar_foo2", fieldType = HsTypRef "CFoo"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclData (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "foo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "foo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "foo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "foo_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "foo_c", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_foo1", fieldType = HsTypRef "Foo"} ::: Field {fieldName = "bar_foo2", fieldType = HsTypRef "Foo"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_foo1", fieldType = HsTypRef "Foo"} ::: Field {fieldName = "bar_foo2", fieldType = HsTypRef "Foo"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_foo1", fieldType = HsTypRef "Foo"} ::: Field {fieldName = "bar_foo2", fieldType = HsTypRef "Foo"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_foo1", fieldType = HsTypRef "Foo"} ::: Field {fieldName = "bar_foo2", fieldType = HsTypRef "Foo"} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) diff --git a/hs-bindgen/fixtures/nested_types.pp.hs b/hs-bindgen/fixtures/nested_types.pp.hs index 4ad36674..fe51fa10 100644 --- a/hs-bindgen/fixtures/nested_types.pp.hs +++ b/hs-bindgen/fixtures/nested_types.pp.hs @@ -6,12 +6,12 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -data CFoo = MkCFoo - { cFoo_i :: FC.CInt - , cFoo_c :: FC.CChar +data Foo = Foo + { foo_i :: FC.CInt + , foo_c :: FC.CChar } -instance F.Storable CFoo where +instance F.Storable Foo where sizeOf = \_ -> 8 @@ -19,7 +19,7 @@ instance F.Storable CFoo where peek = \ptr0 -> - pure MkCFoo + pure Foo <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -27,16 +27,16 @@ instance F.Storable CFoo where \ptr0 -> \s1 -> case s1 of - MkCFoo cFoo_i2 cFoo_c3 -> - F.pokeByteOff ptr0 0 cFoo_i2 - >> F.pokeByteOff ptr0 4 cFoo_c3 + Foo foo_i2 foo_c3 -> + F.pokeByteOff ptr0 0 foo_i2 + >> F.pokeByteOff ptr0 4 foo_c3 -data CBar = MkCBar - { cBar_foo1 :: CFoo - , cBar_foo2 :: CFoo +data Bar = Bar + { bar_foo1 :: Foo + , bar_foo2 :: Foo } -instance F.Storable CBar where +instance F.Storable Bar where sizeOf = \_ -> 16 @@ -44,7 +44,7 @@ instance F.Storable CBar where peek = \ptr0 -> - pure MkCBar + pure Bar <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -52,6 +52,6 @@ instance F.Storable CBar where \ptr0 -> \s1 -> case s1 of - MkCBar cBar_foo12 cBar_foo23 -> - F.pokeByteOff ptr0 0 cBar_foo12 - >> F.pokeByteOff ptr0 8 cBar_foo23 + Bar bar_foo12 bar_foo23 -> + F.pokeByteOff ptr0 0 bar_foo12 + >> F.pokeByteOff ptr0 8 bar_foo23 diff --git a/hs-bindgen/fixtures/nested_types.th.txt b/hs-bindgen/fixtures/nested_types.th.txt index 1f31b3cb..2090478f 100644 --- a/hs-bindgen/fixtures/nested_types.th.txt +++ b/hs-bindgen/fixtures/nested_types.th.txt @@ -1,16 +1,16 @@ -data CFoo = MkCFoo {cFoo_i :: CInt, cFoo_c :: CChar} -instance Storable CFoo +data Foo = Foo {foo_i :: CInt, foo_c :: CChar} +instance Storable Foo where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCFoo <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure Foo <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCFoo cFoo_i_3 - cFoo_c_4 -> pokeByteOff ptr_1 0 cFoo_i_3 >> pokeByteOff ptr_1 4 cFoo_c_4}} -data CBar = MkCBar {cBar_foo1 :: CFoo, cBar_foo2 :: CFoo} -instance Storable CBar + {Foo foo_i_3 + foo_c_4 -> pokeByteOff ptr_1 0 foo_i_3 >> pokeByteOff ptr_1 4 foo_c_4}} +data Bar = Bar {bar_foo1 :: Foo, bar_foo2 :: Foo} +instance Storable Bar where {sizeOf = \_ -> 16; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCBar <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure Bar <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBar cBar_foo1_3 - cBar_foo2_4 -> pokeByteOff ptr_1 0 cBar_foo1_3 >> pokeByteOff ptr_1 8 cBar_foo2_4}} + {Bar bar_foo1_3 + bar_foo2_4 -> pokeByteOff ptr_1 0 bar_foo1_3 >> pokeByteOff ptr_1 8 bar_foo2_4}} diff --git a/hs-bindgen/fixtures/opaque_declaration.hs b/hs-bindgen/fixtures/opaque_declaration.hs index 551d52fa..5c8d64e8 100644 --- a/hs-bindgen/fixtures/opaque_declaration.hs +++ b/hs-bindgen/fixtures/opaque_declaration.hs @@ -1,6 +1,6 @@ -DeclEmpty "CFoo" -DeclData (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_ptrA", fieldType = HsPtr (HsTypRef "CFoo")} ::: Field {fieldName = "cBar_ptrB", fieldType = HsPtr (HsTypRef "CBar")} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_ptrA", fieldType = HsPtr (HsTypRef "CFoo")} ::: Field {fieldName = "cBar_ptrB", fieldType = HsPtr (HsTypRef "CBar")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_ptrA", fieldType = HsPtr (HsTypRef "CFoo")} ::: Field {fieldName = "cBar_ptrB", fieldType = HsPtr (HsTypRef "CBar")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBar", structConstr = "MkCBar", structFields = Field {fieldName = "cBar_ptrA", fieldType = HsPtr (HsTypRef "CFoo")} ::: Field {fieldName = "cBar_ptrB", fieldType = HsPtr (HsTypRef "CBar")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) -DeclData (Struct {structName = "CBaz", structConstr = "MkCBaz", structFields = VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CBaz", structConstr = "MkCBaz", structFields = VNil}) (StorableInstance {storableSizeOf = 0, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CBaz", structConstr = "MkCBaz", structFields = VNil})) []), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CBaz", structConstr = "MkCBaz", structFields = VNil}) 0 (Seq [])))})) -DeclEmpty "CQuu" +DeclEmpty "Foo" +DeclData (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_ptrA", fieldType = HsPtr (HsTypRef "Foo")} ::: Field {fieldName = "bar_ptrB", fieldType = HsPtr (HsTypRef "Bar")} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_ptrA", fieldType = HsPtr (HsTypRef "Foo")} ::: Field {fieldName = "bar_ptrB", fieldType = HsPtr (HsTypRef "Bar")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_ptrA", fieldType = HsPtr (HsTypRef "Foo")} ::: Field {fieldName = "bar_ptrB", fieldType = HsPtr (HsTypRef "Bar")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Bar", structConstr = "Bar", structFields = Field {fieldName = "bar_ptrA", fieldType = HsPtr (HsTypRef "Foo")} ::: Field {fieldName = "bar_ptrB", fieldType = HsPtr (HsTypRef "Bar")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclData (Struct {structName = "Baz", structConstr = "Baz", structFields = VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Baz", structConstr = "Baz", structFields = VNil}) (StorableInstance {storableSizeOf = 0, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Baz", structConstr = "Baz", structFields = VNil})) []), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Baz", structConstr = "Baz", structFields = VNil}) 0 (Seq [])))})) +DeclEmpty "Quu" diff --git a/hs-bindgen/fixtures/opaque_declaration.pp.hs b/hs-bindgen/fixtures/opaque_declaration.pp.hs index 23bec74b..259424e8 100644 --- a/hs-bindgen/fixtures/opaque_declaration.pp.hs +++ b/hs-bindgen/fixtures/opaque_declaration.pp.hs @@ -5,14 +5,14 @@ module Example where import qualified Foreign as F import Prelude ((()), (<*>), (>>), pure, return) -data CFoo +data Foo -data CBar = MkCBar - { cBar_ptrA :: F.Ptr CFoo - , cBar_ptrB :: F.Ptr CBar +data Bar = Bar + { bar_ptrA :: F.Ptr Foo + , bar_ptrB :: F.Ptr Bar } -instance F.Storable CBar where +instance F.Storable Bar where sizeOf = \_ -> 16 @@ -20,7 +20,7 @@ instance F.Storable CBar where peek = \ptr0 -> - pure MkCBar + pure Bar <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -28,25 +28,25 @@ instance F.Storable CBar where \ptr0 -> \s1 -> case s1 of - MkCBar cBar_ptrA2 cBar_ptrB3 -> - F.pokeByteOff ptr0 0 cBar_ptrA2 - >> F.pokeByteOff ptr0 8 cBar_ptrB3 + Bar bar_ptrA2 bar_ptrB3 -> + F.pokeByteOff ptr0 0 bar_ptrA2 + >> F.pokeByteOff ptr0 8 bar_ptrB3 -data CBaz = MkCBaz +data Baz = Baz {} -instance F.Storable CBaz where +instance F.Storable Baz where sizeOf = \_ -> 0 alignment = \_ -> 1 - peek = \ptr0 -> pure MkCBaz + peek = \ptr0 -> pure Baz poke = \ptr0 -> \s1 -> case s1 of - MkCBaz -> return (()) + Baz -> return (()) -data CQuu +data Quu diff --git a/hs-bindgen/fixtures/opaque_declaration.th.txt b/hs-bindgen/fixtures/opaque_declaration.th.txt index 94d61796..8c937120 100644 --- a/hs-bindgen/fixtures/opaque_declaration.th.txt +++ b/hs-bindgen/fixtures/opaque_declaration.th.txt @@ -1,18 +1,17 @@ -data CFoo -data CBar - = MkCBar {cBar_ptrA :: (Ptr CFoo), cBar_ptrB :: (Ptr CBar)} -instance Storable CBar +data Foo +data Bar = Bar {bar_ptrA :: (Ptr Foo), bar_ptrB :: (Ptr Bar)} +instance Storable Bar where {sizeOf = \_ -> 16; alignment = \_ -> 8; - peek = \ptr_0 -> (pure MkCBar <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure Bar <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBar cBar_ptrA_3 - cBar_ptrB_4 -> pokeByteOff ptr_1 0 cBar_ptrA_3 >> pokeByteOff ptr_1 8 cBar_ptrB_4}} -data CBaz = MkCBaz {} -instance Storable CBaz + {Bar bar_ptrA_3 + bar_ptrB_4 -> pokeByteOff ptr_1 0 bar_ptrA_3 >> pokeByteOff ptr_1 8 bar_ptrB_4}} +data Baz = Baz {} +instance Storable Baz where {sizeOf = \_ -> 0; alignment = \_ -> 1; - peek = \ptr_0 -> pure MkCBaz; + peek = \ptr_0 -> pure Baz; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCBaz -> return ()}} -data CQuu + {Baz -> return ()}} +data Quu diff --git a/hs-bindgen/fixtures/primitive_types.hs b/hs-bindgen/fixtures/primitive_types.hs index 8758a497..8665cf8d 100644 --- a/hs-bindgen/fixtures/primitive_types.hs +++ b/hs-bindgen/fixtures/primitive_types.hs @@ -1,2 +1,2 @@ -DeclData (Struct {structName = "CPrimitive", structConstr = "MkCPrimitive", structFields = Field {fieldName = "cPrimitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cPrimitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "cPrimitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "cPrimitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CPrimitive", structConstr = "MkCPrimitive", structFields = Field {fieldName = "cPrimitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cPrimitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "cPrimitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "cPrimitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) (StorableInstance {storableSizeOf = 176, storableAlignment = 16, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CPrimitive", structConstr = "MkCPrimitive", structFields = Field {fieldName = "cPrimitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cPrimitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "cPrimitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "cPrimitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1,PeekByteOff 0 2,PeekByteOff 0 4,PeekByteOff 0 6,PeekByteOff 0 8,PeekByteOff 0 10,PeekByteOff 0 12,PeekByteOff 0 14,PeekByteOff 0 16,PeekByteOff 0 20,PeekByteOff 0 24,PeekByteOff 0 28,PeekByteOff 0 32,PeekByteOff 0 40,PeekByteOff 0 48,PeekByteOff 0 56,PeekByteOff 0 64,PeekByteOff 0 72,PeekByteOff 0 80,PeekByteOff 0 88,PeekByteOff 0 96,PeekByteOff 0 104,PeekByteOff 0 112,PeekByteOff 0 120,PeekByteOff 0 128,PeekByteOff 0 136,PeekByteOff 0 144,PeekByteOff 0 160]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CPrimitive", structConstr = "MkCPrimitive", structFields = Field {fieldName = "cPrimitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cPrimitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "cPrimitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "cPrimitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "cPrimitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cPrimitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "cPrimitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "cPrimitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "cPrimitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "cPrimitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "cPrimitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "cPrimitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "cPrimitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) 29 (Seq [PokeByteOff 30 0 0,PokeByteOff 30 1 1,PokeByteOff 30 2 2,PokeByteOff 30 4 3,PokeByteOff 30 6 4,PokeByteOff 30 8 5,PokeByteOff 30 10 6,PokeByteOff 30 12 7,PokeByteOff 30 14 8,PokeByteOff 30 16 9,PokeByteOff 30 20 10,PokeByteOff 30 24 11,PokeByteOff 30 28 12,PokeByteOff 30 32 13,PokeByteOff 30 40 14,PokeByteOff 30 48 15,PokeByteOff 30 56 16,PokeByteOff 30 64 17,PokeByteOff 30 72 18,PokeByteOff 30 80 19,PokeByteOff 30 88 20,PokeByteOff 30 96 21,PokeByteOff 30 104 22,PokeByteOff 30 112 23,PokeByteOff 30 120 24,PokeByteOff 30 128 25,PokeByteOff 30 136 26,PokeByteOff 30 144 27,PokeByteOff 30 160 28])))})) +DeclData (Struct {structName = "Primitive", structConstr = "Primitive", structFields = Field {fieldName = "primitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "primitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "primitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "primitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Primitive", structConstr = "Primitive", structFields = Field {fieldName = "primitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "primitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "primitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "primitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) (StorableInstance {storableSizeOf = 176, storableAlignment = 16, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Primitive", structConstr = "Primitive", structFields = Field {fieldName = "primitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "primitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "primitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "primitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 1,PeekByteOff 0 2,PeekByteOff 0 4,PeekByteOff 0 6,PeekByteOff 0 8,PeekByteOff 0 10,PeekByteOff 0 12,PeekByteOff 0 14,PeekByteOff 0 16,PeekByteOff 0 20,PeekByteOff 0 24,PeekByteOff 0 28,PeekByteOff 0 32,PeekByteOff 0 40,PeekByteOff 0 48,PeekByteOff 0 56,PeekByteOff 0 64,PeekByteOff 0 72,PeekByteOff 0 80,PeekByteOff 0 88,PeekByteOff 0 96,PeekByteOff 0 104,PeekByteOff 0 112,PeekByteOff 0 120,PeekByteOff 0 128,PeekByteOff 0 136,PeekByteOff 0 144,PeekByteOff 0 160]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Primitive", structConstr = "Primitive", structFields = Field {fieldName = "primitive_c", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "primitive_sc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_uc", fieldType = HsPrimType HsPrimCSChar} ::: Field {fieldName = "primitive_s", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_si", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ss", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_ssi", fieldType = HsPrimType HsPrimCShort} ::: Field {fieldName = "primitive_us", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_usi", fieldType = HsPrimType HsPrimCUShort} ::: Field {fieldName = "primitive_i", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_s2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_si2", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "primitive_u", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_ui", fieldType = HsPrimType HsPrimCUInt} ::: Field {fieldName = "primitive_l", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_li", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sl", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_sli", fieldType = HsPrimType HsPrimCLong} ::: Field {fieldName = "primitive_ul", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_uli", fieldType = HsPrimType HsPrimCULong} ::: Field {fieldName = "primitive_ll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_lli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_sll", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_slli", fieldType = HsPrimType HsPrimCLLong} ::: Field {fieldName = "primitive_ull", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_ulli", fieldType = HsPrimType HsPrimCULLong} ::: Field {fieldName = "primitive_f", fieldType = HsPrimType HsPrimCFloat} ::: Field {fieldName = "primitive_d", fieldType = HsPrimType HsPrimCDouble} ::: Field {fieldName = "primitive_ld", fieldType = HsPrimType HsPrimCDouble} ::: VNil}) 29 (Seq [PokeByteOff 30 0 0,PokeByteOff 30 1 1,PokeByteOff 30 2 2,PokeByteOff 30 4 3,PokeByteOff 30 6 4,PokeByteOff 30 8 5,PokeByteOff 30 10 6,PokeByteOff 30 12 7,PokeByteOff 30 14 8,PokeByteOff 30 16 9,PokeByteOff 30 20 10,PokeByteOff 30 24 11,PokeByteOff 30 28 12,PokeByteOff 30 32 13,PokeByteOff 30 40 14,PokeByteOff 30 48 15,PokeByteOff 30 56 16,PokeByteOff 30 64 17,PokeByteOff 30 72 18,PokeByteOff 30 80 19,PokeByteOff 30 88 20,PokeByteOff 30 96 21,PokeByteOff 30 104 22,PokeByteOff 30 112 23,PokeByteOff 30 120 24,PokeByteOff 30 128 25,PokeByteOff 30 136 26,PokeByteOff 30 144 27,PokeByteOff 30 160 28])))})) diff --git a/hs-bindgen/fixtures/primitive_types.pp.hs b/hs-bindgen/fixtures/primitive_types.pp.hs index e03e9fbb..8428697d 100644 --- a/hs-bindgen/fixtures/primitive_types.pp.hs +++ b/hs-bindgen/fixtures/primitive_types.pp.hs @@ -6,39 +6,39 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -data CPrimitive = MkCPrimitive - { cPrimitive_c :: FC.CChar - , cPrimitive_sc :: FC.CSChar - , cPrimitive_uc :: FC.CSChar - , cPrimitive_s :: FC.CShort - , cPrimitive_si :: FC.CShort - , cPrimitive_ss :: FC.CShort - , cPrimitive_ssi :: FC.CShort - , cPrimitive_us :: FC.CUShort - , cPrimitive_usi :: FC.CUShort - , cPrimitive_i :: FC.CInt - , cPrimitive_s2 :: FC.CInt - , cPrimitive_si2 :: FC.CInt - , cPrimitive_u :: FC.CUInt - , cPrimitive_ui :: FC.CUInt - , cPrimitive_l :: FC.CLong - , cPrimitive_li :: FC.CLong - , cPrimitive_sl :: FC.CLong - , cPrimitive_sli :: FC.CLong - , cPrimitive_ul :: FC.CULong - , cPrimitive_uli :: FC.CULong - , cPrimitive_ll :: FC.CLLong - , cPrimitive_lli :: FC.CLLong - , cPrimitive_sll :: FC.CLLong - , cPrimitive_slli :: FC.CLLong - , cPrimitive_ull :: FC.CULLong - , cPrimitive_ulli :: FC.CULLong - , cPrimitive_f :: FC.CFloat - , cPrimitive_d :: FC.CDouble - , cPrimitive_ld :: FC.CDouble +data Primitive = Primitive + { primitive_c :: FC.CChar + , primitive_sc :: FC.CSChar + , primitive_uc :: FC.CSChar + , primitive_s :: FC.CShort + , primitive_si :: FC.CShort + , primitive_ss :: FC.CShort + , primitive_ssi :: FC.CShort + , primitive_us :: FC.CUShort + , primitive_usi :: FC.CUShort + , primitive_i :: FC.CInt + , primitive_s2 :: FC.CInt + , primitive_si2 :: FC.CInt + , primitive_u :: FC.CUInt + , primitive_ui :: FC.CUInt + , primitive_l :: FC.CLong + , primitive_li :: FC.CLong + , primitive_sl :: FC.CLong + , primitive_sli :: FC.CLong + , primitive_ul :: FC.CULong + , primitive_uli :: FC.CULong + , primitive_ll :: FC.CLLong + , primitive_lli :: FC.CLLong + , primitive_sll :: FC.CLLong + , primitive_slli :: FC.CLLong + , primitive_ull :: FC.CULLong + , primitive_ulli :: FC.CULLong + , primitive_f :: FC.CFloat + , primitive_d :: FC.CDouble + , primitive_ld :: FC.CDouble } -instance F.Storable CPrimitive where +instance F.Storable Primitive where sizeOf = \_ -> 176 @@ -46,7 +46,7 @@ instance F.Storable CPrimitive where peek = \ptr0 -> - pure MkCPrimitive + pure Primitive <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 1 <*> F.peekByteOff ptr0 2 @@ -81,62 +81,62 @@ instance F.Storable CPrimitive where \ptr0 -> \s1 -> case s1 of - MkCPrimitive - cPrimitive_c2 - cPrimitive_sc3 - cPrimitive_uc4 - cPrimitive_s5 - cPrimitive_si6 - cPrimitive_ss7 - cPrimitive_ssi8 - cPrimitive_us9 - cPrimitive_usi10 - cPrimitive_i11 - cPrimitive_s212 - cPrimitive_si213 - cPrimitive_u14 - cPrimitive_ui15 - cPrimitive_l16 - cPrimitive_li17 - cPrimitive_sl18 - cPrimitive_sli19 - cPrimitive_ul20 - cPrimitive_uli21 - cPrimitive_ll22 - cPrimitive_lli23 - cPrimitive_sll24 - cPrimitive_slli25 - cPrimitive_ull26 - cPrimitive_ulli27 - cPrimitive_f28 - cPrimitive_d29 - cPrimitive_ld30 -> - F.pokeByteOff ptr0 0 cPrimitive_c2 - >> F.pokeByteOff ptr0 1 cPrimitive_sc3 - >> F.pokeByteOff ptr0 2 cPrimitive_uc4 - >> F.pokeByteOff ptr0 4 cPrimitive_s5 - >> F.pokeByteOff ptr0 6 cPrimitive_si6 - >> F.pokeByteOff ptr0 8 cPrimitive_ss7 - >> F.pokeByteOff ptr0 10 cPrimitive_ssi8 - >> F.pokeByteOff ptr0 12 cPrimitive_us9 - >> F.pokeByteOff ptr0 14 cPrimitive_usi10 - >> F.pokeByteOff ptr0 16 cPrimitive_i11 - >> F.pokeByteOff ptr0 20 cPrimitive_s212 - >> F.pokeByteOff ptr0 24 cPrimitive_si213 - >> F.pokeByteOff ptr0 28 cPrimitive_u14 - >> F.pokeByteOff ptr0 32 cPrimitive_ui15 - >> F.pokeByteOff ptr0 40 cPrimitive_l16 - >> F.pokeByteOff ptr0 48 cPrimitive_li17 - >> F.pokeByteOff ptr0 56 cPrimitive_sl18 - >> F.pokeByteOff ptr0 64 cPrimitive_sli19 - >> F.pokeByteOff ptr0 72 cPrimitive_ul20 - >> F.pokeByteOff ptr0 80 cPrimitive_uli21 - >> F.pokeByteOff ptr0 88 cPrimitive_ll22 - >> F.pokeByteOff ptr0 96 cPrimitive_lli23 - >> F.pokeByteOff ptr0 104 cPrimitive_sll24 - >> F.pokeByteOff ptr0 112 cPrimitive_slli25 - >> F.pokeByteOff ptr0 120 cPrimitive_ull26 - >> F.pokeByteOff ptr0 128 cPrimitive_ulli27 - >> F.pokeByteOff ptr0 136 cPrimitive_f28 - >> F.pokeByteOff ptr0 144 cPrimitive_d29 - >> F.pokeByteOff ptr0 160 cPrimitive_ld30 + Primitive + primitive_c2 + primitive_sc3 + primitive_uc4 + primitive_s5 + primitive_si6 + primitive_ss7 + primitive_ssi8 + primitive_us9 + primitive_usi10 + primitive_i11 + primitive_s212 + primitive_si213 + primitive_u14 + primitive_ui15 + primitive_l16 + primitive_li17 + primitive_sl18 + primitive_sli19 + primitive_ul20 + primitive_uli21 + primitive_ll22 + primitive_lli23 + primitive_sll24 + primitive_slli25 + primitive_ull26 + primitive_ulli27 + primitive_f28 + primitive_d29 + primitive_ld30 -> + F.pokeByteOff ptr0 0 primitive_c2 + >> F.pokeByteOff ptr0 1 primitive_sc3 + >> F.pokeByteOff ptr0 2 primitive_uc4 + >> F.pokeByteOff ptr0 4 primitive_s5 + >> F.pokeByteOff ptr0 6 primitive_si6 + >> F.pokeByteOff ptr0 8 primitive_ss7 + >> F.pokeByteOff ptr0 10 primitive_ssi8 + >> F.pokeByteOff ptr0 12 primitive_us9 + >> F.pokeByteOff ptr0 14 primitive_usi10 + >> F.pokeByteOff ptr0 16 primitive_i11 + >> F.pokeByteOff ptr0 20 primitive_s212 + >> F.pokeByteOff ptr0 24 primitive_si213 + >> F.pokeByteOff ptr0 28 primitive_u14 + >> F.pokeByteOff ptr0 32 primitive_ui15 + >> F.pokeByteOff ptr0 40 primitive_l16 + >> F.pokeByteOff ptr0 48 primitive_li17 + >> F.pokeByteOff ptr0 56 primitive_sl18 + >> F.pokeByteOff ptr0 64 primitive_sli19 + >> F.pokeByteOff ptr0 72 primitive_ul20 + >> F.pokeByteOff ptr0 80 primitive_uli21 + >> F.pokeByteOff ptr0 88 primitive_ll22 + >> F.pokeByteOff ptr0 96 primitive_lli23 + >> F.pokeByteOff ptr0 104 primitive_sll24 + >> F.pokeByteOff ptr0 112 primitive_slli25 + >> F.pokeByteOff ptr0 120 primitive_ull26 + >> F.pokeByteOff ptr0 128 primitive_ulli27 + >> F.pokeByteOff ptr0 136 primitive_f28 + >> F.pokeByteOff ptr0 144 primitive_d29 + >> F.pokeByteOff ptr0 160 primitive_ld30 diff --git a/hs-bindgen/fixtures/primitive_types.th.txt b/hs-bindgen/fixtures/primitive_types.th.txt index 6bcbfb79..320b251a 100644 --- a/hs-bindgen/fixtures/primitive_types.th.txt +++ b/hs-bindgen/fixtures/primitive_types.th.txt @@ -1,64 +1,64 @@ -data CPrimitive - = MkCPrimitive {cPrimitive_c :: CChar, - cPrimitive_sc :: CSChar, - cPrimitive_uc :: CSChar, - cPrimitive_s :: CShort, - cPrimitive_si :: CShort, - cPrimitive_ss :: CShort, - cPrimitive_ssi :: CShort, - cPrimitive_us :: CUShort, - cPrimitive_usi :: CUShort, - cPrimitive_i :: CInt, - cPrimitive_s2 :: CInt, - cPrimitive_si2 :: CInt, - cPrimitive_u :: CUInt, - cPrimitive_ui :: CUInt, - cPrimitive_l :: CLong, - cPrimitive_li :: CLong, - cPrimitive_sl :: CLong, - cPrimitive_sli :: CLong, - cPrimitive_ul :: CULong, - cPrimitive_uli :: CULong, - cPrimitive_ll :: CLLong, - cPrimitive_lli :: CLLong, - cPrimitive_sll :: CLLong, - cPrimitive_slli :: CLLong, - cPrimitive_ull :: CULLong, - cPrimitive_ulli :: CULLong, - cPrimitive_f :: CFloat, - cPrimitive_d :: CDouble, - cPrimitive_ld :: CDouble} -instance Storable CPrimitive +data Primitive + = Primitive {primitive_c :: CChar, + primitive_sc :: CSChar, + primitive_uc :: CSChar, + primitive_s :: CShort, + primitive_si :: CShort, + primitive_ss :: CShort, + primitive_ssi :: CShort, + primitive_us :: CUShort, + primitive_usi :: CUShort, + primitive_i :: CInt, + primitive_s2 :: CInt, + primitive_si2 :: CInt, + primitive_u :: CUInt, + primitive_ui :: CUInt, + primitive_l :: CLong, + primitive_li :: CLong, + primitive_sl :: CLong, + primitive_sli :: CLong, + primitive_ul :: CULong, + primitive_uli :: CULong, + primitive_ll :: CLLong, + primitive_lli :: CLLong, + primitive_sll :: CLLong, + primitive_slli :: CLLong, + primitive_ull :: CULLong, + primitive_ulli :: CULLong, + primitive_f :: CFloat, + primitive_d :: CDouble, + primitive_ld :: CDouble} +instance Storable Primitive where {sizeOf = \_ -> 176; alignment = \_ -> 16; - peek = \ptr_0 -> ((((((((((((((((((((((((((((pure MkCPrimitive <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1) <*> peekByteOff ptr_0 2) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 6) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 10) <*> peekByteOff ptr_0 12) <*> peekByteOff ptr_0 14) <*> peekByteOff ptr_0 16) <*> peekByteOff ptr_0 20) <*> peekByteOff ptr_0 24) <*> peekByteOff ptr_0 28) <*> peekByteOff ptr_0 32) <*> peekByteOff ptr_0 40) <*> peekByteOff ptr_0 48) <*> peekByteOff ptr_0 56) <*> peekByteOff ptr_0 64) <*> peekByteOff ptr_0 72) <*> peekByteOff ptr_0 80) <*> peekByteOff ptr_0 88) <*> peekByteOff ptr_0 96) <*> peekByteOff ptr_0 104) <*> peekByteOff ptr_0 112) <*> peekByteOff ptr_0 120) <*> peekByteOff ptr_0 128) <*> peekByteOff ptr_0 136) <*> peekByteOff ptr_0 144) <*> peekByteOff ptr_0 160; + peek = \ptr_0 -> ((((((((((((((((((((((((((((pure Primitive <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 1) <*> peekByteOff ptr_0 2) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 6) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 10) <*> peekByteOff ptr_0 12) <*> peekByteOff ptr_0 14) <*> peekByteOff ptr_0 16) <*> peekByteOff ptr_0 20) <*> peekByteOff ptr_0 24) <*> peekByteOff ptr_0 28) <*> peekByteOff ptr_0 32) <*> peekByteOff ptr_0 40) <*> peekByteOff ptr_0 48) <*> peekByteOff ptr_0 56) <*> peekByteOff ptr_0 64) <*> peekByteOff ptr_0 72) <*> peekByteOff ptr_0 80) <*> peekByteOff ptr_0 88) <*> peekByteOff ptr_0 96) <*> peekByteOff ptr_0 104) <*> peekByteOff ptr_0 112) <*> peekByteOff ptr_0 120) <*> peekByteOff ptr_0 128) <*> peekByteOff ptr_0 136) <*> peekByteOff ptr_0 144) <*> peekByteOff ptr_0 160; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCPrimitive cPrimitive_c_3 - cPrimitive_sc_4 - cPrimitive_uc_5 - cPrimitive_s_6 - cPrimitive_si_7 - cPrimitive_ss_8 - cPrimitive_ssi_9 - cPrimitive_us_10 - cPrimitive_usi_11 - cPrimitive_i_12 - cPrimitive_s2_13 - cPrimitive_si2_14 - cPrimitive_u_15 - cPrimitive_ui_16 - cPrimitive_l_17 - cPrimitive_li_18 - cPrimitive_sl_19 - cPrimitive_sli_20 - cPrimitive_ul_21 - cPrimitive_uli_22 - cPrimitive_ll_23 - cPrimitive_lli_24 - cPrimitive_sll_25 - cPrimitive_slli_26 - cPrimitive_ull_27 - cPrimitive_ulli_28 - cPrimitive_f_29 - cPrimitive_d_30 - cPrimitive_ld_31 -> pokeByteOff ptr_1 0 cPrimitive_c_3 >> (pokeByteOff ptr_1 1 cPrimitive_sc_4 >> (pokeByteOff ptr_1 2 cPrimitive_uc_5 >> (pokeByteOff ptr_1 4 cPrimitive_s_6 >> (pokeByteOff ptr_1 6 cPrimitive_si_7 >> (pokeByteOff ptr_1 8 cPrimitive_ss_8 >> (pokeByteOff ptr_1 10 cPrimitive_ssi_9 >> (pokeByteOff ptr_1 12 cPrimitive_us_10 >> (pokeByteOff ptr_1 14 cPrimitive_usi_11 >> (pokeByteOff ptr_1 16 cPrimitive_i_12 >> (pokeByteOff ptr_1 20 cPrimitive_s2_13 >> (pokeByteOff ptr_1 24 cPrimitive_si2_14 >> (pokeByteOff ptr_1 28 cPrimitive_u_15 >> (pokeByteOff ptr_1 32 cPrimitive_ui_16 >> (pokeByteOff ptr_1 40 cPrimitive_l_17 >> (pokeByteOff ptr_1 48 cPrimitive_li_18 >> (pokeByteOff ptr_1 56 cPrimitive_sl_19 >> (pokeByteOff ptr_1 64 cPrimitive_sli_20 >> (pokeByteOff ptr_1 72 cPrimitive_ul_21 >> (pokeByteOff ptr_1 80 cPrimitive_uli_22 >> (pokeByteOff ptr_1 88 cPrimitive_ll_23 >> (pokeByteOff ptr_1 96 cPrimitive_lli_24 >> (pokeByteOff ptr_1 104 cPrimitive_sll_25 >> (pokeByteOff ptr_1 112 cPrimitive_slli_26 >> (pokeByteOff ptr_1 120 cPrimitive_ull_27 >> (pokeByteOff ptr_1 128 cPrimitive_ulli_28 >> (pokeByteOff ptr_1 136 cPrimitive_f_29 >> (pokeByteOff ptr_1 144 cPrimitive_d_30 >> pokeByteOff ptr_1 160 cPrimitive_ld_31)))))))))))))))))))))))))))}} + {Primitive primitive_c_3 + primitive_sc_4 + primitive_uc_5 + primitive_s_6 + primitive_si_7 + primitive_ss_8 + primitive_ssi_9 + primitive_us_10 + primitive_usi_11 + primitive_i_12 + primitive_s2_13 + primitive_si2_14 + primitive_u_15 + primitive_ui_16 + primitive_l_17 + primitive_li_18 + primitive_sl_19 + primitive_sli_20 + primitive_ul_21 + primitive_uli_22 + primitive_ll_23 + primitive_lli_24 + primitive_sll_25 + primitive_slli_26 + primitive_ull_27 + primitive_ulli_28 + primitive_f_29 + primitive_d_30 + primitive_ld_31 -> pokeByteOff ptr_1 0 primitive_c_3 >> (pokeByteOff ptr_1 1 primitive_sc_4 >> (pokeByteOff ptr_1 2 primitive_uc_5 >> (pokeByteOff ptr_1 4 primitive_s_6 >> (pokeByteOff ptr_1 6 primitive_si_7 >> (pokeByteOff ptr_1 8 primitive_ss_8 >> (pokeByteOff ptr_1 10 primitive_ssi_9 >> (pokeByteOff ptr_1 12 primitive_us_10 >> (pokeByteOff ptr_1 14 primitive_usi_11 >> (pokeByteOff ptr_1 16 primitive_i_12 >> (pokeByteOff ptr_1 20 primitive_s2_13 >> (pokeByteOff ptr_1 24 primitive_si2_14 >> (pokeByteOff ptr_1 28 primitive_u_15 >> (pokeByteOff ptr_1 32 primitive_ui_16 >> (pokeByteOff ptr_1 40 primitive_l_17 >> (pokeByteOff ptr_1 48 primitive_li_18 >> (pokeByteOff ptr_1 56 primitive_sl_19 >> (pokeByteOff ptr_1 64 primitive_sli_20 >> (pokeByteOff ptr_1 72 primitive_ul_21 >> (pokeByteOff ptr_1 80 primitive_uli_22 >> (pokeByteOff ptr_1 88 primitive_ll_23 >> (pokeByteOff ptr_1 96 primitive_lli_24 >> (pokeByteOff ptr_1 104 primitive_sll_25 >> (pokeByteOff ptr_1 112 primitive_slli_26 >> (pokeByteOff ptr_1 120 primitive_ull_27 >> (pokeByteOff ptr_1 128 primitive_ulli_28 >> (pokeByteOff ptr_1 136 primitive_f_29 >> (pokeByteOff ptr_1 144 primitive_d_30 >> pokeByteOff ptr_1 160 primitive_ld_31)))))))))))))))))))))))))))}} diff --git a/hs-bindgen/fixtures/recursive_struct.hs b/hs-bindgen/fixtures/recursive_struct.hs index 2c8f5256..53f98056 100644 --- a/hs-bindgen/fixtures/recursive_struct.hs +++ b/hs-bindgen/fixtures/recursive_struct.hs @@ -1,6 +1,6 @@ -DeclData (Struct {structName = "CLinkedListAS", structConstr = "MkCLinkedListAS", structFields = Field {fieldName = "cLinkedListAS_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListAS_next", fieldType = HsPtr (HsTypRef "CLinkedListAS")} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CLinkedListAS", structConstr = "MkCLinkedListAS", structFields = Field {fieldName = "cLinkedListAS_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListAS_next", fieldType = HsPtr (HsTypRef "CLinkedListAS")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CLinkedListAS", structConstr = "MkCLinkedListAS", structFields = Field {fieldName = "cLinkedListAS_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListAS_next", fieldType = HsPtr (HsTypRef "CLinkedListAS")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CLinkedListAS", structConstr = "MkCLinkedListAS", structFields = Field {fieldName = "cLinkedListAS_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListAS_next", fieldType = HsPtr (HsTypRef "CLinkedListAS")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) -DeclNewtype (Newtype {newtypeName = "CLinkedListAT", newtypeConstr = "MkCLinkedListAT", newtypeField = Field {fieldName = "unCLinkedListAT", fieldType = HsTypRef "CLinkedListAS"}}) -DeclNewtypeInstance Storable "CLinkedListAT" -DeclData (Struct {structName = "CLinkedListBT", structConstr = "MkCLinkedListBT", structFields = Field {fieldName = "cLinkedListBT_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListBT_next", fieldType = HsPtr (HsTypRef "CLinkedListBT")} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CLinkedListBT", structConstr = "MkCLinkedListBT", structFields = Field {fieldName = "cLinkedListBT_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListBT_next", fieldType = HsPtr (HsTypRef "CLinkedListBT")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CLinkedListBT", structConstr = "MkCLinkedListBT", structFields = Field {fieldName = "cLinkedListBT_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListBT_next", fieldType = HsPtr (HsTypRef "CLinkedListBT")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CLinkedListBT", structConstr = "MkCLinkedListBT", structFields = Field {fieldName = "cLinkedListBT_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cLinkedListBT_next", fieldType = HsPtr (HsTypRef "CLinkedListBT")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclData (Struct {structName = "Linked_list_A_s", structConstr = "Linked_list_A_s", structFields = Field {fieldName = "linked_list_A_s_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_A_s_next", fieldType = HsPtr (HsTypRef "Linked_list_A_s")} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Linked_list_A_s", structConstr = "Linked_list_A_s", structFields = Field {fieldName = "linked_list_A_s_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_A_s_next", fieldType = HsPtr (HsTypRef "Linked_list_A_s")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Linked_list_A_s", structConstr = "Linked_list_A_s", structFields = Field {fieldName = "linked_list_A_s_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_A_s_next", fieldType = HsPtr (HsTypRef "Linked_list_A_s")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Linked_list_A_s", structConstr = "Linked_list_A_s", structFields = Field {fieldName = "linked_list_A_s_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_A_s_next", fieldType = HsPtr (HsTypRef "Linked_list_A_s")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) +DeclNewtype (Newtype {newtypeName = "Linked_list_A_t", newtypeConstr = "Linked_list_A_t", newtypeField = Field {fieldName = "unLinked_list_A_t", fieldType = HsTypRef "Linked_list_A_s"}}) +DeclNewtypeInstance Storable "Linked_list_A_t" +DeclData (Struct {structName = "Linked_list_B_t", structConstr = "Linked_list_B_t", structFields = Field {fieldName = "linked_list_B_t_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_B_t_next", fieldType = HsPtr (HsTypRef "Linked_list_B_t")} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "Linked_list_B_t", structConstr = "Linked_list_B_t", structFields = Field {fieldName = "linked_list_B_t_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_B_t_next", fieldType = HsPtr (HsTypRef "Linked_list_B_t")} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Linked_list_B_t", structConstr = "Linked_list_B_t", structFields = Field {fieldName = "linked_list_B_t_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_B_t_next", fieldType = HsPtr (HsTypRef "Linked_list_B_t")} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Linked_list_B_t", structConstr = "Linked_list_B_t", structFields = Field {fieldName = "linked_list_B_t_x", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "linked_list_B_t_next", fieldType = HsPtr (HsTypRef "Linked_list_B_t")} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 8 1])))})) diff --git a/hs-bindgen/fixtures/recursive_struct.pp.hs b/hs-bindgen/fixtures/recursive_struct.pp.hs index 9444c55f..088b899b 100644 --- a/hs-bindgen/fixtures/recursive_struct.pp.hs +++ b/hs-bindgen/fixtures/recursive_struct.pp.hs @@ -6,12 +6,12 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -data CLinkedListAS = MkCLinkedListAS - { cLinkedListAS_x :: FC.CInt - , cLinkedListAS_next :: F.Ptr CLinkedListAS +data Linked_list_A_s = Linked_list_A_s + { linked_list_A_s_x :: FC.CInt + , linked_list_A_s_next :: F.Ptr Linked_list_A_s } -instance F.Storable CLinkedListAS where +instance F.Storable Linked_list_A_s where sizeOf = \_ -> 16 @@ -19,7 +19,7 @@ instance F.Storable CLinkedListAS where peek = \ptr0 -> - pure MkCLinkedListAS + pure Linked_list_A_s <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -27,22 +27,22 @@ instance F.Storable CLinkedListAS where \ptr0 -> \s1 -> case s1 of - MkCLinkedListAS cLinkedListAS_x2 cLinkedListAS_next3 -> - F.pokeByteOff ptr0 0 cLinkedListAS_x2 - >> F.pokeByteOff ptr0 8 cLinkedListAS_next3 + Linked_list_A_s linked_list_A_s_x2 linked_list_A_s_next3 -> + F.pokeByteOff ptr0 0 linked_list_A_s_x2 + >> F.pokeByteOff ptr0 8 linked_list_A_s_next3 -newtype CLinkedListAT = MkCLinkedListAT - { unCLinkedListAT :: CLinkedListAS +newtype Linked_list_A_t = Linked_list_A_t + { unLinked_list_A_t :: Linked_list_A_s } -deriving newtype instance F.Storable CLinkedListAT +deriving newtype instance F.Storable Linked_list_A_t -data CLinkedListBT = MkCLinkedListBT - { cLinkedListBT_x :: FC.CInt - , cLinkedListBT_next :: F.Ptr CLinkedListBT +data Linked_list_B_t = Linked_list_B_t + { linked_list_B_t_x :: FC.CInt + , linked_list_B_t_next :: F.Ptr Linked_list_B_t } -instance F.Storable CLinkedListBT where +instance F.Storable Linked_list_B_t where sizeOf = \_ -> 16 @@ -50,7 +50,7 @@ instance F.Storable CLinkedListBT where peek = \ptr0 -> - pure MkCLinkedListBT + pure Linked_list_B_t <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 8 @@ -58,6 +58,6 @@ instance F.Storable CLinkedListBT where \ptr0 -> \s1 -> case s1 of - MkCLinkedListBT cLinkedListBT_x2 cLinkedListBT_next3 -> - F.pokeByteOff ptr0 0 cLinkedListBT_x2 - >> F.pokeByteOff ptr0 8 cLinkedListBT_next3 + Linked_list_B_t linked_list_B_t_x2 linked_list_B_t_next3 -> + F.pokeByteOff ptr0 0 linked_list_B_t_x2 + >> F.pokeByteOff ptr0 8 linked_list_B_t_next3 diff --git a/hs-bindgen/fixtures/recursive_struct.th.txt b/hs-bindgen/fixtures/recursive_struct.th.txt index 63d7274f..417fb2d4 100644 --- a/hs-bindgen/fixtures/recursive_struct.th.txt +++ b/hs-bindgen/fixtures/recursive_struct.th.txt @@ -1,23 +1,23 @@ -data CLinkedListAS - = MkCLinkedListAS {cLinkedListAS_x :: CInt, - cLinkedListAS_next :: (Ptr CLinkedListAS)} -instance Storable CLinkedListAS +data Linked_list_A_s + = Linked_list_A_s {linked_list_A_s_x :: CInt, + linked_list_A_s_next :: (Ptr Linked_list_A_s)} +instance Storable Linked_list_A_s where {sizeOf = \_ -> 16; alignment = \_ -> 8; - peek = \ptr_0 -> (pure MkCLinkedListAS <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure Linked_list_A_s <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCLinkedListAS cLinkedListAS_x_3 - cLinkedListAS_next_4 -> pokeByteOff ptr_1 0 cLinkedListAS_x_3 >> pokeByteOff ptr_1 8 cLinkedListAS_next_4}} -newtype CLinkedListAT - = MkCLinkedListAT {unCLinkedListAT :: CLinkedListAS} -deriving newtype instance Storable CLinkedListAT -data CLinkedListBT - = MkCLinkedListBT {cLinkedListBT_x :: CInt, - cLinkedListBT_next :: (Ptr CLinkedListBT)} -instance Storable CLinkedListBT + {Linked_list_A_s linked_list_A_s_x_3 + linked_list_A_s_next_4 -> pokeByteOff ptr_1 0 linked_list_A_s_x_3 >> pokeByteOff ptr_1 8 linked_list_A_s_next_4}} +newtype Linked_list_A_t + = Linked_list_A_t {unLinked_list_A_t :: Linked_list_A_s} +deriving newtype instance Storable Linked_list_A_t +data Linked_list_B_t + = Linked_list_B_t {linked_list_B_t_x :: CInt, + linked_list_B_t_next :: (Ptr Linked_list_B_t)} +instance Storable Linked_list_B_t where {sizeOf = \_ -> 16; alignment = \_ -> 8; - peek = \ptr_0 -> (pure MkCLinkedListBT <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> (pure Linked_list_B_t <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCLinkedListBT cLinkedListBT_x_3 - cLinkedListBT_next_4 -> pokeByteOff ptr_1 0 cLinkedListBT_x_3 >> pokeByteOff ptr_1 8 cLinkedListBT_next_4}} + {Linked_list_B_t linked_list_B_t_x_3 + linked_list_B_t_next_4 -> pokeByteOff ptr_1 0 linked_list_B_t_x_3 >> pokeByteOff ptr_1 8 linked_list_B_t_next_4}} diff --git a/hs-bindgen/fixtures/simple_structs.hs b/hs-bindgen/fixtures/simple_structs.hs index 31b23462..bc1b68fc 100644 --- a/hs-bindgen/fixtures/simple_structs.hs +++ b/hs-bindgen/fixtures/simple_structs.hs @@ -1,14 +1,14 @@ -DeclData (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS1", structConstr = "MkCS1", structFields = Field {fieldName = "cS1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclData (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS2", structConstr = "MkCS2", structFields = Field {fieldName = "cS2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) 3 (Seq [PokeByteOff 4 0 0,PokeByteOff 4 4 1,PokeByteOff 4 8 2])))})) -DeclNewtype (Newtype {newtypeName = "CS2T", newtypeConstr = "MkCS2T", newtypeField = Field {fieldName = "unCS2T", fieldType = HsTypRef "CS2"}}) -DeclNewtypeInstance Storable "CS2T" -DeclData (Struct {structName = "CS3T", structConstr = "MkCS3T", structFields = Field {fieldName = "cS3T_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS3T", structConstr = "MkCS3T", structFields = Field {fieldName = "cS3T_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS3T", structConstr = "MkCS3T", structFields = Field {fieldName = "cS3T_a", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS3T", structConstr = "MkCS3T", structFields = Field {fieldName = "cS3T_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclData (Struct {structName = "CS4", structConstr = "MkCS4", structFields = Field {fieldName = "cS4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS4", structConstr = "MkCS4", structFields = Field {fieldName = "cS4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS4", structConstr = "MkCS4", structFields = Field {fieldName = "cS4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS4", structConstr = "MkCS4", structFields = Field {fieldName = "cS4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "cS4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) 3 (Seq [PokeByteOff 4 0 0,PokeByteOff 4 4 1,PokeByteOff 4 8 2])))})) -DeclData (Struct {structName = "CS5", structConstr = "MkCS5", structFields = Field {fieldName = "cS5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS5", structConstr = "MkCS5", structFields = Field {fieldName = "cS5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS5", structConstr = "MkCS5", structFields = Field {fieldName = "cS5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS5", structConstr = "MkCS5", structFields = Field {fieldName = "cS5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) -DeclData (Struct {structName = "CS6", structConstr = "MkCS6", structFields = Field {fieldName = "cS6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CS6", structConstr = "MkCS6", structFields = Field {fieldName = "cS6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CS6", structConstr = "MkCS6", structFields = Field {fieldName = "cS6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CS6", structConstr = "MkCS6", structFields = Field {fieldName = "cS6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "cS6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S1", structConstr = "S1", structFields = Field {fieldName = "s1_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s1_b", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) (StorableInstance {storableSizeOf = 12, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S2", structConstr = "S2", structFields = Field {fieldName = "s2_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s2_b", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s2_c", fieldType = HsPrimType HsPrimCFloat} ::: VNil}) 3 (Seq [PokeByteOff 4 0 0,PokeByteOff 4 4 1,PokeByteOff 4 8 2])))})) +DeclNewtype (Newtype {newtypeName = "S2_t", newtypeConstr = "S2_t", newtypeField = Field {fieldName = "unS2_t", fieldType = HsTypRef "S2"}}) +DeclNewtypeInstance Storable "S2_t" +DeclData (Struct {structName = "S3_t", structConstr = "S3_t", structFields = Field {fieldName = "s3_t_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S3_t", structConstr = "S3_t", structFields = Field {fieldName = "s3_t_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S3_t", structConstr = "S3_t", structFields = Field {fieldName = "s3_t_a", fieldType = HsPrimType HsPrimCChar} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S3_t", structConstr = "S3_t", structFields = Field {fieldName = "s3_t_a", fieldType = HsPrimType HsPrimCChar} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclData (Struct {structName = "S4", structConstr = "S4", structFields = Field {fieldName = "s4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S4", structConstr = "S4", structFields = Field {fieldName = "s4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S4", structConstr = "S4", structFields = Field {fieldName = "s4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S4", structConstr = "S4", structFields = Field {fieldName = "s4_b", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s4_a", fieldType = HsPrimType HsPrimCInt} ::: Field {fieldName = "s4_c", fieldType = HsPtr (HsPrimType HsPrimCInt)} ::: VNil}) 3 (Seq [PokeByteOff 4 0 0,PokeByteOff 4 4 1,PokeByteOff 4 8 2])))})) +DeclData (Struct {structName = "S5", structConstr = "S5", structFields = Field {fieldName = "s5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S5", structConstr = "S5", structFields = Field {fieldName = "s5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S5", structConstr = "S5", structFields = Field {fieldName = "s5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S5", structConstr = "S5", structFields = Field {fieldName = "s5_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s5_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) +DeclData (Struct {structName = "S6", structConstr = "S6", structFields = Field {fieldName = "s6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "S6", structConstr = "S6", structFields = Field {fieldName = "s6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "S6", structConstr = "S6", structFields = Field {fieldName = "s6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "S6", structConstr = "S6", structFields = Field {fieldName = "s6_a", fieldType = HsPrimType HsPrimCChar} ::: Field {fieldName = "s6_b", fieldType = HsPrimType HsPrimCInt} ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))})) diff --git a/hs-bindgen/fixtures/simple_structs.pp.hs b/hs-bindgen/fixtures/simple_structs.pp.hs index 4e170d15..954e7ae6 100644 --- a/hs-bindgen/fixtures/simple_structs.pp.hs +++ b/hs-bindgen/fixtures/simple_structs.pp.hs @@ -6,12 +6,12 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -data CS1 = MkCS1 - { cS1_a :: FC.CInt - , cS1_b :: FC.CChar +data S1 = S1 + { s1_a :: FC.CInt + , s1_b :: FC.CChar } -instance F.Storable CS1 where +instance F.Storable S1 where sizeOf = \_ -> 8 @@ -19,7 +19,7 @@ instance F.Storable CS1 where peek = \ptr0 -> - pure MkCS1 + pure S1 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -27,17 +27,17 @@ instance F.Storable CS1 where \ptr0 -> \s1 -> case s1 of - MkCS1 cS1_a2 cS1_b3 -> - F.pokeByteOff ptr0 0 cS1_a2 - >> F.pokeByteOff ptr0 4 cS1_b3 - -data CS2 = MkCS2 - { cS2_a :: FC.CChar - , cS2_b :: FC.CInt - , cS2_c :: FC.CFloat + S1 s1_a2 s1_b3 -> + F.pokeByteOff ptr0 0 s1_a2 + >> F.pokeByteOff ptr0 4 s1_b3 + +data S2 = S2 + { s2_a :: FC.CChar + , s2_b :: FC.CInt + , s2_c :: FC.CFloat } -instance F.Storable CS2 where +instance F.Storable S2 where sizeOf = \_ -> 12 @@ -45,7 +45,7 @@ instance F.Storable CS2 where peek = \ptr0 -> - pure MkCS2 + pure S2 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 <*> F.peekByteOff ptr0 8 @@ -54,22 +54,22 @@ instance F.Storable CS2 where \ptr0 -> \s1 -> case s1 of - MkCS2 cS2_a2 cS2_b3 cS2_c4 -> - F.pokeByteOff ptr0 0 cS2_a2 - >> F.pokeByteOff ptr0 4 cS2_b3 - >> F.pokeByteOff ptr0 8 cS2_c4 + S2 s2_a2 s2_b3 s2_c4 -> + F.pokeByteOff ptr0 0 s2_a2 + >> F.pokeByteOff ptr0 4 s2_b3 + >> F.pokeByteOff ptr0 8 s2_c4 -newtype CS2T = MkCS2T - { unCS2T :: CS2 +newtype S2_t = S2_t + { unS2_t :: S2 } -deriving newtype instance F.Storable CS2T +deriving newtype instance F.Storable S2_t -data CS3T = MkCS3T - { cS3T_a :: FC.CChar +data S3_t = S3_t + { s3_t_a :: FC.CChar } -instance F.Storable CS3T where +instance F.Storable S3_t where sizeOf = \_ -> 1 @@ -77,22 +77,22 @@ instance F.Storable CS3T where peek = \ptr0 -> - pure MkCS3T + pure S3_t <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCS3T cS3T_a2 -> F.pokeByteOff ptr0 0 cS3T_a2 + S3_t s3_t_a2 -> F.pokeByteOff ptr0 0 s3_t_a2 -data CS4 = MkCS4 - { cS4_b :: FC.CChar - , cS4_a :: FC.CInt - , cS4_c :: F.Ptr FC.CInt +data S4 = S4 + { s4_b :: FC.CChar + , s4_a :: FC.CInt + , s4_c :: F.Ptr FC.CInt } -instance F.Storable CS4 where +instance F.Storable S4 where sizeOf = \_ -> 16 @@ -100,7 +100,7 @@ instance F.Storable CS4 where peek = \ptr0 -> - pure MkCS4 + pure S4 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 <*> F.peekByteOff ptr0 8 @@ -109,17 +109,17 @@ instance F.Storable CS4 where \ptr0 -> \s1 -> case s1 of - MkCS4 cS4_b2 cS4_a3 cS4_c4 -> - F.pokeByteOff ptr0 0 cS4_b2 - >> F.pokeByteOff ptr0 4 cS4_a3 - >> F.pokeByteOff ptr0 8 cS4_c4 - -data CS5 = MkCS5 - { cS5_a :: FC.CChar - , cS5_b :: FC.CInt + S4 s4_b2 s4_a3 s4_c4 -> + F.pokeByteOff ptr0 0 s4_b2 + >> F.pokeByteOff ptr0 4 s4_a3 + >> F.pokeByteOff ptr0 8 s4_c4 + +data S5 = S5 + { s5_a :: FC.CChar + , s5_b :: FC.CInt } -instance F.Storable CS5 where +instance F.Storable S5 where sizeOf = \_ -> 8 @@ -127,7 +127,7 @@ instance F.Storable CS5 where peek = \ptr0 -> - pure MkCS5 + pure S5 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -135,16 +135,16 @@ instance F.Storable CS5 where \ptr0 -> \s1 -> case s1 of - MkCS5 cS5_a2 cS5_b3 -> - F.pokeByteOff ptr0 0 cS5_a2 - >> F.pokeByteOff ptr0 4 cS5_b3 + S5 s5_a2 s5_b3 -> + F.pokeByteOff ptr0 0 s5_a2 + >> F.pokeByteOff ptr0 4 s5_b3 -data CS6 = MkCS6 - { cS6_a :: FC.CChar - , cS6_b :: FC.CInt +data S6 = S6 + { s6_a :: FC.CChar + , s6_b :: FC.CInt } -instance F.Storable CS6 where +instance F.Storable S6 where sizeOf = \_ -> 8 @@ -152,7 +152,7 @@ instance F.Storable CS6 where peek = \ptr0 -> - pure MkCS6 + pure S6 <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 @@ -160,6 +160,6 @@ instance F.Storable CS6 where \ptr0 -> \s1 -> case s1 of - MkCS6 cS6_a2 cS6_b3 -> - F.pokeByteOff ptr0 0 cS6_a2 - >> F.pokeByteOff ptr0 4 cS6_b3 + S6 s6_a2 s6_b3 -> + F.pokeByteOff ptr0 0 s6_a2 + >> F.pokeByteOff ptr0 4 s6_b3 diff --git a/hs-bindgen/fixtures/simple_structs.th.txt b/hs-bindgen/fixtures/simple_structs.th.txt index e76b1298..030c4edf 100644 --- a/hs-bindgen/fixtures/simple_structs.th.txt +++ b/hs-bindgen/fixtures/simple_structs.th.txt @@ -1,52 +1,51 @@ -data CS1 = MkCS1 {cS1_a :: CInt, cS1_b :: CChar} -instance Storable CS1 +data S1 = S1 {s1_a :: CInt, s1_b :: CChar} +instance Storable S1 where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure S1 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS1 cS1_a_3 - cS1_b_4 -> pokeByteOff ptr_1 0 cS1_a_3 >> pokeByteOff ptr_1 4 cS1_b_4}} -data CS2 = MkCS2 {cS2_a :: CChar, cS2_b :: CInt, cS2_c :: CFloat} -instance Storable CS2 + {S1 s1_a_3 + s1_b_4 -> pokeByteOff ptr_1 0 s1_a_3 >> pokeByteOff ptr_1 4 s1_b_4}} +data S2 = S2 {s2_a :: CChar, s2_b :: CInt, s2_c :: CFloat} +instance Storable S2 where {sizeOf = \_ -> 12; alignment = \_ -> 4; - peek = \ptr_0 -> ((pure MkCS2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> ((pure S2 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS2 cS2_a_3 - cS2_b_4 - cS2_c_5 -> pokeByteOff ptr_1 0 cS2_a_3 >> (pokeByteOff ptr_1 4 cS2_b_4 >> pokeByteOff ptr_1 8 cS2_c_5)}} -newtype CS2T = MkCS2T {unCS2T :: CS2} -deriving newtype instance Storable CS2T -data CS3T = MkCS3T {cS3T_a :: CChar} -instance Storable CS3T + {S2 s2_a_3 + s2_b_4 + s2_c_5 -> pokeByteOff ptr_1 0 s2_a_3 >> (pokeByteOff ptr_1 4 s2_b_4 >> pokeByteOff ptr_1 8 s2_c_5)}} +newtype S2_t = S2_t {unS2_t :: S2} +deriving newtype instance Storable S2_t +data S3_t = S3_t {s3_t_a :: CChar} +instance Storable S3_t where {sizeOf = \_ -> 1; alignment = \_ -> 1; - peek = \ptr_0 -> pure MkCS3T <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure S3_t <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS3T cS3T_a_3 -> pokeByteOff ptr_1 0 cS3T_a_3}} -data CS4 - = MkCS4 {cS4_b :: CChar, cS4_a :: CInt, cS4_c :: (Ptr CInt)} -instance Storable CS4 + {S3_t s3_t_a_3 -> pokeByteOff ptr_1 0 s3_t_a_3}} +data S4 = S4 {s4_b :: CChar, s4_a :: CInt, s4_c :: (Ptr CInt)} +instance Storable S4 where {sizeOf = \_ -> 16; alignment = \_ -> 8; - peek = \ptr_0 -> ((pure MkCS4 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8; + peek = \ptr_0 -> ((pure S4 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS4 cS4_b_3 - cS4_a_4 - cS4_c_5 -> pokeByteOff ptr_1 0 cS4_b_3 >> (pokeByteOff ptr_1 4 cS4_a_4 >> pokeByteOff ptr_1 8 cS4_c_5)}} -data CS5 = MkCS5 {cS5_a :: CChar, cS5_b :: CInt} -instance Storable CS5 + {S4 s4_b_3 + s4_a_4 + s4_c_5 -> pokeByteOff ptr_1 0 s4_b_3 >> (pokeByteOff ptr_1 4 s4_a_4 >> pokeByteOff ptr_1 8 s4_c_5)}} +data S5 = S5 {s5_a :: CChar, s5_b :: CInt} +instance Storable S5 where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS5 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure S5 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS5 cS5_a_3 - cS5_b_4 -> pokeByteOff ptr_1 0 cS5_a_3 >> pokeByteOff ptr_1 4 cS5_b_4}} -data CS6 = MkCS6 {cS6_a :: CChar, cS6_b :: CInt} -instance Storable CS6 + {S5 s5_a_3 + s5_b_4 -> pokeByteOff ptr_1 0 s5_a_3 >> pokeByteOff ptr_1 4 s5_b_4}} +data S6 = S6 {s6_a :: CChar, s6_b :: CInt} +instance Storable S6 where {sizeOf = \_ -> 8; alignment = \_ -> 4; - peek = \ptr_0 -> (pure MkCS6 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; + peek = \ptr_0 -> (pure S6 <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCS6 cS6_a_3 - cS6_b_4 -> pokeByteOff ptr_1 0 cS6_a_3 >> pokeByteOff ptr_1 4 cS6_b_4}} + {S6 s6_a_3 + s6_b_4 -> pokeByteOff ptr_1 0 s6_a_3 >> pokeByteOff ptr_1 4 s6_b_4}} diff --git a/hs-bindgen/fixtures/typedef_vs_macro.hs b/hs-bindgen/fixtures/typedef_vs_macro.hs index 9fa0af78..6dcf1be0 100644 --- a/hs-bindgen/fixtures/typedef_vs_macro.hs +++ b/hs-bindgen/fixtures/typedef_vs_macro.hs @@ -1,8 +1,8 @@ -DeclNewtype (Newtype {newtypeName = "CM1", newtypeConstr = "MkCM1", newtypeField = Field {fieldName = "unCM1", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtype (Newtype {newtypeName = "CM2", newtypeConstr = "MkCM2", newtypeField = Field {fieldName = "unCM2", fieldType = HsPrimType HsPrimCChar}}) -DeclNewtype (Newtype {newtypeName = "CT1", newtypeConstr = "MkCT1", newtypeField = Field {fieldName = "unCT1", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtypeInstance Storable "CT1" -DeclNewtype (Newtype {newtypeName = "CT2", newtypeConstr = "MkCT2", newtypeField = Field {fieldName = "unCT2", fieldType = HsPrimType HsPrimCChar}}) -DeclNewtypeInstance Storable "CT2" -DeclData (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = Field {fieldName = "cExampleStruct_t1", fieldType = HsTypRef "CT1"} ::: Field {fieldName = "cExampleStruct_t2", fieldType = HsTypRef "CT2"} ::: Field {fieldName = "cExampleStruct_m1", fieldType = HsTypRef "CM1"} ::: Field {fieldName = "cExampleStruct_m2", fieldType = HsTypRef "CM2"} ::: VNil}) -DeclInstance (InstanceStorable (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = Field {fieldName = "cExampleStruct_t1", fieldType = HsTypRef "CT1"} ::: Field {fieldName = "cExampleStruct_t2", fieldType = HsTypRef "CT2"} ::: Field {fieldName = "cExampleStruct_m1", fieldType = HsTypRef "CM1"} ::: Field {fieldName = "cExampleStruct_m2", fieldType = HsTypRef "CM2"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = Field {fieldName = "cExampleStruct_t1", fieldType = HsTypRef "CT1"} ::: Field {fieldName = "cExampleStruct_t2", fieldType = HsTypRef "CT2"} ::: Field {fieldName = "cExampleStruct_m1", fieldType = HsTypRef "CM1"} ::: Field {fieldName = "cExampleStruct_m2", fieldType = HsTypRef "CM2"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8,PeekByteOff 0 12]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = Field {fieldName = "cExampleStruct_t1", fieldType = HsTypRef "CT1"} ::: Field {fieldName = "cExampleStruct_t2", fieldType = HsTypRef "CT2"} ::: Field {fieldName = "cExampleStruct_m1", fieldType = HsTypRef "CM1"} ::: Field {fieldName = "cExampleStruct_m2", fieldType = HsTypRef "CM2"} ::: VNil}) 4 (Seq [PokeByteOff 5 0 0,PokeByteOff 5 4 1,PokeByteOff 5 8 2,PokeByteOff 5 12 3])))})) +DeclNewtype (Newtype {newtypeName = "M1", newtypeConstr = "M1", newtypeField = Field {fieldName = "unM1", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtype (Newtype {newtypeName = "M2", newtypeConstr = "M2", newtypeField = Field {fieldName = "unM2", fieldType = HsPrimType HsPrimCChar}}) +DeclNewtype (Newtype {newtypeName = "T1", newtypeConstr = "T1", newtypeField = Field {fieldName = "unT1", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtypeInstance Storable "T1" +DeclNewtype (Newtype {newtypeName = "T2", newtypeConstr = "T2", newtypeField = Field {fieldName = "unT2", fieldType = HsPrimType HsPrimCChar}}) +DeclNewtypeInstance Storable "T2" +DeclData (Struct {structName = "ExampleStruct", structConstr = "ExampleStruct", structFields = Field {fieldName = "exampleStruct_t1", fieldType = HsTypRef "T1"} ::: Field {fieldName = "exampleStruct_t2", fieldType = HsTypRef "T2"} ::: Field {fieldName = "exampleStruct_m1", fieldType = HsTypRef "M1"} ::: Field {fieldName = "exampleStruct_m2", fieldType = HsTypRef "M2"} ::: VNil}) +DeclInstance (InstanceStorable (Struct {structName = "ExampleStruct", structConstr = "ExampleStruct", structFields = Field {fieldName = "exampleStruct_t1", fieldType = HsTypRef "T1"} ::: Field {fieldName = "exampleStruct_t2", fieldType = HsTypRef "T2"} ::: Field {fieldName = "exampleStruct_m1", fieldType = HsTypRef "M1"} ::: Field {fieldName = "exampleStruct_m2", fieldType = HsTypRef "M2"} ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "ExampleStruct", structConstr = "ExampleStruct", structFields = Field {fieldName = "exampleStruct_t1", fieldType = HsTypRef "T1"} ::: Field {fieldName = "exampleStruct_t2", fieldType = HsTypRef "T2"} ::: Field {fieldName = "exampleStruct_m1", fieldType = HsTypRef "M1"} ::: Field {fieldName = "exampleStruct_m2", fieldType = HsTypRef "M2"} ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4,PeekByteOff 0 8,PeekByteOff 0 12]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "ExampleStruct", structConstr = "ExampleStruct", structFields = Field {fieldName = "exampleStruct_t1", fieldType = HsTypRef "T1"} ::: Field {fieldName = "exampleStruct_t2", fieldType = HsTypRef "T2"} ::: Field {fieldName = "exampleStruct_m1", fieldType = HsTypRef "M1"} ::: Field {fieldName = "exampleStruct_m2", fieldType = HsTypRef "M2"} ::: VNil}) 4 (Seq [PokeByteOff 5 0 0,PokeByteOff 5 4 1,PokeByteOff 5 8 2,PokeByteOff 5 12 3])))})) diff --git a/hs-bindgen/fixtures/typedef_vs_macro.pp.hs b/hs-bindgen/fixtures/typedef_vs_macro.pp.hs index f597e1c8..4f9f4f14 100644 --- a/hs-bindgen/fixtures/typedef_vs_macro.pp.hs +++ b/hs-bindgen/fixtures/typedef_vs_macro.pp.hs @@ -6,34 +6,34 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), (>>), pure) -newtype CM1 = MkCM1 - { unCM1 :: FC.CInt +newtype M1 = M1 + { unM1 :: FC.CInt } -newtype CM2 = MkCM2 - { unCM2 :: FC.CChar +newtype M2 = M2 + { unM2 :: FC.CChar } -newtype CT1 = MkCT1 - { unCT1 :: FC.CInt +newtype T1 = T1 + { unT1 :: FC.CInt } -deriving newtype instance F.Storable CT1 +deriving newtype instance F.Storable T1 -newtype CT2 = MkCT2 - { unCT2 :: FC.CChar +newtype T2 = T2 + { unT2 :: FC.CChar } -deriving newtype instance F.Storable CT2 +deriving newtype instance F.Storable T2 -data CExampleStruct = MkCExampleStruct - { cExampleStruct_t1 :: CT1 - , cExampleStruct_t2 :: CT2 - , cExampleStruct_m1 :: CM1 - , cExampleStruct_m2 :: CM2 +data ExampleStruct = ExampleStruct + { exampleStruct_t1 :: T1 + , exampleStruct_t2 :: T2 + , exampleStruct_m1 :: M1 + , exampleStruct_m2 :: M2 } -instance F.Storable CExampleStruct where +instance F.Storable ExampleStruct where sizeOf = \_ -> 16 @@ -41,7 +41,7 @@ instance F.Storable CExampleStruct where peek = \ptr0 -> - pure MkCExampleStruct + pure ExampleStruct <*> F.peekByteOff ptr0 0 <*> F.peekByteOff ptr0 4 <*> F.peekByteOff ptr0 8 @@ -51,8 +51,8 @@ instance F.Storable CExampleStruct where \ptr0 -> \s1 -> case s1 of - MkCExampleStruct cExampleStruct_t12 cExampleStruct_t23 cExampleStruct_m14 cExampleStruct_m25 -> - F.pokeByteOff ptr0 0 cExampleStruct_t12 - >> F.pokeByteOff ptr0 4 cExampleStruct_t23 - >> F.pokeByteOff ptr0 8 cExampleStruct_m14 - >> F.pokeByteOff ptr0 12 cExampleStruct_m25 + ExampleStruct exampleStruct_t12 exampleStruct_t23 exampleStruct_m14 exampleStruct_m25 -> + F.pokeByteOff ptr0 0 exampleStruct_t12 + >> F.pokeByteOff ptr0 4 exampleStruct_t23 + >> F.pokeByteOff ptr0 8 exampleStruct_m14 + >> F.pokeByteOff ptr0 12 exampleStruct_m25 diff --git a/hs-bindgen/fixtures/typedef_vs_macro.th.txt b/hs-bindgen/fixtures/typedef_vs_macro.th.txt index 08980cbd..c7334b08 100644 --- a/hs-bindgen/fixtures/typedef_vs_macro.th.txt +++ b/hs-bindgen/fixtures/typedef_vs_macro.th.txt @@ -1,20 +1,20 @@ -newtype CM1 = MkCM1 {unCM1 :: CInt} -newtype CM2 = MkCM2 {unCM2 :: CChar} -newtype CT1 = MkCT1 {unCT1 :: CInt} -deriving newtype instance Storable CT1 -newtype CT2 = MkCT2 {unCT2 :: CChar} -deriving newtype instance Storable CT2 -data CExampleStruct - = MkCExampleStruct {cExampleStruct_t1 :: CT1, - cExampleStruct_t2 :: CT2, - cExampleStruct_m1 :: CM1, - cExampleStruct_m2 :: CM2} -instance Storable CExampleStruct +newtype M1 = M1 {unM1 :: CInt} +newtype M2 = M2 {unM2 :: CChar} +newtype T1 = T1 {unT1 :: CInt} +deriving newtype instance Storable T1 +newtype T2 = T2 {unT2 :: CChar} +deriving newtype instance Storable T2 +data ExampleStruct + = ExampleStruct {exampleStruct_t1 :: T1, + exampleStruct_t2 :: T2, + exampleStruct_m1 :: M1, + exampleStruct_m2 :: M2} +instance Storable ExampleStruct where {sizeOf = \_ -> 16; alignment = \_ -> 4; - peek = \ptr_0 -> (((pure MkCExampleStruct <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 12; + peek = \ptr_0 -> (((pure ExampleStruct <*> peekByteOff ptr_0 0) <*> peekByteOff ptr_0 4) <*> peekByteOff ptr_0 8) <*> peekByteOff ptr_0 12; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCExampleStruct cExampleStruct_t1_3 - cExampleStruct_t2_4 - cExampleStruct_m1_5 - cExampleStruct_m2_6 -> pokeByteOff ptr_1 0 cExampleStruct_t1_3 >> (pokeByteOff ptr_1 4 cExampleStruct_t2_4 >> (pokeByteOff ptr_1 8 cExampleStruct_m1_5 >> pokeByteOff ptr_1 12 cExampleStruct_m2_6))}} + {ExampleStruct exampleStruct_t1_3 + exampleStruct_t2_4 + exampleStruct_m1_5 + exampleStruct_m2_6 -> pokeByteOff ptr_1 0 exampleStruct_t1_3 >> (pokeByteOff ptr_1 4 exampleStruct_t2_4 >> (pokeByteOff ptr_1 8 exampleStruct_m1_5 >> pokeByteOff ptr_1 12 exampleStruct_m2_6))}} diff --git a/hs-bindgen/fixtures/typedefs.hs b/hs-bindgen/fixtures/typedefs.hs index 102d9c03..a9b6b4de 100644 --- a/hs-bindgen/fixtures/typedefs.hs +++ b/hs-bindgen/fixtures/typedefs.hs @@ -1,4 +1,4 @@ -DeclNewtype (Newtype {newtypeName = "CMyint", newtypeConstr = "MkCMyint", newtypeField = Field {fieldName = "unCMyint", fieldType = HsPrimType HsPrimCInt}}) -DeclNewtypeInstance Storable "CMyint" -DeclNewtype (Newtype {newtypeName = "CIntptr", newtypeConstr = "MkCIntptr", newtypeField = Field {fieldName = "unCIntptr", fieldType = HsPtr (HsPrimType HsPrimCInt)}}) -DeclNewtypeInstance Storable "CIntptr" +DeclNewtype (Newtype {newtypeName = "Myint", newtypeConstr = "Myint", newtypeField = Field {fieldName = "unMyint", fieldType = HsPrimType HsPrimCInt}}) +DeclNewtypeInstance Storable "Myint" +DeclNewtype (Newtype {newtypeName = "Intptr", newtypeConstr = "Intptr", newtypeField = Field {fieldName = "unIntptr", fieldType = HsPtr (HsPrimType HsPrimCInt)}}) +DeclNewtypeInstance Storable "Intptr" diff --git a/hs-bindgen/fixtures/typedefs.pp.hs b/hs-bindgen/fixtures/typedefs.pp.hs index c9236e9f..3c75dfd2 100644 --- a/hs-bindgen/fixtures/typedefs.pp.hs +++ b/hs-bindgen/fixtures/typedefs.pp.hs @@ -5,14 +5,14 @@ module Example where import qualified Foreign as F import qualified Foreign.C as FC -newtype CMyint = MkCMyint - { unCMyint :: FC.CInt +newtype Myint = Myint + { unMyint :: FC.CInt } -deriving newtype instance F.Storable CMyint +deriving newtype instance F.Storable Myint -newtype CIntptr = MkCIntptr - { unCIntptr :: F.Ptr FC.CInt +newtype Intptr = Intptr + { unIntptr :: F.Ptr FC.CInt } -deriving newtype instance F.Storable CIntptr +deriving newtype instance F.Storable Intptr diff --git a/hs-bindgen/fixtures/typedefs.th.txt b/hs-bindgen/fixtures/typedefs.th.txt index 9bdeac54..68153182 100644 --- a/hs-bindgen/fixtures/typedefs.th.txt +++ b/hs-bindgen/fixtures/typedefs.th.txt @@ -1,4 +1,4 @@ -newtype CMyint = MkCMyint {unCMyint :: CInt} -deriving newtype instance Storable CMyint -newtype CIntptr = MkCIntptr {unCIntptr :: (Ptr CInt)} -deriving newtype instance Storable CIntptr +newtype Myint = Myint {unMyint :: CInt} +deriving newtype instance Storable Myint +newtype Intptr = Intptr {unIntptr :: (Ptr CInt)} +deriving newtype instance Storable Intptr diff --git a/hs-bindgen/fixtures/typenames.hs b/hs-bindgen/fixtures/typenames.hs index c8ccf5ad..597d10cb 100644 --- a/hs-bindgen/fixtures/typenames.hs +++ b/hs-bindgen/fixtures/typenames.hs @@ -1,6 +1,6 @@ -DeclNewtype (Newtype {newtypeName = "CFoo", newtypeConstr = "MkCFoo", newtypeField = Field {fieldName = "unCFoo", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "unCFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "unCFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = Field {fieldName = "unCFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCFOO1", patSynType = "CFoo", patSynConstr = "MkCFoo", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCFOO2", patSynType = "CFoo", patSynConstr = "MkCFoo", patSynValue = 1}) -DeclNewtype (Newtype {newtypeName = "CFoo", newtypeConstr = "MkCFoo", newtypeField = Field {fieldName = "unCFoo", fieldType = HsPrimType HsPrimCDouble}}) -DeclNewtypeInstance Storable "CFoo" +DeclNewtype (Newtype {newtypeName = "Foo", newtypeConstr = "Foo", newtypeField = Field {fieldName = "unFoo", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "unFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "unFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "Foo", structConstr = "Foo", structFields = Field {fieldName = "unFoo", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "FOO1", patSynType = "Foo", patSynConstr = "Foo", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "FOO2", patSynType = "Foo", patSynConstr = "Foo", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "Foo", newtypeConstr = "Foo", newtypeField = Field {fieldName = "unFoo", fieldType = HsPrimType HsPrimCDouble}}) +DeclNewtypeInstance Storable "Foo" diff --git a/hs-bindgen/fixtures/typenames.pp.hs b/hs-bindgen/fixtures/typenames.pp.hs index a85eeefc..5c185af8 100644 --- a/hs-bindgen/fixtures/typenames.pp.hs +++ b/hs-bindgen/fixtures/typenames.pp.hs @@ -6,11 +6,11 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), pure) -newtype CFoo = MkCFoo - { unCFoo :: FC.CUInt +newtype Foo = Foo + { unFoo :: FC.CUInt } -instance F.Storable CFoo where +instance F.Storable Foo where sizeOf = \_ -> 4 @@ -18,23 +18,23 @@ instance F.Storable CFoo where peek = \ptr0 -> - pure MkCFoo + pure Foo <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCFoo unCFoo2 -> F.pokeByteOff ptr0 0 unCFoo2 + Foo unFoo2 -> F.pokeByteOff ptr0 0 unFoo2 -pattern MkCFOO1 :: CFoo -pattern MkCFOO1 = MkCFoo 0 +pattern FOO1 :: Foo +pattern FOO1 = Foo 0 -pattern MkCFOO2 :: CFoo -pattern MkCFOO2 = MkCFoo 1 +pattern FOO2 :: Foo +pattern FOO2 = Foo 1 -newtype CFoo = MkCFoo - { unCFoo :: FC.CDouble +newtype Foo = Foo + { unFoo :: FC.CDouble } -deriving newtype instance F.Storable CFoo +deriving newtype instance F.Storable Foo diff --git a/hs-bindgen/fixtures/typenames.th.txt b/hs-bindgen/fixtures/typenames.th.txt index 9384b451..0ccd3493 100644 --- a/hs-bindgen/fixtures/typenames.th.txt +++ b/hs-bindgen/fixtures/typenames.th.txt @@ -1,13 +1,13 @@ -newtype CFoo = MkCFoo {unCFoo :: CUInt} -instance Storable CFoo +newtype Foo = Foo {unFoo :: CUInt} +instance Storable Foo where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCFoo <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure Foo <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCFoo unCFoo_3 -> pokeByteOff ptr_1 0 unCFoo_3}} -pattern MkCFOO1 :: CFoo -pattern MkCFOO1 = MkCFoo 0 -pattern MkCFOO2 :: CFoo -pattern MkCFOO2 = MkCFoo 1 -newtype CFoo = MkCFoo {unCFoo :: CDouble} -deriving newtype instance Storable CFoo + {Foo unFoo_3 -> pokeByteOff ptr_1 0 unFoo_3}} +pattern FOO1 :: Foo +pattern FOO1 = Foo 0 +pattern FOO2 :: Foo +pattern FOO2 = Foo 1 +newtype Foo = Foo {unFoo :: CDouble} +deriving newtype instance Storable Foo diff --git a/hs-bindgen/fixtures/uses_utf8.hs b/hs-bindgen/fixtures/uses_utf8.hs index eda12f55..bb341295 100644 --- a/hs-bindgen/fixtures/uses_utf8.hs +++ b/hs-bindgen/fixtures/uses_utf8.hs @@ -1,4 +1,4 @@ -DeclNewtype (Newtype {newtypeName = "CMyEnum", newtypeConstr = "MkCMyEnum", newtypeField = Field {fieldName = "unCMyEnum", fieldType = HsPrimType HsPrimCUInt}}) -DeclInstance (InstanceStorable (Struct {structName = "CMyEnum", structConstr = "MkCMyEnum", structFields = Field {fieldName = "unCMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CMyEnum", structConstr = "MkCMyEnum", structFields = Field {fieldName = "unCMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CMyEnum", structConstr = "MkCMyEnum", structFields = Field {fieldName = "unCMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) -DeclPatSyn (PatSyn {patSynName = "MkCSay\20320\22909", patSynType = "CMyEnum", patSynConstr = "MkCMyEnum", patSynValue = 0}) -DeclPatSyn (PatSyn {patSynName = "MkCSay\25308\25308", patSynType = "CMyEnum", patSynConstr = "MkCMyEnum", patSynValue = 1}) +DeclNewtype (Newtype {newtypeName = "MyEnum", newtypeConstr = "MyEnum", newtypeField = Field {fieldName = "unMyEnum", fieldType = HsPrimType HsPrimCUInt}}) +DeclInstance (InstanceStorable (Struct {structName = "MyEnum", structConstr = "MyEnum", structFields = Field {fieldName = "unMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "MyEnum", structConstr = "MyEnum", structFields = Field {fieldName = "unMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "MyEnum", structConstr = "MyEnum", structFields = Field {fieldName = "unMyEnum", fieldType = HsPrimType HsPrimCUInt} ::: VNil}) 1 (Seq [PokeByteOff 2 0 0])))})) +DeclPatSyn (PatSyn {patSynName = "Say\20320\22909", patSynType = "MyEnum", patSynConstr = "MyEnum", patSynValue = 0}) +DeclPatSyn (PatSyn {patSynName = "Say\25308\25308", patSynType = "MyEnum", patSynConstr = "MyEnum", patSynValue = 1}) diff --git a/hs-bindgen/fixtures/uses_utf8.pp.hs b/hs-bindgen/fixtures/uses_utf8.pp.hs index ee28d6ad..292583c3 100644 --- a/hs-bindgen/fixtures/uses_utf8.pp.hs +++ b/hs-bindgen/fixtures/uses_utf8.pp.hs @@ -6,11 +6,11 @@ import qualified Foreign as F import qualified Foreign.C as FC import Prelude ((<*>), pure) -newtype CMyEnum = MkCMyEnum - { unCMyEnum :: FC.CUInt +newtype MyEnum = MyEnum + { unMyEnum :: FC.CUInt } -instance F.Storable CMyEnum where +instance F.Storable MyEnum where sizeOf = \_ -> 4 @@ -18,17 +18,17 @@ instance F.Storable CMyEnum where peek = \ptr0 -> - pure MkCMyEnum + pure MyEnum <*> F.peekByteOff ptr0 0 poke = \ptr0 -> \s1 -> case s1 of - MkCMyEnum unCMyEnum2 -> F.pokeByteOff ptr0 0 unCMyEnum2 + MyEnum unMyEnum2 -> F.pokeByteOff ptr0 0 unMyEnum2 -pattern MkCSay你好 :: CMyEnum -pattern MkCSay你好 = MkCMyEnum 0 +pattern Say你好 :: MyEnum +pattern Say你好 = MyEnum 0 -pattern MkCSay拜拜 :: CMyEnum -pattern MkCSay拜拜 = MkCMyEnum 1 +pattern Say拜拜 :: MyEnum +pattern Say拜拜 = MyEnum 1 diff --git a/hs-bindgen/fixtures/uses_utf8.th.txt b/hs-bindgen/fixtures/uses_utf8.th.txt index ac0a07bf..8e7f2612 100644 --- a/hs-bindgen/fixtures/uses_utf8.th.txt +++ b/hs-bindgen/fixtures/uses_utf8.th.txt @@ -1,11 +1,11 @@ -newtype CMyEnum = MkCMyEnum {unCMyEnum :: CUInt} -instance Storable CMyEnum +newtype MyEnum = MyEnum {unMyEnum :: CUInt} +instance Storable MyEnum where {sizeOf = \_ -> 4; alignment = \_ -> 4; - peek = \ptr_0 -> pure MkCMyEnum <*> peekByteOff ptr_0 0; + peek = \ptr_0 -> pure MyEnum <*> peekByteOff ptr_0 0; poke = \ptr_1 -> \s_2 -> case s_2 of - {MkCMyEnum unCMyEnum_3 -> pokeByteOff ptr_1 0 unCMyEnum_3}} -pattern MkCSay你好 :: CMyEnum -pattern MkCSay你好 = MkCMyEnum 0 -pattern MkCSay拜拜 :: CMyEnum -pattern MkCSay拜拜 = MkCMyEnum 1 + {MyEnum unMyEnum_3 -> pokeByteOff ptr_1 0 unMyEnum_3}} +pattern Say你好 :: MyEnum +pattern Say你好 = MyEnum 0 +pattern Say拜拜 :: MyEnum +pattern Say拜拜 = MyEnum 1 diff --git a/hs-bindgen/src/HsBindgen/C/Fold/Type.hs b/hs-bindgen/src/HsBindgen/C/Fold/Type.hs index 24eab9ea..1cc3a594 100644 --- a/hs-bindgen/src/HsBindgen/C/Fold/Type.hs +++ b/hs-bindgen/src/HsBindgen/C/Fold/Type.hs @@ -60,7 +60,7 @@ mkDefnName = DefnName . CName . go where -- TODO: temporary, expose name structure as is in DefnName go :: Path -> Text go PathTop = "ANONYMOUS" -- shouldn't happen - go (PathField n p) = go p <> getCName n + go (PathField n p) = go p <> "_" <> getCName n go (PathStruct Nothing p) = go p go (PathStruct (Just n) _) = getCName n diff --git a/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs b/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs index 402f33c0..a38640b2 100644 --- a/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs +++ b/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs @@ -1,8 +1,10 @@ module HsBindgen.Hs.AST.Name ( -- * Definition Namespace(..) + , SNamespace(..) + , namespaceOf + , SingNamespace(..) , HsName(..) - , MkHsName(..) -- * Contexts , ModuleNameContext(..) , TypeClassContext(..) @@ -14,6 +16,8 @@ module HsBindgen.Hs.AST.Name ( , NameMangler(..) -- ** DSL , translateName + , handleOverrideNone + , handleOverrideMap , maintainCName , camelCaseCName , dropInvalidChar @@ -22,11 +26,11 @@ module HsBindgen.Hs.AST.Name ( , joinWithConcat , joinWithSnakeCase , joinWithCamelCase + , mkHsNamePrefixInvalid + , mkHsNameDropInvalid , handleReservedNone , handleReservedNames , appendSingleQuote - , handleOverrideNone - , handleOverrideMap , handleModuleNameParent -- ** Reserved Names -- $ReservedNames @@ -115,48 +119,6 @@ newtype HsName (ns :: Namespace) = HsName { getHsName :: Text } -- 'Show' instance valid due to 'IsString' instance deriving newtype (Show, Eq, Ord, IsString, Semigroup) --- | Construct an 'HsName' in namespace @ns@ -class MkHsName (ns :: Namespace) where - - -- | Construct an 'HsName' in namespace @ns@ - -- - -- Haskell identifiers must begin with an uppercase or lowercase letter, - -- according to the type of identifier (namespace). This function changes - -- the case of the first letter of the passed name. - -- - -- If the passed name starts with non-letter characters, those characters - -- are dropped and the case of the first letter is changed. If there are - -- no letters, then name @x@ (or @X@) is returned as a default. - mkHsName :: Text -> HsName ns - -instance MkHsName NsModuleName where - mkHsName = mkHsName' Char.toUpper - -instance MkHsName NsTypeClass where - mkHsName = mkHsName' Char.toUpper - -instance MkHsName NsTypeConstr where - mkHsName = mkHsName' Char.toUpper - -instance MkHsName NsTypeVar where - mkHsName = mkHsName' Char.toLower - -instance MkHsName NsConstr where - mkHsName = mkHsName' Char.toUpper - -instance MkHsName NsVar where - mkHsName = mkHsName' Char.toLower - -mkHsName' :: (Char -> Char) -> Text -> HsName ns -mkHsName' f = HsName . aux - where - aux :: Text -> Text - aux t = case T.uncons t of - Just (c, t') - | Char.isLetter c -> T.cons (f c) t' - | otherwise -> aux t' - Nothing -> T.pack [f 'x'] - {------------------------------------------------------------------------------- Contexts -------------------------------------------------------------------------------} @@ -229,8 +191,6 @@ data VarContext = FieldVarContext { -- | Record type context ctxFieldVarTypeCtx :: TypeConstrContext - , -- | Record type has a single constructor? - ctxFieldVarSingleConstr :: Bool , -- | C field name ctxFieldVarCName :: CName } @@ -267,8 +227,10 @@ data NameMangler = NameMangler { -- | Translate a 'CName' to an 'HsName' -- --- Namespace @ns@ determines the case of the first letter of the name, which is --- converted automatically. +-- The override function may be used to specify translations of C names to +-- Haskell names. The Haskell name must be valid for the specified namespace. +-- Two override functions are provided in this module: 'handleOverrideNone' and +-- 'handleOverrideMap'. -- -- The translation function must return a 'Text' that only contains the -- following (valid) characters: @@ -285,35 +247,55 @@ data NameMangler = NameMangler { -- Three join functions are provided in this module: 'joinWithConcat', -- 'joinWithSnakeCase', and 'joinWithCamelCase'. -- --- The reserved name function may be used to change names that would cause a --- compilation error. Two reserved name functions are provided in this module: --- 'handleReservedNone' and 'handleReservedNames'. +-- Any prefixes and suffixes specified must result in a valid name. -- --- The override function may be used to specify translations of C names to --- Haskell names. The Haskell name must be valid. Two override functions are --- provided in this module: 'handleOverrideNone' and 'handleOverrideMap'. -translateName :: forall ns. MkHsName ns - => (CName -> Text) -- ^ translate a 'CName' to a Haskell name - -> ([Text] -> Text) -- ^ join parts of a name - -> [Text] -- ^ prefixes - -> [Text] -- ^ suffixes - -> (HsName ns -> HsName ns) -- ^ handle reserved names - -> (CName -> Maybe (HsName ns)) -- ^ override translation +-- The constructor function must return an 'HsName' that is valid for the +-- specified namespace. Two constructor functions are provided in this module: +-- 'mkHsNamePrefixInvalid' and 'mkHsNameDropInvalid'. +-- +-- The reserved name function may be used to change names that would cause +-- confusion or a compilation error. Two reserved name functions are provided +-- in this module: 'handleReservedNone' and 'handleReservedNames'. +translateName :: + (CName -> Maybe (HsName ns)) -- ^ Override translation + -> (CName -> Text) -- ^ Translate + -> ([Text] -> Text) -- ^ Join parts of a name + -> [Text] -- ^ Prefixes + -> [Text] -- ^ Suffixes + -> (Text -> HsName ns) -- ^ Construct an 'HsName' + -> (HsName ns -> HsName ns) -- ^ Handle reserved names -> CName -> HsName ns translateName - transCName + override + translate joinParts prefixes suffixes + mkHsName handleReserved - handleOverride cname = - case handleOverride cname of - Just hsName -> hsName + case override cname of + Just name -> name Nothing -> - handleReserved . mkHsName @ns . joinParts $ - prefixes ++ transCName cname : suffixes + handleReserved . mkHsName . joinParts $ + prefixes ++ translate cname : suffixes + +-- | Do not override any translations +handleOverrideNone :: CName -> Maybe (HsName ns) +handleOverrideNone = const Nothing + +-- | Override translations using a map from C names and namespaces to Haskell +-- names +handleOverrideMap :: forall ns. + SingNamespace ns + => Map CName (Map Namespace Text) + -> CName + -> Maybe (HsName ns) +handleOverrideMap overrideMap name = do + nsMap <- Map.lookup name overrideMap + t <- Map.lookup (namespaceOf (singNamespace @ns)) nsMap + pure $ HsName t -- | Translate a C name to a Haskell name, making it as close to the C name as -- possible @@ -414,6 +396,60 @@ joinWithCamelCase = \case Just (c, t') -> T.cons (Char.toUpper c) t' Nothing -> t +-- | Construct an 'HsName', changing the case of the first character or adding a +-- prefix if the first character is invalid +-- +-- >>> mkHsNamePrefixInvalid @NsTypeConstr "C" "_foo" +-- "C_foo" +mkHsNamePrefixInvalid :: forall ns. + SingNamespace ns + => Text -- ^ Prefix to use when first character invalid + -> Text + -> HsName ns +mkHsNamePrefixInvalid prefix = HsName . case singNamespace @ns of + SNsModuleName -> auxU + SNsTypeClass -> auxU + SNsTypeConstr -> auxU + SNsTypeVar -> auxL + SNsConstr -> auxU + SNsVar -> auxL + where + auxU :: Text -> Text + auxU t = case T.uncons t of + Just (c, t') + | Char.isLetter c -> T.cons (Char.toUpper c) t' + | otherwise -> prefix <> t + Nothing -> prefix + + auxL :: Text -> Text + auxL t = case T.uncons t of + Just (c, t') -> T.cons (Char.toLower c) t' + Nothing -> prefix + +-- | Construct an 'HsName', changing the case of the first character after +-- dropping any invalid first characters +-- +-- >>> mkHsNameDropInvalid @NsTypeConstr "_foo" +-- "Foo" +mkHsNameDropInvalid :: forall ns. SingNamespace ns => Text -> HsName ns +mkHsNameDropInvalid = HsName . case singNamespace @ns of + SNsModuleName -> auxU + SNsTypeClass -> auxU + SNsTypeConstr -> auxU + SNsTypeVar -> auxL + SNsConstr -> auxU + SNsVar -> auxL + where + auxU :: Text -> Text + auxU t = case T.uncons (T.dropWhile (not . Char.isLetter) t) of + Just (c, t') -> T.cons (Char.toUpper c) t' + Nothing -> "X" + + auxL :: Text -> Text + auxL t = case T.uncons t of + Just (c, t') -> T.cons (Char.toLower c) t' + Nothing -> "x" + -- | Do not handle reserved names handleReservedNone :: HsName ns -> HsName ns handleReservedNone = id @@ -431,22 +467,6 @@ handleReservedNames f reserved name@(HsName t) appendSingleQuote :: Text -> Text appendSingleQuote = (<> "'") --- | Do not override any translations -handleOverrideNone :: CName -> Maybe (HsName ns) -handleOverrideNone = const Nothing - --- | Override translations using a map from C names and namespaces to Haskell --- names -handleOverrideMap :: forall ns. - SingNamespace ns - => Map CName (Map Namespace Text) - -> CName - -> Maybe (HsName ns) -handleOverrideMap overrideMap name = do - nsMap <- Map.lookup name overrideMap - t <- Map.lookup (namespaceOf (singNamespace @ns)) nsMap - pure $ HsName t - -- | Prepend the parent module name, joining using a @.@, if one is provided in -- the context handleModuleNameParent :: @@ -615,21 +635,24 @@ sanityReservedVarNames = -- | Default name mangler -- --- This default attempts to provide a balance between safety and taste. +-- With this name mangler, names are changed as little as possible. In general, +-- any invalid characters are escaped, and the first character is converted to +-- uppercase/lowercase as needed for the namespace. Collision with a reserved +-- word is resolved by appending a @'@ character. -- --- * Module names are transformed to @PascalCase@, dropping invalid characters. --- * Type class names are transformed to @PascalCase@, escaping invalid --- characters. --- * Type constructors are prefixed with @C@, escaping invalid characters. --- * Type variables have invalid characters escaped, and single quotes are --- appended to reserved names. --- * Constructors are prefixed with @Mk@, escaping invalid characters. --- * Record fields are prefixed with the type name if the data type has a single --- constructor or the constructor name otherwise, joined using an underscore, --- escaping invalid characters. --- * Enumeration fields are prefixed with @un@, escaping invalid characters. --- * Other variables have invalid characters escaped, and single quotes are --- appended to reserved names. +-- Details: +-- +-- * Module, type class, type constructor, and constructor names must start with +-- an uppercase letter. Prefix @C@ is added if the first character is not a +-- letter. +-- * The type constructor name for an anonymous structure/union for a named +-- field is the name of the type and the name of the field joined by +-- underscore. +-- * A constructor name is always the same as the type constructor name. +-- * The accessor name for a @newtype@ wrapper created for an enumeration is +-- @un@ concatenated to the type name. +-- * The accessor name for a structure/union field is the type name and the +-- field name, joined by underscore. defaultNameMangler :: NameMangler defaultNameMangler = NameMangler{..} where @@ -645,88 +668,92 @@ defaultNameMangler = NameMangler{..} mangleModuleName :: ModuleNameContext -> HsName NsModuleName mangleModuleName ctx@ModuleNameContext{..} = handleModuleNameParent ctx $ translateName - (camelCaseCName dropInvalidChar) - joinWithConcat -- not used (no prefixes/suffixes) + handleOverrideNone + (maintainCName escapeInvalidChar) + joinWithSnakeCase -- not used (no prefixes/suffixes) [] [] + (mkHsNamePrefixInvalid "C") handleReservedNone - handleOverrideNone ctxModuleNameCName mangleTypeClassName :: TypeClassContext -> HsName NsTypeClass mangleTypeClassName TypeClassContext{..} = translateName - (camelCaseCName escapeInvalidChar) - joinWithConcat -- not used (no prefixes/suffixes) + handleOverrideNone + (maintainCName escapeInvalidChar) + joinWithSnakeCase -- not used (no prefixes/suffixes) [] [] + (mkHsNamePrefixInvalid "C") handleReservedNone - handleOverrideNone ctxTypeClassCName mangleTypeConstrName :: TypeConstrContext -> HsName NsTypeConstr mangleTypeConstrName = \case TypeConstrContext{..} -> translateName - (camelCaseCName escapeInvalidChar) - joinWithCamelCase - ["C"] + handleOverrideNone + (maintainCName escapeInvalidChar) + joinWithSnakeCase -- not used (no prefixes/suffixes) + [] [] + (mkHsNamePrefixInvalid "C") (handleReservedNames appendSingleQuote reservedTypeNames) - handleOverrideNone ctxTypeConstrCName AnonNamedFieldTypeConstrContext{..} -> translateName - (camelCaseCName escapeInvalidChar) - joinWithCamelCase + handleOverrideNone + (maintainCName escapeInvalidChar) + joinWithSnakeCase [ getHsName $ mangleTypeConstrName ctxAnonNamedFieldTypeConstrAncestorCtx ] [] + (mkHsNamePrefixInvalid "C") handleReservedNone - handleOverrideNone ctxAnonNamedFieldTypeConstrFieldName mangleTypeVarName :: TypeVarContext -> HsName NsTypeVar mangleTypeVarName ctxt = translateName + handleOverrideNone (maintainCName escapeInvalidChar) joinWithSnakeCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid (handleReservedNames appendSingleQuote reservedVarNames) - handleOverrideNone (ctxTypeVarCName ctxt) mangleConstrName :: ConstrContext -> HsName NsConstr mangleConstrName ConstrContext{..} = - HsName $ "Mk" <> getHsName (mangleTypeConstrName ctxConstrTypeCtx) + HsName $ getHsName (mangleTypeConstrName ctxConstrTypeCtx) mangleVarName :: VarContext -> HsName NsVar mangleVarName = \case VarContext{..} -> translateName + handleOverrideNone (maintainCName escapeInvalidChar) joinWithSnakeCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid (handleReservedNames appendSingleQuote reservedVarNames) - handleOverrideNone ctxVarCName EnumVarContext{..} -> HsName $ "un" <> getHsName (mangleTypeConstrName ctxEnumVarTypeCtx) FieldVarContext{..} -> translateName + handleOverrideNone (maintainCName escapeInvalidChar) joinWithSnakeCase - [ if ctxFieldVarSingleConstr - then getHsName $ mangleTypeConstrName ctxFieldVarTypeCtx - else - getHsName $ mangleConstrName (ConstrContext ctxFieldVarTypeCtx) + [ getHsName (mangleTypeConstrName ctxFieldVarTypeCtx) ] [] - handleReservedNone - handleOverrideNone + mkHsNameDropInvalid + handleReservedNone -- not needed since contains underscore ctxFieldVarCName -- | Haskell-style name mangler @@ -764,57 +791,62 @@ haskellNameMangler = NameMangler{..} mangleModuleName :: ModuleNameContext -> HsName NsModuleName mangleModuleName ctx@ModuleNameContext{..} = handleModuleNameParent ctx $ translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid handleReservedNone - handleOverrideNone ctxModuleNameCName mangleTypeClassName :: TypeClassContext -> HsName NsTypeClass mangleTypeClassName TypeClassContext{..} = translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid handleReservedNone - handleOverrideNone ctxTypeClassCName mangleTypeConstrName :: TypeConstrContext -> HsName NsTypeConstr mangleTypeConstrName = \case TypeConstrContext{..} -> translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase ["C"] [] + mkHsNameDropInvalid (handleReservedNames appendSingleQuote reservedTypeNames) - handleOverrideNone ctxTypeConstrCName AnonNamedFieldTypeConstrContext{..} -> translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase [ getHsName $ mangleTypeConstrName ctxAnonNamedFieldTypeConstrAncestorCtx ] [] + mkHsNameDropInvalid handleReservedNone - handleOverrideNone ctxAnonNamedFieldTypeConstrFieldName mangleTypeVarName :: TypeVarContext -> HsName NsTypeVar mangleTypeVarName ctxt = translateName + handleOverrideNone (maintainCName dropInvalidChar) joinWithSnakeCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid (handleReservedNames appendSingleQuote reservedVarNames) - handleOverrideNone (ctxTypeVarCName ctxt) mangleConstrName :: ConstrContext -> HsName NsConstr @@ -825,25 +857,24 @@ haskellNameMangler = NameMangler{..} mangleVarName = \case VarContext{..} -> translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase -- not used (no prefixes/suffixes) [] [] + mkHsNameDropInvalid (handleReservedNames appendSingleQuote reservedVarNames) - handleOverrideNone ctxVarCName EnumVarContext{..} -> HsName $ "un" <> getHsName (mangleTypeConstrName ctxEnumVarTypeCtx) FieldVarContext{..} -> translateName + handleOverrideNone (camelCaseCName dropInvalidChar) joinWithCamelCase - [ if ctxFieldVarSingleConstr - then getHsName $ mangleTypeConstrName ctxFieldVarTypeCtx - else - getHsName $ mangleConstrName (ConstrContext ctxFieldVarTypeCtx) + [ getHsName (mangleTypeConstrName ctxFieldVarTypeCtx) ] [] + mkHsNameDropInvalid handleReservedNone - handleOverrideNone ctxFieldVarCName diff --git a/hs-bindgen/src/HsBindgen/Hs/Translation.hs b/hs-bindgen/src/HsBindgen/Hs/Translation.hs index 48beef26..df6cefff 100644 --- a/hs-bindgen/src/HsBindgen/Hs/Translation.hs +++ b/hs-bindgen/src/HsBindgen/Hs/Translation.hs @@ -98,7 +98,7 @@ structDecs struct fields = structConstr = mangleConstrName $ ConstrContext typeConstrCtx structFields = flip Vec.map fields $ \f -> Hs.Field { fieldName = mangleVarName $ - FieldVarContext typeConstrCtx True (C.fieldName f) + FieldVarContext typeConstrCtx (C.fieldName f) , fieldType = typ nm (C.fieldType f) } in Hs.Struct{..} diff --git a/hs-bindgen/test-th/HsBindgen/TestTH/Spliced.hs b/hs-bindgen/test-th/HsBindgen/TestTH/Spliced.hs index c5918dce..5bd71d8e 100644 --- a/hs-bindgen/test-th/HsBindgen/TestTH/Spliced.hs +++ b/hs-bindgen/test-th/HsBindgen/TestTH/Spliced.hs @@ -13,11 +13,11 @@ $(runIO (findPackageDirectory "hs-bindgen") >>= \dir -> templateHaskell (dir -- usage -val :: CMyStruct -val = MkCMyStruct - { cMyStruct_field1 = 0 - , cMyStruct_field2 = 1 +val :: MyStruct +val = MyStruct + { myStruct_field1 = 0 + , myStruct_field2 = 1 } -pokeVal :: Ptr CMyStruct -> IO () +pokeVal :: Ptr MyStruct -> IO () pokeVal ptr = poke ptr val diff --git a/hs-bindgen/test-th/TestTH.hs b/hs-bindgen/test-th/TestTH.hs index 51331574..72edfdc5 100644 --- a/hs-bindgen/test-th/TestTH.hs +++ b/hs-bindgen/test-th/TestTH.hs @@ -11,7 +11,7 @@ import Foreign main :: IO () main = defaultMain $ testGroup "test-th" [ testCase "constants" $ do - sizeOf (undefined :: CMyStruct) @?= 8 - alignment (undefined :: CMyStruct) @?= 4 + sizeOf (undefined :: MyStruct) @?= 8 + alignment (undefined :: MyStruct) @?= 4 ]