{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData      #-}
module Language.GLSL.Decls where

import qualified Data.IntMap.Strict as M
import           Language.GLSL.AST  (Name (..), NameExpr (..), NameId (..),
                                     Namespace (..))


data Decls a = Decls
  { Decls a -> IntMap a
declsS   :: M.IntMap a
  , Decls a -> IntMap a
declsT   :: M.IntMap a
  , Decls a -> IntMap a
declsU   :: M.IntMap a
  , Decls a -> IntMap a
declsVF  :: M.IntMap a
  , Decls a -> IntMap a
declsIn  :: M.IntMap a
  , Decls a -> IntMap a
declsOut :: M.IntMap a
  }

emptyDecls :: Decls a
emptyDecls :: Decls a
emptyDecls = IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> Decls a
forall a.
IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> IntMap a
-> Decls a
Decls IntMap a
forall a. IntMap a
M.empty IntMap a
forall a. IntMap a
M.empty IntMap a
forall a. IntMap a
M.empty IntMap a
forall a. IntMap a
M.empty IntMap a
forall a. IntMap a
M.empty IntMap a
forall a. IntMap a
M.empty

addDecl :: Namespace -> NameId -> a -> Decls a -> Decls a
addDecl :: Namespace -> NameId -> a -> Decls a -> Decls a
addDecl Namespace
NsT (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsT :: IntMap a
declsT = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsT}
addDecl Namespace
NsS (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsS :: IntMap a
declsS = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsS}
addDecl Namespace
NsU (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsU :: IntMap a
declsU = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsU}
addDecl Namespace
NsVF (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsVF :: IntMap a
declsVF = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsVF}
addDecl Namespace
NsIn (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsIn :: IntMap a
declsIn = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsIn}
addDecl Namespace
NsOut (NameId Int
n) a
v decls :: Decls a
decls@Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = Decls a
decls{declsOut :: IntMap a
declsOut = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
n a
v IntMap a
declsOut}

addDeclN :: Name -> a -> Decls a -> Decls a
addDeclN :: Name -> a -> Decls a -> Decls a
addDeclN (Name Namespace
ns NameId
n) = Namespace -> NameId -> a -> Decls a -> Decls a
forall a. Namespace -> NameId -> a -> Decls a -> Decls a
addDecl Namespace
ns NameId
n

addDeclNE :: NameExpr -> a -> Decls a -> Decls a
addDeclNE :: NameExpr -> a -> Decls a -> Decls a
addDeclNE (NameExpr Name
n)      = Name -> a -> Decls a -> Decls a
forall a. Name -> a -> Decls a -> Decls a
addDeclN Name
n
addDeclNE (UniformExpr NameId
n NameId
m) = Namespace -> NameId -> a -> Decls a -> Decls a
forall a. Namespace -> NameId -> a -> Decls a -> Decls a
addDecl Namespace
NsU ((NameId, NameId) -> NameId
toUniformId (NameId
n, NameId
m))

getDecls :: Namespace -> Decls a -> M.IntMap a
getDecls :: Namespace -> Decls a -> IntMap a
getDecls Namespace
NsT Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..}   = IntMap a
declsT
getDecls Namespace
NsS Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..}   = IntMap a
declsS
getDecls Namespace
NsU Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..}   = IntMap a
declsU
getDecls Namespace
NsVF Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..}  = IntMap a
declsVF
getDecls Namespace
NsIn Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..}  = IntMap a
declsIn
getDecls Namespace
NsOut Decls{IntMap a
declsOut :: IntMap a
declsIn :: IntMap a
declsVF :: IntMap a
declsU :: IntMap a
declsT :: IntMap a
declsS :: IntMap a
declsOut :: forall a. Decls a -> IntMap a
declsIn :: forall a. Decls a -> IntMap a
declsVF :: forall a. Decls a -> IntMap a
declsU :: forall a. Decls a -> IntMap a
declsT :: forall a. Decls a -> IntMap a
declsS :: forall a. Decls a -> IntMap a
..} = IntMap a
declsOut

getDecl :: Namespace -> NameId -> Decls a -> Maybe a
getDecl :: Namespace -> NameId -> Decls a -> Maybe a
getDecl Namespace
ns (NameId Int
n) Decls a
decls = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
n (Namespace -> Decls a -> IntMap a
forall a. Namespace -> Decls a -> IntMap a
getDecls Namespace
ns Decls a
decls)

getDeclN :: Name -> Decls a -> Maybe a
getDeclN :: Name -> Decls a -> Maybe a
getDeclN (Name Namespace
ns NameId
n) = Namespace -> NameId -> Decls a -> Maybe a
forall a. Namespace -> NameId -> Decls a -> Maybe a
getDecl Namespace
ns NameId
n

getDeclNE :: NameExpr -> Decls a -> Maybe a
getDeclNE :: NameExpr -> Decls a -> Maybe a
getDeclNE (NameExpr Name
n)      = Name -> Decls a -> Maybe a
forall a. Name -> Decls a -> Maybe a
getDeclN Name
n
getDeclNE (UniformExpr NameId
n NameId
m) = Namespace -> NameId -> Decls a -> Maybe a
forall a. Namespace -> NameId -> Decls a -> Maybe a
getDecl Namespace
NsU ((NameId, NameId) -> NameId
toUniformId (NameId
n, NameId
m))

toUniformId :: (NameId, NameId) -> NameId
toUniformId :: (NameId, NameId) -> NameId
toUniformId (NameId Int
n, NameId Int
m) = Int -> NameId
NameId (Int -> NameId) -> Int -> NameId
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m

fromUniformId :: NameId -> (NameId, NameId)
fromUniformId :: NameId -> (NameId, NameId)
fromUniformId (NameId Int
i) = let (Int
n, Int
m) = Int
i Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
1000 in (Int -> NameId
NameId Int
n, Int -> NameId
NameId Int
m)

showUniformId :: NameId -> String
showUniformId :: NameId -> String
showUniformId NameId
i =
  let (NameId
n, NameId
m) = NameId -> (NameId, NameId)
fromUniformId NameId
i in
  String
"u" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NameId -> String
forall a. Show a => a -> String
show NameId
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".u" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NameId -> String
forall a. Show a => a -> String
show NameId
m