Strange compilation behaviour:

test.chs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import Control.Applicative
import Data.Singletons
import Data.Singletons.TH
import Foreign
import Foreign.Storable 
import Foreign.C

import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Coerce

#include "test.h"

-- foreign library
#c
typedef struct s s_t;
#endc

typeS :: Ptr SPtr -> IO M
typeS p = do
  t <- {# get s_t->t1 #} (castPtr p)
  return $ if t == 0 then A else B

-- Bindings
{# pointer *s_t as SPtr newtype #}

instance Storable SPtr where
  sizeOf _  = {#sizeof s_t #}
  alignment _  = 8
  peek = undefined
  poke = undefined


data M = A | B deriving (Eq, Show)

genSingletons [''M]

-- | foreign data
newtype S a = S { unS :: Ptr (V a) }

uns :: S a -> Ptr SPtr
uns = castPtr . unS

s :: Ptr SPtr -> S a
s = S . castPtr

-- | unknown type in runtime
data SomeS = forall a . SomeS (S a)

typeOf :: S a -> M
typeOf = unsafePerformIO . typeS . castPtr . unS

cast :: M -> SomeS -> S a
cast ty (SomeS z)
  | ty == typeOf z = s . uns $ z
  | otherwise = error "cast: Type failure."

scast :: SM a -> SomeS -> S a
scast ty z = cast (fromSing ty) z

class MkVal a b | a -> b where
  mkVal :: a -> IO (S b)

instance MkVal Int A where
  mkVal i = do
    p <- malloc :: IO (Ptr SPtr)
    {# set s_t->t1 #} p 0
    {# set s_t->t2 #} p (fromIntegral i)
    {# set s_t->t3 #} p 0
    return $ S (castPtr p) 

instance MkVal Double B where
  mkVal i = do
    p <- malloc :: IO (Ptr SPtr)
    {# set s_t->t1 #} p 0
    {# set s_t->t2 #} p 0
    {# set s_t->t3 #} p (fromRational . toRational $ i)
    return $ S (castPtr p)

data V :: M -> * where
  V1 :: Int -> V A
  V2 :: Double -> V B

instance Storable (V a) where
  sizeOf _ = sizeOf (undefined :: Ptr ())
  alignment _ = sizeOf (undefined :: Ptr ())
  poke = error "not interesting"
  peek s  = case typeOf (S s) of
    A -> do unsafeCoerce $ V1 . fromIntegral <$> ({# get s_t->t2 #} (castPtr s))
    B -> do unsafeCoerce $ V2 . fromRational . toRational <$> ({# get s_t->t3 #} (castPtr s))

foo :: S a -> V a
foo = unsafePerformIO . peek . unS

-- doesn't work
test = do
   inner =<< fmap SomeS (mkVal (1::Int))
  where 
   inner :: SomeS -> IO ()
   inner z = do
     let y = cast A z
     case foo y of
          V1 i -> print i

-- works
test2 = do
   inner =<< fmap SomeS (mkVal (1::Int))
  where 
   inner :: SomeS -> IO ()
   inner z = do
     let y = scast (sing :: SM A) z
     case foo y of
          V1 i -> print i

-- works
test3 = do
   inner =<< fmap SomeS (mkVal (1::Int))
  where 
   inner :: SomeS -> IO ()
   inner z = do
     let y = cast A z :: S A
     case foo y of
          V1 i -> print i

main = test >> test2

test.h

#ifndef TEST_H
#define TEST_H

struct s {
  int t1;
  int t2;
  double t3;
};

#endif