Clean the comments
This commit is contained in:
Kirill Andreev
parent
03b89bc5b7
commit
583d7f8997
@ -160,7 +160,7 @@ eventLoop funs chan = do
|
||||
case Find.definitionOf pos tree of
|
||||
Just defPos -> do
|
||||
error "do later"
|
||||
-- Core.sendFunc funs $ RspDefinition $ _ $ J.SingleLoc $ J.Location uri $ rangeToLoc defPos
|
||||
Core.sendFunc funs $ RspDefinition $ _ $ J.SingleLoc $ J.Location uri $ rangeToLoc defPos
|
||||
|
||||
_ -> U.logs "unknown msg"
|
||||
|
||||
|
||||
@ -5,51 +5,39 @@
|
||||
-}
|
||||
|
||||
module AST.Scope
|
||||
-- ( -- * Monad
|
||||
-- CollectM
|
||||
-- , evalCollectM
|
||||
-- , collectEnv
|
||||
|
||||
-- -- * Scope
|
||||
-- , Env(..)
|
||||
-- , ScopedDecl(..)
|
||||
-- , Kind(..)
|
||||
-- , HasEnv(..)
|
||||
-- , lookupEnv
|
||||
|
||||
-- -- * Methods
|
||||
-- , enter
|
||||
-- , leave
|
||||
-- , define
|
||||
-- , defType
|
||||
-- , def
|
||||
-- )
|
||||
( HasLocalScope (..)
|
||||
, addLocalScopes
|
||||
, lookupEnv
|
||||
, Kind (..)
|
||||
, ScopedDecl (..)
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Arrow (second)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer.Strict hiding (Alt, Product)
|
||||
import Control.Arrow (second)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer.Strict hiding (Alt, Product)
|
||||
|
||||
import Data.Function
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (Map)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Maybe (fromJust, listToMaybe)
|
||||
import qualified Data.List as List
|
||||
import qualified Data.List as List
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromJust, listToMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Range
|
||||
import AST.Types
|
||||
import AST.Parser
|
||||
import Parser
|
||||
import Tree
|
||||
import Comment
|
||||
import Pretty
|
||||
import Product
|
||||
import Lattice
|
||||
import AST.Parser
|
||||
import AST.Types
|
||||
import Comment
|
||||
import Lattice
|
||||
import Parser
|
||||
import Pretty
|
||||
import Product
|
||||
import Range
|
||||
import Tree
|
||||
|
||||
import Debug.Trace
|
||||
import Debug.Trace
|
||||
|
||||
-- | Ability to contain a list of declarations.
|
||||
class HasLocalScope x where
|
||||
getLocalScope :: x -> [ScopedDecl]
|
||||
|
||||
@ -62,6 +50,9 @@ type AddRefsM = State FullEnv
|
||||
|
||||
type FullEnv = Map Range [ScopedDecl]
|
||||
|
||||
-- | Calculate scopes and attach to all tree points declarations that are
|
||||
-- visible there.
|
||||
--
|
||||
addLocalScopes
|
||||
:: HasRange (Product xs)
|
||||
=> Pascal (Product xs)
|
||||
@ -104,11 +95,6 @@ addRef r n env = Map.union (go range) env
|
||||
$ filter (r <?)
|
||||
$ Map.keys env
|
||||
|
||||
-- decls' list = do
|
||||
-- r' <- range
|
||||
-- decls <- Map.lookup r' env
|
||||
-- return $ (r', updateOnly n r addRefToDecl decls)
|
||||
|
||||
addRefToDecl sd = sd
|
||||
{ _sdRefs = r : _sdRefs sd
|
||||
}
|
||||
@ -175,49 +161,10 @@ data Kind = Star
|
||||
instance Pretty Kind where
|
||||
pp _ = "TYPE"
|
||||
|
||||
-- observe :: String -> CollectM a -> CollectM a
|
||||
-- observe what act = do
|
||||
-- s <- get
|
||||
-- traceShowM (what, "BEFORE", s)
|
||||
-- a <- act
|
||||
-- s1 <- get
|
||||
-- traceShowM (what, "AFTER", s1)
|
||||
-- return a
|
||||
|
||||
-- | Search for a name inside a local scope.
|
||||
lookupEnv :: Text -> [ScopedDecl] -> Maybe ScopedDecl
|
||||
lookupEnv name = listToMaybe . filter ((name ==) . ppToText . _sdName)
|
||||
|
||||
-- -- | Make a new scope out of enclosing parent one.
|
||||
-- enter :: Range -> CollectM ()
|
||||
-- enter r = observe "enter" do
|
||||
-- modify \rest ->
|
||||
-- mk r (ScopeTree Map.empty []) : rest
|
||||
|
||||
-- -- | Leave current scope, return to parent one.
|
||||
-- leave :: CollectM ()
|
||||
-- leave = observe "leave" do
|
||||
-- modify \case
|
||||
-- (a : parent : rest) ->
|
||||
-- fromJust do
|
||||
-- -- traceShowM ("MOVE", a)
|
||||
-- -- traceShowM ("TO ", parent)
|
||||
-- (r, ScopeTree e cs) <- match parent
|
||||
-- -- traceShowM ("== ", mk r (ScopeTree e (a : cs)))
|
||||
-- -- traceShowM ("--")
|
||||
-- return $ mk r (ScopeTree e (a : cs)) : rest
|
||||
|
||||
-- [x] -> error $ "trying to leave \n" ++ show x
|
||||
|
||||
-- -- | Add a declaration to the current scope.
|
||||
-- define :: Text -> ScopedDecl -> CollectM ()
|
||||
-- define name d = observe "define" do
|
||||
-- s <- get
|
||||
-- traceShowM ("DEFINE", s)
|
||||
-- modify \(top : rest) ->
|
||||
-- fromJust do
|
||||
-- (r, ScopeTree a cs) <- match top
|
||||
-- return $ mk r (ScopeTree (Map.insert name d a) cs) : rest
|
||||
|
||||
-- | Add a type declaration to the current scope.
|
||||
defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
|
||||
defType name kind body = do
|
||||
@ -229,37 +176,11 @@ defType name kind body = do
|
||||
(Just (Right kind))
|
||||
[]
|
||||
|
||||
observe :: Pretty i => Pretty res => Text -> i -> res -> res
|
||||
observe msg i res
|
||||
= traceShow (pp msg, "INPUT", pp i)
|
||||
$ traceShow (pp msg, "OUTPUT", pp res)
|
||||
$ res
|
||||
|
||||
-- addRef
|
||||
-- :: Pascal ()
|
||||
-- -> Range
|
||||
-- -> FullEnv
|
||||
-- -> FullEnv
|
||||
-- addRef name pos (AppendMap envs) =
|
||||
-- AppendMap $ envs <> affected''
|
||||
-- where
|
||||
-- ranges = Map.keys envs
|
||||
-- (affected, other) = List.partition (pos <?) ranges
|
||||
-- affected' = foldMap (\r -> Map.singleton r (envs Map.! r)) affected
|
||||
-- affected'' = Map.map (\decls -> observe "addRef" decls $ addRefScopedDecls decls) affected'
|
||||
|
||||
-- addRefScopedDecls :: [ScopedDecl] -> [ScopedDecl]
|
||||
-- addRefScopedDecls decls =
|
||||
-- case after of
|
||||
-- decl : after -> before ++ [addRefScopedDecl decl] ++ after
|
||||
-- [] -> before
|
||||
-- where
|
||||
-- (before, after) = break (\sd -> ppToText (_sdName sd) == ppName) decls
|
||||
|
||||
-- addRefScopedDecl :: ScopedDecl -> ScopedDecl
|
||||
-- addRefScopedDecl decl = decl { _sdRefs = pos : _sdRefs decl }
|
||||
|
||||
-- ppName = ppToText name
|
||||
-- observe :: Pretty i => Pretty res => Text -> i -> res -> res
|
||||
-- observe msg i res
|
||||
-- = traceShow (pp msg, "INPUT", pp i)
|
||||
-- $ traceShow (pp msg, "OUTPUT", pp res)
|
||||
-- $ res
|
||||
|
||||
-- | Add a value declaration to the current scope.
|
||||
def
|
||||
@ -352,66 +273,3 @@ instance HasRange a => UpdateOver CollectM Pattern (Pascal a) where
|
||||
instance UpdateOver CollectM QualifiedName (Pascal a)
|
||||
instance UpdateOver CollectM Path (Pascal a)
|
||||
instance UpdateOver CollectM Name (Pascal a) where
|
||||
before range (Name raw) = do
|
||||
-- traceShowM ("name", raw)
|
||||
skip
|
||||
-- modify $ modElem $ addRef range (mk () (Name raw))
|
||||
|
||||
-- class HasEnv a where
|
||||
-- getEnv :: a -> Env
|
||||
|
||||
-- instance HasEnv Env where
|
||||
-- getEnv = id
|
||||
|
||||
-- instance Contains Env xs => HasEnv (Product xs) where
|
||||
-- getEnv = getElem
|
||||
|
||||
-- data Scope = Scope { unScope :: [Text] }
|
||||
|
||||
-- instance HasComments Scope where
|
||||
-- getComments = unScope
|
||||
|
||||
-- -- pinEnv :: Product xs -> CollectM (Product (Env : xs))
|
||||
-- -- pinEnv xs = (`Cons` xs) <$> gets head
|
||||
|
||||
-- collectEnv :: Contains Range xs => Product xs -> CollectM (Product (Scopes : xs))
|
||||
-- collectEnv xs = do
|
||||
-- gets \case
|
||||
-- st : _ -> Cons st xs
|
||||
-- [] -> Cons (mk (getRange xs) $ ScopeTree Map.empty []) xs
|
||||
|
||||
-- instance UpdateOver (State [Env]) ScopeTree Scopes where
|
||||
-- before r (ScopeTree e _) = modify (e :)
|
||||
-- after r _ = modify tail
|
||||
|
||||
-- distributeEnv :: ScopeTree Scopes -> State [Env] (ScopeTree Scopes)
|
||||
-- distributeEnv (ScopeTree e' cs) = do
|
||||
-- e <- gets (Map.unions . (e' :))
|
||||
-- return $ ScopeTree e cs
|
||||
|
||||
-- pinEnv :: Contains Range xs => Scopes -> Product xs -> CollectM (Product (Env : xs))
|
||||
-- pinEnv scopes info = do
|
||||
-- let (_, ScopeTree e _) = fromJust $ match =<< lookupTree (getElem info) scopes
|
||||
-- return (Cons e info)
|
||||
|
||||
-- instance HasComments Range where
|
||||
-- getComments _ = []
|
||||
|
||||
-- instance Pretty (Product xs) => HasComments (Product xs) where
|
||||
-- getComments xs = if Text.null $ Text.strip x then [] else [x]
|
||||
-- where
|
||||
-- x = ppToText $ color 3 $ pp $ xs
|
||||
|
||||
-- ascribeEnv :: (Contains Range xs, Pretty (Product xs)) => Pascal (Product xs) -> Scopes -- Pascal (Product (Env : xs))
|
||||
-- ascribeEnv tree =
|
||||
-- let
|
||||
-- scopes =
|
||||
-- evalCollectM do
|
||||
-- traverseTree collectEnv tree
|
||||
-- gets head
|
||||
|
||||
-- -- distributed = evalState (traverseOnly distributeEnv scopes) []
|
||||
-- in
|
||||
-- scopes
|
||||
-- -- distributed
|
||||
-- -- evalCollectM $ traverseTree (pinEnv distributed) tree
|
||||
Loading…
Reference in New Issue
Block a user