elna/lib/Language/Elna/SymbolTable.hs

module Language.Elna.SymbolTable
    ( Info(..)
    , ParameterInfo(..)
    , SymbolTable
    , builtInSymbolTable
    , empty
    , enter
    , fromList
    , lookup
    , member
    ) where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List (sort)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Vector (Vector)
import Language.Elna.Location (Identifier(..))
import Language.Elna.Types (Type(..), intType, booleanType)
import Prelude hiding (lookup)

newtype SymbolTable = SymbolTable (HashMap Identifier Info)
    deriving (Eq, Show)

instance Semigroup SymbolTable
  where
    (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs

instance Monoid SymbolTable
  where
    mempty = empty

builtInSymbolTable :: SymbolTable
builtInSymbolTable = SymbolTable $ HashMap.fromList
    [ ("boolean", TypeInfo booleanType)
    , ("int", TypeInfo intType)
    ]

empty :: SymbolTable
empty = SymbolTable HashMap.empty

enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
enter identifier info table@(SymbolTable hashTable)
    | member identifier table = Nothing
    | otherwise = Just
        $ SymbolTable
        $ HashMap.insert identifier info hashTable

lookup :: Identifier -> SymbolTable -> Maybe Info
lookup identifier (SymbolTable table) = HashMap.lookup identifier table

member :: Identifier -> SymbolTable -> Bool
member identifier (SymbolTable table) = HashMap.member identifier table

fromList :: [(Identifier, Info)] -> Either (NonEmpty Identifier) SymbolTable
fromList elements
    | Just identifierDuplicates' <- identifierDuplicates =
        Left identifierDuplicates'
    | otherwise = Right $ SymbolTable $ HashMap.fromList elements
  where
    identifierDuplicates = NonEmpty.nonEmpty
        $ fmap NonEmpty.head
        $ filter ((> 1) . NonEmpty.length)
        $ NonEmpty.group . sort
        $ fst <$> elements

data ParameterInfo = ParameterInfo
    { name :: Identifier
    , type' :: Type
    , isReferenceParameter :: Bool
    } deriving (Eq, Show)

data Info
    = TypeInfo Type
    | VariableInfo Type Bool
    | ProcedureInfo SymbolTable (Vector ParameterInfo)
    deriving (Eq, Show)