mirror of
https://github.com/github/semantic.git
synced 2024-11-24 00:42:33 +03:00
Use CurrentScope to indicate the significance of Names.
This newtype is useful, and sports an identical definition within `semantic`. We should use it everywhere.
This commit is contained in:
parent
6a00388913
commit
babde11f98
@ -48,6 +48,7 @@ import Source.Span
|
||||
|
||||
import Scope.Graph.AdjacencyList (ScopeGraph)
|
||||
import qualified Scope.Graph.AdjacencyList as AdjacencyList
|
||||
import Scope.Types
|
||||
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Declaration as Props
|
||||
import qualified Control.Effect.ScopeGraph.Properties.Function as Props
|
||||
@ -63,18 +64,18 @@ maybeM f = maybe f pure
|
||||
type ScopeGraphEff sig m
|
||||
= ( Has (State (ScopeGraph Name)) sig m
|
||||
, Has (State Name) sig m
|
||||
, Has (Reader Name) sig m
|
||||
, Has Fresh sig m
|
||||
, Has (Reader (CurrentScope Name)) sig m
|
||||
, Has (Reader Module.ModuleInfo) sig m
|
||||
)
|
||||
|
||||
graphInProgress :: ScopeGraphEff sig m => m (ScopeGraph Name)
|
||||
graphInProgress = get
|
||||
|
||||
currentScope :: ScopeGraphEff sig m => m Name
|
||||
currentScope :: ScopeGraphEff sig m => m (CurrentScope Name)
|
||||
currentScope = ask
|
||||
|
||||
withScope :: ScopeGraphEff sig m
|
||||
=> Name
|
||||
=> CurrentScope Name
|
||||
-> m a
|
||||
-> m a
|
||||
withScope scope = local (const scope)
|
||||
@ -82,7 +83,7 @@ withScope scope = local (const scope)
|
||||
|
||||
declare :: ScopeGraphEff sig m => Name -> Props.Declaration -> m ()
|
||||
declare n props = do
|
||||
current <- currentScope
|
||||
CurrentScope current <- currentScope
|
||||
old <- graphInProgress
|
||||
let Props.Declaration kind relation associatedScope span = props
|
||||
let (new, _pos) =
|
||||
@ -101,7 +102,7 @@ declare n props = do
|
||||
-- | Establish a reference to a prior declaration.
|
||||
reference :: forall sig m . ScopeGraphEff sig m => Text -> Text -> Props.Reference -> m ()
|
||||
reference n decl props = do
|
||||
current <- currentScope
|
||||
CurrentScope current <- currentScope
|
||||
old <- graphInProgress
|
||||
let new =
|
||||
ScopeGraph.reference
|
||||
@ -124,7 +125,7 @@ newScope edges = do
|
||||
-- | Takes an edge label and a list of names and inserts an import edge to a hole.
|
||||
newEdge :: ScopeGraphEff sig m => ScopeGraph.EdgeLabel -> NonEmpty Name -> m ()
|
||||
newEdge label address = do
|
||||
current <- currentScope
|
||||
CurrentScope current <- currentScope
|
||||
old <- graphInProgress
|
||||
let new = ScopeGraph.addImportEdge label (toList address) current old
|
||||
put new
|
||||
@ -135,7 +136,7 @@ lookupScope address = maybeM undefined . ScopeGraph.lookupScope address =<< get
|
||||
-- | Inserts a reference.
|
||||
newReference :: ScopeGraphEff sig m => Name -> Props.Reference -> m ()
|
||||
newReference name props = do
|
||||
currentAddress <- currentScope
|
||||
CurrentScope currentAddress <- currentScope
|
||||
scope <- lookupScope currentAddress
|
||||
|
||||
let refProps = Reference.ReferenceInfo (props^.span_) (Props.Reference.kind props) lowerBound
|
||||
@ -159,7 +160,7 @@ newReference name props = do
|
||||
|
||||
declareFunction :: forall sig m . ScopeGraphEff sig m => Maybe Name -> Props.Function -> m (Name, Name)
|
||||
declareFunction name (Props.Function kind span) = do
|
||||
currentScope' <- currentScope
|
||||
CurrentScope currentScope' <- currentScope
|
||||
let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ]
|
||||
associatedScope <- newScope lexicalEdges
|
||||
name' <- declareMaybeName name Props.Declaration
|
||||
|
@ -29,8 +29,6 @@ import Scope.Scope
|
||||
import Scope.Types
|
||||
import Source.Span
|
||||
|
||||
newtype CurrentScope address = CurrentScope { unCurrentScope :: address }
|
||||
|
||||
newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
|
@ -7,6 +7,8 @@ module Scope.Types
|
||||
, Domain (..)
|
||||
, Kind (..)
|
||||
, AccessControl (..)
|
||||
-- * Identificatory newtypes
|
||||
, CurrentScope (..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON)
|
||||
@ -92,3 +94,8 @@ instance Ord AccessControl where
|
||||
-- | Public AccessControl "on the left" has access only to Public AccessControl "on the right".
|
||||
(<=) Public Public = True
|
||||
(<=) Public _ = False
|
||||
|
||||
-- | A newtype indicating that the wrapped datum represents a parent scope
|
||||
-- in some contextual computation.
|
||||
newtype CurrentScope address = CurrentScope { unCurrentScope :: address }
|
||||
|
||||
|
@ -80,6 +80,7 @@ import Data.Map (Map)
|
||||
import Data.Maybe.Exts
|
||||
import GHC.Generics (Generic1)
|
||||
import Prelude hiding (lookup)
|
||||
import Scope.Types (CurrentScope (..))
|
||||
import Source.Span
|
||||
|
||||
lookup :: ( Ord address
|
||||
@ -218,8 +219,6 @@ newPreludeScope edges = do
|
||||
address <- alloc name
|
||||
address <$ modify (ScopeGraph.newPreludeScope address edges)
|
||||
|
||||
newtype CurrentScope address = CurrentScope { unCurrentScope :: address }
|
||||
|
||||
currentScope :: Has (Reader (CurrentScope address)) sig m
|
||||
=> Evaluator term address value m address
|
||||
currentScope = asks unCurrentScope
|
||||
|
Loading…
Reference in New Issue
Block a user