content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}
  -- | The CType package defines the concrete representation of types and kinds.
  module CType(
    -- * Types
    Type(..), CType, TyVar(..), TyCon(..), TISort(..), StructSubType(..),
  
    -- ** Examining Types
    getTyVarId, getTypeKind,
    isTNum, getTNum,
    isTStr, getTStr,
    isTVar, isTCon, isIfc, isInterface, isUpdateable,
    leftCon, leftTyCon, allTyCons, allTConNames, tyConArgs,
    splitTAp, normTAp,
    isTypeBit, isTypeString,
    isTypePrimAction, isTypeAction,
    isTypeActionValue, isTypeActionValue_,
    isTypePolyBit, bitWidth,
    isTypeUnit,
    noTyVarNo, isGeneratedTVar,
    getArrows,  getRes,
    seqCType,
    -- if the above are not sufficient, use these:
    isTypeTConNoArgs, isTypeTConArgs,
    getActionValueArg,
    isTConArrow, isTConPair,
  
    -- ** Constructing Types
    noType, tVar, tVarKind, cTVar, cTVarKind, cTVarNum, cTCon, cTNum, cTStr,
    cTApplys, setTypePosition,
  
    -- * Kinds
    Kind(..), PartialKind(..),
  
  
    -- ** Examining Kinds
    isKVar, getArgKinds, getResKind,
  
    -- ** Constructing Kinds
    baseKVar,
  
    -- * Type Classes
    CTypeclass(..),
  
    -- ** Examining Type Classes
    typeclassId,
  
    -- * Type class constraints
    CQType(..), CPred(..),
    getCQArrows,
  
          ) where
  
  #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804)
  import Prelude hiding ((<>))
  #endif
  
  import Data.Char(isDigit, chr)
  import Data.List(union)
  import Data.Maybe
  import qualified Data.Generics as Generic
  
  import Eval
  import PPrint
  import Position
  import Id
  import IdPrint
  import PreIds(idArrow, idPrimPair, idPrimUnit, idBit, idString,
                idPrimAction, idAction, idActionValue_, idActionValue,
                idTNumToStr
                {-, idSizeOf -})
  import Util(itos)
  import ErrorUtil
  import Pragma(IfcPragma)
  import TypeOps
  import PVPrint(PVPrint(..))
  import FStringCompat
  
  -- Data structures
  
  -- | Representation of types
  data Type = TVar TyVar         -- ^ type variable
            | TCon TyCon         -- ^ type constructor
            | TAp Type Type      -- ^ type-level application
            | TGen Position Int  -- ^ quantified type variable used in type schemes
            | TDefMonad Position -- ^ not used after CVParserImperative
      deriving (Show, Generic.Data, Generic.Typeable)
  
  -- | Representation of a type variable
  data TyVar = TyVar { tv_name :: Id    -- ^ name of the type variable
                     , tv_num  :: Int   -- ^ number for a generated type variable
                     , tv_kind :: Kind  -- ^ kind of the type variable
                     }
      deriving (Show, Generic.Data, Generic.Typeable)
  
  
  -- | Representation of a type constructor
  data TyCon = -- | A constructor for a type of value kind
               TyCon { tcon_name :: Id           -- ^ name of the type constructor
                     , tcon_kind :: (Maybe Kind) -- ^ kind of the type constructor
                     , tcon_sort :: TISort       -- ^ purpose of the type constructor
                     }
               -- | A constructor for a type of numeric kind
             | TyNum { tynum_value :: Integer  -- ^ type-level numeric value
                     , tynum_pos   :: Position -- ^ position of introduction
                     }
               -- | A constructor for a type of string kind
             | TyStr { tystr_value :: FString  -- ^ type-level string value
                     , tystr_pos   :: Position -- ^ position of introduction
                     }
      deriving (Show, Generic.Data, Generic.Typeable)
  
  data TISort
          = -- type synonym
            TItype Integer Type
          | TIdata { tidata_cons :: [Id]
                   , tidata_enum :: Bool
                   }
          | TIstruct StructSubType [Id]
            -- primitive abstract type
            -- e.g. Integer, Bit, Module, etc.
          | TIabstract
          deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable)
  
  
  data StructSubType
          = SStruct
          | SClass
          | SDataCon { sdatacon_id :: Id
                     , sdatacon_named_fields :: Bool
                     }
          | SInterface [IfcPragma]
          | SPolyWrap { spolywrap_id :: Id         -- ^ name of the type with the wrapped field
                      , spolywrap_ctor :: Maybe Id -- ^ name of the data constructor
                      , spolywrap_field :: Id      -- ^ name of the wrapped field
                      }
          deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable)
  
  type CType = Type
  
  -- | Representation of kinds
  data Kind = KStar           -- ^ kind of a simple value type
            | KNum            -- ^ kind of a simple numeric type
            | KStr            -- ^ kind of a simple string type
            | Kfun Kind Kind  -- ^ kind of type constructors (type-level function)
            | KVar Int        -- ^ generated kind variable (used only during kind inference)
      deriving (Eq, Ord, Show, Generic.Data, Generic.Typeable)
  
  -- Used for providing partial Kind information
  data PartialKind
          = PKNoInfo -- this is what makes it partial
          | PKStar
          | PKNum
          | PKStr
          | PKfun PartialKind PartialKind
          deriving (Eq, Ord, Show)
  
  -- | A named typeclass
  newtype CTypeclass = CTypeclass Id
      deriving (Eq, Ord, Show, PPrint, HasPosition, Hyper)
  
  -- | Representation of the provisos and other class constraints
  data CPred = CPred { cpred_tc   :: CTypeclass  -- ^ constraint class, e.g., "Eq"
                     , cpred_args :: [CType]     -- ^ argument types
                     }
          deriving (Eq, Ord, Show)
  
  -- Eq instances
  
  -- | used to do the sorting of instances
  -- so that overlapping matches go to the most specific
  -- TAp first because it brings forward instances with larger structure
  -- see the Has_tpl_n instances in the Prelude
  cmp :: Type -> Type -> Ordering
  cmp (TAp f1 a1) (TAp f2 a2) = compare (f1, a1) (f2, a2)
  cmp (TAp _  _)  _           = LT
  cmp (TCon c1) (TCon c2) = compare c1 c2
  cmp (TCon _)  (TAp _ _) = GT
  cmp (TCon _)  _         = LT
  cmp (TVar _) (TCon _)   = GT
  cmp (TVar _) (TAp _ _)  = GT
  cmp (TVar v1) (TVar v2) = compare v1 v2
  cmp (TVar _)  _         = LT
  cmp (TGen _ i1) (TGen _ i2) = compare i1 i2
  cmp (TGen _ _) (TDefMonad _) = LT
  cmp (TGen _ _) _        = GT
  cmp (TDefMonad _) (TDefMonad _) = EQ
  cmp (TDefMonad _) _  = GT
  
  instance Eq Type where
      x == y  =  cmp x y == EQ
  
  instance Eq TyVar where
      TyVar i n _ == TyVar i' n' _  =  (n, i) == (n', i')
  
  instance Eq TyCon where
      TyCon i k _ == TyCon i' k' _  =  qualEq i i' && k == k'
      TyNum i _   == TyNum i' _     =  i == i'
      TyStr s _   == TyStr s' _     =  s == s'
      _           == _              =  False
  
  -- Ord instances
  
  instance Ord Type where
      compare x y = cmp x y
  
  instance Ord TyVar where
      TyVar i n _ <= TyVar i' n' _  =  (n, i) <= (n', i')
      TyVar i n _ <  TyVar i' n' _  =  (n, i) <  (n', i')
      TyVar i n _ >= TyVar i' n' _  =  (n, i) >= (n', i')
      TyVar i n _ >  TyVar i' n' _  =  (n, i) >  (n', i')
      TyVar i n _ `compare` TyVar i' n' _  =  (n, i) `compare` (n', i')
  
  instance Ord TyCon where
      TyCon i k _ `compare` TyCon i' k' _   =  (getIdBase i, getIdQual i, k) `compare` (getIdBase i', getIdQual i', k')
      TyCon _ _ _ `compare` TyNum _  _      =  LT
      TyCon _ _ _ `compare` TyStr _  _      =  LT
      TyNum _ _   `compare` TyCon _  _  _   =  GT
      TyNum i _   `compare` TyNum i' _      =  i `compare` i'
      TyNum _ _   `compare` TyStr _  _      =  LT
      TyStr _ _   `compare` TyCon _  _  _   =  GT
      TyStr _ _   `compare` TyNum _  _      =  GT
      TyStr s _   `compare` TyStr s' _      =  s `compare` s'
  
  
  
  
  
  instance PPrint Type where
      pPrint d p (TCon (TyCon unit _ _)) | unit == idPrimUnit = text "()"
      pPrint d p (TCon c) = pPrint d 0 c
      pPrint d p (TVar i) = pPrint d 0 i
      pPrint d p (TAp (TAp (TCon pair) a) b) | isTConPair pair =
          pparen (p >= 0) (sep [pPrint d 0 a <> text ",", pPrint d (-1) b])
      pPrint d p (TAp (TAp (TCon arr) a) r) | isTConArrow arr =
          pparen (p > 8) (sep [pPrint d 9 a <+> text "->", pPrint d 8 r])
      pPrint d p (TAp e e') = pparen (p>9) $
          sep [pPrint d 9 e, pPrint d 10 e']
      pPrint d p (TDefMonad _) = text ("TDefMonad")
      pPrint d p (TGen _ n) = pparen True (text "TGen" <+> pPrint d p n)
  
  instance Hyper Type where
      hyper (TVar v) y = hyper v y
      hyper (TCon c) y = hyper c y
      hyper (TAp t1 t2) y = hyper2 t1 t2 y
      hyper (TGen p i) y = hyper2 p i y
      hyper (TDefMonad _) y = y
  
  instance HasPosition Type where
      getPosition (TVar var) = getPosition var
      getPosition (TCon con) = getPosition con
      getPosition (TAp f a) = getPosition f `bestPosition` getPosition a
      getPosition (TGen pos _) = pos
      getPosition (TDefMonad pos) = pos
  
  instance Hyper TyVar where
      hyper (TyVar i n k) y = hyper3 i n k y
  
  instance HasPosition TyVar where
      getPosition (TyVar name _ _) = getPosition name
  
  getTyVarId :: TyVar -> Id
  getTyVarId = tv_name
  
  instance PPrint TyVar where
      pPrint d _ (TyVar i _ _) = ppVarId d i
  
  instance PPrint TyCon where
      pPrint d _ (TyCon i _ _) = ppConId d i
      pPrint d _ (TyNum i _) = text (itos i)
      pPrint d _ (TyStr s _) = text (show s)
  
  instance Hyper TyCon where
      hyper (TyCon i k s) y = hyper3 i k s y
      hyper (TyNum i p) y = hyper2 i p y
      hyper (TyStr s p) y = hyper2 s p y
  
  instance HasPosition TyCon where
      getPosition (TyCon name k _) = getPosition name
      getPosition (TyNum _ pos) = pos
      getPosition (TyStr _ pos) = pos
  
  instance HasPosition CQType where
      -- prefer t to ps, since that is a better position for BSV
      getPosition (CQType ps t) = getPosition t `bestPosition` getPosition ps
  
  instance HasPosition CPred where
      getPosition (CPred c ts) = getPosition (c, ts)
  
  data CQType = CQType [CPred] CType
      deriving (Eq, Ord, Show)
  
  instance Hyper CQType where
      hyper (CQType i ts) y = hyper2 i ts y
  
  
  {-
  -- should typeclass ids be equal if they are qualEq?
  instance Eq CTypeclass where
    (==) (CTypeclass i) (Ctypeclass i') = qualEq i i'
  
  instance Ord CTypeclass where
    compare (CTypeclass i) (CTypeclass i') | qualEq i i' = EQ
                                           | otherwise  = compare i i'
  -}
  
  -- This function is dangerous, it allows a CTypeclass to be "coerced" in type to a
  -- bare Id, which in turn might be interpreted as something else.
  typeclassId :: CTypeclass -> Id
  typeclassId (CTypeclass i) = i
  
  instance PVPrint CTypeclass where
     pvPrint d p (CTypeclass i) = pvPrint d p i
  
  instance Hyper CPred where
      hyper (CPred i ts) y = hyper2 i ts y
  
  instance PPrint CQType where
      pPrint d p (CQType [] ct) = pPrint d p ct
      pPrint d p (CQType preds ct) = sep [text "(" <> sepList (map (pPrint d 0) preds) (text ",") <> text ")" <+> text "=>", pPrint d 0 ct]
  
  instance PPrint CPred where
      pPrint d p (CPred (CTypeclass c) []) = ppConId d c
      pPrint d p (CPred (CTypeclass c) ts) = ppConId d c <+> sep (map (pPrint d (maxPrec+1)) ts)
  
  noTyVarNo :: Int
  noTyVarNo = -1
  
  tVarKind :: Id -> Kind -> TyVar
  tVarKind i k = TyVar i noTyVarNo k
  
  tVar :: Id -> TyVar
  -- XXX KVar (-42) below is a hack so that undefined is not visible
  -- XXX when deriving Show
  tVar i = tVarKind i (KVar (-42))
  
  cTVar :: Id -> CType
  cTVar i = TVar (tVar i)
  
  cTVarKind :: Id -> Kind -> CType
  cTVarKind name kind = TVar (tVarKind name kind)
  
  cTVarNum :: Id -> CType
  cTVarNum name = cTVarKind name KNum
  
  cTCon :: Id -> CType
  cTCon i | all isDigit s = cTNum (read s) (getIdPosition i)
          | head s == '"' = cTStr (mkFString $ read s) (getIdPosition i)
    where s = getIdString i
  cTCon i = TCon (TyCon i Nothing TIabstract)
  
  cTNum :: Integer -> Position -> CType
  cTNum n pos = TCon (TyNum n pos)
  
  isTNum :: CType -> Bool
  isTNum (TCon (TyNum _ _)) = True
  isTNum _ = False
  
  getTNum :: CType -> Integer
  getTNum (TCon (TyNum n _)) = n
  getTNum t = internalError $ "getTNum: not a type-level integer -- " ++ (show t)
  
  cTStr :: FString -> Position -> CType
  cTStr s pos = TCon (TyStr s pos)
  
  isTStr :: CType -> Bool
  isTStr (TCon (TyStr _ _)) = True
  isTStr _ = False
  
  getTStr :: CType -> FString
  getTStr (TCon (TyStr s _)) = s
  getTStr t = internalError $ "getTNum: not a type-level string -- " ++ (show t)
  
  isTVar :: Type -> Bool
  isTVar (TVar _) = True
  isTVar _ = False
  
  isTCon :: Type -> Bool
  isTCon (TCon _) = True
  isTCon _ = False
  
  isGeneratedTVar :: TyVar -> Bool
  isGeneratedTVar (TyVar _ n _) = n /= noTyVarNo
  
  isIfc :: StructSubType -> Bool
  isIfc SInterface {} = True
  --isIfc SStruct = True -- XXX why??
  isIfc _ = False
  
  isInterface :: CType -> Bool
  isInterface t | Just (TyCon _ _ (TIstruct s _)) <- leftTyCon t = isIfc s
  isInterface _ = False
  
  isUpdateable :: StructSubType -> Bool
  isUpdateable SStruct = True
  isUpdateable SInterface {} = True
  isUpdateable _ = False
  
  noType :: Type
  noType = TGen noPosition (-1)
  
  getCQArrows :: CQType -> ([CQType], CQType)
  getCQArrows (CQType preds ctype) =
      let (args, result) = getArrows ctype
      in  (map (CQType preds) args, CQType preds result)
  
  getArrows :: Type -> ([Type], Type)
  getArrows t = getArrowsAccum [] t
      where getArrowsAccum ts (TAp (TAp (TCon arr) a) r) | isTConArrow arr
                                = getArrowsAccum (a:ts) r
            getArrowsAccum ts r = (reverse ts, r)
  
  getRes :: Type -> Type
  getRes t = snd (getArrows t)
  
  isTConArrow :: TyCon -> Bool
  isTConArrow (TyCon i _ _) =  i == idArrow noPosition
  isTConArrow t = internalError("isTConArrow: not TCon " ++ show t)
  
  isTConPair :: TyCon -> Bool
  isTConPair (TyCon i _ _) =  i == idPrimPair
  isTConPair t = internalError("isTConPair: not TCon " ++ show t)
  
  -- is a type a specific TCon with no arguments
  isTypeTConNoArgs :: Id -> Type -> Bool
  isTypeTConNoArgs cid (TCon (TyCon i _ _)) | (i == cid) = True
  isTypeTConNoArgs _ _ = False
  
  -- is a type a specific TCon with arguments
  isTypeTConArgs :: Id -> Type -> Bool
  isTypeTConArgs cid (TAp (TCon (TyCon i _ _)) _) | (i == cid) = True
  isTypeTConArgs _ _ = False
  
  isTypeBit, isTypeString, isTypePrimAction, isTypeAction :: Type -> Bool
  isTypeBit          = isTypeTConArgs   idBit
  isTypeString       = isTypeTConNoArgs idString
  isTypePrimAction   = isTypeTConNoArgs idPrimAction
  isTypeAction       = isTypeTConNoArgs idAction
  
  isTypeActionValue, isTypeActionValue_, isTypeUnit :: Type -> Bool
  isTypeActionValue  = isTypeTConArgs   idActionValue
  isTypeActionValue_ = isTypeTConArgs   idActionValue_
  isTypeUnit         = isTypeTConNoArgs  idPrimUnit
  
  getActionValueArg :: Type -> Type
  getActionValueArg (TAp (TCon (TyCon i _ _)) arg) | (i == idActionValue) = arg
  getActionValueArg t = internalError ("getActionValueArg: " ++ ppReadable t)
  
  -- These are used during foreign function processing to determine if arguments
  -- and return values are polymorphic or of a known size.
  isTypePolyBit :: Type -> Bool
  isTypePolyBit (TAp (TCon (TyCon i _ _)) arg)
    | (i == idBit) || (i == idActionValue) || (i == idActionValue_) = isTVar arg
  isTypePolyBit _ = False
  
  bitWidth :: Type -> Integer
  bitWidth (TAp (TCon (TyCon i _ _)) arg)
    | ((i == idBit) || (i == idActionValue) || (i == idActionValue_)) &&
       (isTNum arg) = getTNum arg
  bitWidth t =
    internalError $ "bitWidth: not a Bit type of known width -- " ++ (show t)
  
  
  cTApplys :: CType -> [CType] -> CType
  cTApplys t ts = foldl TAp t ts
  
  leftCon :: CType -> Maybe Id
  leftCon (TAp f _) = leftCon f
  leftCon (TCon (TyCon i _ _)) = Just i
  leftCon _ = Nothing
  
  leftTyCon :: CType -> Maybe TyCon
  leftTyCon (TAp f _) = leftTyCon f
  leftTyCon (TCon tc) = Just tc
  leftTyCon _ = Nothing
  
  tyConArgs :: CType -> [CType]
  tyConArgs (TAp f a) = tyConArgs f ++ [a]
  tyConArgs (TCon _) = []
  tyConArgs t = internalError("tyConArgs: " ++ show t)
  
  allTyCons :: CType -> [TyCon]
  allTyCons (TCon c) = [c]
  allTyCons (TAp f a) = allTyCons f `union` allTyCons a
  allTyCons _ = []
  
  getTConName :: TyCon -> Maybe Id
  getTConName (TyCon i _ _) = Just i
  getTConName (TyNum {}) = Nothing
  getTConName (TyStr {}) = Nothing
  
  allTConNames :: CType -> [Id]
  allTConNames = mapMaybe getTConName . allTyCons
  
  -- like the above functions, but works even if the left-most is not a tycon
  splitTAp :: CType -> (CType, [CType])
  splitTAp (TAp f a) = let (l,as) = splitTAp f
                       in  (l,as ++ [a])
  splitTAp t = (t,[])
  
  -- Copied from normITAp
  normTAp :: Type -> Type -> Type
  normTAp (TAp (TCon (TyCon op _ _)) (TCon (TyNum x xpos))) (TCon (TyNum y ypos))
          | isJust (res) = cTNum (fromJust res) (getPosition op)
    where res = opNumT op [x, y]
  
  normTAp (TCon (TyCon op _ _)) (TCon (TyNum x xpos))
          | isJust (res) = cTNum (fromJust res) (getPosition op)
    where res = opNumT op [x]
  
  normTAp (TAp (TCon (TyCon op _ _)) (TCon (TyStr x xpos))) (TCon (TyStr y ypos))
          | isJust (res) = cTStr (fromJust res) (getPosition op)
    where res = opStrT op [x, y]
  
  normTAp (TCon (TyCon op _ _)) (TCon (TyNum x xpos))
          | op == idTNumToStr = cTStr (mkNumFString x) (getPosition op)
  
  normTAp f a = TAp f a
  
  getTypeKind :: Type -> Maybe Kind
  getTypeKind (TVar (TyVar _ _ k))  = Just k
  getTypeKind (TCon (TyCon _ mk _)) = mk
  getTypeKind (TCon (TyNum _ _)) = Just KNum
  getTypeKind (TCon (TyStr _ _)) = Just KStr
  getTypeKind (TAp t1 t2) = case (getTypeKind t1) of
                              Just (Kfun k1 k2) -> Just k2
                              _ -> Nothing -- don't know or isn't Kfun
  getTypeKind _ = Nothing
  
  ----
  
  -- KIMisc.newKVar starts at this number
  baseKVar :: Int
  baseKVar = 1000
  
  isKVar :: Kind -> Bool
  isKVar (KVar _) = True
  isKVar _ = False
  
  -- Display the kind variable with letters
  showKVar :: Int -> String
  showKVar v =
      let
          makeDigit x = chr (x + 97)  -- 97 = ASCII a
  
          showDigits :: Int -> String
          showDigits x | (x < 26) = [makeDigit x]
          showDigits x = (showDigits (x `div` 26)) ++ [makeDigit (x `mod` 26)]
      in
          if (v < baseKVar)
          then (itos v)
          else (showDigits (v - baseKVar))
  
  -- this differs from the version in KIMisc because it does not include the kind of the result
  getArgKinds :: Kind -> [Kind]
  getArgKinds (Kfun a b) = a : getArgKinds b
  getArgKinds _ = []
  
  getResKind :: Kind -> Kind
  getResKind (Kfun a b) = getResKind b
  getResKind k = k
  
  instance PPrint Kind where
      pPrint _ _ KStar = text "*"
      pPrint _ _ KNum = text "#"
      pPrint _ _ KStr = text "$"
      pPrint d p (Kfun l r) = pparen (p>9) $ pPrint d 10 l <+> text "->" <+> pPrint d 9 r
      pPrint _ _ (KVar i) = text (showKVar i)
  
  instance Hyper Kind where
      hyper (Kfun k1 k2) y = hyper2 k1 k2 y
      hyper k y = k `seq` y
  
  ----
  
  instance PPrint PartialKind where
      pPrint _ _ PKNoInfo = text "?"
      pPrint _ _ PKStar = text "*"
      pPrint _ _ PKNum = text "#"
      pPrint _ _ PKStr = text "$"
      pPrint d p (PKfun l r) =
          pparen (p>9) $ pPrint d 10 l <+> text "->" <+> pPrint d 9 r
  
  instance Hyper PartialKind where
      hyper (PKfun k1 k2) y = hyper2 k1 k2 y
      hyper k y = k `seq` y
  
  ----
  
  instance PPrint TISort where
      pPrint d p (TItype n t) = pparen (p>0) $ text "TItype" <+> pPrint d 0 n <+> pPrint d 1 t
      pPrint d p (TIdata is enum) = pparen (p>0) $ text (if enum then "TIdata (enum)" else "TIdata") <+> pPrint d 1 is
      pPrint d p (TIstruct ss is) = pparen (p>0) $ text "TIstruct" <+> pPrint d 1 ss <+> pPrint d 1 is
      pPrint d p (TIabstract) = text "TIabstract"
  
  instance Hyper TISort where
      hyper (TItype i t) y = hyper2 i t y
      hyper (TIdata is enum) y = hyper2 is enum y
      hyper (TIstruct ss is) y = hyper2 ss is y
      hyper (TIabstract) y = y
  
  instance PPrint StructSubType where
      pPrint _ _ ss = text (show ss)
  
  instance Hyper StructSubType where
      hyper (SDataCon i nm) y = hyper2 i nm y
      hyper x y = x `seq` y
  
  -- Force evaluation of a Ctype
  seqCType :: CType -> CType
  seqCType t@(TVar v) = seq v t
  seqCType t@(TCon c) = t
  seqCType t@(TAp t1 t2) = seq (seqCType t1) (seq (seqCType t2) t)
  seqCType t@(TGen _ _) = t
  seqCType t@(TDefMonad _) = t
  
  ----
  setTypePosition :: Position -> Type -> Type
  setTypePosition pos (TVar (TyVar id n k)) = (TVar (TyVar (setIdPosition pos id) n k))
  setTypePosition pos (TCon (TyCon id k s)) = (TCon (TyCon (setIdPosition pos id) k s))
  setTypePosition pos (TCon (TyNum n _)) = (TCon (TyNum n pos))
  setTypePosition pos (TCon (TyStr s _)) = (TCon (TyStr s pos))
  setTypePosition pos (TAp f a) = (TAp (setTypePosition pos f) (setTypePosition pos a))
  setTypePosition pos (TGen _ n)    = (TGen pos n)
  setTypePosition pos (TDefMonad _) = (TDefMonad pos)
  