{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}

{- |
Module      : Language.Egison.IExpr
Licence     : MIT

This module defines internal representation of Egison language.
-}

module Language.Egison.IExpr
  ( ITopExpr (..)
  , IExpr (..)
  , IPattern (..)
  , ILoopRange (..)
  , IBindingExpr
  , IMatchClause
  , IPatternDef
  , IPrimitiveDataPattern
  -- Typed versions
  , TITopExpr (..)
  , TIExpr (..)
  , TIExprNode (..)
  , TIPattern (..)
  , TIPatternNode (..)
  , TILoopRange (..)
  , TIBindingExpr
  , TIMatchClause
  , TIPatternDef
  , tiExprType
  , tiExprScheme
  , tiExprTypeVars
  , tiExprConstraints
  , tipType
  , stripType
  , stripTypeTopExpr
  , Var (..)
  , stringToVar
  , extractNameFromVar
  , Index (..)
  , extractSupOrSubIndex
  , extractIndex
  , makeIApply
  -- Re-export from AST
  , ConstantExpr (..)
  , PMMode (..)
  , PrimitivePatPattern (..)
  , PDPatternBase (..)
  ) where

import           Data.Hashable
import           GHC.Generics        (Generic)

import           Language.Egison.AST (ConstantExpr (..), PDPatternBase (..), PMMode (..), PrimitivePatPattern (..))
import           Language.Egison.Type.Types (Type(..), TypeScheme(..), Constraint(..), TyVar(..))

data ITopExpr
  = IDefine Var IExpr
  | IDefineMany [(Var, IExpr)]  -- Multiple definitions (for type class instances)
  | ITest IExpr
  | IExecute IExpr
  | ILoadFile String
  | ILoad String
  | IDeclareSymbol [String] (Maybe Type)  -- Symbol declaration
  | IPatternFunctionDecl String [TyVar] [(String, Type)] Type IPattern  -- Pattern function declaration
    -- String: function name
    -- [TyVar]: type parameters
    -- [(String, Type)]: parameters (name and type)
    -- Type: return type
    -- IPattern: body
  deriving Int -> ITopExpr -> ShowS
[ITopExpr] -> ShowS
ITopExpr -> String
(Int -> ITopExpr -> ShowS)
-> (ITopExpr -> String) -> ([ITopExpr] -> ShowS) -> Show ITopExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ITopExpr -> ShowS
showsPrec :: Int -> ITopExpr -> ShowS
$cshow :: ITopExpr -> String
show :: ITopExpr -> String
$cshowList :: [ITopExpr] -> ShowS
showList :: [ITopExpr] -> ShowS
Show

data IExpr
  = IConstantExpr ConstantExpr
  | IVarExpr String
  | IIndexedExpr Bool IExpr [Index IExpr]
  | ISubrefsExpr Bool IExpr IExpr
  | ISuprefsExpr Bool IExpr IExpr
  | IUserrefsExpr Bool IExpr IExpr
  | IInductiveDataExpr String [IExpr]
  | ITupleExpr [IExpr]
  | ICollectionExpr [IExpr]
  | IConsExpr IExpr IExpr
  | IJoinExpr IExpr IExpr
  | IHashExpr [(IExpr, IExpr)]
  | IVectorExpr [IExpr]
  | ILambdaExpr (Maybe Var) [Var] IExpr
  | IMemoizedLambdaExpr [String] IExpr
  | ICambdaExpr String IExpr
  | IIfExpr IExpr IExpr IExpr
  | ILetRecExpr [IBindingExpr] IExpr
  | ILetExpr [IBindingExpr] IExpr
  | IWithSymbolsExpr [String] IExpr
  | IMatchExpr PMMode IExpr IExpr [IMatchClause]
  | IMatchAllExpr PMMode IExpr IExpr [IMatchClause]
  | IMatcherExpr [IPatternDef]
  | IQuoteExpr IExpr
  | IQuoteSymbolExpr IExpr
  | IWedgeApplyExpr IExpr [IExpr]
  | IDoExpr [IBindingExpr] IExpr
  | ISeqExpr IExpr IExpr
  | IApplyExpr IExpr [IExpr]
  | IGenerateTensorExpr IExpr IExpr
  | ITensorExpr IExpr IExpr
  | ITensorContractExpr IExpr
  | ITensorMapExpr IExpr IExpr
  | ITensorMap2Expr IExpr IExpr IExpr
  | ITensorMap2WedgeExpr IExpr IExpr IExpr
  | ITransposeExpr IExpr IExpr
  | IFlipIndicesExpr IExpr
  | IFunctionExpr [String]
  | IPatternFuncExpr [String] IPattern  -- Pattern function: parameter names and pattern body
  deriving Int -> IExpr -> ShowS
[IExpr] -> ShowS
IExpr -> String
(Int -> IExpr -> ShowS)
-> (IExpr -> String) -> ([IExpr] -> ShowS) -> Show IExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IExpr -> ShowS
showsPrec :: Int -> IExpr -> ShowS
$cshow :: IExpr -> String
show :: IExpr -> String
$cshowList :: [IExpr] -> ShowS
showList :: [IExpr] -> ShowS
Show

type IBindingExpr = (IPrimitiveDataPattern, IExpr)
type IMatchClause = (IPattern, IExpr)
type IPatternDef  = (PrimitivePatPattern, IExpr, [(IPrimitiveDataPattern, IExpr)])
type IPrimitiveDataPattern = PDPatternBase Var

data IPattern
  = IWildCard
  | IPatVar String
  | IValuePat IExpr
  | IPredPat IExpr
  | IIndexedPat IPattern [IExpr]
  | ILetPat [IBindingExpr] IPattern
  | INotPat IPattern
  | IAndPat IPattern IPattern
  | IOrPat IPattern IPattern
  | IForallPat IPattern IPattern
  | ITuplePat [IPattern]
  | IInductivePat String [IPattern]
  | ILoopPat String ILoopRange IPattern IPattern
  | IContPat
  | IPApplyPat IExpr [IPattern]
  | IVarPat String
  | IInductiveOrPApplyPat String [IPattern]
  | ISeqNilPat
  | ISeqConsPat IPattern IPattern
  | ILaterPatVar
  -- For symbolic computing
  | IDApplyPat IPattern [IPattern]
  deriving Int -> IPattern -> ShowS
[IPattern] -> ShowS
IPattern -> String
(Int -> IPattern -> ShowS)
-> (IPattern -> String) -> ([IPattern] -> ShowS) -> Show IPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPattern -> ShowS
showsPrec :: Int -> IPattern -> ShowS
$cshow :: IPattern -> String
show :: IPattern -> String
$cshowList :: [IPattern] -> ShowS
showList :: [IPattern] -> ShowS
Show

data ILoopRange = ILoopRange IExpr IExpr IPattern
  deriving Int -> ILoopRange -> ShowS
[ILoopRange] -> ShowS
ILoopRange -> String
(Int -> ILoopRange -> ShowS)
-> (ILoopRange -> String)
-> ([ILoopRange] -> ShowS)
-> Show ILoopRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ILoopRange -> ShowS
showsPrec :: Int -> ILoopRange -> ShowS
$cshow :: ILoopRange -> String
show :: ILoopRange -> String
$cshowList :: [ILoopRange] -> ShowS
showList :: [ILoopRange] -> ShowS
Show

data Index a
  = Sub a
  | Sup a
  | MultiSub a Integer a
  | MultiSup a Integer a
  | SupSub a
  | User a
  | DF Integer Integer
  deriving (Int -> Index a -> ShowS
[Index a] -> ShowS
Index a -> String
(Int -> Index a -> ShowS)
-> (Index a -> String) -> ([Index a] -> ShowS) -> Show (Index a)
forall a. Show a => Int -> Index a -> ShowS
forall a. Show a => [Index a] -> ShowS
forall a. Show a => Index a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Index a -> ShowS
showsPrec :: Int -> Index a -> ShowS
$cshow :: forall a. Show a => Index a -> String
show :: Index a -> String
$cshowList :: forall a. Show a => [Index a] -> ShowS
showList :: [Index a] -> ShowS
Show, Index a -> Index a -> Bool
(Index a -> Index a -> Bool)
-> (Index a -> Index a -> Bool) -> Eq (Index a)
forall a. Eq a => Index a -> Index a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Index a -> Index a -> Bool
== :: Index a -> Index a -> Bool
$c/= :: forall a. Eq a => Index a -> Index a -> Bool
/= :: Index a -> Index a -> Bool
Eq, Eq (Index a)
Eq (Index a) =>
(Index a -> Index a -> Ordering)
-> (Index a -> Index a -> Bool)
-> (Index a -> Index a -> Bool)
-> (Index a -> Index a -> Bool)
-> (Index a -> Index a -> Bool)
-> (Index a -> Index a -> Index a)
-> (Index a -> Index a -> Index a)
-> Ord (Index a)
Index a -> Index a -> Bool
Index a -> Index a -> Ordering
Index a -> Index a -> Index a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Index a)
forall a. Ord a => Index a -> Index a -> Bool
forall a. Ord a => Index a -> Index a -> Ordering
forall a. Ord a => Index a -> Index a -> Index a
$ccompare :: forall a. Ord a => Index a -> Index a -> Ordering
compare :: Index a -> Index a -> Ordering
$c< :: forall a. Ord a => Index a -> Index a -> Bool
< :: Index a -> Index a -> Bool
$c<= :: forall a. Ord a => Index a -> Index a -> Bool
<= :: Index a -> Index a -> Bool
$c> :: forall a. Ord a => Index a -> Index a -> Bool
> :: Index a -> Index a -> Bool
$c>= :: forall a. Ord a => Index a -> Index a -> Bool
>= :: Index a -> Index a -> Bool
$cmax :: forall a. Ord a => Index a -> Index a -> Index a
max :: Index a -> Index a -> Index a
$cmin :: forall a. Ord a => Index a -> Index a -> Index a
min :: Index a -> Index a -> Index a
Ord, (forall a b. (a -> b) -> Index a -> Index b)
-> (forall a b. a -> Index b -> Index a) -> Functor Index
forall a b. a -> Index b -> Index a
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Index a -> Index b
fmap :: forall a b. (a -> b) -> Index a -> Index b
$c<$ :: forall a b. a -> Index b -> Index a
<$ :: forall a b. a -> Index b -> Index a
Functor, (forall m. Monoid m => Index m -> m)
-> (forall m a. Monoid m => (a -> m) -> Index a -> m)
-> (forall m a. Monoid m => (a -> m) -> Index a -> m)
-> (forall a b. (a -> b -> b) -> b -> Index a -> b)
-> (forall a b. (a -> b -> b) -> b -> Index a -> b)
-> (forall b a. (b -> a -> b) -> b -> Index a -> b)
-> (forall b a. (b -> a -> b) -> b -> Index a -> b)
-> (forall a. (a -> a -> a) -> Index a -> a)
-> (forall a. (a -> a -> a) -> Index a -> a)
-> (forall a. Index a -> [a])
-> (forall a. Index a -> Bool)
-> (forall a. Index a -> Int)
-> (forall a. Eq a => a -> Index a -> Bool)
-> (forall a. Ord a => Index a -> a)
-> (forall a. Ord a => Index a -> a)
-> (forall a. Num a => Index a -> a)
-> (forall a. Num a => Index a -> a)
-> Foldable Index
forall a. Eq a => a -> Index a -> Bool
forall a. Num a => Index a -> a
forall a. Ord a => Index a -> a
forall m. Monoid m => Index m -> m
forall a. Index a -> Bool
forall a. Index a -> Int
forall a. Index a -> [a]
forall a. (a -> a -> a) -> Index a -> a
forall m a. Monoid m => (a -> m) -> Index a -> m
forall b a. (b -> a -> b) -> b -> Index a -> b
forall a b. (a -> b -> b) -> b -> Index a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Index m -> m
fold :: forall m. Monoid m => Index m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Index a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Index a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Index a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Index a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Index a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Index a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Index a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Index a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Index a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Index a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Index a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Index a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Index a -> a
foldr1 :: forall a. (a -> a -> a) -> Index a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Index a -> a
foldl1 :: forall a. (a -> a -> a) -> Index a -> a
$ctoList :: forall a. Index a -> [a]
toList :: forall a. Index a -> [a]
$cnull :: forall a. Index a -> Bool
null :: forall a. Index a -> Bool
$clength :: forall a. Index a -> Int
length :: forall a. Index a -> Int
$celem :: forall a. Eq a => a -> Index a -> Bool
elem :: forall a. Eq a => a -> Index a -> Bool
$cmaximum :: forall a. Ord a => Index a -> a
maximum :: forall a. Ord a => Index a -> a
$cminimum :: forall a. Ord a => Index a -> a
minimum :: forall a. Ord a => Index a -> a
$csum :: forall a. Num a => Index a -> a
sum :: forall a. Num a => Index a -> a
$cproduct :: forall a. Num a => Index a -> a
product :: forall a. Num a => Index a -> a
Foldable, (forall x. Index a -> Rep (Index a) x)
-> (forall x. Rep (Index a) x -> Index a) -> Generic (Index a)
forall x. Rep (Index a) x -> Index a
forall x. Index a -> Rep (Index a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Index a) x -> Index a
forall a x. Index a -> Rep (Index a) x
$cfrom :: forall a x. Index a -> Rep (Index a) x
from :: forall x. Index a -> Rep (Index a) x
$cto :: forall a x. Rep (Index a) x -> Index a
to :: forall x. Rep (Index a) x -> Index a
Generic, Functor Index
Foldable Index
(Functor Index, Foldable Index) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Index a -> f (Index b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Index (f a) -> f (Index a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Index a -> m (Index b))
-> (forall (m :: * -> *) a. Monad m => Index (m a) -> m (Index a))
-> Traversable Index
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Index (m a) -> m (Index a)
forall (f :: * -> *) a. Applicative f => Index (f a) -> f (Index a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Index a -> m (Index b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Index a -> f (Index b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Index a -> f (Index b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Index a -> f (Index b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Index (f a) -> f (Index a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Index (f a) -> f (Index a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Index a -> m (Index b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Index a -> m (Index b)
$csequence :: forall (m :: * -> *) a. Monad m => Index (m a) -> m (Index a)
sequence :: forall (m :: * -> *) a. Monad m => Index (m a) -> m (Index a)
Traversable)

extractSupOrSubIndex :: Index a -> Maybe a
extractSupOrSubIndex :: forall a. Index a -> Maybe a
extractSupOrSubIndex (Sub a
x)    = a -> Maybe a
forall a. a -> Maybe a
Just a
x
extractSupOrSubIndex (Sup a
x)    = a -> Maybe a
forall a. a -> Maybe a
Just a
x
extractSupOrSubIndex (SupSub a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
extractSupOrSubIndex Index a
_          = Maybe a
forall a. Maybe a
Nothing

extractIndex :: Index a -> a
extractIndex :: forall a. Index a -> a
extractIndex (Sub a
x)    = a
x
extractIndex (Sup a
x)    = a
x
extractIndex (SupSub a
x) = a
x
extractIndex (User a
x)   = a
x
extractIndex DF{}       = a
forall a. HasCallStack => a
undefined

data Var = Var String [Index (Maybe Var)]
  deriving ((forall x. Var -> Rep Var x)
-> (forall x. Rep Var x -> Var) -> Generic Var
forall x. Rep Var x -> Var
forall x. Var -> Rep Var x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Var -> Rep Var x
from :: forall x. Var -> Rep Var x
$cto :: forall x. Rep Var x -> Var
to :: forall x. Rep Var x -> Var
Generic, Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var -> ShowS
showsPrec :: Int -> Var -> ShowS
$cshow :: Var -> String
show :: Var -> String
$cshowList :: [Var] -> ShowS
showList :: [Var] -> ShowS
Show)

-- for eq, ord and hashable
data Var' = Var' String [Index ()]
  deriving (Var' -> Var' -> Bool
(Var' -> Var' -> Bool) -> (Var' -> Var' -> Bool) -> Eq Var'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var' -> Var' -> Bool
== :: Var' -> Var' -> Bool
$c/= :: Var' -> Var' -> Bool
/= :: Var' -> Var' -> Bool
Eq, Eq Var'
Eq Var' =>
(Var' -> Var' -> Ordering)
-> (Var' -> Var' -> Bool)
-> (Var' -> Var' -> Bool)
-> (Var' -> Var' -> Bool)
-> (Var' -> Var' -> Bool)
-> (Var' -> Var' -> Var')
-> (Var' -> Var' -> Var')
-> Ord Var'
Var' -> Var' -> Bool
Var' -> Var' -> Ordering
Var' -> Var' -> Var'
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Var' -> Var' -> Ordering
compare :: Var' -> Var' -> Ordering
$c< :: Var' -> Var' -> Bool
< :: Var' -> Var' -> Bool
$c<= :: Var' -> Var' -> Bool
<= :: Var' -> Var' -> Bool
$c> :: Var' -> Var' -> Bool
> :: Var' -> Var' -> Bool
$c>= :: Var' -> Var' -> Bool
>= :: Var' -> Var' -> Bool
$cmax :: Var' -> Var' -> Var'
max :: Var' -> Var' -> Var'
$cmin :: Var' -> Var' -> Var'
min :: Var' -> Var' -> Var'
Ord, (forall x. Var' -> Rep Var' x)
-> (forall x. Rep Var' x -> Var') -> Generic Var'
forall x. Rep Var' x -> Var'
forall x. Var' -> Rep Var' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Var' -> Rep Var' x
from :: forall x. Var' -> Rep Var' x
$cto :: forall x. Rep Var' x -> Var'
to :: forall x. Rep Var' x -> Var'
Generic, Int -> Var' -> ShowS
[Var'] -> ShowS
Var' -> String
(Int -> Var' -> ShowS)
-> (Var' -> String) -> ([Var'] -> ShowS) -> Show Var'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var' -> ShowS
showsPrec :: Int -> Var' -> ShowS
$cshow :: Var' -> String
show :: Var' -> String
$cshowList :: [Var'] -> ShowS
showList :: [Var'] -> ShowS
Show)

instance Eq Var where
  Var String
name (MultiSup Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_) == :: Var -> Var -> Bool
== Var String
name' [Index (Maybe Var)]
is' = String -> [Index (Maybe Var)] -> Var
Var String
name [] Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [Index (Maybe Var)] -> Var
Var String
name' [Index (Maybe Var)]
is'
  Var String
name (MultiSub Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_) == Var String
name' [Index (Maybe Var)]
is' = String -> [Index (Maybe Var)] -> Var
Var String
name [] Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [Index (Maybe Var)] -> Var
Var String
name' [Index (Maybe Var)]
is'
  Var String
name [Index (Maybe Var)]
is == Var String
name' (MultiSup Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)  = String -> [Index (Maybe Var)] -> Var
Var String
name [Index (Maybe Var)]
is Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [Index (Maybe Var)] -> Var
Var String
name' []
  Var String
name [Index (Maybe Var)]
is == Var String
name' (MultiSub Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)  = String -> [Index (Maybe Var)] -> Var
Var String
name [Index (Maybe Var)]
is Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [Index (Maybe Var)] -> Var
Var String
name' []
  Var String
name [Index (Maybe Var)]
is == Var String
name' [Index (Maybe Var)]
is'                 = String -> [Index ()] -> Var'
Var' String
name ((Index (Maybe Var) -> Index ())
-> [Index (Maybe Var)] -> [Index ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> ()) -> Index (Maybe Var) -> Index ()
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> ())) [Index (Maybe Var)]
is) Var' -> Var' -> Bool
forall a. Eq a => a -> a -> Bool
== String -> [Index ()] -> Var'
Var' String
name' ((Index (Maybe Var) -> Index ())
-> [Index (Maybe Var)] -> [Index ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> ()) -> Index (Maybe Var) -> Index ()
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> ())) [Index (Maybe Var)]
is')

instance Ord Var where
  compare :: Var -> Var -> Ordering
compare (Var String
name (MultiSup Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)) (Var String
name' [Index (Maybe Var)]
is') = Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> [Index (Maybe Var)] -> Var
Var String
name []) (String -> [Index (Maybe Var)] -> Var
Var String
name' [Index (Maybe Var)]
is')
  compare (Var String
name (MultiSub Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)) (Var String
name' [Index (Maybe Var)]
is') = Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> [Index (Maybe Var)] -> Var
Var String
name []) (String -> [Index (Maybe Var)] -> Var
Var String
name' [Index (Maybe Var)]
is')
  compare (Var String
name [Index (Maybe Var)]
is) (Var String
name' (MultiSup Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_))  = Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> [Index (Maybe Var)] -> Var
Var String
name [Index (Maybe Var)]
is) (String -> [Index (Maybe Var)] -> Var
Var String
name' [])
  compare (Var String
name [Index (Maybe Var)]
is) (Var String
name' (MultiSub Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_))  = Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> [Index (Maybe Var)] -> Var
Var String
name [Index (Maybe Var)]
is) (String -> [Index (Maybe Var)] -> Var
Var String
name' [])
  compare (Var String
name [Index (Maybe Var)]
is) (Var String
name' [Index (Maybe Var)]
is') = 
    Var' -> Var' -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> [Index ()] -> Var'
Var' String
name ((Index (Maybe Var) -> Index ())
-> [Index (Maybe Var)] -> [Index ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> ()) -> Index (Maybe Var) -> Index ()
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> ())) [Index (Maybe Var)]
is)) (String -> [Index ()] -> Var'
Var' String
name' ((Index (Maybe Var) -> Index ())
-> [Index (Maybe Var)] -> [Index ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> ()) -> Index (Maybe Var) -> Index ()
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> ())) [Index (Maybe Var)]
is'))

instance Hashable a => Hashable (Index a)
instance Hashable Var'
instance Hashable Var where
  hashWithSalt :: Int -> Var -> Int
hashWithSalt Int
salt (Var String
name (MultiSup Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)) = Int -> Var' -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (String -> [Index ()] -> Var'
Var' String
name [])
  hashWithSalt Int
salt (Var String
name (MultiSub Maybe Var
_ Integer
_ Maybe Var
_:[Index (Maybe Var)]
_)) = Int -> Var' -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (String -> [Index ()] -> Var'
Var' String
name [])
  hashWithSalt Int
salt (Var String
name [Index (Maybe Var)]
is) = Int -> Var' -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (String -> [Index ()] -> Var'
Var' String
name ((Index (Maybe Var) -> Index ())
-> [Index (Maybe Var)] -> [Index ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Var -> ()) -> Index (Maybe Var) -> Index ()
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Var
_ -> ())) [Index (Maybe Var)]
is))

stringToVar :: String -> Var
stringToVar :: String -> Var
stringToVar String
name = String -> [Index (Maybe Var)] -> Var
Var String
name []

extractNameFromVar :: Var -> String
extractNameFromVar :: Var -> String
extractNameFromVar (Var String
name [Index (Maybe Var)]
_) = String
name

makeIApply :: String -> [IExpr] -> IExpr
makeIApply :: String -> [IExpr] -> IExpr
makeIApply String
fn [IExpr]
args = IExpr -> [IExpr] -> IExpr
IApplyExpr (String -> IExpr
IVarExpr String
fn) [IExpr]
args

--
-- Typed Internal Expressions
--------------------------------------------------------------------------------
-- Phase 9: TIExpr - Evaluatable Typed IR with Type Info Preserved
--------------------------------------------------------------------------------
-- TIExpr is the result of Phase 8 (TypedDesugar) and input to Phase 10 (Evaluation).
-- It carries type information alongside the expression for:
--   - Better runtime error messages with type information
--   - Type-based dispatch during evaluation
--   - Debugging support with type annotations
--
-- Design Decision (design/implementation.md):
-- Type information is preserved after TypedDesugar for better error messages.
-- Type classes have already been resolved to dictionary passing, so no type class
-- constraints are needed here.

-- | Typed top-level expression (Phase 9: TITopExpr)
-- Result of TypedDesugar phase, ready for evaluation.
data TITopExpr
  = TIDefine TypeScheme Var TIExpr     -- ^ Typed definition with type scheme (includes type vars & constraints)
  | TIDefineMany [(Var, TIExpr)]       -- ^ Multiple definitions (letrec)
  | TITest TIExpr                      -- ^ Test expression (REPL)
  | TIExecute TIExpr                   -- ^ Execute IO expression
  | TILoadFile String                  -- ^ Load file (should not appear after expandLoads)
  | TILoad String                      -- ^ Load library (should not appear after expandLoads)
  | TIDeclareSymbol [String] Type      -- ^ Typed symbol declaration
  | TIPatternFunctionDecl String TypeScheme [(String, Type)] Type TIPattern  -- ^ Typed pattern function declaration
    -- String: function name
    -- TypeScheme: type scheme with type parameters and constraints
    -- [(String, Type)]: parameters (name and type with type params substituted)
    -- Type: return type (with type params substituted)
    -- TIPattern: typed body
  deriving Int -> TITopExpr -> ShowS
[TITopExpr] -> ShowS
TITopExpr -> String
(Int -> TITopExpr -> ShowS)
-> (TITopExpr -> String)
-> ([TITopExpr] -> ShowS)
-> Show TITopExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TITopExpr -> ShowS
showsPrec :: Int -> TITopExpr -> ShowS
$cshow :: TITopExpr -> String
show :: TITopExpr -> String
$cshowList :: [TITopExpr] -> ShowS
showList :: [TITopExpr] -> ShowS
Show

-- | Typed internal expression (Phase 9: TIExpr)
-- Each expression node carries its inferred/checked type scheme with type variables and constraints.
-- TypeScheme info is preserved for Phase 8 (TypedDesugar) to perform type-driven transformations
-- such as type class dictionary passing and tensorMap insertion.
--
-- NEW: TIExpr is now RECURSIVE - each sub-expression is also a TIExpr,
-- allowing type information to be preserved throughout the tree.
-- This eliminates the need to re-run type inference during TypeClassExpand.
data TIExpr = TIExpr
  { TIExpr -> TypeScheme
tiScheme :: TypeScheme    -- ^ Type scheme with type variables, constraints, and type
  , TIExpr -> TIExprNode
tiExprNode :: TIExprNode  -- ^ Typed expression node with typed sub-expressions
  } deriving Int -> TIExpr -> ShowS
[TIExpr] -> ShowS
TIExpr -> String
(Int -> TIExpr -> ShowS)
-> (TIExpr -> String) -> ([TIExpr] -> ShowS) -> Show TIExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIExpr -> ShowS
showsPrec :: Int -> TIExpr -> ShowS
$cshow :: TIExpr -> String
show :: TIExpr -> String
$cshowList :: [TIExpr] -> ShowS
showList :: [TIExpr] -> ShowS
Show

-- | Typed expression node - each constructor contains typed sub-expressions (TIExpr)
-- This mirrors IExpr but with TIExpr in place of IExpr for all sub-expressions
data TIExprNode
  -- Constants and variables
  = TIConstantExpr ConstantExpr
  | TIVarExpr String
  
  -- Collections
  | TITupleExpr [TIExpr]
  | TICollectionExpr [TIExpr]
  | TIConsExpr TIExpr TIExpr
  | TIJoinExpr TIExpr TIExpr
  | TIHashExpr [(TIExpr, TIExpr)]
  | TIVectorExpr [TIExpr]
  
  -- Lambda expressions
  | TILambdaExpr (Maybe Var) [Var] TIExpr
  | TIMemoizedLambdaExpr [String] TIExpr
  | TICambdaExpr String TIExpr
  
  -- Application
  | TIApplyExpr TIExpr [TIExpr]
  
  -- Control flow
  | TIIfExpr TIExpr TIExpr TIExpr
  
  -- Let expressions
  | TILetExpr [TIBindingExpr] TIExpr
  | TILetRecExpr [TIBindingExpr] TIExpr
  | TIWithSymbolsExpr [String] TIExpr
  
  -- Pattern matching
  | TIMatchExpr PMMode TIExpr TIExpr [TIMatchClause]
  | TIMatchAllExpr PMMode TIExpr TIExpr [TIMatchClause]
  | TIMatcherExpr [TIPatternDef]
  
  -- Inductive data
  | TIInductiveDataExpr String [TIExpr]
  
  -- Quote expressions
  | TIQuoteExpr TIExpr
  | TIQuoteSymbolExpr TIExpr
  
  -- Indexed expressions
  | TIIndexedExpr Bool TIExpr [Index TIExpr]
  | TISubrefsExpr Bool TIExpr TIExpr
  | TISuprefsExpr Bool TIExpr TIExpr
  | TIUserrefsExpr Bool TIExpr TIExpr
  
  -- Application variants
  | TIWedgeApplyExpr TIExpr [TIExpr]
  
  -- Do expressions
  | TIDoExpr [TIBindingExpr] TIExpr
  
  -- Sequence
  | TISeqExpr TIExpr TIExpr
  
  -- Tensor operations
  | TIGenerateTensorExpr TIExpr TIExpr
  | TITensorExpr TIExpr TIExpr
  | TITensorContractExpr TIExpr
  | TITensorMapExpr TIExpr TIExpr
  | TITensorMap2Expr TIExpr TIExpr TIExpr
  | TITensorMap2WedgeExpr TIExpr TIExpr TIExpr  -- Like TensorMap2 but supplements different indices
  | TITransposeExpr TIExpr TIExpr
  | TIFlipIndicesExpr TIExpr
  
  -- Function reference
  | TIFunctionExpr [String]
  deriving Int -> TIExprNode -> ShowS
[TIExprNode] -> ShowS
TIExprNode -> String
(Int -> TIExprNode -> ShowS)
-> (TIExprNode -> String)
-> ([TIExprNode] -> ShowS)
-> Show TIExprNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIExprNode -> ShowS
showsPrec :: Int -> TIExprNode -> ShowS
$cshow :: TIExprNode -> String
show :: TIExprNode -> String
$cshowList :: [TIExprNode] -> ShowS
showList :: [TIExprNode] -> ShowS
Show

-- | Typed binding expression
type TIBindingExpr = (IPrimitiveDataPattern, TIExpr)

-- | Typed match clause
type TIMatchClause = (TIPattern, TIExpr)

-- | Typed pattern definition (for matcher expressions)
type TIPatternDef = (PrimitivePatPattern, TIExpr, [TIBindingExpr])

-- | Get the type of a typed expression (extracts Type from TypeScheme)
tiExprType :: TIExpr -> Type
tiExprType :: TIExpr -> Type
tiExprType (TIExpr (Forall [TyVar]
_ [Constraint]
_ Type
t) TIExprNode
_) = Type
t

-- | Get the type scheme of a typed expression
tiExprScheme :: TIExpr -> TypeScheme
tiExprScheme :: TIExpr -> TypeScheme
tiExprScheme = TIExpr -> TypeScheme
tiScheme

-- | Get the type variables of a typed expression
tiExprTypeVars :: TIExpr -> [TyVar]
tiExprTypeVars :: TIExpr -> [TyVar]
tiExprTypeVars (TIExpr (Forall [TyVar]
tvs [Constraint]
_ Type
_) TIExprNode
_) = [TyVar]
tvs

-- | Get the constraints of a typed expression
tiExprConstraints :: TIExpr -> [Constraint]
tiExprConstraints :: TIExpr -> [Constraint]
tiExprConstraints (TIExpr (Forall [TyVar]
_ [Constraint]
cs Type
_) TIExprNode
_) = [Constraint]
cs

-- | Strip type information, returning the untyped expression
-- This recursively converts TIExpr back to IExpr for evaluation
stripType :: TIExpr -> IExpr
stripType :: TIExpr -> IExpr
stripType (TIExpr TypeScheme
_ TIExprNode
node) = case TIExprNode
node of
  TIConstantExpr ConstantExpr
c -> ConstantExpr -> IExpr
IConstantExpr ConstantExpr
c
  TIVarExpr String
name -> String -> IExpr
IVarExpr String
name
  TITupleExpr [TIExpr]
exprs -> [IExpr] -> IExpr
ITupleExpr ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
exprs)
  TICollectionExpr [TIExpr]
exprs -> [IExpr] -> IExpr
ICollectionExpr ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
exprs)
  TIConsExpr TIExpr
e1 TIExpr
e2 -> IExpr -> IExpr -> IExpr
IConsExpr (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TIJoinExpr TIExpr
e1 TIExpr
e2 -> IExpr -> IExpr -> IExpr
IJoinExpr (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TIHashExpr [(TIExpr, TIExpr)]
pairs -> [(IExpr, IExpr)] -> IExpr
IHashExpr [(TIExpr -> IExpr
stripType TIExpr
k, TIExpr -> IExpr
stripType TIExpr
v) | (TIExpr
k, TIExpr
v) <- [(TIExpr, TIExpr)]
pairs]
  TIVectorExpr [TIExpr]
exprs -> [IExpr] -> IExpr
IVectorExpr ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
exprs)
  TILambdaExpr Maybe Var
mVar [Var]
params TIExpr
body -> Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
mVar [Var]
params (TIExpr -> IExpr
stripType TIExpr
body)
  TIMemoizedLambdaExpr [String]
args TIExpr
body -> [String] -> IExpr -> IExpr
IMemoizedLambdaExpr [String]
args (TIExpr -> IExpr
stripType TIExpr
body)
  TICambdaExpr String
var TIExpr
body -> String -> IExpr -> IExpr
ICambdaExpr String
var (TIExpr -> IExpr
stripType TIExpr
body)
  TIApplyExpr TIExpr
func [TIExpr]
args -> IExpr -> [IExpr] -> IExpr
IApplyExpr (TIExpr -> IExpr
stripType TIExpr
func) ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
args)
  TIIfExpr TIExpr
cond TIExpr
thenE TIExpr
elseE -> IExpr -> IExpr -> IExpr -> IExpr
IIfExpr (TIExpr -> IExpr
stripType TIExpr
cond) (TIExpr -> IExpr
stripType TIExpr
thenE) (TIExpr -> IExpr
stripType TIExpr
elseE)
  TILetExpr [TIBindingExpr]
bindings TIExpr
body -> [IBindingExpr] -> IExpr -> IExpr
ILetExpr ((TIBindingExpr -> IBindingExpr)
-> [TIBindingExpr] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> IBindingExpr
stripTypeBinding [TIBindingExpr]
bindings) (TIExpr -> IExpr
stripType TIExpr
body)
  TILetRecExpr [TIBindingExpr]
bindings TIExpr
body -> [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr ((TIBindingExpr -> IBindingExpr)
-> [TIBindingExpr] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> IBindingExpr
stripTypeBinding [TIBindingExpr]
bindings) (TIExpr -> IExpr
stripType TIExpr
body)
  TIWithSymbolsExpr [String]
syms TIExpr
body -> [String] -> IExpr -> IExpr
IWithSymbolsExpr [String]
syms (TIExpr -> IExpr
stripType TIExpr
body)
  TIMatchExpr PMMode
mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses -> 
    PMMode -> IExpr -> IExpr -> [IMatchClause] -> IExpr
IMatchExpr PMMode
mode (TIExpr -> IExpr
stripType TIExpr
target) (TIExpr -> IExpr
stripType TIExpr
matcher) ((TIMatchClause -> IMatchClause)
-> [TIMatchClause] -> [IMatchClause]
forall a b. (a -> b) -> [a] -> [b]
map TIMatchClause -> IMatchClause
stripTypeClause [TIMatchClause]
clauses)
  TIMatchAllExpr PMMode
mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses -> 
    PMMode -> IExpr -> IExpr -> [IMatchClause] -> IExpr
IMatchAllExpr PMMode
mode (TIExpr -> IExpr
stripType TIExpr
target) (TIExpr -> IExpr
stripType TIExpr
matcher) ((TIMatchClause -> IMatchClause)
-> [TIMatchClause] -> [IMatchClause]
forall a b. (a -> b) -> [a] -> [b]
map TIMatchClause -> IMatchClause
stripTypeClause [TIMatchClause]
clauses)
  TIMatcherExpr [TIPatternDef]
patDefs -> 
    [IPatternDef] -> IExpr
IMatcherExpr [(PrimitivePatPattern
pat, TIExpr -> IExpr
stripType TIExpr
expr, (TIBindingExpr -> IBindingExpr)
-> [TIBindingExpr] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> IBindingExpr
stripTypeBinding [TIBindingExpr]
bindings) | (PrimitivePatPattern
pat, TIExpr
expr, [TIBindingExpr]
bindings) <- [TIPatternDef]
patDefs]
  TIInductiveDataExpr String
name [TIExpr]
exprs -> String -> [IExpr] -> IExpr
IInductiveDataExpr String
name ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
exprs)
  TIQuoteExpr TIExpr
e -> IExpr -> IExpr
IQuoteExpr (TIExpr -> IExpr
stripType TIExpr
e)
  TIQuoteSymbolExpr TIExpr
e -> IExpr -> IExpr
IQuoteSymbolExpr (TIExpr -> IExpr
stripType TIExpr
e)
  TIIndexedExpr Bool
override TIExpr
expr [Index TIExpr]
indices -> Bool -> IExpr -> [Index IExpr] -> IExpr
IIndexedExpr Bool
override (TIExpr -> IExpr
stripType TIExpr
expr) ((TIExpr -> IExpr) -> Index TIExpr -> Index IExpr
forall a b. (a -> b) -> Index a -> Index b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TIExpr -> IExpr
stripType (Index TIExpr -> Index IExpr) -> [Index TIExpr] -> [Index IExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Index TIExpr]
indices)
  TISubrefsExpr Bool
b TIExpr
e1 TIExpr
e2 -> Bool -> IExpr -> IExpr -> IExpr
ISubrefsExpr Bool
b (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TISuprefsExpr Bool
b TIExpr
e1 TIExpr
e2 -> Bool -> IExpr -> IExpr -> IExpr
ISuprefsExpr Bool
b (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TIUserrefsExpr Bool
b TIExpr
e1 TIExpr
e2 -> Bool -> IExpr -> IExpr -> IExpr
IUserrefsExpr Bool
b (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TIWedgeApplyExpr TIExpr
func [TIExpr]
args -> IExpr -> [IExpr] -> IExpr
IWedgeApplyExpr (TIExpr -> IExpr
stripType TIExpr
func) ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
args)
  TIDoExpr [TIBindingExpr]
bindings TIExpr
body -> [IBindingExpr] -> IExpr -> IExpr
IDoExpr ((TIBindingExpr -> IBindingExpr)
-> [TIBindingExpr] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> IBindingExpr
stripTypeBinding [TIBindingExpr]
bindings) (TIExpr -> IExpr
stripType TIExpr
body)
  TISeqExpr TIExpr
e1 TIExpr
e2 -> IExpr -> IExpr -> IExpr
ISeqExpr (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2)
  TIGenerateTensorExpr TIExpr
func TIExpr
shape -> IExpr -> IExpr -> IExpr
IGenerateTensorExpr (TIExpr -> IExpr
stripType TIExpr
func) (TIExpr -> IExpr
stripType TIExpr
shape)
  TITensorExpr TIExpr
shape TIExpr
elems -> IExpr -> IExpr -> IExpr
ITensorExpr (TIExpr -> IExpr
stripType TIExpr
shape) (TIExpr -> IExpr
stripType TIExpr
elems)
  TITensorContractExpr TIExpr
e -> IExpr -> IExpr
ITensorContractExpr (TIExpr -> IExpr
stripType TIExpr
e)
  TITensorMapExpr TIExpr
func TIExpr
tensor -> IExpr -> IExpr -> IExpr
ITensorMapExpr (TIExpr -> IExpr
stripType TIExpr
func) (TIExpr -> IExpr
stripType TIExpr
tensor)
  TITensorMap2Expr TIExpr
func TIExpr
t1 TIExpr
t2 -> IExpr -> IExpr -> IExpr -> IExpr
ITensorMap2Expr (TIExpr -> IExpr
stripType TIExpr
func) (TIExpr -> IExpr
stripType TIExpr
t1) (TIExpr -> IExpr
stripType TIExpr
t2)
  TITensorMap2WedgeExpr TIExpr
func TIExpr
t1 TIExpr
t2 -> IExpr -> IExpr -> IExpr -> IExpr
ITensorMap2WedgeExpr (TIExpr -> IExpr
stripType TIExpr
func) (TIExpr -> IExpr
stripType TIExpr
t1) (TIExpr -> IExpr
stripType TIExpr
t2)
  TITransposeExpr TIExpr
perm TIExpr
tensor -> IExpr -> IExpr -> IExpr
ITransposeExpr (TIExpr -> IExpr
stripType TIExpr
perm) (TIExpr -> IExpr
stripType TIExpr
tensor)
  TIFlipIndicesExpr TIExpr
tensor -> IExpr -> IExpr
IFlipIndicesExpr (TIExpr -> IExpr
stripType TIExpr
tensor)
  TIFunctionExpr [String]
names -> [String] -> IExpr
IFunctionExpr [String]
names
  where
    stripTypeBinding :: TIBindingExpr -> IBindingExpr
    stripTypeBinding :: TIBindingExpr -> IBindingExpr
stripTypeBinding (PDPatternBase Var
pat, TIExpr
expr) = (PDPatternBase Var
pat, TIExpr -> IExpr
stripType TIExpr
expr)
    
    stripTypeClause :: TIMatchClause -> IMatchClause
    stripTypeClause :: TIMatchClause -> IMatchClause
stripTypeClause (TIPattern
tipat, TIExpr
expr) = (TIPattern -> IPattern
stripTypePat TIPattern
tipat, TIExpr -> IExpr
stripType TIExpr
expr)
    
    stripTypePat :: TIPattern -> IPattern
    stripTypePat :: TIPattern -> IPattern
stripTypePat (TIPattern TypeScheme
_ TIPatternNode
node) = case TIPatternNode
node of
      TIPatternNode
TIWildCard -> IPattern
IWildCard
      TIPatVar String
name -> String -> IPattern
IPatVar String
name
      TIValuePat TIExpr
expr -> IExpr -> IPattern
IValuePat (TIExpr -> IExpr
stripType TIExpr
expr)
      TIPredPat TIExpr
expr -> IExpr -> IPattern
IPredPat (TIExpr -> IExpr
stripType TIExpr
expr)
      TIIndexedPat TIPattern
pat [TIExpr]
exprs -> IPattern -> [IExpr] -> IPattern
IIndexedPat (TIPattern -> IPattern
stripTypePat TIPattern
pat) ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
exprs)
      TILetPat [TIBindingExpr]
bindings TIPattern
pat -> [IBindingExpr] -> IPattern -> IPattern
ILetPat ((TIBindingExpr -> IBindingExpr)
-> [TIBindingExpr] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> IBindingExpr
stripTypeBinding [TIBindingExpr]
bindings) (TIPattern -> IPattern
stripTypePat TIPattern
pat)
      TINotPat TIPattern
pat -> IPattern -> IPattern
INotPat (TIPattern -> IPattern
stripTypePat TIPattern
pat)
      TIAndPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IAndPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIOrPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IOrPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIForallPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IForallPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TITuplePat [TIPattern]
pats -> [IPattern] -> IPattern
ITuplePat ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
pats)
      TIInductivePat String
name [TIPattern]
pats -> String -> [IPattern] -> IPattern
IInductivePat String
name ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
pats)
      TILoopPat String
var TILoopRange
range TIPattern
p1 TIPattern
p2 -> String -> ILoopRange -> IPattern -> IPattern -> IPattern
ILoopPat String
var (TILoopRange -> ILoopRange
stripTypeLoopRange TILoopRange
range) (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIPatternNode
TIContPat -> IPattern
IContPat
      TIPApplyPat TIExpr
func [TIPattern]
pats -> IExpr -> [IPattern] -> IPattern
IPApplyPat (TIExpr -> IExpr
stripType TIExpr
func) ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
pats)
      TIVarPat String
name -> String -> IPattern
IVarPat String
name
      TIInductiveOrPApplyPat String
name [TIPattern]
pats -> String -> [IPattern] -> IPattern
IInductiveOrPApplyPat String
name ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
pats)
      TIPatternNode
TISeqNilPat -> IPattern
ISeqNilPat
      TISeqConsPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
ISeqConsPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIPatternNode
TILaterPatVar -> IPattern
ILaterPatVar
      TIDApplyPat TIPattern
pat [TIPattern]
pats -> IPattern -> [IPattern] -> IPattern
IDApplyPat (TIPattern -> IPattern
stripTypePat TIPattern
pat) ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
pats)
    
    stripTypeLoopRange :: TILoopRange -> ILoopRange
    stripTypeLoopRange :: TILoopRange -> ILoopRange
stripTypeLoopRange (TILoopRange TIExpr
e1 TIExpr
e2 TIPattern
pat) = IExpr -> IExpr -> IPattern -> ILoopRange
ILoopRange (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2) (TIPattern -> IPattern
stripTypePat TIPattern
pat)
    
    _stripTypeIndex :: Index TIExpr -> Index IExpr
    _stripTypeIndex :: Index TIExpr -> Index IExpr
_stripTypeIndex Index TIExpr
idx = case Index TIExpr
idx of
      DF Integer
i1 Integer
i2 -> Integer -> Integer -> Index IExpr
forall a. Integer -> Integer -> Index a
DF Integer
i1 Integer
i2
      Sub TIExpr
e -> IExpr -> Index IExpr
forall a. a -> Index a
Sub (TIExpr -> IExpr
stripType TIExpr
e)
      Sup TIExpr
e -> IExpr -> Index IExpr
forall a. a -> Index a
Sup (TIExpr -> IExpr
stripType TIExpr
e)
      MultiSub TIExpr
e1 Integer
n TIExpr
e2 -> IExpr -> Integer -> IExpr -> Index IExpr
forall a. a -> Integer -> a -> Index a
MultiSub (TIExpr -> IExpr
stripType TIExpr
e1) Integer
n (TIExpr -> IExpr
stripType TIExpr
e2)
      MultiSup TIExpr
e1 Integer
n TIExpr
e2 -> IExpr -> Integer -> IExpr -> Index IExpr
forall a. a -> Integer -> a -> Index a
MultiSup (TIExpr -> IExpr
stripType TIExpr
e1) Integer
n (TIExpr -> IExpr
stripType TIExpr
e2)
      SupSub TIExpr
e -> IExpr -> Index IExpr
forall a. a -> Index a
SupSub (TIExpr -> IExpr
stripType TIExpr
e)
      User TIExpr
e -> IExpr -> Index IExpr
forall a. a -> Index a
User (TIExpr -> IExpr
stripType TIExpr
e)

-- | Strip type information from top-level expression
stripTypeTopExpr :: TITopExpr -> ITopExpr
stripTypeTopExpr :: TITopExpr -> ITopExpr
stripTypeTopExpr (TIDefine TypeScheme
_scheme Var
var TIExpr
expr) = Var -> IExpr -> ITopExpr
IDefine Var
var (TIExpr -> IExpr
stripType TIExpr
expr)
stripTypeTopExpr (TIDefineMany [(Var, TIExpr)]
bindings) = [(Var, IExpr)] -> ITopExpr
IDefineMany [(Var
v, TIExpr -> IExpr
stripType TIExpr
e) | (Var
v, TIExpr
e) <- [(Var, TIExpr)]
bindings]
stripTypeTopExpr (TITest TIExpr
expr) = IExpr -> ITopExpr
ITest (TIExpr -> IExpr
stripType TIExpr
expr)
stripTypeTopExpr (TIExecute TIExpr
expr) = IExpr -> ITopExpr
IExecute (TIExpr -> IExpr
stripType TIExpr
expr)
stripTypeTopExpr (TILoadFile String
file) = String -> ITopExpr
ILoadFile String
file
stripTypeTopExpr (TILoad String
file) = String -> ITopExpr
ILoad String
file
stripTypeTopExpr (TIDeclareSymbol [String]
names Type
ty) = [String] -> Maybe Type -> ITopExpr
IDeclareSymbol [String]
names (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
ty)
stripTypeTopExpr (TIPatternFunctionDecl String
name TypeScheme
_scheme [(String, Type)]
params Type
retType TIPattern
body) = 
  String
-> [TyVar] -> [(String, Type)] -> Type -> IPattern -> ITopExpr
IPatternFunctionDecl String
name [TyVar]
tyVars [(String, Type)]
params Type
retType (TIPattern -> IPattern
stripTypePat TIPattern
body)
  where
    -- Extract type variables from the type scheme
    Forall [TyVar]
tyVars [Constraint]
_ Type
_ = TypeScheme
_scheme
    
    -- Helper function to strip type from pattern
    stripTypePat :: TIPattern -> IPattern
    stripTypePat :: TIPattern -> IPattern
stripTypePat (TIPattern TypeScheme
_ TIPatternNode
node) = case TIPatternNode
node of
      TIPatternNode
TIWildCard -> IPattern
IWildCard
      TIPatVar String
v -> String -> IPattern
IPatVar String
v
      TIValuePat TIExpr
e -> IExpr -> IPattern
IValuePat (TIExpr -> IExpr
stripType TIExpr
e)
      TIPredPat TIExpr
e -> IExpr -> IPattern
IPredPat (TIExpr -> IExpr
stripType TIExpr
e)
      TIIndexedPat TIPattern
p [TIExpr]
es -> IPattern -> [IExpr] -> IPattern
IIndexedPat (TIPattern -> IPattern
stripTypePat TIPattern
p) ((TIExpr -> IExpr) -> [TIExpr] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> IExpr
stripType [TIExpr]
es)
      TILetPat [TIBindingExpr]
binds TIPattern
p -> [IBindingExpr] -> IPattern -> IPattern
ILetPat [(PDPatternBase Var
pd, TIExpr -> IExpr
stripType TIExpr
e) | (PDPatternBase Var
pd, TIExpr
e) <- [TIBindingExpr]
binds] (TIPattern -> IPattern
stripTypePat TIPattern
p)
      TIAndPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IAndPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIOrPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IOrPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TINotPat TIPattern
p -> IPattern -> IPattern
INotPat (TIPattern -> IPattern
stripTypePat TIPattern
p)
      TITuplePat [TIPattern]
ps -> [IPattern] -> IPattern
ITuplePat ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
ps)
      TIInductivePat String
name [TIPattern]
ps -> String -> [IPattern] -> IPattern
IInductivePat String
name ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
ps)
      TIPApplyPat TIExpr
e [TIPattern]
ps -> IExpr -> [IPattern] -> IPattern
IPApplyPat (TIExpr -> IExpr
stripType TIExpr
e) ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
ps)
      TIDApplyPat TIPattern
p [TIPattern]
ps -> IPattern -> [IPattern] -> IPattern
IDApplyPat (TIPattern -> IPattern
stripTypePat TIPattern
p) ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
ps)
      TILoopPat String
v TILoopRange
r TIPattern
p1 TIPattern
p2 -> String -> ILoopRange -> IPattern -> IPattern -> IPattern
ILoopPat String
v (TILoopRange -> ILoopRange
stripTypeLoopRange TILoopRange
r) (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIVarPat String
v -> String -> IPattern
IVarPat String
v
      TIForallPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
IForallPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIPatternNode
TIContPat -> IPattern
IContPat
      TIPatternNode
TISeqNilPat -> IPattern
ISeqNilPat
      TISeqConsPat TIPattern
p1 TIPattern
p2 -> IPattern -> IPattern -> IPattern
ISeqConsPat (TIPattern -> IPattern
stripTypePat TIPattern
p1) (TIPattern -> IPattern
stripTypePat TIPattern
p2)
      TIPatternNode
TILaterPatVar -> IPattern
ILaterPatVar
      TIInductiveOrPApplyPat String
name [TIPattern]
ps -> String -> [IPattern] -> IPattern
IInductiveOrPApplyPat String
name ((TIPattern -> IPattern) -> [TIPattern] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> IPattern
stripTypePat [TIPattern]
ps)
    
    stripTypeLoopRange :: TILoopRange -> ILoopRange
    stripTypeLoopRange :: TILoopRange -> ILoopRange
stripTypeLoopRange (TILoopRange TIExpr
e1 TIExpr
e2 TIPattern
pat) = IExpr -> IExpr -> IPattern -> ILoopRange
ILoopRange (TIExpr -> IExpr
stripType TIExpr
e1) (TIExpr -> IExpr
stripType TIExpr
e2) (TIPattern -> IPattern
stripTypePat TIPattern
pat)

-- | Typed pattern with recursive structure (like TIExpr)
data TIPattern = TIPattern
  { TIPattern -> TypeScheme
tipScheme :: TypeScheme      -- ^ Type scheme with type variables and constraints
  , TIPattern -> TIPatternNode
tipPatternNode :: TIPatternNode  -- ^ The pattern node
  } deriving Int -> TIPattern -> ShowS
[TIPattern] -> ShowS
TIPattern -> String
(Int -> TIPattern -> ShowS)
-> (TIPattern -> String)
-> ([TIPattern] -> ShowS)
-> Show TIPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIPattern -> ShowS
showsPrec :: Int -> TIPattern -> ShowS
$cshow :: TIPattern -> String
show :: TIPattern -> String
$cshowList :: [TIPattern] -> ShowS
showList :: [TIPattern] -> ShowS
Show

-- | Pattern node with type information (recursive structure)
data TIPatternNode
  = TIWildCard
  | TIPatVar String
  | TIValuePat TIExpr
  | TIPredPat TIExpr
  | TIIndexedPat TIPattern [TIExpr]
  | TILetPat [TIBindingExpr] TIPattern
  | TINotPat TIPattern
  | TIAndPat TIPattern TIPattern
  | TIOrPat TIPattern TIPattern
  | TIForallPat TIPattern TIPattern
  | TITuplePat [TIPattern]
  | TIInductivePat String [TIPattern]
  | TILoopPat String TILoopRange TIPattern TIPattern
  | TIContPat
  | TIPApplyPat TIExpr [TIPattern]
  | TIVarPat String
  | TIInductiveOrPApplyPat String [TIPattern]
  | TISeqNilPat
  | TISeqConsPat TIPattern TIPattern
  | TILaterPatVar
  | TIDApplyPat TIPattern [TIPattern]
  deriving Int -> TIPatternNode -> ShowS
[TIPatternNode] -> ShowS
TIPatternNode -> String
(Int -> TIPatternNode -> ShowS)
-> (TIPatternNode -> String)
-> ([TIPatternNode] -> ShowS)
-> Show TIPatternNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIPatternNode -> ShowS
showsPrec :: Int -> TIPatternNode -> ShowS
$cshow :: TIPatternNode -> String
show :: TIPatternNode -> String
$cshowList :: [TIPatternNode] -> ShowS
showList :: [TIPatternNode] -> ShowS
Show

-- | Get the type of a typed pattern (extracts Type from TypeScheme)
tipType :: TIPattern -> Type
tipType :: TIPattern -> Type
tipType (TIPattern (Forall [TyVar]
_ [Constraint]
_ Type
t) TIPatternNode
_) = Type
t

-- | Typed loop range
data TILoopRange = TILoopRange TIExpr TIExpr TIPattern
  deriving Int -> TILoopRange -> ShowS
[TILoopRange] -> ShowS
TILoopRange -> String
(Int -> TILoopRange -> ShowS)
-> (TILoopRange -> String)
-> ([TILoopRange] -> ShowS)
-> Show TILoopRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TILoopRange -> ShowS
showsPrec :: Int -> TILoopRange -> ShowS
$cshow :: TILoopRange -> String
show :: TILoopRange -> String
$cshowList :: [TILoopRange] -> ShowS
showList :: [TILoopRange] -> ShowS
Show

-- NOTE: TIBindingExpr, TIMatchClause, and TIPatternDef are now defined
-- near TIExprNode (around line 302-308) to keep type definitions close together

instance {-# OVERLAPPING #-} Show (Index String) where
  show :: Index String -> String
show (Sup String
s)    = String
"~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  show (Sub String
s)    = String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  show (SupSub String
s) = String
"~_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  show (User String
s)   = String
"|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  show (DF Integer
_ Integer
_)   = String
""