content: -------------------------------------------------------------------------------
  ---- |
  ---- 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]
    
  