github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-27 00:44:57 +03:00
Code Issues Projects Releases Wiki Activity

Normalize the unevaluated module table representation.

Browse Source
This commit is contained in:
Rob Rix 2018-06-05 09:43:55 -04:00
parent 1002a48f83
commit 4536f219ec
3 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Control/Abstract/Modules.hs
View File

@ -66,9 +66,9 @@ runModules :: forall term address value effects a
) )
=> (Module term -> Evaluator address value (Modules address value ': effects) (value, Environment address)) => (Module term -> Evaluator address value (Modules address value ': effects) (value, Environment address))
-> Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Modules address value ': effects) a
-> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
runModules evaluateModule = go runModules evaluateModule = go
where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
go = reinterpret (\ m -> case m of go = reinterpret (\ m -> case m of
Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
where where
@ -95,7 +95,7 @@ getModuleTable = get
cacheModule :: Member (State (ModuleTable (Maybe (value, Environment address)))) effects => ModulePath -> Maybe (value, Environment address) -> Evaluator address value effects (Maybe (value, Environment address)) cacheModule :: Member (State (ModuleTable (Maybe (value, Environment address)))) effects => ModulePath -> Maybe (value, Environment address) -> Evaluator address value effects (Maybe (value, Environment address))
cacheModule path result = modify' (ModuleTable.insert path result) $> result cacheModule path result = modify' (ModuleTable.insert path result) $> result
askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator address value effects (ModuleTable [Module term]) askModuleTable :: Member (Reader (ModuleTable (NonEmpty (Module term)))) effects => Evaluator address value effects (ModuleTable (NonEmpty (Module term)))
askModuleTable = ask askModuleTable = ask

8
src/Data/Abstract/ModuleTable.hs
View File

@ -42,10 +42,10 @@ insert k v = ModuleTable . Map.insert k v . unModuleTable
keys :: ModuleTable a -> [ModulePath] keys :: ModuleTable a -> [ModulePath]
keys = Map.keys . unModuleTable keys = Map.keys . unModuleTable
-- | Construct a 'ModuleTable' from a list of 'Module's. -- | Construct a 'ModuleTable' from a non-empty list of 'Module's.
fromModules :: [Module term] -> ModuleTable [Module term] fromModules :: [Module term] -> ModuleTable (NonEmpty (Module term))
fromModules modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules)) fromModules modules = ModuleTable (Map.fromListWith (<>) (fmap toEntry modules))
where toEntry m = (modulePath (moduleInfo m), [m]) where toEntry m = (modulePath (moduleInfo m), m:|[])
toPairs :: ModuleTable a -> [(ModulePath, a)] toPairs :: ModuleTable a -> [(ModulePath, a)]
toPairs = Map.toList . unModuleTable toPairs = Map.toList . unModuleTable

3
src/Data/Abstract/Package.hs
View File

@ -5,6 +5,7 @@ import Data.Abstract.Module
import Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.ModuleTable as ModuleTable
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Abstract.Name import Data.Abstract.Name
import Prologue
type PackageName = Name type PackageName = Name
@ -20,7 +21,7 @@ newtype Version = Version { versionString :: String }
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data PackageBody term = PackageBody data PackageBody term = PackageBody
{ packageModules :: ModuleTable [Module term] { packageModules :: ModuleTable (NonEmpty (Module term))
, packagePrelude :: Maybe (Module term) , packagePrelude :: Maybe (Module term)
, packageEntryPoints :: ModuleTable (Maybe Name) , packageEntryPoints :: ModuleTable (Maybe Name)
} }