Ticket #11401: RecordSelectorCtevDest.hs

File RecordSelectorCtevDest.hs, 1.3 KB (added by Lemming, 3 years ago)

Example module as file

Line 
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE FlexibleInstances #-}
4module RecordSelectorCtevDest where
5
6import Data.Word (Word32, )
7import Foreign.Ptr (Ptr, )
8
9
10newtype Value a = Value a
11newtype Function a = Function a
12newtype CodeGenFunction r a = CodeGenFunction a
13
14bind :: CodeGenFunction r a -> (a -> CodeGenFunction r b) -> CodeGenFunction r b
15bind (CodeGenFunction a) k = k a
16
17class
18   (f ~ CalledFunction g, r ~ CallerResult g, g ~ CallerFunction f r) =>
19       CallArgs f g r where
20   type CalledFunction g :: *
21   type CallerResult g :: *
22   type CallerFunction f r :: *
23   call :: Function f -> g
24
25instance CallArgs (IO a) (CodeGenFunction r (Value a)) r where
26   type CalledFunction (CodeGenFunction r (Value a)) = IO a
27   type CallerResult (CodeGenFunction r (Value a)) = r
28   type CallerFunction (IO a) r = CodeGenFunction r (Value a)
29   call = undefined
30
31instance CallArgs b b' r => CallArgs (a -> b) (Value a -> b') r where
32   type CalledFunction (Value a -> b') = a -> CalledFunction b'
33   type CallerResult (Value a -> b') = CallerResult b'
34   type CallerFunction (a -> b) r = Value a -> CallerFunction b r
35   call = undefined
36
37test ::
38   Function (IO (Ptr a)) ->
39   Function (Ptr a -> IO Word32) ->
40   CodeGenFunction Word32 (Value Word32)
41test start fill =
42   bind (call start) (call fill)