Skip to content

Commit

Permalink
Add HsTypRef for handling TypElaborated
Browse files Browse the repository at this point in the history
  • Loading branch information
@phadej @edsko
phadej authored and edsko committed Oct 30, 2024
1 parent d194cba commit 54f3a84
Show file tree
Hide file tree
Showing 9 changed files with 22 additions and 15 deletions.
2 changes: 1 addition & 1 deletion hs-bindgen/fixtures/fixedwidth.hs
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
List {getList = [DeclData (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsType "\"uint64_t\"") ::: ("cFoo_thirty_two",HsType "\"uint32_t\"") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsType "\"uint64_t\"") ::: ("cFoo_thirty_two",HsType "\"uint32_t\"") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsType "\"uint64_t\"") ::: ("cFoo_thirty_two",HsType "\"uint32_t\"") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 64]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsType "\"uint64_t\"") ::: ("cFoo_thirty_two",HsType "\"uint32_t\"") ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 64 x2]}))))})))]}
List {getList = [DeclData (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsTypRef "CUint64T") ::: ("cFoo_thirty_two",HsTypRef "CUint32T") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsTypRef "CUint64T") ::: ("cFoo_thirty_two",HsTypRef "CUint32T") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 8, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsTypRef "CUint64T") ::: ("cFoo_thirty_two",HsTypRef "CUint32T") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 64]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_sixty_four",HsTypRef "CUint64T") ::: ("cFoo_thirty_two",HsTypRef "CUint32T") ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 64 x2]}))))})))]}
2 changes: 1 addition & 1 deletion hs-bindgen/fixtures/fixedwidth.th.txt
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
data CFoo
= MkCFoo {cFoo_sixty_four :: Void, cFoo_thirty_two :: Void}
= MkCFoo {cFoo_sixty_four :: CUint64T, cFoo_thirty_two :: CUint32T}
instance Storable CFoo
where {sizeOf = \_ -> 16;
alignment = \_ -> 8;
Expand Down
2 changes: 1 addition & 1 deletion hs-bindgen/fixtures/nested_types.hs
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
List {getList = [DeclData (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 32]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 32 x2]}))))}))), DeclData (WithStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsType "\"struct foo\"") ::: ("cBar_foo2",HsType "\"struct foo\"") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsType "\"struct foo\"") ::: ("cBar_foo2",HsType "\"struct foo\"") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsType "\"struct foo\"") ::: ("cBar_foo2",HsType "\"struct foo\"") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 64]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsType "\"struct foo\"") ::: ("cBar_foo2",HsType "\"struct foo\"") ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 64 x2]}))))})))]}
List {getList = [DeclData (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 32]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CFoo", structConstr = "MkCFoo", structFields = ("cFoo_i",HsPrimType HsPrimCInt) ::: ("cFoo_c",HsPrimType HsPrimCChar) ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 32 x2]}))))}))), DeclData (WithStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsTypRef "CStruct'0020foo") ::: ("cBar_foo2",HsTypRef "CStruct'0020foo") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsTypRef "CStruct'0020foo") ::: ("cBar_foo2",HsTypRef "CStruct'0020foo") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsTypRef "CStruct'0020foo") ::: ("cBar_foo2",HsTypRef "CStruct'0020foo") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 64]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CBar", structConstr = "MkCBar", structFields = ("cBar_foo1",HsTypRef "CStruct'0020foo") ::: ("cBar_foo2",HsTypRef "CStruct'0020foo") ::: VNil}) (\(x1 ::: x2 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 64 x2]}))))})))]}
4 changes: 3 additions & 1 deletion hs-bindgen/fixtures/nested_types.th.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,9 @@ instance Storable CFoo
poke = \x_1 -> \x_2 -> case x_2 of
{MkCFoo cFoo_i_3
cFoo_c_4 -> pokeByteOff x_1 0 cFoo_i_3 >> pokeByteOff x_1 32 cFoo_c_4}}
data CBar = MkCBar {cBar_foo1 :: Void, cBar_foo2 :: Void}
data CBar
= MkCBar {cBar_foo1 :: CStruct'0020foo,
cBar_foo2 :: CStruct'0020foo}
instance Storable CBar
where {sizeOf = \_ -> 16;
alignment = \_ -> 4;
Expand Down
2 changes: 1 addition & 1 deletion hs-bindgen/fixtures/typedef_vs_macro.hs
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
List {getList = [DeclData (WithStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsType "\"T1\"") ::: ("cExampleStruct_t2",HsType "\"T2\"") ::: ("cExampleStruct_m1",HsType "\"M1\"") ::: ("cExampleStruct_m2",HsType "\"M2\"") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsType "\"T1\"") ::: ("cExampleStruct_t2",HsType "\"T2\"") ::: ("cExampleStruct_m1",HsType "\"M1\"") ::: ("cExampleStruct_m2",HsType "\"M2\"") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsType "\"T1\"") ::: ("cExampleStruct_t2",HsType "\"T2\"") ::: ("cExampleStruct_m1",HsType "\"M1\"") ::: ("cExampleStruct_m2",HsType "\"M2\"") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 32, PeekByteOff x0 64, PeekByteOff x0 96]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsType "\"T1\"") ::: ("cExampleStruct_t2",HsType "\"T2\"") ::: ("cExampleStruct_m1",HsType "\"M1\"") ::: ("cExampleStruct_m2",HsType "\"M2\"") ::: VNil}) (\(x1 ::: x2 ::: x3 ::: x4 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 32 x2, PokeByteOff x0 64 x3, PokeByteOff x0 96 x4]}))))})))]}
List {getList = [DeclData (WithStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsTypRef "CT1") ::: ("cExampleStruct_t2",HsTypRef "CT2") ::: ("cExampleStruct_m1",HsTypRef "CM1") ::: ("cExampleStruct_m2",HsTypRef "CM2") ::: VNil}) (MkDataDecl)), DeclInstance (InstanceStorable (WithStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsTypRef "CT1") ::: ("cExampleStruct_t2",HsTypRef "CT2") ::: ("cExampleStruct_m1",HsTypRef "CM1") ::: ("cExampleStruct_m2",HsTypRef "CM2") ::: VNil}) (StorableInstance {storableSizeOf = 16, storableAlignment = 4, storablePeek = Lambda (\x0 -> Ap (IntroStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsTypRef "CT1") ::: ("cExampleStruct_t2",HsTypRef "CT2") ::: ("cExampleStruct_m1",HsTypRef "CM1") ::: ("cExampleStruct_m2",HsTypRef "CM2") ::: VNil})) [PeekByteOff x0 0, PeekByteOff x0 32, PeekByteOff x0 64, PeekByteOff x0 96]), storablePoke = Lambda (\x0 -> ElimStruct (Struct {structName = "CExampleStruct", structConstr = "MkCExampleStruct", structFields = ("cExampleStruct_t1",HsTypRef "CT1") ::: ("cExampleStruct_t2",HsTypRef "CT2") ::: ("cExampleStruct_m1",HsTypRef "CM1") ::: ("cExampleStruct_m2",HsTypRef "CM2") ::: VNil}) (\(x1 ::: x2 ::: x3 ::: x4 ::: VNil) -> (Seq (List {getList = [PokeByteOff x0 0 x1, PokeByteOff x0 32 x2, PokeByteOff x0 64 x3, PokeByteOff x0 96 x4]}))))})))]}
8 changes: 4 additions & 4 deletions hs-bindgen/fixtures/typedef_vs_macro.th.txt
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
data CExampleStruct
= MkCExampleStruct {cExampleStruct_t1 :: Void,
cExampleStruct_t2 :: Void,
cExampleStruct_m1 :: Void,
cExampleStruct_m2 :: Void}
= MkCExampleStruct {cExampleStruct_t1 :: CT1,
cExampleStruct_t2 :: CT2,
cExampleStruct_m1 :: CM1,
cExampleStruct_m2 :: CM2}
instance Storable CExampleStruct
where {sizeOf = \_ -> 16;
alignment = \_ -> 4;
Expand Down
1 change: 1 addition & 0 deletions hs-bindgen/src/HsBindgen/Backend/Common/Translation.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,7 @@ instance Backend be => ToBE be (Hs.WithStruct Hs.DataDecl) where

typeToBE :: Hs.HsType -> SType be
typeToBE (Hs.HsPrimType t) = TGlobal (PrimType t)
typeToBE (Hs.HsTypRef r) = TCon r
typeToBE (Hs.HsPtr t) = TApp (TGlobal Foreign_Ptr) (typeToBE t)
typeToBE _ = TGlobal (PrimType HsPrimVoid)

Expand Down
3 changes: 3 additions & 0 deletions hs-bindgen/src/HsBindgen/Hs/AST/Type.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@ module HsBindgen.Hs.AST.Type (
HsType (..),
) where

import HsBindgen.Hs.AST.Name

{-------------------------------------------------------------------------------
Types
-------------------------------------------------------------------------------}
Expand Down Expand Up @@ -43,5 +45,6 @@ data HsPrimType
data HsType =
HsType String
| HsPrimType HsPrimType
| HsTypRef (HsName NsTypeConstr)
| HsPtr HsType
deriving stock (Show)
13 changes: 7 additions & 6 deletions hs-bindgen/src/HsBindgen/Translation/LowLevel.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,7 @@ structDecs struct fields = List
mkField f =
( toHsName opts (FieldContext structName structConstr True) $
C.fieldName f
, typ (C.fieldType f)
, typ opts (C.fieldType f)
)
structFields = Vec.map mkField fields
in Hs.Struct{..}
Expand Down Expand Up @@ -154,10 +154,11 @@ enumDecs e = List [
Types
-------------------------------------------------------------------------------}

typ :: C.Typ -> Hs.HsType
typ (C.TypElaborated c) = Hs.HsType (show c) -- wrong
typ (C.TypStruct s) = Hs.HsType (show (C.structTag s)) -- also wrong
typ (C.TypPrim p) = case p of
typ :: NameManglingOptions -> C.Typ -> Hs.HsType
typ opts (C.TypElaborated c) =
Hs.HsTypRef (toHsName opts EmptyNsTypeConstrContext c) -- wrong
typ _ (C.TypStruct s) =Hs.HsType (show (C.structTag s)) -- also wrong
typ _ (C.TypPrim p) = case p of
C.PrimVoid -> Hs.HsPrimType HsPrimVoid
C.PrimChar Nothing -> Hs.HsPrimType HsPrimCChar
C.PrimChar (Just C.Signed) -> Hs.HsPrimType HsPrimCSChar
Expand All @@ -173,4 +174,4 @@ typ (C.TypPrim p) = case p of
C.PrimFloat -> Hs.HsPrimType HsPrimCFloat
C.PrimDouble -> Hs.HsPrimType HsPrimCDouble
C.PrimLongDouble -> Hs.HsPrimType HsPrimCDouble -- not sure this is correct.
typ (C.TypPointer t) = Hs.HsPtr (typ t)
typ opts (C.TypPointer t) = Hs.HsPtr (typ opts t)

0 comments on commit 54f3a84

Please sign in to comment.