{- |
Module      : Language.Egison.Type.Error
Licence     : MIT

This module defines type errors for the Egison type system.
-}

{-# LANGUAGE DeriveGeneric #-}

module Language.Egison.Type.Error
  ( TypeError(..)
  , TypeErrorContext(..)
  , TypeWarning(..)
  , SourceLocation(..)
  , formatTypeError
  , formatTypeWarning
  , emptyContext
  , withLocation
  , withExpr
  , withContext
  ) where

import           Data.List                  (intercalate)
import           GHC.Generics               (Generic)

import           Language.Egison.Type.Index (IndexSpec)
import           Language.Egison.Type.Types (TensorShape (..), TyVar (..), Type (..))

-- | Source location information
data SourceLocation = SourceLocation
  { SourceLocation -> Maybe FilePath
srcFile   :: Maybe FilePath     -- ^ Source file path
  , SourceLocation -> Maybe Int
srcLine   :: Maybe Int          -- ^ Line number (1-based)
  , SourceLocation -> Maybe Int
srcColumn :: Maybe Int          -- ^ Column number (1-based)
  } deriving (SourceLocation -> SourceLocation -> Bool
(SourceLocation -> SourceLocation -> Bool)
-> (SourceLocation -> SourceLocation -> Bool) -> Eq SourceLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceLocation -> SourceLocation -> Bool
== :: SourceLocation -> SourceLocation -> Bool
$c/= :: SourceLocation -> SourceLocation -> Bool
/= :: SourceLocation -> SourceLocation -> Bool
Eq, Int -> SourceLocation -> ShowS
[SourceLocation] -> ShowS
SourceLocation -> FilePath
(Int -> SourceLocation -> ShowS)
-> (SourceLocation -> FilePath)
-> ([SourceLocation] -> ShowS)
-> Show SourceLocation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceLocation -> ShowS
showsPrec :: Int -> SourceLocation -> ShowS
$cshow :: SourceLocation -> FilePath
show :: SourceLocation -> FilePath
$cshowList :: [SourceLocation] -> ShowS
showList :: [SourceLocation] -> ShowS
Show, (forall x. SourceLocation -> Rep SourceLocation x)
-> (forall x. Rep SourceLocation x -> SourceLocation)
-> Generic SourceLocation
forall x. Rep SourceLocation x -> SourceLocation
forall x. SourceLocation -> Rep SourceLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceLocation -> Rep SourceLocation x
from :: forall x. SourceLocation -> Rep SourceLocation x
$cto :: forall x. Rep SourceLocation x -> SourceLocation
to :: forall x. Rep SourceLocation x -> SourceLocation
Generic)

-- | Context information for where a type error occurred
data TypeErrorContext = TypeErrorContext
  { TypeErrorContext -> Maybe SourceLocation
errorLocation :: Maybe SourceLocation  -- ^ Precise source location
  , TypeErrorContext -> Maybe FilePath
errorExpr     :: Maybe String          -- ^ Expression that caused the error
  , TypeErrorContext -> Maybe FilePath
errorContext  :: Maybe String          -- ^ Additional context (e.g., "in function application")
  } deriving (TypeErrorContext -> TypeErrorContext -> Bool
(TypeErrorContext -> TypeErrorContext -> Bool)
-> (TypeErrorContext -> TypeErrorContext -> Bool)
-> Eq TypeErrorContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeErrorContext -> TypeErrorContext -> Bool
== :: TypeErrorContext -> TypeErrorContext -> Bool
$c/= :: TypeErrorContext -> TypeErrorContext -> Bool
/= :: TypeErrorContext -> TypeErrorContext -> Bool
Eq, Int -> TypeErrorContext -> ShowS
[TypeErrorContext] -> ShowS
TypeErrorContext -> FilePath
(Int -> TypeErrorContext -> ShowS)
-> (TypeErrorContext -> FilePath)
-> ([TypeErrorContext] -> ShowS)
-> Show TypeErrorContext
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeErrorContext -> ShowS
showsPrec :: Int -> TypeErrorContext -> ShowS
$cshow :: TypeErrorContext -> FilePath
show :: TypeErrorContext -> FilePath
$cshowList :: [TypeErrorContext] -> ShowS
showList :: [TypeErrorContext] -> ShowS
Show, (forall x. TypeErrorContext -> Rep TypeErrorContext x)
-> (forall x. Rep TypeErrorContext x -> TypeErrorContext)
-> Generic TypeErrorContext
forall x. Rep TypeErrorContext x -> TypeErrorContext
forall x. TypeErrorContext -> Rep TypeErrorContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeErrorContext -> Rep TypeErrorContext x
from :: forall x. TypeErrorContext -> Rep TypeErrorContext x
$cto :: forall x. Rep TypeErrorContext x -> TypeErrorContext
to :: forall x. Rep TypeErrorContext x -> TypeErrorContext
Generic)

-- | Empty error context
emptyContext :: TypeErrorContext
emptyContext :: TypeErrorContext
emptyContext = Maybe SourceLocation
-> Maybe FilePath -> Maybe FilePath -> TypeErrorContext
TypeErrorContext Maybe SourceLocation
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing

-- | Add location to a context
withLocation :: SourceLocation -> TypeErrorContext -> TypeErrorContext
withLocation :: SourceLocation -> TypeErrorContext -> TypeErrorContext
withLocation SourceLocation
loc TypeErrorContext
ctx = TypeErrorContext
ctx { errorLocation = Just loc }

-- | Add expression to a context
withExpr :: String -> TypeErrorContext -> TypeErrorContext
withExpr :: FilePath -> TypeErrorContext -> TypeErrorContext
withExpr FilePath
expr TypeErrorContext
ctx = TypeErrorContext
ctx { errorExpr = Just expr }

-- | Add context message
withContext :: String -> TypeErrorContext -> TypeErrorContext
withContext :: FilePath -> TypeErrorContext -> TypeErrorContext
withContext FilePath
ctxMsg TypeErrorContext
ctx = TypeErrorContext
ctx { errorContext = Just ctxMsg }

-- | Type warnings (non-fatal issues)
data TypeWarning
  = UnboundVariableWarning String TypeErrorContext
    -- ^ Variable not in type environment (treated as Any in permissive mode)
  | AnyTypeWarning String TypeErrorContext
    -- ^ Expression has 'Any' type
  | PartiallyTypedWarning String Type TypeErrorContext
    -- ^ Expression is only partially typed
  | UnsupportedExpressionWarning String TypeErrorContext
    -- ^ Expression type cannot be inferred (treated as Any)
  | DeprecatedFeatureWarning String TypeErrorContext
    -- ^ Feature is deprecated
  deriving (TypeWarning -> TypeWarning -> Bool
(TypeWarning -> TypeWarning -> Bool)
-> (TypeWarning -> TypeWarning -> Bool) -> Eq TypeWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeWarning -> TypeWarning -> Bool
== :: TypeWarning -> TypeWarning -> Bool
$c/= :: TypeWarning -> TypeWarning -> Bool
/= :: TypeWarning -> TypeWarning -> Bool
Eq, Int -> TypeWarning -> ShowS
[TypeWarning] -> ShowS
TypeWarning -> FilePath
(Int -> TypeWarning -> ShowS)
-> (TypeWarning -> FilePath)
-> ([TypeWarning] -> ShowS)
-> Show TypeWarning
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeWarning -> ShowS
showsPrec :: Int -> TypeWarning -> ShowS
$cshow :: TypeWarning -> FilePath
show :: TypeWarning -> FilePath
$cshowList :: [TypeWarning] -> ShowS
showList :: [TypeWarning] -> ShowS
Show, (forall x. TypeWarning -> Rep TypeWarning x)
-> (forall x. Rep TypeWarning x -> TypeWarning)
-> Generic TypeWarning
forall x. Rep TypeWarning x -> TypeWarning
forall x. TypeWarning -> Rep TypeWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeWarning -> Rep TypeWarning x
from :: forall x. TypeWarning -> Rep TypeWarning x
$cto :: forall x. Rep TypeWarning x -> TypeWarning
to :: forall x. Rep TypeWarning x -> TypeWarning
Generic)

-- | Type errors
data TypeError
  = UnificationError Type Type TypeErrorContext
    -- ^ Two types could not be unified
  | OccursCheckError TyVar Type TypeErrorContext
    -- ^ Infinite type detected (e.g., a = [a])
  | UnboundVariable String TypeErrorContext
    -- ^ Variable not found in type environment
  | TypeMismatch Type Type String TypeErrorContext
    -- ^ Types don't match with explanation
  | TensorShapeMismatch TensorShape TensorShape TypeErrorContext
    -- ^ Tensor shapes are incompatible
  | TensorIndexMismatch IndexSpec IndexSpec TypeErrorContext
    -- ^ Tensor indices are incompatible
  | ArityMismatch Int Int TypeErrorContext
    -- ^ Wrong number of arguments
  | NotAFunction Type TypeErrorContext
    -- ^ Tried to apply a non-function
  | NotATensor Type TypeErrorContext
    -- ^ Expected a tensor type
  | AmbiguousType TyVar TypeErrorContext
    -- ^ Could not infer a concrete type
  | TypeAnnotationMismatch Type Type TypeErrorContext
    -- ^ Inferred type doesn't match annotation
  | UnsupportedFeature String TypeErrorContext
    -- ^ Feature not yet implemented
  deriving (TypeError -> TypeError -> Bool
(TypeError -> TypeError -> Bool)
-> (TypeError -> TypeError -> Bool) -> Eq TypeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeError -> TypeError -> Bool
== :: TypeError -> TypeError -> Bool
$c/= :: TypeError -> TypeError -> Bool
/= :: TypeError -> TypeError -> Bool
Eq, Int -> TypeError -> ShowS
[TypeError] -> ShowS
TypeError -> FilePath
(Int -> TypeError -> ShowS)
-> (TypeError -> FilePath)
-> ([TypeError] -> ShowS)
-> Show TypeError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeError -> ShowS
showsPrec :: Int -> TypeError -> ShowS
$cshow :: TypeError -> FilePath
show :: TypeError -> FilePath
$cshowList :: [TypeError] -> ShowS
showList :: [TypeError] -> ShowS
Show, (forall x. TypeError -> Rep TypeError x)
-> (forall x. Rep TypeError x -> TypeError) -> Generic TypeError
forall x. Rep TypeError x -> TypeError
forall x. TypeError -> Rep TypeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeError -> Rep TypeError x
from :: forall x. TypeError -> Rep TypeError x
$cto :: forall x. Rep TypeError x -> TypeError
to :: forall x. Rep TypeError x -> TypeError
Generic)


-- | Format a type error for display
formatTypeError :: TypeError -> String
formatTypeError :: TypeError -> FilePath
formatTypeError TypeError
err = case TypeError
err of
  UnificationError Type
t1 Type
t2 TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Cannot unify types:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Expected: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Actual:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t2 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t2 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"

  OccursCheckError (TyVar FilePath
v) Type
t TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Infinite type detected:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Type variable '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
v FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"' occurs in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t

  UnboundVariable FilePath
name TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Unbound variable: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name

  TypeMismatch Type
t1 Type
t2 FilePath
reason TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Type mismatch: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
reason FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Expected: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Actual:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t2

  TensorShapeMismatch TensorShape
sh1 TensorShape
sh2 TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Tensor shape mismatch:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Expected: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ TensorShape -> FilePath
prettyShape TensorShape
sh1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Actual:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ TensorShape -> FilePath
prettyShape TensorShape
sh2

  TensorIndexMismatch IndexSpec
is1 IndexSpec
is2 TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Tensor index mismatch:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Expected: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IndexSpec -> FilePath
forall a. Show a => a -> FilePath
show IndexSpec
is1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Actual:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ IndexSpec -> FilePath
forall a. Show a => a -> FilePath
show IndexSpec
is2

  ArityMismatch Int
expected Int
actual TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Wrong number of arguments:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Expected: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
expected FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Actual:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
actual

  NotAFunction Type
t TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Not a function type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t

  NotATensor Type
t TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Expected a tensor type, but got: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t

  AmbiguousType (TyVar FilePath
v) TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Ambiguous type: cannot infer a concrete type for '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
v FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'"

  TypeAnnotationMismatch Type
annotated Type
inferred TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Type annotation mismatch:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Annotation: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
annotated FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Inferred:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
inferred

  UnsupportedFeature FilePath
feature TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Unsupported feature: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
feature

-- | Format error with context
formatWithContext :: TypeErrorContext -> String -> String
formatWithContext :: TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx FilePath
msg =
  let locStr :: FilePath
locStr = case TypeErrorContext -> Maybe SourceLocation
errorLocation TypeErrorContext
ctx of
        Just SourceLocation
loc -> FilePath
"At " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceLocation -> FilePath
formatSourceLocation SourceLocation
loc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":\n"
        Maybe SourceLocation
Nothing  -> FilePath
""
      exprStr :: FilePath
exprStr = case TypeErrorContext -> Maybe FilePath
errorExpr TypeErrorContext
ctx of
        Just FilePath
expr -> FilePath
"In expression: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
expr FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
        Maybe FilePath
Nothing   -> FilePath
""
      ctxStr :: FilePath
ctxStr = case TypeErrorContext -> Maybe FilePath
errorContext TypeErrorContext
ctx of
        Just FilePath
c -> FilePath
"(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
c FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")\n"
        Maybe FilePath
Nothing -> FilePath
""
  in FilePath
locStr FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
exprStr FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
ctxStr FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
msg

-- | Format source location
formatSourceLocation :: SourceLocation -> String
formatSourceLocation :: SourceLocation -> FilePath
formatSourceLocation SourceLocation
loc =
  let file :: FilePath
file = FilePath -> ShowS -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"<unknown>" ShowS
forall a. a -> a
id (SourceLocation -> Maybe FilePath
srcFile SourceLocation
loc)
      line :: FilePath
line = FilePath -> (Int -> FilePath) -> Maybe Int -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"?" Int -> FilePath
forall a. Show a => a -> FilePath
show (SourceLocation -> Maybe Int
srcLine SourceLocation
loc)
      col :: FilePath
col  = FilePath -> (Int -> FilePath) -> Maybe Int -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
":" ++) ShowS -> (Int -> FilePath) -> Int -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) (SourceLocation -> Maybe Int
srcColumn SourceLocation
loc)
  in FilePath
file FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
line FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
col

-- | Format a type warning for display
formatTypeWarning :: TypeWarning -> String
formatTypeWarning :: TypeWarning -> FilePath
formatTypeWarning TypeWarning
warn = case TypeWarning
warn of
  UnboundVariableWarning FilePath
name TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Warning: Unbound variable '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"' (assuming type 'Any')"

  AnyTypeWarning FilePath
desc TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Warning: Expression has 'Any' type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc

  PartiallyTypedWarning FilePath
desc Type
ty TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Warning: Partially typed expression: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
      FilePath
"  Inferred type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
ty

  UnsupportedExpressionWarning FilePath
desc TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Warning: Cannot infer type for: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (assuming 'Any')"

  DeprecatedFeatureWarning FilePath
feature TypeErrorContext
ctx ->
    TypeErrorContext -> ShowS
formatWithContext TypeErrorContext
ctx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath
"Warning: Deprecated feature: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
feature

-- | Pretty print a type
prettyType :: Type -> String
prettyType :: Type -> FilePath
prettyType Type
TInt = FilePath
"Integer"
prettyType Type
TMathExpr = FilePath
"MathExpr"
prettyType Type
TPolyExpr = FilePath
"PolyExpr"
prettyType Type
TTermExpr = FilePath
"TermExpr"
prettyType Type
TSymbolExpr = FilePath
"SymbolExpr"
prettyType Type
TIndexExpr = FilePath
"IndexExpr"
prettyType Type
TFloat = FilePath
"Float"
prettyType Type
TBool = FilePath
"Bool"
prettyType Type
TChar = FilePath
"Char"
prettyType Type
TString = FilePath
"String"
prettyType (TVar (TyVar FilePath
v)) = FilePath
v
prettyType (TTuple [Type]
ts) = FilePath
"(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((Type -> FilePath) -> [Type] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Type -> FilePath
prettyType [Type]
ts) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"
prettyType (TCollection Type
t) = FilePath
"[" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"]"
prettyType (TInductive FilePath
name []) = FilePath
name
prettyType (TInductive FilePath
name [Type]
args) = FilePath
name FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords ((Type -> FilePath) -> [Type] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Type -> FilePath
prettyType [Type]
args)
prettyType (TTensor Type
t) = FilePath
"Tensor " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t
prettyType (THash Type
k Type
v) = FilePath
"Hash " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
v
prettyType (TMatcher Type
t) = FilePath
"Matcher " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t
prettyType (TFun Type
t1 Type
t2) = Type -> FilePath
prettyType Type
t1 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" -> " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t2
prettyType (TIO Type
t) = FilePath
"IO " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t
prettyType (TIORef Type
t) = FilePath
"IORef " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
prettyType Type
t
prettyType Type
TPort = FilePath
"Port"
prettyType Type
TAny = FilePath
"_"

-- | Pretty print a tensor shape
prettyShape :: TensorShape -> String
prettyShape :: TensorShape -> FilePath
prettyShape (ShapeLit [Integer]
dims) = [Integer] -> FilePath
forall a. Show a => a -> FilePath
show [Integer]
dims
prettyShape (ShapeVar FilePath
v) = FilePath
v
prettyShape TensorShape
ShapeUnknown = FilePath
"?"