Я не могу заставить мой динамический тип на основе GADT работать с параметрическими типами

Поэтому, чтобы помочь мне понять некоторые из более продвинутых функций и концепций Haskell/GHC, я решил взять работающую реализацию динамически типизированных данных на основе GADT и расширить ее для охвата параметрических типов. (Прошу прощения за длину этого примера.)

{-# LANGUAGE GADTs #-}

module Dyn ( Dynamic(..), 
             toDynamic,
             fromDynamic
           ) where

import Control.Applicative

----------------------------------------------------------------
----------------------------------------------------------------
--
-- Equality proofs
--

-- | The type of equality proofs.
data Equal a b where
    Reflexivity :: Equal a a
    -- | Inductive case for parametric types
    Induction   :: Equal a b -> Equal (f a) (f b)

instance Show (Equal a b) where
    show Reflexivity = "Reflexivity"
    show (Induction proof) = "Induction (" ++ show proof ++ ")"

----------------------------------------------------------------
----------------------------------------------------------------
--
-- Type representations
--

-- | Type representations.  If @x :: TypeRep a@, then @x@ is a singleton
-- value that stands in for type @a@.
data TypeRep a where 
    Integer :: TypeRep Integer
    Char :: TypeRep Char
    Maybe :: TypeRep a -> TypeRep (Maybe a)
    List :: TypeRep a -> TypeRep [a]

-- | Typeclass for types that have a TypeRep
class Representable a where
    typeRep :: TypeRep a

instance Representable Integer where typeRep = Integer
instance Representable Char where typeRep = Char

instance Representable a => Representable (Maybe a) where 
    typeRep = Maybe typeRep

instance Representable a => Representable [a] where 
    typeRep = List typeRep


-- | Match two types and return @Just@ an equality proof if they are
-- equal, @Nothing@ if they are not.
matchTypes :: TypeRep a -> TypeRep b -> Maybe (Equal a b)
matchTypes Integer Integer = Just Reflexivity
matchTypes Char Char = Just Reflexivity
matchTypes (List a) (List b) = Induction <$> (matchTypes a b)
matchTypes (Maybe a) (Maybe b) = Induction <$> (matchTypes a b)
matchTypes _ _ = Nothing


instance Show (TypeRep a) where
    show Integer = "Integer"
    show Char = "Char"
    show (List a) = "[" ++ show a ++ "]"
    show (Maybe a) = "Maybe (" ++ show a ++ ")"


----------------------------------------------------------------
----------------------------------------------------------------
--
-- Dynamic data
--

data Dynamic where
    Dyn :: TypeRep a -> a -> Dynamic

instance Show Dynamic where
    show (Dyn typ val) = "Dyn " ++ show typ

-- | Inject a value of a @Representable@ type into @Dynamic@.
toDynamic :: Representable a => a -> Dynamic
toDynamic = Dyn typeRep

-- | Cast a @Dynamic@ into a @Representable@ type.
fromDynamic :: Representable a => Dynamic -> Maybe a
fromDynamic = fromDynamic' typeRep

fromDynamic' :: TypeRep a -> Dynamic -> Maybe a
fromDynamic' target (Dyn source value) = 
    case matchTypes source target of
      Just Reflexivity -> Just value
      Nothing -> Nothing
      -- The following pattern causes compilation to fail.
      Just (Induction _) -> Just value

Однако компиляция этого завершается ошибкой в ​​последней строке (мои номера строк не совпадают с примером):

../src/Dyn.hs:105:34:
    Could not deduce (a2 ~ b)
    from the context (a1 ~ f a2, a ~ f b)
      bound by a pattern with constructor
                 Induction :: forall a b (f :: * -> *).
                              Equal a b -> Equal (f a) (f b),
               in a case alternative
      at ../src/Dyn.hs:105:13-23
      `a2' is a rigid type variable bound by
           a pattern with constructor
             Induction :: forall a b (f :: * -> *).
                          Equal a b -> Equal (f a) (f b),
           in a case alternative
           at ../src/Dyn.hs:105:13
      `b' is a rigid type variable bound by
          a pattern with constructor
            Induction :: forall a b (f :: * -> *).
                         Equal a b -> Equal (f a) (f b),
          in a case alternative
          at ../src/Dyn.hs:105:13
    Expected type: a1
      Actual type: a
    In the first argument of `Just', namely `value'
    In the expression: Just value
    In a case alternative: Just (Induction _) -> Just value

Как я это прочитал, компилятор не может понять, что в Inductive :: Equal a b -> Equal (f a) (f b), a и b должны быть равны для ненижних значений. Итак, я попробовал Inductive :: Equal a a -> Equal (f a) (f a), но это тоже не помогло в определении matchTypes :: TypeRep a -> TypeRep b -> Maybe (Equal a b):

../src/Dyn.hs:66:60:
    Could not deduce (a2 ~ a1)
    from the context (a ~ [a1])
      bound by a pattern with constructor
                 List :: forall a. TypeRep a -> TypeRep [a],
               in an equation for `matchTypes'
      at ../src/Dyn.hs:66:13-18
    or from (b ~ [a2])
      bound by a pattern with constructor
                 List :: forall a. TypeRep a -> TypeRep [a],
               in an equation for `matchTypes'
      at ../src/Dyn.hs:66:22-27
      `a2' is a rigid type variable bound by
           a pattern with constructor
             List :: forall a. TypeRep a -> TypeRep [a],
           in an equation for `matchTypes'
           at ../src/Dyn.hs:66:22
      `a1' is a rigid type variable bound by
           a pattern with constructor
             List :: forall a. TypeRep a -> TypeRep [a],
           in an equation for `matchTypes'
           at ../src/Dyn.hs:66:13
    Expected type: TypeRep a1
      Actual type: TypeRep a
    In the second argument of `matchTypes', namely `b'
    In the second argument of `(<$>)', namely `(matchTypes a b)'

Изменение типа matchTypes :: TypeRep a -> TypeRep b -> Maybe (Equal a b) для получения matchTypes :: TypeRep a -> TypeRep b -> Maybe (Equal a a) не работает (просто читайте это как предложение). Как и matchTypes :: TypeRep a -> TypeRep a -> Maybe (Equal a a) (еще одно тривиальное предложение, и это, как я понимаю, потребует пользователей fromDynamic' to know theain theTypeRep acontained in theDynamic`).

Итак, я в тупике. Любые указатели на то, как двигаться вперед здесь?


person Luis Casillas    schedule 11.06.2012    source источник
comment
Разве вы не можете отказаться от конструктора Induction и вывести тот же принцип induction :: Eq a b -> Eq (f a) (f b); induction Reflexivity = Reflexivity?   -  person pigworker    schedule 11.06.2012


Ответы (1)


Проблема в том, что подстановочный шаблон вашего шаблона теряет информацию о равенстве. Если вы закодируете индукцию таким образом, вы не сможете написать (конечную) коллекцию паттернов, охватывающую все случаи. Решение состоит в том, чтобы перенести индукцию из вашего типа данных в определенное значение. Соответствующие изменения выглядят так:

data Equal a b where
    Reflexivity :: Equal a a

induction :: Equal a b -> Equal (f a) (f b)
induction Reflexivity = Reflexivity

matchTypes (List a) (List b) = induction <$> matchTypes a b
matchTypes (Maybe a) (Maybe b) = induction <$> matchTypes a b

fromDynamic' :: TypeRep a -> Dynamic -> Maybe a
fromDynamic' target (Dyn source value) = 
    case matchTypes source target of
      Just Reflexivity -> Just value
      Nothing -> Nothing

Таким образом, шаблоны в fromDynamic' являются исчерпывающими, но не содержат подстановочных знаков, приводящих к потере информации.

person Daniel Wagner    schedule 11.06.2012
comment
Да, я подозревал подстановочные знаки. В какой-то момент я попытался решить проблему, написав функцию normalizeEqual :: Equal a b -> Equal a a, которая превращает все случаи Induction в Reflexivity, но это также не удалось по причинам, которые я не могу вспомнить... - person Luis Casillas; 11.06.2012
comment
Вы действительно можете нормализовать данные из этого типа data EqI :: * -> * -> * where ReflI :: EqI a a; RespI :: EqI a b -> EqI (f a) (f b) в данные этого типа data EqR :: * -> * -> * where Refl :: EqR a a следующим образом: fact :: EqI a b -> EqR a b; fact ReflI = Refl; fact (RespI p) = case fact p of Refl -> Refl - person pigworker; 11.06.2012
comment
@sacundim Думаю, вы могли бы заставить normalizeEqual :: Equal a b -> Equal a b работать, но предложенный вами тип кажется мне странным. Вы всегда можете построить значение типа Equal a a — доказательство того, что a равно чему-то еще, кажется ненужным. - person Daniel Wagner; 11.06.2012