diff --git a/hs-bindgen/fixtures/anonymous.bindingspec.yaml b/hs-bindgen/fixtures/anonymous.bindingspec.yaml index 633e46e10..eafce2848 100644 --- a/hs-bindgen/fixtures/anonymous.bindingspec.yaml +++ b/hs-bindgen/fixtures/anonymous.bindingspec.yaml @@ -11,47 +11,47 @@ types: - Show - Storable - headers: anonymous.h - cname: S1_c + cname: struct S2 module: Example - identifier: S1_c + identifier: S2 instances: - Eq - Show - Storable - headers: anonymous.h - cname: struct S2 + cname: struct S3 module: Example - identifier: S2 + identifier: S3 instances: - Eq - Show - Storable - headers: anonymous.h - cname: S2_inner + cname: struct @S1_c module: Example - identifier: S2_inner + identifier: S1_c instances: - Eq - Show - Storable - headers: anonymous.h - cname: S2_inner_deep + cname: struct @S2_inner module: Example - identifier: S2_inner_deep + identifier: S2_inner instances: - Eq - Show - Storable - headers: anonymous.h - cname: struct S3 + cname: struct @S2_inner_deep module: Example - identifier: S3 + identifier: S2_inner_deep instances: - Eq - Show - Storable - headers: anonymous.h - cname: S3_c + cname: struct @S3_c module: Example identifier: S3_c instances: diff --git a/hs-bindgen/fixtures/attributes.bindingspec.yaml b/hs-bindgen/fixtures/attributes.bindingspec.yaml index 539bbbb0a..00d31b8ea 100644 --- a/hs-bindgen/fixtures/attributes.bindingspec.yaml +++ b/hs-bindgen/fixtures/attributes.bindingspec.yaml @@ -19,23 +19,23 @@ types: - Show - Storable - headers: attributes.h - cname: baz + cname: struct foo module: Example - identifier: Baz + identifier: Foo instances: - Eq - Show - Storable - headers: attributes.h - cname: struct foo + cname: struct @baz module: Example - identifier: Foo + identifier: Baz instances: - Eq - Show - Storable - headers: attributes.h - cname: qux + cname: struct @qux module: Example identifier: Qux instances: diff --git a/hs-bindgen/fixtures/distilled_lib_1.bindingspec.yaml b/hs-bindgen/fixtures/distilled_lib_1.bindingspec.yaml index f9d1ca282..44d7cea2c 100644 --- a/hs-bindgen/fixtures/distilled_lib_1.bindingspec.yaml +++ b/hs-bindgen/fixtures/distilled_lib_1.bindingspec.yaml @@ -21,65 +21,65 @@ types: - Real - Storable - headers: distilled_lib_1.h - cname: a_typedef_enum_e + cname: struct a_typedef_struct module: Example - identifier: A_typedef_enum_e + identifier: A_typedef_struct_t instances: - Eq - - Ord - - Read - Show - Storable - headers: distilled_lib_1.h - cname: struct a_typedef_struct + cname: callback_t module: Example - identifier: A_typedef_struct_t + identifier: Callback_t instances: - Eq + - Ord - Show - Storable - headers: distilled_lib_1.h - cname: another_typedef_enum_e + cname: var_t module: Example - identifier: Another_typedef_enum_e + identifier: Var_t instances: - Eq - Ord + - Enum + - Ix + - Bounded - Read - Show + - Bits + - FiniteBits + - Integral + - Num + - Real - Storable - headers: distilled_lib_1.h - cname: another_typedef_struct_t + cname: enum @a_typedef_enum_e module: Example - identifier: Another_typedef_struct_t + identifier: A_typedef_enum_e instances: - Eq + - Ord + - Read - Show - Storable - headers: distilled_lib_1.h - cname: callback_t + cname: enum @another_typedef_enum_e module: Example - identifier: Callback_t + identifier: Another_typedef_enum_e instances: - Eq - Ord + - Read - Show - Storable - headers: distilled_lib_1.h - cname: var_t + cname: struct @another_typedef_struct_t module: Example - identifier: Var_t + identifier: Another_typedef_struct_t instances: - Eq - - Ord - - Enum - - Ix - - Bounded - - Read - Show - - Bits - - FiniteBits - - Integral - - Num - - Real - Storable diff --git a/hs-bindgen/fixtures/doxygen_docs.bindingspec.yaml b/hs-bindgen/fixtures/doxygen_docs.bindingspec.yaml index e3658c3db..e073efc9f 100644 --- a/hs-bindgen/fixtures/doxygen_docs.bindingspec.yaml +++ b/hs-bindgen/fixtures/doxygen_docs.bindingspec.yaml @@ -2,14 +2,6 @@ version: hs_bindgen: 0.1.0 binding_specification: '1.0' types: -- headers: doxygen_docs.h - cname: bitfield_t - module: Example - identifier: Bitfield_t - instances: - - Eq - - Show - - Storable - headers: doxygen_docs.h cname: enum color_enum module: Example @@ -20,28 +12,6 @@ types: - Read - Show - Storable -- headers: doxygen_docs.h - cname: config_t - module: Example - identifier: Config_t - instances: - - Eq - - Show - - Storable -- headers: doxygen_docs.h - cname: data_union_t - module: Example - identifier: Data_union_t - instances: - - Storable -- headers: doxygen_docs.h - cname: data_union_t_as_parts - module: Example - identifier: Data_union_t_as_parts - instances: - - Eq - - Show - - Storable - headers: doxygen_docs.h cname: event_callback_t module: Example @@ -103,7 +73,37 @@ types: - Real - Storable - headers: doxygen_docs.h - cname: status_code_t + cname: struct @bitfield_t + module: Example + identifier: Bitfield_t + instances: + - Eq + - Show + - Storable +- headers: doxygen_docs.h + cname: struct @config_t + module: Example + identifier: Config_t + instances: + - Eq + - Show + - Storable +- headers: doxygen_docs.h + cname: union @data_union_t + module: Example + identifier: Data_union_t + instances: + - Storable +- headers: doxygen_docs.h + cname: struct @data_union_t_as_parts + module: Example + identifier: Data_union_t_as_parts + instances: + - Eq + - Show + - Storable +- headers: doxygen_docs.h + cname: enum @status_code_t module: Example identifier: Status_code_t instances: diff --git a/hs-bindgen/fixtures/enum_cpp_syntax.bindingspec.yaml b/hs-bindgen/fixtures/enum_cpp_syntax.bindingspec.yaml index e2c735214..8675e13fd 100644 --- a/hs-bindgen/fixtures/enum_cpp_syntax.bindingspec.yaml +++ b/hs-bindgen/fixtures/enum_cpp_syntax.bindingspec.yaml @@ -3,7 +3,7 @@ version: binding_specification: '1.0' types: - headers: enum_cpp_syntax.h - cname: foo_enum + cname: enum @foo_enum module: Example identifier: Foo_enum instances: diff --git a/hs-bindgen/fixtures/enums.bindingspec.yaml b/hs-bindgen/fixtures/enums.bindingspec.yaml index 380a68763..21881af6d 100644 --- a/hs-bindgen/fixtures/enums.bindingspec.yaml +++ b/hs-bindgen/fixtures/enums.bindingspec.yaml @@ -2,16 +2,6 @@ version: hs_bindgen: 0.1.0 binding_specification: '1.0' types: -- headers: enums.h - cname: enumA - module: Example - identifier: EnumA - instances: - - Eq - - Ord - - Read - - Show - - Storable - headers: enums.h cname: enum enumB module: Example @@ -92,3 +82,13 @@ types: - Read - Show - Storable +- headers: enums.h + cname: enum @enumA + module: Example + identifier: EnumA + instances: + - Eq + - Ord + - Read + - Show + - Storable diff --git a/hs-bindgen/fixtures/flam.bindingspec.yaml b/hs-bindgen/fixtures/flam.bindingspec.yaml index 456b122c6..f3c518ec0 100644 --- a/hs-bindgen/fixtures/flam.bindingspec.yaml +++ b/hs-bindgen/fixtures/flam.bindingspec.yaml @@ -19,25 +19,25 @@ types: - Show - Storable - headers: flam.h - cname: foo_bar + cname: struct pascal module: Example - identifier: Foo_bar + identifier: Pascal instances: - Eq - Show - Storable - headers: flam.h - cname: struct pascal + cname: struct triplets module: Example - identifier: Pascal + identifier: Triplets instances: - Eq - Show - Storable - headers: flam.h - cname: struct triplets + cname: struct @foo_bar module: Example - identifier: Triplets + identifier: Foo_bar instances: - Eq - Show diff --git a/hs-bindgen/fixtures/fun_attributes.bindingspec.yaml b/hs-bindgen/fixtures/fun_attributes.bindingspec.yaml index ddc21b2f4..0644f5ca7 100644 --- a/hs-bindgen/fixtures/fun_attributes.bindingspec.yaml +++ b/hs-bindgen/fixtures/fun_attributes.bindingspec.yaml @@ -2,14 +2,6 @@ version: hs_bindgen: 0.1.0 binding_specification: '1.0' types: -- headers: fun_attributes.h - cname: FILE - module: Example - identifier: FILE - instances: - - Eq - - Show - - Storable - headers: fun_attributes.h cname: size_t module: Example @@ -28,3 +20,11 @@ types: - Num - Real - Storable +- headers: fun_attributes.h + cname: struct @FILE + module: Example + identifier: FILE + instances: + - Eq + - Show + - Storable diff --git a/hs-bindgen/fixtures/globals.bindingspec.yaml b/hs-bindgen/fixtures/globals.bindingspec.yaml index e58936e7f..e4f636a65 100644 --- a/hs-bindgen/fixtures/globals.bindingspec.yaml +++ b/hs-bindgen/fixtures/globals.bindingspec.yaml @@ -44,31 +44,31 @@ types: - Show - Storable - headers: globals.h - cname: struct1_t + cname: struct tuple module: Example - identifier: Struct1_t + identifier: Tuple instances: - Eq - Show - Storable - headers: globals.h - cname: struct2_t + cname: struct @struct1_t module: Example - identifier: Struct2_t + identifier: Struct1_t instances: - Eq - Show - Storable - headers: globals.h - cname: struct tuple + cname: struct @struct2_t module: Example - identifier: Tuple + identifier: Struct2_t instances: - Eq - Show - Storable - headers: globals.h - cname: version_t + cname: struct @version_t module: Example identifier: Version_t instances: diff --git a/hs-bindgen/fixtures/hsb_complex_test.bindingspec.yaml b/hs-bindgen/fixtures/hsb_complex_test.bindingspec.yaml index 97aea8319..3b2899a44 100644 --- a/hs-bindgen/fixtures/hsb_complex_test.bindingspec.yaml +++ b/hs-bindgen/fixtures/hsb_complex_test.bindingspec.yaml @@ -3,7 +3,7 @@ version: binding_specification: '1.0' types: - headers: hsb_complex_test.h - cname: complex_object_t + cname: struct @complex_object_t module: Example identifier: Complex_object_t instances: diff --git a/hs-bindgen/fixtures/macro_in_fundecl_vs_typedef.bindingspec.yaml b/hs-bindgen/fixtures/macro_in_fundecl_vs_typedef.bindingspec.yaml index e4bf76164..48ba6d8eb 100644 --- a/hs-bindgen/fixtures/macro_in_fundecl_vs_typedef.bindingspec.yaml +++ b/hs-bindgen/fixtures/macro_in_fundecl_vs_typedef.bindingspec.yaml @@ -46,14 +46,6 @@ types: - Eq - Show - Storable -- headers: macro_in_fundecl_vs_typedef.h - cname: struct2 - module: Example - identifier: Struct2 - instances: - - Eq - - Show - - Storable - headers: macro_in_fundecl_vs_typedef.h cname: struct struct3 module: Example @@ -78,3 +70,11 @@ types: - Eq - Show - Storable +- headers: macro_in_fundecl_vs_typedef.h + cname: struct @struct2 + module: Example + identifier: Struct2 + instances: + - Eq + - Show + - Storable diff --git a/hs-bindgen/fixtures/macro_typedef_struct.bindingspec.yaml b/hs-bindgen/fixtures/macro_typedef_struct.bindingspec.yaml index 0d11b047d..3bb62a06b 100644 --- a/hs-bindgen/fixtures/macro_typedef_struct.bindingspec.yaml +++ b/hs-bindgen/fixtures/macro_typedef_struct.bindingspec.yaml @@ -21,7 +21,7 @@ types: - Real - Storable - headers: macro_typedef_struct.h - cname: bar + cname: struct @bar module: Example identifier: Bar instances: diff --git a/hs-bindgen/fixtures/named_vs_anon.bindingspec.yaml b/hs-bindgen/fixtures/named_vs_anon.bindingspec.yaml index 50c1df467..2d59d7e06 100644 --- a/hs-bindgen/fixtures/named_vs_anon.bindingspec.yaml +++ b/hs-bindgen/fixtures/named_vs_anon.bindingspec.yaml @@ -43,71 +43,71 @@ types: - Show - Storable - headers: named_vs_anon.h - cname: f + cname: struct struct1 module: Example - identifier: F + identifier: Struct1 instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: g + cname: struct struct2_s module: Example - identifier: G + identifier: Struct2_s instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: h + cname: struct struct3 module: Example - identifier: H + identifier: Struct3 instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: struct struct1 + cname: struct struct4 module: Example - identifier: Struct1 + identifier: Struct4 instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: struct struct2_s + cname: struct struct5_s module: Example - identifier: Struct2_s + identifier: Struct5_s instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: struct struct3 + cname: struct @f module: Example - identifier: Struct3 + identifier: F instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: struct struct4 + cname: struct @g module: Example - identifier: Struct4 + identifier: G instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: struct struct5_s + cname: struct @h module: Example - identifier: Struct5_s + identifier: H instances: - Eq - Show - Storable - headers: named_vs_anon.h - cname: typedef1 + cname: struct @typedef1 module: Example identifier: Typedef1 instances: @@ -115,7 +115,7 @@ types: - Show - Storable - headers: named_vs_anon.h - cname: typedef2 + cname: struct @typedef2 module: Example identifier: Typedef2 instances: @@ -123,7 +123,7 @@ types: - Show - Storable - headers: named_vs_anon.h - cname: typedef3 + cname: struct @typedef3 module: Example identifier: Typedef3 instances: diff --git a/hs-bindgen/fixtures/nested_enums.bindingspec.yaml b/hs-bindgen/fixtures/nested_enums.bindingspec.yaml index 4955c2112..ee53e856a 100644 --- a/hs-bindgen/fixtures/nested_enums.bindingspec.yaml +++ b/hs-bindgen/fixtures/nested_enums.bindingspec.yaml @@ -29,7 +29,7 @@ types: - Show - Storable - headers: nested_enums.h - cname: exB_fieldB1 + cname: enum @exB_fieldB1 module: Example identifier: ExB_fieldB1 instances: diff --git a/hs-bindgen/fixtures/nested_types.bindingspec.yaml b/hs-bindgen/fixtures/nested_types.bindingspec.yaml index 02cf8daaf..6ddd2eaf2 100644 --- a/hs-bindgen/fixtures/nested_types.bindingspec.yaml +++ b/hs-bindgen/fixtures/nested_types.bindingspec.yaml @@ -18,14 +18,6 @@ types: - Eq - Show - Storable -- headers: nested_types.h - cname: ex3_ex3_struct - module: Example - identifier: Ex3_ex3_struct - instances: - - Eq - - Show - - Storable - headers: nested_types.h cname: struct ex4_even module: Example @@ -50,3 +42,11 @@ types: - Eq - Show - Storable +- headers: nested_types.h + cname: struct @ex3_ex3_struct + module: Example + identifier: Ex3_ex3_struct + instances: + - Eq + - Show + - Storable diff --git a/hs-bindgen/fixtures/nested_unions.bindingspec.yaml b/hs-bindgen/fixtures/nested_unions.bindingspec.yaml index 06c1d3967..15ba9d93d 100644 --- a/hs-bindgen/fixtures/nested_unions.bindingspec.yaml +++ b/hs-bindgen/fixtures/nested_unions.bindingspec.yaml @@ -15,14 +15,14 @@ types: instances: - Storable - headers: nested_unions.h - cname: exB_fieldB1 + cname: union unionA module: Example - identifier: ExB_fieldB1 + identifier: UnionA instances: - Storable - headers: nested_unions.h - cname: union unionA + cname: union @exB_fieldB1 module: Example - identifier: UnionA + identifier: ExB_fieldB1 instances: - Storable diff --git a/hs-bindgen/fixtures/simple_structs.bindingspec.yaml b/hs-bindgen/fixtures/simple_structs.bindingspec.yaml index 5ba141e4a..79b89c9b9 100644 --- a/hs-bindgen/fixtures/simple_structs.bindingspec.yaml +++ b/hs-bindgen/fixtures/simple_structs.bindingspec.yaml @@ -18,14 +18,6 @@ types: - Eq - Show - Storable -- headers: simple_structs.h - cname: S3_t - module: Example - identifier: S3_t - instances: - - Eq - - Show - - Storable - headers: simple_structs.h cname: struct S4 module: Example @@ -60,24 +52,32 @@ types: - Show - Storable - headers: simple_structs.h - cname: S7a_Deref + cname: S7b module: Example - identifier: S7a_Deref + identifier: S7b + instances: + - Eq + - Ord + - Show + - Storable +- headers: simple_structs.h + cname: struct @S3_t + module: Example + identifier: S3_t instances: - Eq - Show - Storable - headers: simple_structs.h - cname: S7b + cname: struct @S7a_Deref module: Example - identifier: S7b + identifier: S7a_Deref instances: - Eq - - Ord - Show - Storable - headers: simple_structs.h - cname: S7b_Deref + cname: struct @S7b_Deref module: Example identifier: S7b_Deref instances: diff --git a/hs-bindgen/fixtures/spec_examples.bindingspec.yaml b/hs-bindgen/fixtures/spec_examples.bindingspec.yaml index 30a2cf620..5d6579a56 100644 --- a/hs-bindgen/fixtures/spec_examples.bindingspec.yaml +++ b/hs-bindgen/fixtures/spec_examples.bindingspec.yaml @@ -22,14 +22,6 @@ types: cname: struct C module: Example identifier: C -- headers: spec_examples.h - cname: cint16_T - module: Example - identifier: Cint16_T - instances: - - Eq - - Show - - Storable - headers: spec_examples.h cname: int16_T module: Example @@ -84,3 +76,11 @@ types: - Num - Real - Storable +- headers: spec_examples.h + cname: struct @cint16_T + module: Example + identifier: Cint16_T + instances: + - Eq + - Show + - Storable diff --git a/hs-bindgen/fixtures/type_attributes.bindingspec.yaml b/hs-bindgen/fixtures/type_attributes.bindingspec.yaml index 3d45929df..d5b4edc73 100644 --- a/hs-bindgen/fixtures/type_attributes.bindingspec.yaml +++ b/hs-bindgen/fixtures/type_attributes.bindingspec.yaml @@ -93,7 +93,7 @@ types: module: Example identifier: Wait - headers: type_attributes.h - cname: wait_status_ptr_t + cname: union @wait_status_ptr_t module: Example identifier: Wait_status_ptr_t instances: diff --git a/hs-bindgen/fixtures/unions.bindingspec.yaml b/hs-bindgen/fixtures/unions.bindingspec.yaml index 3de007ef8..82d412a01 100644 --- a/hs-bindgen/fixtures/unions.bindingspec.yaml +++ b/hs-bindgen/fixtures/unions.bindingspec.yaml @@ -8,22 +8,6 @@ types: identifier: AnonA instances: - Storable -- headers: unions.h - cname: AnonA_polar - module: Example - identifier: AnonA_polar - instances: - - Eq - - Show - - Storable -- headers: unions.h - cname: AnonA_xy - module: Example - identifier: AnonA_xy - instances: - - Eq - - Show - - Storable - headers: unions.h cname: struct Dim module: Example @@ -64,3 +48,19 @@ types: identifier: DimPayloadB instances: - Storable +- headers: unions.h + cname: struct @AnonA_polar + module: Example + identifier: AnonA_polar + instances: + - Eq + - Show + - Storable +- headers: unions.h + cname: struct @AnonA_xy + module: Example + identifier: AnonA_xy + instances: + - Eq + - Show + - Storable diff --git a/hs-bindgen/fixtures/vector.bindingspec.yaml b/hs-bindgen/fixtures/vector.bindingspec.yaml index d4cb744ca..c20226eaa 100644 --- a/hs-bindgen/fixtures/vector.bindingspec.yaml +++ b/hs-bindgen/fixtures/vector.bindingspec.yaml @@ -3,7 +3,7 @@ version: binding_specification: '1.0' types: - headers: vector.h - cname: vector + cname: struct @vector module: Example identifier: Vector instances: diff --git a/hs-bindgen/src-internal/HsBindgen/BindingSpec/Gen.hs b/hs-bindgen/src-internal/HsBindgen/BindingSpec/Gen.hs index 1612407e1..955c5d717 100644 --- a/hs-bindgen/src-internal/HsBindgen/BindingSpec/Gen.hs +++ b/hs-bindgen/src-internal/HsBindgen/BindingSpec/Gen.hs @@ -13,7 +13,6 @@ module HsBindgen.BindingSpec.Gen ( import Data.ByteString (ByteString) import Data.Map.Strict qualified as Map -import Data.Maybe (listToMaybe) import Data.Set qualified as Set import HsBindgen.Backend.Hs.AST qualified as Hs @@ -164,12 +163,14 @@ getNewtypeSpec hsModuleName hsNewtype = getCQualName :: C.DeclInfo -> C.NameKind -> C.QualName getCQualName declInfo cNameKind = case C.declOrigin declInfo of - C.NameOriginInSource -> C.QualName cName cNameKind - C.NameOriginGenerated{} -> - let cName' = fromMaybe cName (listToMaybe (C.declAliases declInfo)) - in C.QualName cName' C.NameKindOrdinary + C.NameOriginInSource -> C.QualName cName cNameKind + C.NameOriginGenerated{} -> C.QualNameAnon cName $ + case cNameKind of + C.NameKindTagged tagKind -> tagKind + -- TODO Refactor C AST IDs (#1146) + C.NameKindOrdinary -> panicPure "getCQualName namespace mismatch" C.NameOriginRenamedFrom fromCName -> C.QualName fromCName cNameKind - C.NameOriginBuiltin -> C.QualName cName C.NameKindOrdinary + C.NameOriginBuiltin -> C.QualName cName C.NameKindOrdinary where cName :: C.Name cName = C.nameC (C.declId declInfo) diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/AST/Internal.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/AST/Internal.hs index 623e8bb33..1d19fff66 100644 --- a/hs-bindgen/src-internal/HsBindgen/Frontend/AST/Internal.hs +++ b/hs-bindgen/src-internal/HsBindgen/Frontend/AST/Internal.hs @@ -517,8 +517,7 @@ declQualDeclId Decl{declInfo = DeclInfo{declId}, declKind} = C.QualDeclId { } declQualName :: Id p ~ C.DeclId => Decl p -> C.QualName -declQualName Decl{declInfo = DeclInfo{declId}, declKind} = - C.QualName (C.declIdName declId) (declKindNameKind declKind) +declQualName = C.qualDeclIdQualName . declQualDeclId declKindNameKind :: DeclKind p -> C.NameKind declKindNameKind = \case diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Naming.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Naming.hs index 3c8a69030..2ea91b606 100644 --- a/hs-bindgen/src-internal/HsBindgen/Frontend/Naming.hs +++ b/hs-bindgen/src-internal/HsBindgen/Frontend/Naming.hs @@ -73,6 +73,7 @@ module HsBindgen.Frontend.Naming ( -- ** QualDeclId , QualDeclId(..) , qualDeclId + , qualDeclIdQualName , qualDeclIdText , qualDeclIdNsPrelimDeclId @@ -153,7 +154,7 @@ data TagKind = -- | @enum@ tag kind | TagKindEnum - deriving stock (Show, Eq, Ord, Generic) + deriving stock (Show, Eq, Ord, Bounded, Enum, Generic) instance PrettyForTrace TagKind where prettyForTrace = PP.showToCtxDoc @@ -220,30 +221,54 @@ nameKindPrefix = \case QualName -------------------------------------------------------------------------------} --- | C name, qualified by the 'NameKind' --- --- This is the parsed representation of a @libclang@ C spelling. -data QualName = QualName { - qualNameName :: Name - , qualNameKind :: NameKind - } +-- | C name, qualified to distinguish kinds and anonymous names +data QualName = + -- | Valid C name + -- + -- This is the parsed representation of a @libclang@ C spelling. + QualName { + qualNameName :: Name + , qualNameKind :: NameKind + } + + -- | Generated name for an anonymous C type + -- + -- Syntax: @struct \@foo@ references an anonymous C @struct@ type with + -- generated name @foo@. + | QualNameAnon { + qualNameAnonGeneratedName :: Name + , qualNameAnonTagKind :: TagKind + } deriving stock (Eq, Generic, Ord, Show) instance PrettyForTrace QualName where prettyForTrace = PP.textToCtxDoc . qualNameText qualNameText :: QualName -> Text -qualNameText QualName{..} = case nameKindPrefix qualNameKind of - Nothing -> getName qualNameName - Just prefix -> prefix <> " " <> getName qualNameName +qualNameText = \case + QualName{..} -> case nameKindPrefix qualNameKind of + Nothing -> getName qualNameName + Just prefix -> Text.unwords [prefix, getName qualNameName] + QualNameAnon{..} -> Text.concat [ + tagKindPrefix qualNameAnonTagKind + , " @" + , getName qualNameAnonGeneratedName + ] parseQualName :: Text -> Maybe QualName parseQualName t = case Text.words t of - [n] -> Just $ QualName (Name n) NameKindOrdinary - ["struct", n] -> Just $ QualName (Name n) (NameKindTagged TagKindStruct) - ["union", n] -> Just $ QualName (Name n) (NameKindTagged TagKindUnion) - ["enum", n] -> Just $ QualName (Name n) (NameKindTagged TagKindEnum) + [n] -> case Text.stripPrefix "@" n of + Nothing -> Just $ QualName (Name n) NameKindOrdinary + Just{} -> Nothing + ["struct", n] -> Just $ aux n TagKindStruct + ["union", n] -> Just $ aux n TagKindUnion + ["enum", n] -> Just $ aux n TagKindEnum _otherwise -> Nothing + where + aux :: Text -> TagKind -> QualName + aux n tag = case Text.stripPrefix "@" n of + Nothing -> QualName (Name n) (NameKindTagged tag) + Just n' -> QualNameAnon (Name n') tag {------------------------------------------------------------------------------- AnonId @@ -473,10 +498,17 @@ qualDeclId DeclId{..} nameKind = QualDeclId { , qualDeclIdKind = nameKind } +qualDeclIdQualName :: QualDeclId -> QualName +qualDeclIdQualName QualDeclId{..} = case qualDeclIdOrigin of + NameOriginGenerated{} -> QualNameAnon qualDeclIdName $ + case qualDeclIdKind of + NameKindTagged tagKind -> tagKind + -- TODO Refactor C AST IDs (#1146) + NameKindOrdinary -> panicPure "qualDeclIdQualName namespace mismatch" + _otherwise -> QualName qualDeclIdName qualDeclIdKind + qualDeclIdText :: QualDeclId -> Text -qualDeclIdText QualDeclId{..} = case qualDeclIdOrigin of - NameOriginGenerated{} -> "anon:" <> getName qualDeclIdName - _otherwise -> qualNameText $ QualName qualDeclIdName qualDeclIdKind +qualDeclIdText = qualNameText . qualDeclIdQualName qualDeclIdNsPrelimDeclId :: QualDeclId -> NsPrelimDeclId qualDeclIdNsPrelimDeclId QualDeclId{..} = case qualDeclIdOrigin of diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/MangleNames.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/MangleNames.hs index 55462bea4..a6e5b9a65 100644 --- a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/MangleNames.hs +++ b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/MangleNames.hs @@ -142,10 +142,13 @@ class MangleDecl a where -> a HandleTypedefs -> M (a MangleNames) mangleQualName :: C.QualName -> C.NameOrigin -> M (NamePair, C.NameOrigin) -mangleQualName cQualName@(C.QualName cName _namespace) nameOrigin = do +mangleQualName cQualName cNameOrigin = do + let cName = case cQualName of + C.QualName{..} -> qualNameName + C.QualNameAnon{..} -> qualNameAnonGeneratedName nm <- asks envNameMap case Map.lookup cQualName nm of - Just hsName -> return (NamePair cName hsName, nameOrigin) + Just hsName -> return (NamePair cName hsName, cNameOrigin) Nothing -> do -- NB: We did not register any declaration with the given ID. This is -- most likely because the user did not select the declaration. If the @@ -153,7 +156,14 @@ mangleQualName cQualName@(C.QualName cName _namespace) nameOrigin = do -- already. modify (MangleNamesMissingDeclaration cQualName :) -- Use a fake Haskell ID. - return (NamePair cName (Hs.Identifier "MissingDeclaration"), nameOrigin) + return + (NamePair cName (Hs.Identifier "MissingDeclaration"), cNameOrigin) + +mangleQualName' :: C.DeclId -> C.NameKind -> M (NamePair, C.NameOrigin) +mangleQualName' cDeclId cNameKind = + mangleQualName + (C.qualDeclIdQualName (C.qualDeclId cDeclId cNameKind)) + (C.declIdOrigin cDeclId) {------------------------------------------------------------------------------- Additional name mangling functionality @@ -294,10 +304,13 @@ instance MangleDecl C.DeclKind where instance Mangle C.CommentRef where mangle (C.ById C.DeclId{..}) = do nm <- asks envNameMap - let lookupResults = - catMaybes [ Map.lookup (C.QualName declIdName nameKind) nm - | nameKind <- [minBound .. maxBound] - ] + let lookupResults = catMaybes $ + [ Map.lookup (C.QualName declIdName nameKind) nm + | nameKind <- [minBound .. maxBound] + ] ++ + [ Map.lookup (C.QualNameAnon declIdName tagKind) nm + | tagKind <- [minBound .. maxBound] + ] case lookupResults of (hsName:_) -> return $ C.ById (NamePair declIdName hsName, declIdOrigin) [] -> do @@ -451,20 +464,14 @@ instance MangleDecl C.CheckedMacroType where instance Mangle C.Type where mangle = \case - C.TypeStruct C.DeclId{..} -> C.TypeStruct <$> - mangleQualName - (C.QualName declIdName (C.NameKindTagged C.TagKindStruct)) - declIdOrigin - C.TypeUnion C.DeclId{..} -> C.TypeUnion <$> - mangleQualName - (C.QualName declIdName (C.NameKindTagged C.TagKindUnion)) - declIdOrigin - C.TypeEnum C.DeclId{..} -> C.TypeEnum <$> - mangleQualName - (C.QualName declIdName (C.NameKindTagged C.TagKindEnum)) - declIdOrigin - C.TypeMacroTypedef C.DeclId{..} -> C.TypeMacroTypedef <$> - mangleQualName (C.QualName declIdName C.NameKindOrdinary) declIdOrigin + C.TypeStruct cDeclId -> C.TypeStruct <$> + mangleQualName' cDeclId (C.NameKindTagged C.TagKindStruct) + C.TypeUnion cDeclId -> C.TypeUnion <$> + mangleQualName' cDeclId (C.NameKindTagged C.TagKindUnion) + C.TypeEnum cDeclId -> C.TypeEnum <$> + mangleQualName' cDeclId (C.NameKindTagged C.TagKindEnum) + C.TypeMacroTypedef cDeclId -> C.TypeMacroTypedef <$> + mangleQualName' cDeclId C.NameKindOrdinary -- Recursive cases C.TypeTypedef ref -> C.TypeTypedef <$> mangle ref @@ -482,10 +489,11 @@ instance Mangle C.Type where C.TypeComplex prim -> return $ C.TypeComplex prim instance Mangle RenamedTypedefRef where - mangle (TypedefRegular C.DeclId{..}) = TypedefRegular <$> - mangleQualName (C.QualName declIdName C.NameKindOrdinary) declIdOrigin - mangle (TypedefSquashed cName ty) = - TypedefSquashed cName <$> mangle ty + mangle = \case + TypedefRegular cDeclId -> + TypedefRegular <$> mangleQualName' cDeclId C.NameKindOrdinary + TypedefSquashed cName ty -> + TypedefSquashed cName <$> mangle ty {------------------------------------------------------------------------------- Internal auxiliary diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Parse/Decl/Monad.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Parse/Decl/Monad.hs index 2e8f64da1..a69526634 100644 --- a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Parse/Decl/Monad.hs +++ b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/Parse/Decl/Monad.hs @@ -192,7 +192,7 @@ recordNonParsedDecl declInfo nameKind = } Nothing -> -- We __do not track unselected anonymous declarations__. If we want to - -- use descriptive binding specification with anonymous declarations, we + -- use an external binding specification with anonymous declarations, we -- __must__ select these declarations. return () where diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpec.hs b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpec.hs index 7ee0fecdb..d4413257e 100644 --- a/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpec.hs +++ b/hs-bindgen/src-internal/HsBindgen/Frontend/Pass/ResolveBindingSpec.hs @@ -407,8 +407,8 @@ instance Resolve C.Type where -> M (Set C.NsPrelimDeclId, C.Type ResolveBindingSpec) aux mk cQualDeclId@C.QualDeclId{..} = RWS.ask >>= \MEnv{..} -> RWS.get >>= \MState{..} -> do - let cQualName = C.QualName qualDeclIdName qualDeclIdKind - nsid = C.qualDeclIdNsPrelimDeclId cQualDeclId + let cQualName = C.qualDeclIdQualName cQualDeclId + nsid = C.qualDeclIdNsPrelimDeclId cQualDeclId -- check for type omitted by binding specification when (Set.member cQualName stateOmitTypes) $ RWS.modify' $ diff --git a/manual/external/vector.yaml b/manual/external/vector.yaml index 97bae3325..ce3233521 100644 --- a/manual/external/vector.yaml +++ b/manual/external/vector.yaml @@ -1,7 +1,7 @@ version: '1.0' types: - headers: vector.h - cname: vector + cname: '@vector' module: Vector identifier: Vector instances: