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

import qualified Data.Map as Map
import Data.Semigroup
import Language.Haskell.Exts
import Language.Haskell.Names.SyntaxUtils (dropAnn)
import Language.Haskell.Names.Types

-- | Local symbol table — contains locally bound names
newtype Table = Table (Map.Map (Name ()) SrcLoc)
  deriving (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
$c<> :: Table -> Table -> Table
<> :: Table -> Table -> Table
$csconcat :: NonEmpty Table -> Table
sconcat :: NonEmpty Table -> Table
$cstimes :: forall b. Integral b => b -> Table -> Table
stimes :: forall b. Integral b => b -> Table -> Table
Semigroup, Semigroup Table
Table
Semigroup Table =>
Table
-> (Table -> Table -> Table) -> ([Table] -> Table) -> Monoid Table
[Table] -> Table
Table -> Table -> Table
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Table
mempty :: Table
$cmappend :: Table -> Table -> Table
mappend :: Table -> Table -> Table
$cmconcat :: [Table] -> Table
mconcat :: [Table] -> Table
Monoid)

addValue :: SrcInfo l => Name l -> Table -> Table
addValue :: forall l. SrcInfo l => Name l -> Table -> Table
addValue Name l
n (Table Map (Name ()) SrcLoc
vs) =
  Map (Name ()) SrcLoc -> Table
Table (Name () -> SrcLoc -> Map (Name ()) SrcLoc -> Map (Name ()) SrcLoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn 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 l. Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name l
n) Map (Name ()) SrcLoc
vs)

lookupValue :: QName l -> Table -> Either (Error l) SrcLoc
lookupValue :: forall l. QName l -> Table -> Either (Error l) SrcLoc
lookupValue qn :: QName l
qn@(UnQual l
_ Name l
n) (Table Map (Name ()) 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
$
    Name () -> Map (Name ()) SrcLoc -> Maybe SrcLoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
n) Map (Name ()) 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 (Name ()) SrcLoc -> Table
Table Map (Name ()) SrcLoc
forall k a. Map k a
Map.empty