Skip to content

Commit

Permalink
Generate pattern synonym for enum values
Browse files Browse the repository at this point in the history
  • Loading branch information
@phadej
phadej committed Dec 5, 2024
1 parent 31c9b65 commit 5d1d686
Show file tree
Hide file tree
Showing 20 changed files with 249 additions and 19 deletions.
6 changes: 6 additions & 0 deletions hs-bindgen/fixtures/distilled_lib_1.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@ DeclData (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnot
DeclInstance (InstanceStorable (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = ("cAnotherTypedefStructT_foo",HsPrimType HsPrimCInt) ::: ("cAnotherTypedefStructT_bar",HsPrimType HsPrimCChar) ::: VNil}) (StorableInstance {storableSizeOf = 8, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = ("cAnotherTypedefStructT_foo",HsPrimType HsPrimCInt) ::: ("cAnotherTypedefStructT_bar",HsPrimType HsPrimCChar) ::: VNil})) [PeekByteOff 0 0,PeekByteOff 0 4]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CAnotherTypedefStructT", structConstr = "MkCAnotherTypedefStructT", structFields = ("cAnotherTypedefStructT_foo",HsPrimType HsPrimCInt) ::: ("cAnotherTypedefStructT_bar",HsPrimType HsPrimCChar) ::: VNil}) 2 (Seq [PokeByteOff 3 0 0,PokeByteOff 3 4 1])))}))
DeclNewtype (Newtype {newtypeName = "CAnotherTypedefEnumE", newtypeConstr = "MkCAnotherTypedefEnumE", newtypeField = "unCAnotherTypedefEnumE", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = ("unCAnotherTypedefEnumE",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = ("unCAnotherTypedefEnumE",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CAnotherTypedefEnumE", structConstr = "MkCAnotherTypedefEnumE", structFields = ("unCAnotherTypedefEnumE",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 = "unCATypeT", newtypeType = HsPrimType HsPrimCInt})
DeclNewtypeInstance Storable "CATypeT"
DeclNewtype (Newtype {newtypeName = "CVarT", newtypeConstr = "MkCVarT", newtypeField = "unCVarT", newtypeType = HsPrimType HsPrimCInt})
Expand All @@ -25,6 +27,10 @@ DeclNewtype (Newtype {newtypeName = "CATypedefStructT", newtypeConstr = "MkCATyp
DeclNewtypeInstance Storable "CATypedefStructT"
DeclNewtype (Newtype {newtypeName = "CATypedefEnumE", newtypeConstr = "MkCATypedefEnumE", newtypeField = "unCATypedefEnumE", newtypeType = HsPrimType HsPrimCSChar})
DeclInstance (InstanceStorable (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = ("unCATypedefEnumE",HsPrimType HsPrimCSChar) ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = ("unCATypedefEnumE",HsPrimType HsPrimCSChar) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CATypedefEnumE", structConstr = "MkCATypedefEnumE", structFields = ("unCATypedefEnumE",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 = "unCInt32T", newtypeType = HsPrimType HsPrimCInt})
DeclNewtypeInstance Storable "CInt32T"
DeclNewtype (Newtype {newtypeName = "CCallbackT", newtypeConstr = "MkCCallbackT", newtypeField = "unCCallbackT", newtypeType = HsFunPtr (HsFun (HsPtr (HsPrimType HsPrimVoid)) (HsFun (HsTypRef "CUint32T") (HsIO (HsTypRef "CUint32T"))))})
Expand Down
12 changes: 12 additions & 0 deletions hs-bindgen/fixtures/distilled_lib_1.pp.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,10 @@ instance F.Storable CAnotherTypedefEnumE where
MkCAnotherTypedefEnumE unCAnotherTypedefEnumE2 ->
F.pokeByteOff ptr0 0 unCAnotherTypedefEnumE2

-- TODO pattern

-- TODO pattern

newtype CATypeT = MkCATypeT
{ unCATypeT :: FC.CInt
}
Expand Down Expand Up @@ -197,6 +201,14 @@ instance F.Storable CATypedefEnumE where
case s1 of
MkCATypedefEnumE unCATypedefEnumE2 -> F.pokeByteOff ptr0 0 unCATypedefEnumE2

-- TODO pattern

-- TODO pattern

-- TODO pattern

-- TODO pattern

newtype CInt32T = MkCInt32T
{ unCInt32T :: FC.CInt
}
Expand Down
12 changes: 12 additions & 0 deletions hs-bindgen/fixtures/distilled_lib_1.th.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,10 @@ instance Storable CAnotherTypedefEnumE
peek = \ptr_0 -> pure MkCAnotherTypedefEnumE <*> 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}
Expand Down Expand Up @@ -79,6 +83,14 @@ instance Storable CATypedefEnumE
peek = \ptr_0 -> pure MkCATypedefEnumE <*> 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
Expand Down
18 changes: 18 additions & 0 deletions hs-bindgen/fixtures/enums.hs
View file
Original file line number Diff line number Diff line change
@@ -1,18 +1,36 @@
DeclNewtype (Newtype {newtypeName = "CFirst", newtypeConstr = "MkCFirst", newtypeField = "unCFirst", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = ("unCFirst",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = ("unCFirst",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CFirst", structConstr = "MkCFirst", structFields = ("unCFirst",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 = "unCSecond", newtypeType = HsPrimType HsPrimCInt})
DeclInstance (InstanceStorable (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = ("unCSecond",HsPrimType HsPrimCInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = ("unCSecond",HsPrimType HsPrimCInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CSecond", structConstr = "MkCSecond", structFields = ("unCSecond",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 = "unCSame", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CSame", structConstr = "MkCSame", structFields = ("unCSame",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CSame", structConstr = "MkCSame", structFields = ("unCSame",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CSame", structConstr = "MkCSame", structFields = ("unCSame",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 = "unCPackad", newtypeType = HsPrimType HsPrimCSChar})
DeclInstance (InstanceStorable (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = ("unCPackad",HsPrimType HsPrimCSChar) ::: VNil}) (StorableInstance {storableSizeOf = 1, storableAlignment = 1, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = ("unCPackad",HsPrimType HsPrimCSChar) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CPackad", structConstr = "MkCPackad", structFields = ("unCPackad",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 = "unCEnumA", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = ("unCEnumA",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = ("unCEnumA",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumA", structConstr = "MkCEnumA", structFields = ("unCEnumA",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 = "unCEnumB", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = ("unCEnumB",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = ("unCEnumB",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumB", structConstr = "MkCEnumB", structFields = ("unCEnumB",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 = "unCEnumC", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = ("unCEnumC",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = ("unCEnumC",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumC", structConstr = "MkCEnumC", structFields = ("unCEnumC",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 = "unCEnumD", newtypeType = HsPrimType HsPrimCUInt})
DeclInstance (InstanceStorable (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = ("unCEnumD",HsPrimType HsPrimCUInt) ::: VNil}) (StorableInstance {storableSizeOf = 4, storableAlignment = 4, storablePeek = Lambda "ptr" (Ap (StructCon (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = ("unCEnumD",HsPrimType HsPrimCUInt) ::: VNil})) [PeekByteOff 0 0]), storablePoke = Lambda "ptr" (Lambda "s" (ElimStruct 0 (Struct {structName = "CEnumD", structConstr = "MkCEnumD", structFields = ("unCEnumD",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 = "unCEnumDT", newtypeType = HsTypRef "CEnumD"})
DeclNewtypeInstance Storable "CEnumDT"
36 changes: 36 additions & 0 deletions hs-bindgen/fixtures/enums.pp.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,10 @@ instance F.Storable CFirst where
case s1 of
MkCFirst unCFirst2 -> F.pokeByteOff ptr0 0 unCFirst2

-- TODO pattern

-- TODO pattern

newtype CSecond = MkCSecond
{ unCSecond :: FC.CInt
}
Expand All @@ -48,6 +52,12 @@ instance F.Storable CSecond where
case s1 of
MkCSecond unCSecond2 -> F.pokeByteOff ptr0 0 unCSecond2

-- TODO pattern

-- TODO pattern

-- TODO pattern

newtype CSame = MkCSame
{ unCSame :: FC.CUInt
}
Expand All @@ -69,6 +79,10 @@ instance F.Storable CSame where
case s1 of
MkCSame unCSame2 -> F.pokeByteOff ptr0 0 unCSame2

-- TODO pattern

-- TODO pattern

newtype CPackad = MkCPackad
{ unCPackad :: FC.CSChar
}
Expand All @@ -90,6 +104,12 @@ instance F.Storable CPackad where
case s1 of
MkCPackad unCPackad2 -> F.pokeByteOff ptr0 0 unCPackad2

-- TODO pattern

-- TODO pattern

-- TODO pattern

newtype CEnumA = MkCEnumA
{ unCEnumA :: FC.CUInt
}
Expand All @@ -111,6 +131,10 @@ instance F.Storable CEnumA where
case s1 of
MkCEnumA unCEnumA2 -> F.pokeByteOff ptr0 0 unCEnumA2

-- TODO pattern

-- TODO pattern

newtype CEnumB = MkCEnumB
{ unCEnumB :: FC.CUInt
}
Expand All @@ -132,6 +156,10 @@ instance F.Storable CEnumB where
case s1 of
MkCEnumB unCEnumB2 -> F.pokeByteOff ptr0 0 unCEnumB2

-- TODO pattern

-- TODO pattern

newtype CEnumC = MkCEnumC
{ unCEnumC :: FC.CUInt
}
Expand All @@ -153,6 +181,10 @@ instance F.Storable CEnumC where
case s1 of
MkCEnumC unCEnumC2 -> F.pokeByteOff ptr0 0 unCEnumC2

-- TODO pattern

-- TODO pattern

newtype CEnumD = MkCEnumD
{ unCEnumD :: FC.CUInt
}
Expand All @@ -174,6 +206,10 @@ instance F.Storable CEnumD where
case s1 of
MkCEnumD unCEnumD2 -> F.pokeByteOff ptr0 0 unCEnumD2

-- TODO pattern

-- TODO pattern

newtype CEnumDT = MkCEnumDT
{ unCEnumDT :: CEnumD
}
Expand Down
Loading

0 comments on commit 5d1d686

Please sign in to comment.