-------------------------------------------------------------------------------
---- |
---- Module      :  RSL.AST
---- Copyright   :  (c) Syoyo Fujita
---- License     :  Modified BSD
----
---- Maintainer  :  syoyo@lucillerender.org
---- Stability   :  experimental
---- Portability :  GHC 6.8
----
---- RSLParser   :  Data structure for RSL Abstract Syntax Tree.
----
-------------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable #-} 

module RSL.AST where

import Data.Generics      -- from syb package

data Op
  = OpAdd
  | OpSub
  | OpMul
  | OpDiv
  | OpDot       -- .
  | OpNeg       -- !
  | OpGe        -- >=
  | OpGt        -- >
  | OpLe        -- <=
  | OpLt        -- <
  | OpEq        -- ==
  | OpNeq       -- !=
  | OpOr        -- ||
  | OpAnd       -- &&
  | OpAssign    -- =
  | OpAddAssign -- +=
  | OpSubAssign -- -=
  | OpMulAssign -- *=
  | OpDivAssign -- /=
    deriving (Show, Eq, Typeable, Data)

-- | Output type specifier
data OutputSpec = OutputSpec
    deriving (Show, Eq, Typeable, Data) 
  
data Type
  = TyUnknown
  | TyVoid
  | TyInt
  | TyString
  | TyFloat
  | TyVector
  | TyColor
  | TyPoint
  | TyNormal
  | TyMatrix
  | TyBool                  -- Used internally
  -- | TyQualified Qual Type
  | TyArray Int Type        -- Array type
    deriving (Show, Eq, Typeable, Data)

isVectorTy :: Type -> Bool
isVectorTy ty = case ty of
  TyVector -> True
  TyColor  -> True
  TyPoint  -> True
  TyNormal -> True
  _        -> False

data VaArgs
  = VaArgs Int [Type]
    deriving (Show, Eq, Typeable, Data)

data StorageClass
  = Uniform
  | Varying
  | Vertex            -- Not in RI Spec3.2
  | FaceVarying       -- Not in RI Spec3.2
  | FaceVertex        -- Not in RI Spec3.2
    deriving (Show, Eq, Typeable, Data)

data ShaderType 
  = Surface
  | Light
  | Volume
  | Displacement
  | Imager
    deriving (Show, Eq, Typeable, Data)

data Const 
  = I Int             -- optinal?
  | F Double
  | S String
  | V [Double]        -- vector
  | M [Double]        -- matrix
    deriving (Show, Eq, Typeable, Data)

data Kind
  = KindVariable
  | KindExternalVariable      -- used in nested function.
  | KindFormalVariable
  | KindBuiltinVariable
    deriving (Show, Eq, Typeable, Data)


data Symbol
  = SymVar  String              -- name of the symbol
            Type                -- type of the symbol
            (Maybe OutputSpec)  -- output spec
            StorageClass        -- storage class of the symbol
            Kind                -- kind of the symbol

  | SymFunc String              -- name of the function
            Type                -- return type of the function
            [Type]              -- arguments of the function         
            [Type]              -- optional arguments
            (Maybe String)      -- nested function has uniqe name

  | SymBuiltinFunc 
            String              -- name of the function
            Type                -- return type of the function
            [Type]              -- arguments of the function         
            (Maybe Type)        -- vaarg

    deriving (Show, Eq, Typeable, Data)

getNameOfSym (SymVar  name _ _ _ _)       = name
getNameOfSym (SymFunc name _ _ _ _)       = name
getNameOfSym (SymBuiltinFunc name _ _ _)  = name

getTyOfSym   (SymVar  _ ty _ _ _)         = ty
getTyOfSym   (SymFunc _ ty _ _ _)         = ty
getTyOfSym   (SymBuiltinFunc _ ty _ _)    = ty

getTyOfExpr :: Expr -> Type
getTyOfExpr expr = case expr of
  Const (Just sym) _              -> getTyOfSym sym
  TypeCast (Just sym) _ _ _       -> getTyOfSym sym
  Var   (Just sym) _              -> getTyOfSym sym
  Array (Just sym) _ _            -> getTyOfSym sym
  UnaryOp (Just sym) _ _          -> getTyOfSym sym
  BinOp (Just sym) _ _ _          -> getTyOfSym sym
  Call (Just sym) _ _             -> getTyOfSym sym
  Triple (Just sym) _             -> getTyOfSym sym
  Conditional (Just sym) _ _ _    -> getTyOfSym sym
  _                               -> error $ "getTyOfExpr: TODO: " ++ (show expr)

type SymbolTable
  = [(String, [Symbol])]

type Statement = [Expr]

--
-- TODO: - Separate Statement constructor from Expr.
--       - Add field for SourcePos
--

--
-- We define 3-address form of AST.
--
data Expr 
  = Const      (Maybe Symbol)
                Const
  | TypeCast   (Maybe Symbol)
                Type                        -- toType
                String                      -- spaceType if any
                Expr                        -- fromExpr
  | Var        (Maybe Symbol)
                Symbol
  | Assign     (Maybe Symbol)
                Op                          -- operator
                Expr                        -- lhs
                Expr                        -- rhs
  | Def         Symbol (Maybe Expr)         -- variable definition
  | UnaryOp    (Maybe Symbol)
                Op                          -- Operator
                Expr                        
  | BinOp      (Maybe Symbol)
                Op                          -- Operator
                Expr                        -- Left
                Expr                        -- Right
  | Call       (Maybe Symbol)
                Symbol                      -- Function signature
               [Expr]                       -- Arguments

  | Triple     (Maybe Symbol)
               [Expr]                       -- length(expr) == 3

  | Conditional (Maybe Symbol)
                Expr                        -- cond
                Expr                        -- then
                Expr                        -- else


  -- Stmt
  
  | If          Expr                      -- condition
                [Expr]                    -- statement
                (Maybe [Expr])            -- else statement

  | While       Expr                      -- condition
               [Expr]                     -- statement

  | For         Expr                      -- init
                Expr                      -- cond
                Expr                      -- inc
               [Expr]                     -- statement

  | Extract    (Maybe Symbol)
                Char                      -- x, y, z, or w
                Expr                      -- Should be vector expr.

  | Illuminance Expr                      -- position
                Expr                      -- normal
                Expr                      -- angle
               (Maybe String)             -- category
               [Expr]                     -- statement
  | Illuminate  Expr                      -- position
                Expr                      -- FIXME: make this optional
                Expr                      -- FIXME: make this optional
               [Expr]                     -- statement

  | Return     (Maybe Symbol)
                Expr                      -- expr
  | NestedFunc  Int                       -- unique id
                Type                      -- return type
                String                    -- func name
                [FormalDecl]              -- args
                [Expr]                    -- statement
  | Array      (Maybe Symbol)
                Expr                      -- index
                Expr                      -- expr
  | EList      [Expr]                     -- internal expr
  | Nil                                   -- null expr
    deriving (Show, Eq, Typeable, Data)
  

data FormalDecl 
  = FormalDecl Type (Maybe OutputSpec) String (Maybe Expr)     -- TODO: Allow const expression
    deriving (Show, Eq, Typeable, Data)

data Func 
  = ShaderFunc ShaderType String [FormalDecl] [Expr]
  | UserFunc   Type       String
  | StructDef             String [FormalDecl]                  -- RSL2
  | Preprocessor String
    deriving (Show, Eq, Typeable, Data)

type RSLUnit = [Func]
  
