{-  CAO Compiler
    Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. -}

{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}

{- 
Module      :  $Header$
Description :  Syntax manipulation utils.
Copyright   :  (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License     :  GPL

Maintainer  :  Paulo Silva <paufil@di.uminho.pt>
Stability   :  experimental
Portability :  non-portable (<reason>)

General functions for AST manipulation or query are provided.
-}

module Language.CAO.Syntax.Utils
    (-- * Variable manipulation
      FV ( fvs   )
    , BV ( bvs   )
    , RN ( (<|>) )
    , Renamable(..)
    , Subst ( subst )
    , IsVar

    , lvname
    , lvalNames
    , globals
    , getVars
    , getLVars
    , getRVars
    , sameKind

    -- * Sequences
    , isAscSeq

    -- * AST Queries
    , isSimpleLVal
    , isAssignStmt
    , isLit
    , isIntLit
    , isSimpleVDecl
    , isReturn
    , defVar
    , getDeclVar
    , isRange
    , isEqNeq

    , type2TyDecl
    , Typeable(typeOf)
    
  ) where

import Data.IntMap ( IntMap )
import qualified Data.IntMap as IntMap

import Data.List ( foldl' )

import Data.Map ( Map )
import qualified Data.Map as Map

import Data.Set ( Set )
import qualified Data.Set as Set

import Language.CAO.Common.Literal
import Language.CAO.Common.Outputable
import Language.CAO.Common.Polynomial
import Language.CAO.Common.SrcLoc
import Language.CAO.Common.Utils ( mapSnd )
import Language.CAO.Common.Var

import Language.CAO.Index
import Language.CAO.Index.Utils

import Language.CAO.Syntax

import Language.CAO.Type
import Language.CAO.Type.Utils

type family VarOf f :: *
type instance VarOf Name        = Name
type instance VarOf Var         = Var

type instance VarOf (Maybe a)   = VarOf a
type instance VarOf [a]         = VarOf a
type instance VarOf (Located a) = VarOf a
type instance VarOf (Either a a) = VarOf a

type instance VarOf (Prog a)    = a
type instance VarOf (Def a)     = a
type instance VarOf (VarDecl a) = a
type instance VarOf (ConstAnn a) = a
type instance VarOf (ConstDecl a) = a
type instance VarOf (Fun a)     = a
type instance VarOf (TyDef a)   = a
type instance VarOf (TyDecl a)  = a
type instance VarOf (Expr a)    = a
type instance VarOf (TExpr a)    = a
type instance VarOf (BinOp a)   = a
type instance VarOf (Stmt a)    = a
type instance VarOf (Arg a)     = a
type instance VarOf (Mod a)     = a
type instance VarOf (Pol a)     = a
type instance VarOf (Mon a)     = a
type instance VarOf (MCoef a)   = a
type instance VarOf (MBase a)   = a
type instance VarOf (APat a)    = a
type instance VarOf (RowAPat a) = a
type instance VarOf (Literal a) = a
type instance VarOf (LVal a)    = a

type instance VarOf (Type a)    = a
type instance VarOf (Class a)   = a

type instance VarOf (ICond a)   = a
type instance VarOf (IExpr a)   = a

type family SubstOf f :: *
type instance SubstOf Name        = Name
type instance SubstOf Var         = Var

type instance SubstOf (Maybe a)   = SubstOf a
type instance SubstOf [a]         = SubstOf a
type instance SubstOf (Located a) = SubstOf a

type instance SubstOf (Prog a)    = Expr a
type instance SubstOf (Def a)     = Expr a
type instance SubstOf (VarDecl a) = Expr a
type instance SubstOf (ConstDecl a) = Expr a
type instance SubstOf (Fun a)     = Expr a
type instance SubstOf (TyDef a)   = Expr a
type instance SubstOf (TyDecl a)  = Expr a
type instance SubstOf (Expr a)    = Expr a
type instance SubstOf (TExpr a)    = Expr a
type instance SubstOf (BinOp a)   = Expr a
type instance SubstOf (Stmt a)    = Expr a
type instance SubstOf (Arg a)     = Expr a
type instance SubstOf (Mod a)     = Expr a
type instance SubstOf (Pol a)     = IExpr a
type instance SubstOf (Mon a)     = IExpr a
type instance SubstOf (MCoef a)   = IExpr a
type instance SubstOf (MBase a)   = Expr a
type instance SubstOf (APat a)    = Expr a
type instance SubstOf (RowAPat a) = Expr a
type instance SubstOf (Literal a) = Expr a
type instance SubstOf (LVal a)    = Expr a

type instance SubstOf (Type a)    = IExpr a
type instance SubstOf (Class a)   = Expr a

type instance SubstOf (ICond a)   = IExpr a
type instance SubstOf (IExpr a)   = IExpr a

class (FV id, BV id, Ord id, PP id, RN id) => IsVar id where
instance IsVar Name where
instance IsVar Var  where

--------------------------------------------------------------------------------
-- Free variables
--------------------------------------------------------------------------------
-- | Free variables
class FV f where
    fvs :: (Ord b, VarOf f ~ b) => f -> Set b

    fvsLst :: (Ord b, VarOf f ~ b) => [f] -> Set b
    fvsLst = Set.unions . map fvs

instance FV a => FV (Maybe a) where
    fvs Nothing  = Set.empty
    fvs (Just a) = fvs a

instance FV a => FV (Located a) where
    fvs (L _ a) = fvs a

instance FV a => FV [a] where
    fvs = fvsLst

instance (FV a, a ~ b) => FV (Either a b) where
    fvs (Left l)  = fvs l
    fvs (Right r) = fvs r

instance FV Name where
    fvs = Set.singleton

instance FV Var where
    fvs = Set.singleton

instance (IsVar a, a ~ VarOf a) => FV (Def a) where
    fvs (VarDef   vd) = fvs vd
    fvs (FunDef   fd) = fvs fd
    fvs (TyDef    td) = fvs td
    fvs (ConstDef cd) = fvs cd

instance (IsVar a, a ~ VarOf a) => FV (VarDecl a) where
    fvs (VarD v td me)   = (fvs td `Set.union` fvs me) Set.\\ fvs v
    fvs (MultiD vs td)   = fvs td Set.\\ fvs vs
    fvs (ContD v td  es) = (fvs td `Set.union` fvs es) Set.\\ fvs v

instance (IsVar a, a ~ VarOf a) => FV (ConstAnn a) where
    fvs None          = Set.empty
    fvs (ConstInit e) = fvs e
    fvs (ConstCond c) = fvs c

instance (IsVar a, a ~ VarOf a) => FV (ConstDecl a) where
    fvs (ConstD v td i)       = (fvs td `Set.union` fvs i) Set.\\ fvs v
    fvs (MultiConstD vs td c) = (fvs td `Set.union` fvs c) Set.\\ fvs vs

instance (IsVar a, a ~ VarOf a) => FV (Fun a) where
    fvs (Fun v args rt body) = (fvs body `Set.union` fvs rt)
                                  Set.\\ (fvs v `Set.union` fvs args)

instance (IsVar a, a ~ VarOf a) => FV (Arg a) where
    fvs (Arg a _)        = fvs a
    fvs (ArgConst a _ _) = fvs a

instance (IsVar a, a ~ VarOf a) => FV (TyDef a) where
    fvs (TySynDef v td)
      = fvs td Set.\\ fvs v
    fvs (StructDecl v flds)
      = Set.unions (map (fvs . snd) flds)
          Set.\\ Set.unions (fvs v: map (fvs . fst) flds)

instance (IsVar a, a ~ VarOf a) => FV (TyDecl a) where
    fvs IntD                = Set.empty
    fvs RIntD               = Set.empty
    fvs BoolD               = Set.empty
    fvs (BitsD _ e)         = fvs e
    fvs (ModD m)            = fvs m
    fvs (VectorD e td)      = fvs e  `Set.union` fvs td
    fvs (MatrixD e1 e2 td)  = fvs e1 `Set.union` fvs e2 `Set.union` fvs td
    fvs (TySynD v)          = fvs v

instance (IsVar a, a ~ VarOf a) => FV (Mod a) where
    fvs (ModNum e)         = fvs e
    fvs (ModPol td ti pol) = (fvs td `Set.union` fvs pol) Set.\\ fvs ti

instance (IsVar a, a ~ VarOf a) => FV (TExpr a) where
    fvs (TyE _ e) = fvs e

instance (IsVar a, a ~ VarOf a) => FV (Expr a) where
    fvs (Var v)              = fvs v
    fvs (Lit l)            = fvs l
    fvs (FunCall v args)     = fvs v  `Set.union` fvs args
    fvs (StructProj e fi)    = fvs e  `Set.union` fvs fi
    fvs (UnaryOp _ e)        = fvs e
    fvs (BinaryOp _ e1 e2)   = fvs e1 `Set.union` fvs e2
    fvs (Access e1 pat)    = fvs e1 `Set.union` fvs pat
    fvs (Cast _ td e)      = fvs td `Set.union` fvs e

instance (IsVar a, a ~ VarOf a) => FV (BinOp a) where
    fvs _ = Set.empty

instance (IsVar a, a ~ VarOf a) => FV (Literal a) where
    fvs (PLit p) = fvs p
    fvs _        = Set.empty

instance (IsVar a, a ~ VarOf a) => FV (APat a) where
    fvs (VectP rp)   = fvs rp
    fvs (MatP rp cp) = fvs rp `Set.union` fvs cp

instance (IsVar a, a ~ VarOf a) => FV (RowAPat a) where
    fvs (CElem e)      = fvs e
    fvs (CRange e1 e2) = fvs e1 `Set.union` fvs e2

instance (IsVar a, a ~ VarOf a) => FV (Stmt a) where
    fvs (VDecl  vd)                  = fvs vd
    fvs (CDecl  cd)                  = fvs cd
    fvs (Assign lvs es)              = fvs lvs `Set.union` fvs es
    fvs (FCallS n   es)              = fvs n `Set.union` fvs es
    fvs (Ret e)                      = fvs e
    fvs (Ite i t e)                  = fvs i `Set.union` fvs t `Set.union` fvs e
    fvs (Seq (SeqIter v s e b _) ss) = 
        (fvs s `Set.union` fvs e `Set.union` fvs b `Set.union` fvs ss) 
        Set.\\ fvs v
    fvs (While e ss)                 = fvs e `Set.union` fvs ss
    fvs (Nop _)                      = Set.empty

    fvsLst []              = Set.empty
    fvsLst (VDecl vd:ss)   = fvs ss Set.\\ fvs vd
    fvsLst (s:ss)          = fvs s `Set.union` fvs ss

instance (IsVar a, a ~ VarOf a) => FV (LVal a) where
    fvs (LVVar v)        = fvs v
    fvs (LVStruct lv fi) = fvs lv `Set.union` fvs fi
    fvs (LVCont _ lv p)  = fvs lv `Set.union` fvs p

instance (IsVar a, a ~ VarOf a) => FV (Pol a) where
    fvs (Pol ms) = fvs ms

instance (IsVar a, a ~ VarOf a) => FV (Mon a) where
    fvs (Mon c b) = fvs c `Set.union` fvs b

instance (IsVar a, a ~ VarOf a) => FV (MCoef a) where
    fvs (CoefI _) = Set.empty
    fvs (CoefP p) = fvs p

instance (IsVar a, a ~ VarOf a) => FV (MBase a) where
    fvs EZero       = Set.empty
    fvs (MExpI n _) = fvs n

instance (IsVar a, a ~ VarOf a) => FV (Type a) where
    fvs Int              = Set.empty
    fvs RInt             = Set.empty
    fvs Bool             = Set.empty
    fvs Bullet           = Set.empty
    fvs (Bits _ e)       = fvs e
    fvs (Indet t)        = fvs t
    fvs (Tuple ts)       = fvs ts
    fvs (Vector e t)     = fvs e `Set.union` fvs t
    fvs (TySyn v t)      = fvs v `Set.union` fvs t
    fvs (SField v t)     = fvs v `Set.union` fvs t
    fvs (Mod mty e p)    = Set.unions [fvs mty, fvs e, fvs p]
    fvs (Matrix e1 e2 t) = Set.unions [fvs e1, fvs e2, fvs t]
    fvs (FuncSig ts t c) = Set.unions [fvs ts, fvs t, fvs c]
    fvs (Struct v fs)    = Set.unions [fvs v, fvs (map fst fs), 
                                              fvs (map snd fs)]
    fvs (Index v mc t)   = Set.unions [fvs v, fvs mc, fvs t]
    fvs (TyVar _)        = Set.empty
    fvs (IntVar _)       = Set.empty
    fvs (ModVar _)       = Set.empty

instance (IsVar a, a ~ VarOf a) => FV (IExpr a) where
    fvs (IInt _)         = Set.empty
    fvs (IInd v)         = Set.singleton v
    fvs (ISum es)        = fvs es
    fvs (IArith _ e1 e2) = fvs e1 `Set.union` fvs e2
    fvs (ISym e)         = fvs e

instance (IsVar a, a ~ VarOf a) => FV (ICond a) where
    fvs (IBool _)         = Set.empty
    fvs (IBInd v)         = Set.singleton v
    fvs (INot  c)         = fvs c
    fvs (IAnd cs)         = fvs cs
    fvs (IBoolOp _ e1 e2) = fvs e1 `Set.union` fvs e2
    fvs (ILeq e)          = fvs e
    fvs (IEq  e)          = fvs e

instance (IsVar a, a ~ VarOf a) => FV (Class a) where
    fvs _ = Set.empty


--------------------------------------------------------------------------------
-- Bound variables (defs, args, etc ...)
--  * The bound variables of fun/proc definition are it's local variables
--------------------------------------------------------------------------------

-- | Bound variables (defs, args, etc ...)
--   The bound variables of function/procedure definition are its local variables.
class BV f where
    bvs :: (Ord b, VarOf f ~ b) => f -> Set b

instance BV a => BV (Maybe a) where
    bvs Nothing  = Set.empty
    bvs (Just a) = bvs a

instance BV a => BV (Located a) where
    bvs (L _ a) = bvs a

instance BV a => BV [a] where
    bvs = Set.unions . map bvs

globals :: Prog Var -> Set Var
globals = Set.filter isGlobal . bvs

instance (IsVar a, a ~ VarOf a) => BV (Prog a) where
    bvs (Prog defs ip) = bvs defs `Set.union` maybe Set.empty bvs ip

instance (IsVar a, a ~ VarOf a) => BV (Def a) where
    bvs (VarDef   vd) = bvs vd
    bvs (FunDef   fd) = bvs fd
    bvs (TyDef    td) = bvs td
    bvs (ConstDef cd) = bvs cd

instance (IsVar a, a ~ VarOf a) => BV (VarDecl a) where
    bvs (VarD v _ _)  = fvs v
    bvs (MultiD vs _) = fvs vs
    bvs (ContD v _ _) = fvs v

instance (IsVar a, a ~ VarOf a) => BV (ConstDecl a) where
    bvs (ConstD v _ _)       = fvs v
    bvs (MultiConstD vs _ _) = fvs vs

instance (IsVar a, a ~ VarOf a) => BV (Fun a) where
    bvs (Fun v args _ body) = bvs body `Set.union` fvs v `Set.union` fvs args

instance (IsVar a, a ~ VarOf a) => BV (TyDef a) where
    bvs (TySynDef v _)
      = fvs v
    bvs (StructDecl v flds)
      = Set.unions $ fvs v : map (fvs . fst) flds

instance (IsVar a, a ~ VarOf a) => BV (Mod a) where
    bvs (ModNum _)      = Set.empty
    bvs (ModPol _ ti _) = fvs ti

instance (IsVar a, a ~ VarOf a) => BV (Stmt a) where
    bvs (VDecl  vd)                  = bvs vd
    bvs (CDecl  cd)                  = bvs cd
    bvs (Ite _ t e)                  = bvs t `Set.union` bvs e
    bvs (Seq (SeqIter v _ _ _ _) ss) = fvs v `Set.union` bvs ss
    bvs (While _ ss)                 = bvs ss
    bvs _                            = Set.empty

instance BV Name where
    bvs _ = Set.empty
instance BV Var where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (Arg a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (TyDecl a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (TExpr a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (Expr a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (BinOp a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (Literal a) where
    bvs _  = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (APat a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (RowAPat a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (LVal a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (Pol a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (Mon a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (MCoef a) where
    bvs _ = Set.empty
instance (IsVar a, a ~ VarOf a) => BV (MBase a) where
    bvs _ = Set.empty

--------------------------------------------------------------------------------
-- Variable substitution
--------------------------------------------------------------------------------

infixl 7 ~>
infixl 6 +>
infixl 5 \\
infixl 4 .$.

infixr 4 <|>

-- | Variable substitution
class (IsVar v1, IsVar v2) => Renamable v1 v2 where
    -- | Remaning environment
    data SEnv v1 v2 :: *

    -- | Capture predicate
    captures :: SEnv v1 v2 -> Set v1 -> Set v1 -> Bool
    -- | Empty renaming environment
    emptyRN  :: SEnv v1 v2
    -- | Singleton environment where substitution @v1 -> v2@ is stored
    (~>)     :: v1 -> v2 -> SEnv v1 v2
    -- | Returns the variable that should replace @v1@ from the remaing
    --    environment
    (.$.)    :: SEnv v1 v2 -> v1 -> v2
    -- | (Left-biased) Union of two renaming environments
    (+>)     :: SEnv v1 v2 -> SEnv v1 v2 -> SEnv v1 v2
    -- | Removes a set of variables from the domain of the renaming
    --    environment
    (\\)     :: SEnv v1 v2 -> Set v1 -> SEnv v1 v2

instance Renamable Name Name where
    data SEnv Name Name = NN (Map Name Name)

    captures (NN s) bs
      = Set.fold goC False
      where goC _ True
              = True
            goC f False
              | Just fv <-  Map.lookup f s = fv `Set.member` bs
              | otherwise                  = False
    emptyRN = NN Map.empty
    v1    ~> v2    = NN $ Map.insert v1 v2 Map.empty
    NN s2 +> NN s1 = NN $ Map.union s1 s2
    NN s  \\ v     = NN $ Set.fold Map.delete s v
    NN s  .$.     v
        | Just v' <- Map.lookup v s = v'
        | otherwise                 = v

instance Renamable Var Var where
    data SEnv Var Var = VV (IntMap Var)
  
    captures (VV s) bs
      = Set.fold goC False
      where goC _ True
              = True
            goC f False
              | Just fv <-  IntMap.lookup (varId f) s
                = fv `Set.member` bs
              | otherwise
                = False
    emptyRN = VV IntMap.empty
    v1    ~> v2    = VV $ IntMap.insert (varId v1) v2 IntMap.empty
    VV s2 +> VV s1 = VV $ IntMap.union s1 s2
    VV s  \\ v     = VV $ Set.fold (\a b -> IntMap.delete (varId a) b) s v
    f@(VV s)  .$.     v
      | Just v' <- IntMap.lookup (varId v) s = setType (varType v' <|> f) v'
      | otherwise                            = v

-- In substitutions from Name to Var, all variables MUST be in the renaming
-- environment
instance Renamable Name Var where
    data SEnv Name Var = NV (Map Name Var)
 
    captures (NV s) bs
      = Set.fold goC False
      where goC _ True
              = True
            goC f False
              | Just fv <-  Map.lookup f s = varName fv `Set.member` bs
              | otherwise                  = False
    emptyRN = NV Map.empty
    v1    ~> v2    = NV $ Map.insert v1 v2 Map.empty
    NV s2 +> NV s1 = NV $ Map.union s1 s2
    NV s  \\ v     = NV $ Set.fold Map.delete s v
    NV s  .$.     v
      | Just v' <- Map.lookup v s = v'
      | otherwise                 = error $ "<Language.CAO.Syntax.Utils>.\
          \<rename>: Not in scope" ++ showPprDebug v

--------------------------------------------------------------------------------
-- Types where substitution is defined


type family RNTy t v :: *
type instance RNTy Name t = t
type instance RNTy Var t  = t

type instance RNTy [a] b         = [RNTy a b]
type instance RNTy (Maybe a) b   = Maybe (RNTy a b)
type instance RNTy (Located a) b = Located (RNTy a b)

type instance RNTy (Prog a) b    = Prog (RNTy a b)
type instance RNTy (Def a) b     = Def (RNTy a b)
type instance RNTy (Fun a) b     = Fun (RNTy a b)
type instance RNTy (TyDef a) b   = TyDef (RNTy a b)
type instance RNTy (VarDecl a) b = VarDecl (RNTy a b)
type instance RNTy (LVal a) b    = LVal (RNTy a b)
type instance RNTy (Stmt a) b    = Stmt (RNTy a b)
type instance RNTy (Arg a) b     = Arg (RNTy a b)
type instance RNTy (Literal a) b = Literal (RNTy a b)
type instance RNTy (Class a) b   = Class (RNTy a b)
type instance RNTy (Type a) b    = Type (RNTy a b)
type instance RNTy (Mod a) b     = Mod (RNTy a b)
type instance RNTy (TyDecl a) b  = TyDecl (RNTy a b)
type instance RNTy (APat a) b    = APat (RNTy a b)
type instance RNTy (RowAPat a) b = RowAPat (RNTy a b)
type instance RNTy (Expr a) b    = Expr (RNTy a b)
type instance RNTy (TExpr a) b   = TExpr (RNTy a b)
type instance RNTy (BinOp a) b   = BinOp (RNTy a b)
type instance RNTy (Pol a) b     = Pol (RNTy a b)
type instance RNTy (Mon a) b     = Mon (RNTy a b)
type instance RNTy (MCoef a) b   = MCoef (RNTy a b)
type instance RNTy (MBase a) b   = MBase (RNTy a b)

type instance RNTy (ICond a) b   = ICond (RNTy a b)
type instance RNTy (IExpr a) b   = IExpr (RNTy a b)

-- INVARIANT: Variable capture MUST NOT happen.
-- | Renamables for variables types
class RN t where
    (<|>) :: (Renamable v0 v, VarOf t ~ v0, VarOf v0 ~ v0)
          => t -> SEnv v0 v -> RNTy t v

    substLst :: (Renamable v0 v, VarOf t ~ v0, VarOf v0 ~ v0)
             => [t] -> SEnv v0 v -> [RNTy t v]
    substLst lst f = map (<|> f) lst

-- Renamables for variable types
instance RN Name where
    n <|> s = s .$. n

instance RN Var where
    n <|> s = s .$. n

rnTuple :: (Renamable v0 c, 
            RN a, RN b, 
            VarOf a ~ v0, VarOf b ~ v0, VarOf v0 ~ v0)
        => (a, b) -> SEnv v0 c -> (RNTy a c, RNTy b c)
rnTuple (a,b) f = (a <|> f, b <|> f)

-- Renamables for containers
instance RN a => RN [a] where
    lst <|> f = substLst lst f

instance RN a => RN (Maybe a) where
    Nothing  <|> _ = Nothing
    (Just v) <|> f = Just $ v <|> f

instance RN a => RN (Located a) where
    (L l v) <|> f = L l $ v <|> f

-- Substitution of top-level variables:
--    > Substitute all variables except local vars bound
--    > by local variables.
--
--    Example: 
--    def v0 : ...
--    
--    def f ( ... v0 ...) { ... v0 ... }
--    def g ( ... ) { ... v0 ... }
--
--    subst v0 ~> v1
--
--    def v1 : ...
--    
--    def f ( ... v0 ...) { ... v0 ... }
--    def g ( ... ) { ... v1 ... }
-- 
instance RN a => RN (Prog a) where
    Prog defs ip <|> f = Prog (defs <|> f) (ip <|> f)

instance RN a => RN (Def a) where
    VarDef vd <|> f  = VarDef $ vd <|> f
    FunDef vd <|> f  = FunDef $ vd <|> f
    TyDef  vd <|> f  = TyDef  $ vd <|> f
    _ <|> _ = error "<Language.CAO.Syntax.Utils>.\
        \<instance RN [Def a]>: Not defined!"

    substLst [] _ = []
    substLst (d:ds) f
      | captures f (bvs d) (fvs ds)
        = error "<Language.CAO.Syntax.Utils>.\
            \<instance RN [Def a]>: Variable capture!"
      | otherwise 
        = (d <|> f) : substLst ds f

instance RN a => RN (Fun a) where
    Fun n args rt stmts <|> f
      | captures f bs fs
        = error "<Language.CAO.Syntax.Utils>.\
            \<instance RN (Fun a)>: Variable capture!"
      | otherwise
        = Fun n' args' rt' stmts'
      where n'     = n     <|> f'
            args'  = args  <|> f'
            rt'    = rt    <|> f'
            stmts' = stmts <|> f'
            f'     = f \\ bs
            fs     = fvs args `Set.union` fvs stmts
            bs     = fvs n `Set.union` fvs args

instance RN a => RN (TyDef a) where
    TySynDef   n td   <|> f
      = TySynDef (n <|> f') (td <|> f')
      where f' = f \\ fvs n
    StructDecl n flds <|> f
      = StructDecl (n <|> f') (map (`rnTuple` f') flds)
      where f' = f \\ fvs n `Set.union` fvs (map fst flds)

instance RN a => RN (VarDecl a) where
    VarD   n  td i  <|> f = VarD   (n  <|> f') (td <|> f') (i  <|> f')
                          where f' = f \\ fvs n
    MultiD ns td    <|> f = MultiD (ns <|> f') (td <|> f')
                          where f' = f \\ fvs ns
    ContD  n  td is <|> f = ContD  (n  <|> f') (td <|> f') (is <|> f')
                          where f' = f \\ fvs n

instance RN a => RN (LVal a) where
    LVVar v         <|> f = LVVar $ v <|> f
    LVStruct lv fi  <|> f = LVStruct (lv <|> f) (fi  <|> f)
    LVCont t lv pat <|> f = LVCont (t <|> f) (lv <|> f) (pat <|> f)

instance RN a => RN (Stmt a) where
    VDecl  vd                 <|> f =
        VDecl (vd <|> f)
    Assign lvs es             <|> f =
        Assign (lvs <|> f) (es <|> f)
    FCallS n   es             <|> f =
        FCallS (n <|> f) (es <|> f)
    Ret e                     <|> f =
        Ret (e <|> f)
    Ite i t e                 <|> f =
        Ite (i <|> f) (t <|> f) (e <|> f)
    Seq (SeqIter v s e b r) ss  <|> f
        | captures f (fvs v) freevs
          = error "<Language.CAO.Syntax.Utils>.<instance RN Stmt>:\
              \ variable capture!"
        | otherwise
          = Seq ( SeqIter (v <|> f')
                          (s <|> f')
                          (e <|> f')
                          (b <|> f')
                          r )
                ( ss <|> f' )
      where freevs =           fvs s
                   `Set.union` fvs e
                   `Set.union` fvs b
                   `Set.union` fvs ss
            f' = f \\ fvs v
    While e ss                <|> f =
        While (e <|> f) (ss <|> f)
    Nop a <|> _ = Nop a
    _ <|> _ = error "<Language.CAO.Syntax.Utils>.\
        \<instance RN [Stmt a]>: Not defined!"

    substLst [] _
      = []
    substLst (s:ss) f
      | captures f (bvs s) (fvs ss)
        = error "<Language.CAO.Syntax.Utils>.\
            \<instance RN [Stmt a]>: Variable capture!"
      | otherwise 
        = (s <|> f) : substLst ss f

instance RN a => RN (Arg a) where
    Arg n td <|> f = Arg (n <|> f) (td <|> f)
    _ <|> _ = error "<Language.CAO.Syntax.Utils>.\
        \<instance RN [Arg a]>: Not defined!"

    substLst []     _ = []
    substLst (a:as) f
      | captures f (fvs a) (fvs as)
        = error "<Language.CAO.Syntax.Utils>.\
            \<instance RN [Arg a]>: Variable capture!"
      | otherwise
        = (a <|> f) : substLst as f

instance RN a => RN (Literal a) where
    ILit  p   <|> _ = ILit p
    BLit  p   <|> _ = BLit p
    BSLit s p <|> _ = BSLit s p
    PLit  p   <|> f = PLit $ p <|> f

instance RN a => RN (Class a) where
    Pure     <|> _ = Pure
    RO       <|> _ = RO
    Proc lst <|> f = Proc $ lst <|> f

instance RN a => RN (Type a) where
    Index v c t        <|> f = Index (v <|> f) (c <|> f) (t <|> f)
    Mod    ty ti p     <|> f = Mod (ty <|> f) (ti <|> f) (p <|> f)
    Vector i  ty       <|> f = Vector (i <|> f)   (ty <|> f)
    Matrix i  j  ty    <|> f = Matrix (i <|> f) (j <|> f) (ty <|> f)
    TySyn n ty         <|> f = TySyn (n <|> f) (ty <|> f)
    FuncSig args rt c  <|> f = FuncSig (args <|> f) (rt <|> f) (c <|> f)
    Struct n flds      <|> f = Struct (n <|> f) (map (`rnTuple` f) flds)
    SField n ty        <|> f = SField (n <|> f) (ty <|> f)
    Indet ty           <|> f = Indet  (ty <|> f)
    Tuple tys          <|> f = Tuple  (tys <|> f)
    Bits s n           <|> f = Bits s (n <|> f)
    Int                <|> _ = Int
    RInt               <|> _ = RInt
    Bool               <|> _ = Bool
    Bullet             <|> _ = Bullet

    -- These should not be needed in the end

    TyVar n <|> _ = TyVar n
    IntVar n <|> _ = IntVar n
    ModVar n <|> _ = ModVar n

instance RN a => RN (Mod a) where
    ModNum e         <|> f = ModNum $ e <|> f
    ModPol td ti pol <|> f = ModPol (td <|> f) (ti <|> f) (pol <|> f)

instance RN a => RN (TyDecl a) where
    IntD             <|> _ = IntD 
    RIntD            <|> _ = RIntD 
    BoolD            <|> _ = BoolD
    BitsD s e        <|> f = BitsD s $ e <|> f
    ModD m           <|> f = ModD $ m <|> f
    VectorD e td     <|> f = VectorD (e <|> f) (td <|> f)
    MatrixD e1 e2 td <|> f = MatrixD (e1 <|> f) (e2 <|> f) (td <|> f)
    TySynD v         <|> f = TySynD (v <|> f)

instance RN a => RN (APat a) where
    VectP rp    <|> f = VectP $ rp <|> f
    MatP  rp cp <|> f = MatP   (rp <|> f) (cp <|> f)

instance RN a => RN (RowAPat a) where
    CElem e      <|> f = CElem $ e <|> f
    CRange e1 e2 <|> f = CRange (e1 <|> f) (e2 <|> f)

instance RN a => RN (TExpr a) where
    TyE ty e <|> f = TyE (ty <|> f) (e <|> f)

instance RN a => RN (Expr a) where
    Var           v    <|> f = Var $ v <|> f
    Lit        l    <|> f = Lit (l <|> f)
    FunCall    n  args <|> f = FunCall (n <|> f) (args <|> f)
    StructProj e  fi   <|> f = StructProj (e <|> f) (fi <|> f)
    UnaryOp op e       <|> f = UnaryOp op $ e <|> f
    BinaryOp op e1 e2  <|> f = BinaryOp  (op <|> f) (e1 <|> f) (e2 <|> f) 
    Access td pat   <|> f = Access (td <|> f) (pat <|> f)
    Cast b td e     <|> f = Cast b (td <|> f) (e <|> f)

instance RN a => RN (BinOp a) where
    ArithOp op <|> _ = ArithOp op
    BoolOp op <|> _ = BoolOp op
    BitOp op <|> _ = BitOp op
    BitsSROp op <|> _ = BitsSROp op
    CmpOp ty op <|> f = CmpOp (ty <|> f) op
    Concat <|>_ = Concat

-- Renaming for polynomials
instance RN a => RN (Pol a) where
    Pol ms <|> f = Pol $ ms <|> f

instance RN a => RN (Mon a) where
    Mon c e <|> f  = Mon (c <|> f) (e <|> f)

instance RN a => RN (MCoef a) where
    CoefP p <|> f = CoefP $ p <|> f
    CoefI i <|> f = CoefI $ i <|> f

instance RN a => RN (MBase a) where
    EZero       <|> _ = EZero
    MExpI n e <|> f = MExpI (n <|> f) e

-- TODO: Capture avoiding!!
instance RN a => RN (ICond a) where
    IBool b <|> _          = IBool b
    IBInd v <|> f          = IBInd $ v  <|> f
    INot  e <|> f          = INot  $ e  <|> f
    IAnd le <|> f          = IAnd  $ le <|> f
    ILeq  e <|> f          = ILeq  $ e  <|> f
    IEq   e <|> f          = IEq   $ e  <|> f
    IBoolOp op e1 e2 <|> f = IBoolOp op (e1 <|> f) (e2 <|> f)

instance RN a => RN (IExpr a) where
    IInt n  <|> _         = IInt n
    IInd v  <|> f         = IInd $ v  <|> f
    ISum le <|> f         = ISum $ le <|> f
    ISym e  <|> f         = ISym $ e  <|> f
    IArith op e1 e2 <|> f = IArith op (e1 <|> f) (e2 <|> f)

-- | Substitutions
class Subst f where
    -- | Substitution of variable @v0@ by @v1@.
    subst :: (VarOf f ~ v0, SubstOf f ~ v1) => (v0, v1) -> f -> f
    substBlock :: (VarOf f ~ v0, SubstOf f ~ v1) => (v0, v1) -> [f] -> [f]
    substBlock v = map (subst v)

instance Subst a => Subst (Located a) where
    subst f = fmap (subst f)

instance Subst a => Subst (Maybe a) where
    subst f = fmap (subst f)

instance Subst a => Subst [a] where
    subst = substBlock 

instance Eq a => Subst (RowAPat a) where
    subst f (CElem  e)     = CElem $ subst f e
    subst f (CRange e1 e2) = CRange (subst f e1) (subst f e2)

instance Eq a => Subst (APat a) where
    subst f (VectP  e)   = VectP $ subst f e
    subst f (MatP e1 e2) = MatP (subst f e1) (subst f e2)

instance Eq a => Subst (TExpr a) where
    subst f (TyE ty e) = TyE ty (subst f e)

instance Eq a => Subst (Expr a) where
    subst (v0, e) v@(Var v1)
        | v1 == v0   = e
        | otherwise  = v
    subst _ l@(Lit _) = l
    subst f (FunCall n es)      = FunCall n $ map (subst f) es
    subst f (StructProj e n)    = StructProj (subst f e) n
    subst f (UnaryOp op e)      = UnaryOp op (subst f e)
    subst f (BinaryOp op e1 e2) = BinaryOp op (subst f e1) (subst f e2)
    subst f (Access e p)     = Access (subst f e) (subst f p)
    subst f (Cast b td e)    = Cast b (subst f td) (subst f e)

instance Eq a => Subst (BinOp a) where
    subst _ c = c

instance Eq a => Subst (TyDecl a) where
    subst f (BitsD s e)      = BitsD s $ subst f e
    subst f (ModD m)         = ModD $ subst f m
    subst f (VectorD e td)   = VectorD (subst f e) (subst f td)
    subst f (MatrixD r c td) = MatrixD (subst f r) (subst f c) (subst f td)
    subst _ d                = d

instance Eq a => Subst (Mod a) where
    subst f (ModNum e)        = ModNum $ subst f e
    subst f (ModPol td n pol) = ModPol (subst f td) n pol

instance Eq a => Subst (Stmt a) where
    subst f (VDecl vd)      = VDecl (subst f vd)
    subst f (Assign lvs es) = Assign (map (subst f) lvs) (map (subst f) es)
    subst f (FCallS n es)   = FCallS n $ map (subst f) es
    subst f (Ret es)        = Ret $ map (subst f) es
    subst f (Ite i t e)     = Ite (subst f i) (subst f t) (subst f e)
    subst f@(v0,_) sq@(Seq (SeqIter v1 s e b r) ss)
        | v0 == v1  = sq
        | otherwise = Seq (SeqIter v1 (subst f s)
                                      (subst f e)
                                      (subst f b)
                                      r ) $ subst f ss
    subst f (While e ss) = While (subst f e) (subst f ss)
    subst _ (Nop a)      = Nop a
    subst _  _ = error "<Language.CAO.Syntax.Utils>.\
        \<instance Subst [Stmt a]>: Not defined!"

    substBlock _ [] = []
    substBlock f@(v0, _) ss@(VDecl vd : rest)
        | v0 `elem` getDeclVar vd = ss
        | otherwise               = VDecl (subst f vd) : substBlock f rest
    substBlock f (s:ss) = subst f s : subst f ss

instance Eq a => Subst (LVal a) where
    subst _ v@(LVVar _)        = v
    subst f (LVStruct lv e)    = LVStruct (subst f lv) e
    subst f (LVCont ty lv pat) = LVCont ty (subst f lv) (subst f pat)

instance Eq a => Subst (VarDecl a) where
    subst f (VarD n td e)   = VarD n (subst f td) (subst f e)
    subst f (MultiD n td)   = MultiD n (subst f td)
    subst f (ContD n td es) = ContD n (subst f td) $ map (subst f) es

instance Eq a => Subst (Pol a) where
    subst f (Pol ps) = Pol (map (subst f) ps)

instance Eq a => Subst (Mon a) where
    subst f (Mon c b) = Mon (subst f c) b

instance Eq a => Subst (MCoef a) where
    subst f (CoefI i) = CoefI $ subst f i
    subst f (CoefP p) = CoefP $ subst f p

instance Eq a => Subst (Type a) where
    subst _ Int               = Int
    subst _ RInt              = RInt
    subst _ Bool              = Bool
    subst f (Bits b i)        = Bits b $ subst f i
    subst f (Mod a b c)       = Mod (subst f a) b (subst f c)
    subst f (Vector n t)      = Vector (subst f n) (subst f t)
    subst f (Matrix n m t)    = Matrix (subst f n) (subst f m) (subst f t)
    subst f (TySyn v t)       = TySyn v (subst f t)
    subst f (FuncSig ta tr c) = FuncSig (map (subst f) ta) (subst f tr) c
    subst f (Struct v t)      = Struct v (map (mapSnd (subst f)) t)
    subst f (SField v t)      = SField v (subst f t)
    subst f (Indet t)         = Indet (subst f t)
    subst f (Tuple t)         = Tuple $ subst f t
    subst _ Bullet            = Bullet
    subst f (Index v c t)     = Index v (subst f c) (subst f t)
    subst _  _ = error "<Language.CAO.Syntax.Utils>.\
        \<instance Subst [Type a]>: Not defined!"

instance Eq a => Subst (ICond a) where
    subst _ v@(IBInd _)        = v
    subst _ l@(IBool _)        = l
    subst f (INot e)           = INot $ subst f e
    subst f (IAnd le)          = IAnd $ map (subst f) le
    subst f (IBoolOp op e1 e2) = IBoolOp op (subst f e1) (subst f e2)
    subst f (ILeq e)           = ILeq $ subst f e
    subst f (IEq e)            = IEq $ subst f e

instance Eq a => Subst (IExpr a) where
    subst (v0, e) v@(IInd v1)
        | v1 == v0   = e
        | otherwise  = v
    subst _ l@(IInt _)        = l
    subst f (ISum le)         = ISum $ map (subst f) le
    subst f (ISym e)          = ISym $ subst f e
    subst f (IArith op e1 e2) = IArith op (subst f e1) (subst f e2)

--------------------------------------------------------------------------------
-- General Utils
--

lvname :: LVal id -> id
lvname (LVVar v)       = unLoc v
lvname (LVStruct lv _) = lvname lv
lvname (LVCont _ lv _) = lvname lv

lvalNames :: Ord id => [LStmt id] -> Set id
lvalNames = foldl' lvalNames' Set.empty
    where 
    lvalNames' vs (unLoc -> Assign lvs _)
        = vs `Set.union` Set.fromList (map lvname lvs)
    lvalNames' vs (unLoc -> Ite _ t e)
        = vs `Set.union` lvalNames t `Set.union` maybe Set.empty lvalNames e
    lvalNames' vs (unLoc -> While _ ss')
        = vs `Set.union` lvalNames ss'
    lvalNames' vs (unLoc -> Seq _ ss')
        = vs `Set.union` lvalNames ss'
    lvalNames' vs _
        = vs

getVars :: LStmt Var -> [Var]
getVars ss = Set.toList $ Set.filter nsVar $ fvs ss

getLVars :: Ord id => LStmt id -> [id]
getLVars ss = Set.toList $ lvalNames [ss]

getRVars :: LStmt Var -> [Var]
getRVars ss = Set.toList $ Set.filter nsVar (fvs ss) Set.\\ lvalNames [ss]

sameKind :: LStmt Var -> LStmt Var -> Bool
(L _ s1) `sameKind` (L _ s2) = s1 `doSK` s2
    where 
    doSK :: Stmt Var -> Stmt Var -> Bool
    doSK (VDecl _)         (VDecl _)
        = True
    doSK (Assign lvs1 es1) (Assign lvs2 es2)
        | length lvs1 == length lvs2 && length es1 == length es2
          = all (uncurry sameKindExpr) $ zip es1 es2
    doSK (FCallS fn1 es1)  (FCallS fn2 es2)
        = fn1 == fn2 && all (uncurry sameKindExpr) (zip es1 es2)
    doSK (Ret es1)         (Ret es2)
        = all (uncurry sameKindExpr) $ zip es1 es2
    doSK (Ite i1 t1 Nothing)   (Ite i2 t2 Nothing)
        = sameKindExpr i1 i2 && all (uncurry sameKind) (zip t1 t2)
    doSK (Ite i1 t1 (Just e1))   (Ite i2 t2 (Just e2))
        =  sameKindExpr i1 i2 && all (uncurry sameKind) (zip t1 t2)
        && all (uncurry sameKind) (zip e1 e2)
    doSK (Seq si1 ss1)     (Seq si2 ss2)
        | seqIdx si1 == seqIdx si2 = all (uncurry sameKind) (zip ss1 ss2)
    doSK (While _ _)    (While _ _)
        = False -- Need to have same number of iterations
    doSK _ _
        = False

-- TODO: Review pattern:  | guard = True. Is there any good reason to use this?
sameKindExpr :: TLExpr Var -> TLExpr Var -> Bool
sameKindExpr (L _ (TyE _ le1)) (L _ (TyE _ le2)) = ske le1 le2
    where 
    ske (Var _)                  (Var _)
        = True
    ske (Lit _)                (Lit _)
        = True
    ske (FunCall (L _ fn1) es1)  (FunCall (L _ fn2) es2)
        | fn1 == fn2 && all (uncurry sameKindExpr) (zip es1 es2)
            = True
    ske (StructProj e1 _  )      (StructProj e2 _  )
        | sameKindExpr e1 e2
            = True

    ske (BinaryOp op1 e11 e12)   (BinaryOp op2 e21 e22)
        | op1 == op2 && sameKindExpr e11 e21 && sameKindExpr e12 e22
            = True

    ske (UnaryOp op1 e1)         (UnaryOp op2 e2)
        = op1 == op2 && sameKindExpr e1 e2

    ske (Access e1 p1)         (Access e2 p2)
        = sameKindExpr e1 e2 && sameKindPat p1 p2
    ske (Cast _ _ e1)          (Cast _ _ e2)
        = sameKindExpr e1 e2
    ske _ _
        = False

sameKindPat :: APat Var -> APat Var -> Bool
sameKindPat (VectP rp1) (VectP rp2)
    = sameKindRP rp1 rp2
sameKindPat (MatP rp1 cp1) (MatP rp2 cp2)
    = sameKindRP rp1 rp2 && sameKindRP cp1 cp2
sameKindPat _ _
    = False

sameKindRP :: RowAPat Var -> RowAPat Var -> Bool
sameKindRP (CElem e1) (CElem e2)
    = sameKindExpr e1 e2
sameKindRP (CRange e11 e12) (CRange e21 e22)
    = sameKindExpr e11 e21 && sameKindExpr e12 e22
sameKindRP _ _
    = False


isAscSeq :: SeqIter id -> Bool
isAscSeq = maybe True aux . seqBy
    where
    aux :: LExpr id -> Bool
    aux (L _ (Lit (ILit n))) = n > 0
    aux _ = error "<isAscSeq>: not expected case"

{-# INLINE isSimpleLVal #-}
isSimpleLVal :: LVal id -> Bool
isSimpleLVal (LVVar _) = True
isSimpleLVal _         = False

{-# INLINE isAssignStmt #-}
isAssignStmt :: Stmt id -> Bool
isAssignStmt (Assign _ _) = True
isAssignStmt _            = False

{-# INLINE isLit #-}
isLit :: Expr id -> Bool
isLit (Lit _) = True
isLit _         = False

{-# INLINE isIntLit #-}
isIntLit :: Expr id -> Bool
isIntLit (Lit (ILit _)) = True
isIntLit _              = False

{-# INLINE isSimpleVDecl #-}
isSimpleVDecl :: Stmt id -> Bool
isSimpleVDecl (VDecl (VarD {})) = True
isSimpleVDecl (VDecl (MultiD {})) = True
isSimpleVDecl _ = False

{-# INLINE isReturn #-}
isReturn :: Stmt a -> Bool
isReturn (Ret _) = True
isReturn _ = False

defVar :: LDef id -> [id]
defVar = defV . unLoc
    where 
    defV (VarDef (VarD n _ _))  = [unLoc n]
    defV (VarDef (MultiD n _))  = map unLoc n
    defV (VarDef (ContD n _ _)) = [unLoc n]
    defV (ConstDef (ConstD n _ _)) = [unLoc n]
    defV (ConstDef (MultiConstD n _ _)) = map unLoc n
    defV (FunDef f)             = [unLoc $ funId f]
    defV (TyDef (TySynDef t _))   = [unLoc t]
    defV (TyDef (StructDecl s _)) = [unLoc s]

getDeclVar :: VarDecl id -> [id]
getDeclVar (VarD n _ _)  = [unLoc n]
getDeclVar (MultiD n _)  = map unLoc n
getDeclVar (ContD n _ _) = [unLoc n]

{-# INLINE isRange #-}
isRange :: APat id -> Bool
isRange (VectP (CRange _ _))  = True
isRange (MatP (CRange _ _) _) = True
isRange (MatP _ (CRange _ _)) = True
isRange _                     = False

{-# INLINE isEqNeq #-}
isEqNeq :: COp -> Bool
isEqNeq bop = case bop of
    Eq -> True
    Neq -> True
    _ -> False

type2TyDecl :: Type Var -> TyDecl Var
type2TyDecl Int = IntD
type2TyDecl RInt = RIntD
type2TyDecl Bool = BoolD
type2TyDecl (Bits s n) = BitsD s (ind2Expr n)
type2TyDecl (Mod Nothing Nothing (Pol [Mon (CoefI n) EZero]))
  = ModD $ ModNum $ ind2Expr n
type2TyDecl (Mod (Just b) (Just i) p)
  = ModD $ ModPol (type2TyDecl b) i p
type2TyDecl (Vector k it)
  = VectorD (ind2Expr k) (type2TyDecl it)
type2TyDecl (Matrix u v it)
  = MatrixD (ind2Expr u) (ind2Expr v) (type2TyDecl it)
type2TyDecl (Struct sn _)
  = TySynD (L genSrcLoc sn)
type2TyDecl (SField _ t) = type2TyDecl t
type2TyDecl (Index _ _ t) = type2TyDecl t
type2TyDecl t
  = error $ "<Utils.hs>.<type2TyDecl>: " ++ showPprDebug t

class Typeable a where
    typeOf :: a -> Type Var

instance Typeable Var where
    typeOf = varType 

instance Typeable (TExpr Var) where
    typeOf (TyE t _) = t

instance Typeable (LVal Var) where
    typeOf (LVVar v)        = varType $ unLoc v
    typeOf (LVStruct lv fi) = fieldType fi (typeOf lv)
    typeOf (LVCont ty _ _)  = ty

instance Typeable a => Typeable (Located a) where
    typeOf (L _ e) = typeOf e

instance Typeable (IExpr Var) where
    typeOf = queryIndexTy

instance Typeable (Type Var) where
    typeOf = id