CStruct in haskell (example 1)
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeApplications #-} | |
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE AllowAmbiguousTypes #-} | |
module Main where | |
import GHC.TypeLits | |
import Data.Proxy | |
import CStruct | |
-- this really should be Addr# | |
data Ptr (k :: Element) = Ptr Int | |
deriving (Show,Eq) | |
plusPtr :: Ptr k -> Integer -> Ptr v | |
plusPtr (Ptr p) i = Ptr (p + fromIntegral i) | |
accessor :: forall fields el child . (KnownNat (Offset 0 fields el), Resolv fields el ~ child) | |
=> Ptr el -> Ptr child | |
accessor p = p `plusPtr` (getOffset @el @fields) | |
type X = 'FStruct | |
'[ '("a", 'FInt64) | |
, '("b", 'FInt8) | |
, '("c", 'FWord32) | |
, '("byte", 'FArray 2 'FWord8) | |
, '("xyz", 'FArray 12 'FWord64) | |
] | |
type U = 'FUnion '[ '("w64", 'FWord64) | |
, '("w32", 'FStruct '[ '("high", 'FWord32), '("low", 'FWord32) ]) | |
, '("x", X) | |
] | |
type Y = 'FStruct | |
'[ '("other", 'FInt64) | |
, '("myx", X) | |
, '("union", U) | |
] | |
(+>) :: Ptr x -> (Ptr x -> Ptr y) -> Ptr y | |
(+>) p access = access p | |
main :: IO () | |
main = do | |
putStrLn $ "X: " ++ show (getSize @X) | |
putStrLn $ "U: " ++ show (getSize @U) | |
putStrLn $ "Y: " ++ show (getSize @Y) | |
putStrLn $ show (getOffset @X @('[ 'Field "a"])) | |
putStrLn $ show (getOffset @Y @('[ 'Field "myx", 'Field "c"])) | |
putStrLn $ show (getOffset @Y @('[ 'Field "union", 'Field "x", 'Field "c"])) | |
let p = Ptr 0 :: Ptr Y | |
p2 = (accessor @('[ 'Field "myx", 'Field "c"])) p | |
p4 = p +> accessor @('Field "myx" ': '[]) | |
p5 = accessor @('Field "myx" ': '[]) p | |
p6 = p +> accessor @('Field "myx" ': 'Field "byte" ': '[ 'Index 0]) | |
putStrLn $ show p | |
putStrLn $ show p2 | |
putStrLn $ show p6 | |
return () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment