diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 05f05b5c5..6f36178f3 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -157,7 +157,7 @@ withFrame :: forall term address value sig m a. ( => address -> Evaluator term address value m a -- Not sure about this `sig` here (substituting `sig` for `effects`) -> Evaluator term address value m a -withFrame address action = local @(address, address) (second (const address)) action +withFrame address = local @(address, address) (second (const address)) -- | Define a declaration and assign the value of an action in the current frame. define :: forall value sig address m term. ( HasCallStack diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index cd404e36e..1ca8cc8f2 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,40 +1,40 @@ -{-# LANGUAGE FunctionalDependencies, UndecidableInstances, ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE TupleSections #-} module Control.Abstract.Primitive ( defineClass , defineNamespace , defineBuiltIn ) where -import Control.Abstract.Context -import Control.Abstract.Evaluator -import Control.Abstract.Heap -import Control.Abstract.ScopeGraph -import Control.Abstract.Value -import Data.Abstract.BaseError -import Data.Map.Strict as Map -import Data.Abstract.Ref +import Control.Abstract.Context +import Control.Abstract.Evaluator +import Control.Abstract.Heap +import Control.Abstract.ScopeGraph +import Control.Abstract.Value +import Data.Abstract.BaseError import Data.Abstract.Name +import Data.Abstract.Ref +import Data.Map.Strict as Map import Data.Span -import Prologue +import Prologue -defineBuiltIn :: forall value sig address m term. ( HasCallStack - , Member (Deref value) sig - , Member (Reader ModuleInfo) sig - , Member (Reader Span) sig - , Member (Reader (address, address)) sig - , Member (State (Heap address address value)) sig - , Member (State (ScopeGraph address)) sig - , Member (Resumable (BaseError (ScopeError address))) sig - , Member (Resumable (BaseError (HeapError address))) sig - , Member (Function term address value) sig - , Member (Allocator address) sig - , Member Fresh sig - , Ord address - , Carrier sig m - ) - => Declaration - -> BuiltIn - -> Evaluator term address value m (ValueRef address value) +defineBuiltIn :: ( HasCallStack + , Member (Deref value) sig + , Member (Reader ModuleInfo) sig + , Member (Reader Span) sig + , Member (Reader (address, address)) sig + , Member (State (Heap address address value)) sig + , Member (State (ScopeGraph address)) sig + , Member (Resumable (BaseError (ScopeError address))) sig + , Member (Resumable (BaseError (HeapError address))) sig + , Member (Function term address value) sig + , Member (Allocator address) sig + , Member Fresh sig + , Ord address + , Carrier sig m + ) + => Declaration + -> BuiltIn + -> Evaluator term address value m (ValueRef address value) defineBuiltIn declaration value = withCurrentCallStack callStack $ do currentScope' <- currentScope let lexicalEdges = Map.singleton Lexical [ currentScope' ] @@ -72,9 +72,7 @@ defineClass :: ( AbstractValue term address value m defineClass declaration superclasses body = void . define declaration $ do currentScope' <- currentScope - superScopes <- for superclasses $ \superclass -> do - scope <- associatedScope superclass - pure scope + superScopes <- for superclasses associatedScope let superclassEdges = (Superclass, ) <$> (fmap pure . catMaybes $ superScopes) current = fmap (Lexical, ) . pure . pure $ currentScope' @@ -83,7 +81,7 @@ defineClass declaration superclasses body = void . define declaration $ do putDeclarationScope declaration childScope withScope childScope $ do - void $ body + void body pure unit diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 6435c002f..f9e0d685f 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -69,7 +69,7 @@ putDeclarationScope decl assocScope = do modify (ScopeGraph.insertDeclarationScope decl assocScope currentAddress) putDeclarationSpan :: forall address sig m term value. (Ord address, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> Span -> Evaluator term address value m () -putDeclarationSpan decl = modify @(ScopeGraph address) . (ScopeGraph.insertDeclarationSpan decl) +putDeclarationSpan decl = modify @(ScopeGraph address) . ScopeGraph.insertDeclarationSpan decl reference :: forall address sig m term value . ( Ord address @@ -182,8 +182,7 @@ maybeLookupScopePath :: -> Evaluator term address value m (Maybe (ScopeGraph.Path address)) maybeLookupScopePath Declaration{..} = do currentAddress <- currentScope - scopeGraph <- get - pure (ScopeGraph.lookupScopePath unDeclaration currentAddress scopeGraph) + gets (ScopeGraph.lookupScopePath unDeclaration currentAddress) lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig , Member (Reader ModuleInfo) sig @@ -222,7 +221,7 @@ withScope :: forall sig m address term value a. ( Carrier sig m => address -> Evaluator term address value m a -> Evaluator term address value m a -withScope scope action = local @(address, address) (first (const scope)) action +withScope scope = local @(address, address) (first (const scope)) throwScopeError :: ( Member (Resumable (BaseError (ScopeError address))) sig , Member (Reader ModuleInfo) sig diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 3780aa628..549e6f5d9 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -28,10 +28,9 @@ module Control.Abstract.Value , rvalBox ) where -import Control.Abstract.ScopeGraph (Declaration, ScopeGraph) import Control.Abstract.Evaluator import Control.Abstract.Heap -import Control.Abstract.ScopeGraph (Allocator) +import Control.Abstract.ScopeGraph (Allocator, Declaration, ScopeGraph) import Control.Effect.Carrier import Data.Abstract.BaseError import Data.Abstract.Module @@ -172,7 +171,7 @@ forLoop :: ( Carrier sig m -> Evaluator term address value m value -- ^ Increment/stepper -> Evaluator term address value m value -- ^ Body -> Evaluator term address value m (ValueRef address value) -forLoop initial cond step body = initial *> while cond ((withLexicalScopeAndFrame body) *> step) +forLoop initial cond step body = initial *> while cond (withLexicalScopeAndFrame body *> step) data While address value m k = While (m value) (m value) (ValueRef address value -> k) @@ -303,7 +302,7 @@ value :: ( Member (Deref value) sig ) => ValueRef address value -> Evaluator term address value m value -value (Rval val) = pure val +value (Rval val) = pure val value (LvalMember slot) = deref slot -- | Convenience function for boxing a raw value and wrapping it in an Rval diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index f6165772b..90ea8d652 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, ScopedTypeVariables, InstanceSigs, ScopedTypeVariables #-} +{-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, InstanceSigs #-} module Data.Abstract.Evaluatable ( module X , Evaluatable(..) @@ -118,10 +118,7 @@ instance HasPrelude 'Python where instance HasPrelude 'Ruby where definePrelude _ = do - let self = Declaration $ X.name "__self" - declare self emptySpan Nothing - slot <- lookupDeclaration self - assign slot =<< object =<< currentFrame + defineSelf void $ defineBuiltIn (Declaration $ X.name "puts") Print @@ -129,21 +126,33 @@ instance HasPrelude 'Ruby where void $ defineBuiltIn (Declaration $ X.name "inspect") Show instance HasPrelude 'TypeScript where - definePrelude _ = do - let self = Declaration $ X.name "__self" - declare self emptySpan Nothing - slot <- lookupDeclaration self - assign slot =<< object =<< currentFrame - -- defineNamespace (Declaration (X.name "console")) (builtIn (X.name "log") Print) + definePrelude _ = defineSelf + -- defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Print instance HasPrelude 'JavaScript where definePrelude _ = do - let self = Declaration $ X.name "__self" - declare self emptySpan Nothing - slot <- lookupDeclaration self - assign slot =<< object =<< currentFrame + defineSelf defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Print +defineSelf :: ( AbstractValue term address value m + , Carrier sig m + , Member (State (ScopeGraph address)) sig + , Member (Resumable (BaseError (ScopeError address))) sig + , Member (Resumable (BaseError (HeapError address))) sig + , Member (Deref value) sig + , Member (Reader ModuleInfo) sig + , Member (Reader Span) sig + , Member (State (Heap address address value)) sig + , Member (Reader (address, address)) sig + , Ord address + ) + => Evaluator term address value m () +defineSelf = do + let self = Declaration $ X.name "__self" + declare self emptySpan Nothing + slot <- lookupDeclaration self + assign slot =<< object =<< currentFrame + -- Effects diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index 450cc66df..6b33364bf 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -114,7 +114,7 @@ initFrame :: (Ord address) => scope -> address -> Map EdgeLabel (Map scope addre initFrame scope address links slots = fillFrame address slots . newFrame scope address links insertFrame :: Ord address => address -> Frame scope address value -> Heap scope address value -> Heap scope address value -insertFrame address frame h@Heap{..} = h { heap = (Map.insert address frame heap) } +insertFrame address frame h@Heap{..} = h { heap = Map.insert address frame heap } fillFrame :: Ord address => address -> IntMap (Set value) -> Heap scope address value -> Heap scope address value fillFrame address slots heap = @@ -139,7 +139,7 @@ heapRestrict :: Ord address => Heap address address value -> Live address -> Hea heapRestrict (Heap m) roots = Heap (Map.filterWithKey (\ address _ -> address `liveMember` roots) m) isHeapEmpty :: (Eq address, Eq value) => Heap scope address value -> Bool -isHeapEmpty h@Heap{..} = (heapSize h) == 1 && +isHeapEmpty h@Heap{..} = heapSize h == 1 && (toEmptyFrame <$> Map.elems heap) == [ Frame () mempty mempty ] where toEmptyFrame Frame{..} = Frame () (Map.mapKeysMonotonic (const ()) <$> links) slots diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index d71e568d7..b40aab7e3 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -42,8 +42,8 @@ data Slot address = Slot { frameAddress :: address, position :: Position } deriving (Eq, Show, Ord, Generic, NFData) -- Offsets and frame addresses in the heap should be addresses? -data Scope scopeAddress = Scope { - edges :: Map EdgeLabel [scopeAddress] -- Maybe Map EdgeLabel [Path scope]? +data Scope scopeAddress = Scope + { edges :: Map EdgeLabel [scopeAddress] -- Maybe Map EdgeLabel [Path scope]? , references :: Map Reference (Path scopeAddress) , declarations :: Seq (Declaration, (Span, Maybe scopeAddress)) } deriving (Eq, Show, Ord, Generic, NFData) @@ -60,7 +60,7 @@ instance AbstractHole address => AbstractHole (Slot address) where newtype Position = Position { unPosition :: Int } deriving (Eq, Show, Ord, Generic, NFData) -newtype ScopeGraph scope = ScopeGraph { graph :: Map scope (Scope scope) } +newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) } instance Ord scope => Lower (ScopeGraph scope) where lowerBound = ScopeGraph mempty @@ -109,91 +109,76 @@ pathPosition (EPath _ _ p) = pathPosition p -- Returns the reference paths of a scope in a scope graph. pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference (Path scope)) -pathsOfScope scope = fmap references . Map.lookup scope . graph +pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph -- Returns the declaration data of a scope in a scope graph. ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Declaration, (Span, Maybe scope))) -ddataOfScope scope = fmap declarations . Map.lookup scope . graph +ddataOfScope scope = fmap declarations . Map.lookup scope . unScopeGraph -- Returns the edges of a scope in a scope graph. linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope]) -linksOfScope scope = fmap edges . Map.lookup scope . graph +linksOfScope scope = fmap edges . Map.lookup scope . unScopeGraph -- Lookup a scope in the scope graph. lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope) -lookupScope scope = Map.lookup scope . graph +lookupScope scope = Map.lookup scope . unScopeGraph -- Declare a declaration with a span and an associated scope in the scope graph. -- TODO: Return the whole value in Maybe or Either. declare :: Ord scope => Declaration -> Span -> Maybe scope -> scope -> ScopeGraph scope -> (ScopeGraph scope, Maybe Position) -declare declaration ddata assocScope currentScope g@ScopeGraph{..} = fromMaybe (g, Nothing) $ do +declare declaration ddata assocScope currentScope g@(ScopeGraph graph) = fromMaybe (g, Nothing) $ do scope <- lookupScope currentScope g dataSeq <- ddataOfScope currentScope g case Seq.findIndexR (\(decl, (span, _)) -> decl == declaration && ddata == span) dataSeq of - Just index -> pure (g, Just $ Position index) + Just index -> pure (g, Just (Position index)) Nothing -> do - let newScope = scope { declarations = (declarations scope) Seq.|> (declaration, (ddata, assocScope)) } - pure $ (g { graph = Map.insert currentScope newScope graph }, Just . Position $ length (declarations newScope)) + let newScope = scope { declarations = declarations scope Seq.|> (declaration, (ddata, assocScope)) } + pure (ScopeGraph (Map.insert currentScope newScope graph), Just (Position (length (declarations newScope)))) -- | Add a reference to a declaration in the scope graph. -- Returns the original scope graph if the declaration could not be found. reference :: Ord scope => Reference -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope -reference ref decl@Declaration{..} currentAddress g@ScopeGraph{..} = fromMaybe g $ do +reference ref decl@Declaration{..} currentAddress g@(ScopeGraph graph) = fromMaybe g $ do -- Start from the current address currentScope' <- lookupScope currentAddress g -- Build a path up to the declaration go currentScope' currentAddress id where - go currentScope address path = - case lookupDeclaration unDeclaration address g of - Just (_, index) -> - let newScope = currentScope { references = Map.insert ref (path (DPath decl index)) (references currentScope) } - in Just (g { graph = Map.insert currentAddress newScope graph }) - Nothing -> let - traverseEdges edge = do - linkMap <- linksOfScope address g - scopes <- Map.lookup edge linkMap - -- Return the first path to the declaration through the scopes. - getFirst (foldMap (First . ap (go currentScope) ((path .) . EPath edge)) scopes) - in traverseEdges Superclass <|> traverseEdges Import <|> traverseEdges Lexical + go currentScope address path + = ScopeGraph . flip (Map.insert currentAddress) graph . modifyReferences currentScope . Map.insert ref . path . DPath decl . snd <$> lookupDeclaration unDeclaration address g + <|> traverseEdges' Superclass <|> traverseEdges' Import <|> traverseEdges' Lexical + where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path (go currentScope) edge -- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph. insertImportReference :: Ord address => Reference -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address) -insertImportReference ref decl@Declaration{..} currentAddress g@ScopeGraph{..} scope = do - go currentAddress (EPath Import currentAddress) +insertImportReference ref decl@Declaration{..} currentAddress g scope = go currentAddress (EPath Import currentAddress) where - go address path = - case lookupDeclaration unDeclaration address g of - Just (_, index) -> - Just $ scope { references = Map.insert ref (path (DPath decl index)) (references scope) } - Nothing -> traverseEdges Superclass <|> traverseEdges Export <|> traverseEdges Import <|> traverseEdges Lexical - where - traverseEdges edge = do - linkMap <- linksOfScope address g - scopes <- Map.lookup edge linkMap - -- Return the first path to the declaration through the scopes. - getFirst (foldMap (First . (\scope -> go scope (path . EPath edge scope))) scopes) + go address path + = modifyReferences scope . Map.insert ref . path . DPath decl . snd <$> lookupDeclaration unDeclaration address g + <|> traverseEdges' Superclass <|> traverseEdges' Export <|> traverseEdges' Import <|> traverseEdges' Lexical + where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path go edge lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) -lookupScopePath declaration currentAddress g@ScopeGraph{..} = do - go currentAddress id +lookupScopePath declaration currentAddress g = go currentAddress id where - go address path = - case lookupDeclaration declaration address g of - Just (_, index) -> Just $ path (DPath (Declaration declaration) index) - Nothing -> maybe Nothing (Just . path) (lookupReference declaration address g) - <|> traverseEdges Superclass <|> traverseEdges Export <|> traverseEdges Import <|> traverseEdges Lexical - where - traverseEdges edge = do - linkMap <- linksOfScope address g - scopes <- Map.lookup edge linkMap - getFirst (foldMap (First . (\scope -> go scope (path . EPath edge scope))) scopes) + go address path + = path . DPath (Declaration declaration) . snd <$> lookupDeclaration declaration address g + <|> path <$> lookupReference declaration address g + <|> traverseEdges' Superclass <|> traverseEdges' Export <|> traverseEdges' Import <|> traverseEdges' Lexical + where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path go edge + +modifyReferences :: Scope scopeAddress -> (Map Reference (Path scopeAddress) -> Map Reference (Path scopeAddress)) -> Scope scopeAddress +modifyReferences scope f = scope { references = f (references scope) } + +traverseEdges :: Foldable t => (Path scopeAddress -> Path scopeAddress) -> (scopeAddress -> (Path scopeAddress -> Path scopeAddress) -> Maybe a) -> EdgeLabel -> t scopeAddress -> Maybe a +-- Return the first path to the declaration through the scopes. +traverseEdges path go edge = getFirst . foldMap (First . (go <*> fmap path . EPath edge)) lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe ((Declaration, (Span, Maybe scopeAddress)), Position) lookupDeclaration declaration scope g = do dataSeq <- ddataOfScope scope g - index <- Seq.findIndexR (((Declaration declaration) ==) . fst) dataSeq + index <- Seq.findIndexR ((Declaration declaration ==) . fst) dataSeq (, Position index) <$> Seq.lookup index dataSeq declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration @@ -204,48 +189,48 @@ declarationNames edgeLabels scope scopeGraph = localDeclarations <> edgeNames putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -putDeclarationScopeAtPosition scope position assocScope g = fromMaybe g $ do +putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = fromMaybe g $ do dataSeq <- ddataOfScope scope g let seq = Seq.adjust' (\(d, (span, _)) -> (d, (span, assocScope))) (unPosition position) dataSeq - pure $ g { graph = Map.adjust (\s -> s { declarations = seq }) scope (graph g) } + pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph) lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) lookupReference name scope g = Map.lookup (Reference name) =<< pathsOfScope scope g insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -insertEdge label target currentAddress g@ScopeGraph{..} = fromMaybe g $ do +insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do currentScope' <- lookupScope currentAddress g - scopes <- maybe (Just mempty) pure (Map.lookup label (edges currentScope')) + scopes <- maybeM (Just mempty) (Map.lookup label (edges currentScope')) let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') } - pure (g { graph = Map.insert currentAddress newScope graph }) + pure (ScopeGraph (Map.insert currentAddress newScope graph)) -- | Insert associate the given associated scope into the declaration in the scope graph. insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -insertDeclarationScope decl@Declaration{..} address currentAddress g@ScopeGraph{..} = fromMaybe g $ do +insertDeclarationScope decl@Declaration{..} address currentAddress g@(ScopeGraph graph) = fromMaybe g $ do declScope <- pathDeclarationScope currentAddress =<< lookupScopePath unDeclaration currentAddress g (span, position) <- (fst . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g scope <- lookupScope declScope g - pure $ g { graph = Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, Just address))) position (declarations scope) }) graph } + pure $ ScopeGraph (Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, Just address))) position (declarations scope) }) graph) -- | Insert a declaration span into the declaration in the scope graph. insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress -insertDeclarationSpan decl@Declaration{..} span g@ScopeGraph{..} = fromMaybe g $ do +insertDeclarationSpan decl@Declaration{..} span g@(ScopeGraph graph) = fromMaybe g $ do declScope <- scopeOfDeclaration decl g (associatedScope, position) <- (snd . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g scope <- lookupScope declScope g - pure $ g { graph = Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, associatedScope))) position (declarations scope) }) graph } + pure $ ScopeGraph (Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, associatedScope))) position (declarations scope) }) graph) -- | Insert a new scope with the given address and edges into the scope graph. newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address newScope address edges = insertScope address (Scope edges mempty mempty) insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address -insertScope address scope g@ScopeGraph{..} = g { graph = Map.insert address scope graph } +insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph -- | Returns the scope of a reference in the scope graph. scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope -scopeOfRef ref g@ScopeGraph{..} = go (Map.keys graph) +scopeOfRef ref g@(ScopeGraph graph) = go (Map.keys graph) where go (s : scopes') = fromMaybe (go scopes') $ do pathMap <- pathsOfScope s g @@ -262,17 +247,15 @@ pathOfRef ref graph = do -- Returns the scope the declaration was declared in. scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope -scopeOfDeclaration Declaration{..} g@ScopeGraph{..} = go (Map.keys graph) +scopeOfDeclaration Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph) where - go (scope : scopes') = fromMaybe (go scopes') $ lookupDeclaration unDeclaration scope g >> pure (Just scope) - go [] = Nothing + go = foldr (\ scope -> (scope <$ lookupDeclaration unDeclaration scope g <|>)) Nothing -- | Returns the scope associated with a declaration (the child scope if any exists). associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope -associatedScope Declaration{..} g@ScopeGraph{..} = go (Map.keys graph) +associatedScope Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph) where - go (scope : scopes') = fromMaybe (go scopes') $ snd . snd . fst <$> lookupDeclaration unDeclaration scope g - go [] = Nothing + go = foldr (\ scope -> ((lookupDeclaration unDeclaration scope g >>= snd . snd . fst) <|>)) Nothing newtype Reference = Reference { unReference :: Name } deriving (Eq, Ord, Show, Generic, NFData) diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 665339f1f..c778cd68a 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -38,9 +38,9 @@ data Value term address | String Text | Symbol Text | Regex Text - | Tuple [(Value term address)] - | Array [(Value term address)] - | Class Declaration [(Value term address)] address + | Tuple [Value term address] + | Array [Value term address] + | Class Declaration [Value term address] address | Object address | Namespace Name address | KVPair (Value term address) (Value term address) @@ -350,7 +350,7 @@ data ValueError term address resume where BitwiseError :: Value term address -> ValueError term address (Value term address) Bitwise2Error :: Value term address -> Value term address -> ValueError term address (Value term address) KeyValueError :: Value term address -> ValueError term address (Value term address, Value term address) - ArrayError :: Value term address -> ValueError term address [(Value term address)] + ArrayError :: Value term address -> ValueError term address [Value term address] -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching. ArithmeticError :: ArithException -> ValueError term address (Value term address) -- Out-of-bounds error diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 3b41411cf..31b062cc0 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -153,7 +153,7 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable VariableDeclaration where eval _ (VariableDeclaration []) = rvalBox unit eval eval (VariableDeclaration decs) = do - _ <- for decs $ \declaration -> do + for_ decs $ \declaration -> do name <- maybeM (throwEvalError NoNameError) (declaredName declaration) declare (Declaration name) emptySpan Nothing (span, _) <- do @@ -242,8 +242,8 @@ instance Evaluatable Class where (Just scope, Just frame) -> Just (scope, frame) _ -> Nothing - let superclassEdges = fmap (Superclass, ) . fmap (pure . fst) . catMaybes $ superScopes - current = fmap (Lexical, ) . pure . pure $ currentScope' + let superclassEdges = (Superclass, ) . pure . fst <$> catMaybes superScopes + current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) childScope <- newScope edges declare (Declaration name) span (Just childScope) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index bca47a58e..96543666f 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, LambdaCase #-} +{-# LANGUAGE DeriveAnyClass #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Go.Syntax where