-- | This module is designed to be imported qualified.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
module Language.Haskell.Names.LocalSymbolTable
  ( Table
  , empty
  , lookupValue
  , addValue
  ) where

import           Fay.Compiler.Prelude               hiding (empty)
import           Language.Haskell.Names.SyntaxUtils
import           Language.Haskell.Names.Types

import qualified Data.Map                           as Map
import           Language.Haskell.Exts
import           Data.Semigroup ()

-- | Local symbol table — contains locally bound names
newtype Table = Table (Map.Map NameS SrcLoc)
  deriving b -> Table -> Table
NonEmpty Table -> Table
Table -> Table -> Table
(Table -> Table -> Table)
-> (NonEmpty Table -> Table)
-> (forall b. Integral b => b -> Table -> Table)
-> Semigroup Table
forall b. Integral b => b -> Table -> Table
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Table -> Table
$cstimes :: forall b. Integral b => b -> Table -> Table
sconcat :: NonEmpty Table -> Table
$csconcat :: NonEmpty Table -> Table
<> :: Table -> Table -> Table
$c<> :: Table -> Table -> Table
Semigroup

addValue :: SrcInfo l => Name l -> Table -> Table
addValue :: Name l -> Table -> Table
addValue Name l
n (Table Map NameS SrcLoc
vs) =
  Map NameS SrcLoc -> Table
Table (NameS -> SrcLoc -> Map NameS SrcLoc -> Map NameS SrcLoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Name l -> NameS
forall l. Name l -> NameS
nameToString Name l
n) (l -> SrcLoc
forall si. SrcInfo si => si -> SrcLoc
getPointLoc (l -> SrcLoc) -> l -> SrcLoc
forall a b. (a -> b) -> a -> b
$ Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name l
n) Map NameS SrcLoc
vs)

lookupValue :: QName l -> Table -> Either (Error l) SrcLoc
lookupValue :: QName l -> Table -> Either (Error l) SrcLoc
lookupValue qn :: QName l
qn@(UnQual l
_ Name l
n) (Table Map NameS SrcLoc
vs) =
  Either (Error l) SrcLoc
-> (SrcLoc -> Either (Error l) SrcLoc)
-> Maybe SrcLoc
-> Either (Error l) SrcLoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error l -> Either (Error l) SrcLoc
forall a b. a -> Either a b
Left (Error l -> Either (Error l) SrcLoc)
-> Error l -> Either (Error l) SrcLoc
forall a b. (a -> b) -> a -> b
$ QName l -> Error l
forall l. QName l -> Error l
ENotInScope QName l
qn) SrcLoc -> Either (Error l) SrcLoc
forall a b. b -> Either a b
Right (Maybe SrcLoc -> Either (Error l) SrcLoc)
-> Maybe SrcLoc -> Either (Error l) SrcLoc
forall a b. (a -> b) -> a -> b
$
    NameS -> Map NameS SrcLoc -> Maybe SrcLoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name l -> NameS
forall l. Name l -> NameS
nameToString Name l
n) Map NameS SrcLoc
vs
lookupValue QName l
qn Table
_ = Error l -> Either (Error l) SrcLoc
forall a b. a -> Either a b
Left (Error l -> Either (Error l) SrcLoc)
-> Error l -> Either (Error l) SrcLoc
forall a b. (a -> b) -> a -> b
$ QName l -> Error l
forall l. QName l -> Error l
ENotInScope QName l
qn

empty :: Table
empty :: Table
empty = Map NameS SrcLoc -> Table
Table Map NameS SrcLoc
forall k a. Map k a
Map.empty