No match in record selector ctev_dest
With the llvm-tf package I got the following problem:
$ cat RecordSelectorCtevDest.hs
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module RecordSelectorCtevDest where
newtype Value a = Value a
newtype CodeGen r a = CodeGen a
bind :: CodeGen r a -> (a -> CodeGen r b) -> CodeGen r b
bind (CodeGen a) k = k a
class
(f ~ CalledFunction g, r ~ CallerResult g, g ~ CallerFunction f r) =>
CallArgs f g r where
type CalledFunction g :: *
type CallerResult g :: *
type CallerFunction f r :: *
call :: f -> g
instance CallArgs (IO a) (CodeGen r (Value a)) r where
type CalledFunction (CodeGen r (Value a)) = IO a
type CallerResult (CodeGen r (Value a)) = r
type CallerFunction (IO a) r = CodeGen r (Value a)
call = undefined
instance CallArgs b b' r => CallArgs (a -> b) (Value a -> b') r where
type CalledFunction (Value a -> b') = a -> CalledFunction b'
type CallerResult (Value a -> b') = CallerResult b'
type CallerFunction (a -> b) r = Value a -> CallerFunction b r
call = undefined
test :: IO a -> (a -> IO ()) -> CodeGen () (Value ())
test start stop = bind (call start) (call stop)
$ ghci-8.0.0.20160109 RecordSelectorCtevDest.hs
GHCi, version 8.0.0.20160109: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling RecordSelectorCtevDest ( RecordSelectorCtevDest.hs, interpreted )
*** Exception: No match in record selector ctev_dest
The problem disappears when I remove the 'r' parameter from CodeGen, CallArgs and CallerFunction and remove the CallerResult consequently.
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information