goldfirere / ghc

Mirror of ghc repository. DO NOT SUBMIT PULL REQUESTS HERE
http://www.haskell.org/ghc/
Other
25 stars 1 forks source link

Untidy error in dynApply #3

Open goldfirere opened 9 years ago

goldfirere commented 9 years ago

{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell, DataKinds,
             PolyKinds, GADTs, RankNTypes, MultiParamTypeClasses,
             FlexibleInstances, UndecidableInstances,
             FunctionalDependencies, StandaloneDeriving,
             TypeOperators, ScopedTypeVariables, NoMonomorphismRestriction,
             MonadComprehensions, DeriveGeneric, FlexibleContexts,
             GeneralizedNewtypeDeriving, ConstraintKinds,
             LambdaCase, ViewPatterns, AllowAmbiguousTypes,
             DefaultSignatures, -- ImpredicativeTypes, 
             ImplicitParams, MagicHash, UnboxedTuples,
             ExtendedDefaultRules, PatternSynonyms,
             DeriveFunctor, OverloadedLists -- , OverlappingInstances,
             -- NullaryTypeClasses
 #-}

module Scratch where

import Data.Type.Equality

data TyCon (a :: k) where
  TInt    :: TyCon  Int
  TBool   :: TyCon  Bool
  TMaybe  :: TyCon  Maybe
  TArrow  :: TyCon  (->)

data TypeRep (a :: k) where
  TyCon :: TyCon a -> TypeRep a
  TyApp :: TypeRep a -> TypeRep b -> TypeRep (a b)

eqTc :: TyCon a -> TyCon b -> Maybe (a :~: b)
eqTc TInt    TInt    = Just Refl
eqTc TBool   TBool   = Just Refl
eqTc TMaybe  TMaybe  = Just Refl
eqTc TArrow  TArrow  = Just Refl
eqTc _ _ = Nothing

eqT :: TypeRep a -> TypeRep b -> Maybe (a :~: b)
eqT (TyCon t1) (TyCon t2) = eqTc t1 t2
eqT (TyApp a1 b1) (TyApp a2 b2)
  | Just Refl <- eqT a1 a2
  , Just Refl <- eqT b1 b2
  = Just Refl
eqT _ _ = Nothing

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

foo :: TypeRep a -> a -> ()
foo (TyApp (TyCon TMaybe) _) = ()
-}
{-
dynApply :: Dyn -> Dyn -> Maybe Dyn
dynApply (Dyn (TyApp (TyApp (TyCon TArrow) targ) tres) fun) (Dyn targ' arg)
  = case eqT targ targ' of
      Just Refl  -> Just (Dyn tres (fun arg))
      Nothing    -> Nothing
dynApply _ _ = Nothing
-}