module CC.AST.Source(
    module CC.AST.Source,
    module CC.Types
) where

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

import CC.Pretty
import CC.Types


data Program = Program [Decl]
  deriving (Show, Read)

data Decl = DeclFunc FuncDef
          | DeclType TypeDef
          | DeclAlias AliasDef
  deriving (Show, Read)

data FuncDef =
    FuncDef (Maybe Type)
            (Name, SourceRange)
            [(Name, SourceRange)]
            Expr
  deriving (Show, Read)

-- Named type with named arguments
data TypeDef = TypeDef (Name, SourceRange) [(Name, SourceRange)] Type
  deriving (Show, Read)

data AliasDef = AliasDef (Name, SourceRange) [(Name, SourceRange)] Type
  deriving (Show, Read)

data Type = TFun Type Type
          | TInt
          | TTup [Type]
          | TNamed Name [Type]  -- named type with type arguments
          | TUnion (Set Type)
          | TyVar Name
  deriving (Eq, Ord, Show, Read)

data Expr = Lam SourceRange [(Name, SourceRange)] Expr
          | Let SourceRange (Name, SourceRange) Expr Expr
          | Call SourceRange Expr Expr
          | Int SourceRange Int
          | Tup SourceRange [Expr]
          | Var SourceRange Name
          | Constr SourceRange Name  -- type constructor
          | Annot SourceRange Expr Type
  deriving (Show, Read)

instance Semigroup Program where Program p1 <> Program p2 = Program (p1 <> p2)
instance Monoid    Program where mempty                   = Program mempty

instance Pretty Type where
    prettyPrec _ TInt = "Int"
    prettyPrec p (TFun a b) =
        precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b)
    prettyPrec _ (TTup ts) =
        "(" ++ intercalate ", " (map pretty ts) ++ ")"
    prettyPrec _ (TNamed n ts) =
        n ++ "[" ++ intercalate ", " (map pretty ts) ++ "]"
    prettyPrec _ (TUnion ts) =
        "{" ++ intercalate " | " (map pretty (Set.toList ts)) ++ "}"
    prettyPrec _ (TyVar n) = "<" ++ n ++ ">"

instance HasRange Expr where
    range (Lam sr _ _) = sr
    range (Let sr _ _ _) = sr
    range (Call sr _ _) = sr
    range (Int sr _) = sr
    range (Tup sr _) = sr
    range (Var sr _) = sr
    range (Constr sr _) = sr
    range (Annot sr _ _) = sr