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
|
case Find.definitionOf pos tree of
|
||||||
Just defPos -> do
|
Just defPos -> do
|
||||||
error "do later"
|
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"
|
_ -> U.logs "unknown msg"
|
||||||
|
|
||||||
|
|||||||
@ -5,51 +5,39 @@
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
module AST.Scope
|
module AST.Scope
|
||||||
-- ( -- * Monad
|
( HasLocalScope (..)
|
||||||
-- CollectM
|
, addLocalScopes
|
||||||
-- , evalCollectM
|
, lookupEnv
|
||||||
-- , collectEnv
|
, Kind (..)
|
||||||
|
, ScopedDecl (..)
|
||||||
-- -- * Scope
|
)
|
||||||
-- , Env(..)
|
|
||||||
-- , ScopedDecl(..)
|
|
||||||
-- , Kind(..)
|
|
||||||
-- , HasEnv(..)
|
|
||||||
-- , lookupEnv
|
|
||||||
|
|
||||||
-- -- * Methods
|
|
||||||
-- , enter
|
|
||||||
-- , leave
|
|
||||||
-- , define
|
|
||||||
-- , defType
|
|
||||||
-- , def
|
|
||||||
-- )
|
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Writer.Strict hiding (Alt, Product)
|
import Control.Monad.Writer.Strict hiding (Alt, Product)
|
||||||
|
|
||||||
import Data.Function
|
import Data.Function
|
||||||
import qualified Data.Map as Map
|
import qualified Data.List as List
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import Data.Text (Text)
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Text as Text
|
import Data.Maybe (fromJust, listToMaybe)
|
||||||
import Data.Maybe (fromJust, listToMaybe)
|
import Data.Text (Text)
|
||||||
import qualified Data.List as List
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
import Range
|
import AST.Parser
|
||||||
import AST.Types
|
import AST.Types
|
||||||
import AST.Parser
|
import Comment
|
||||||
import Parser
|
import Lattice
|
||||||
import Tree
|
import Parser
|
||||||
import Comment
|
import Pretty
|
||||||
import Pretty
|
import Product
|
||||||
import Product
|
import Range
|
||||||
import Lattice
|
import Tree
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
|
-- | Ability to contain a list of declarations.
|
||||||
class HasLocalScope x where
|
class HasLocalScope x where
|
||||||
getLocalScope :: x -> [ScopedDecl]
|
getLocalScope :: x -> [ScopedDecl]
|
||||||
|
|
||||||
@ -62,6 +50,9 @@ type AddRefsM = State FullEnv
|
|||||||
|
|
||||||
type FullEnv = Map Range [ScopedDecl]
|
type FullEnv = Map Range [ScopedDecl]
|
||||||
|
|
||||||
|
-- | Calculate scopes and attach to all tree points declarations that are
|
||||||
|
-- visible there.
|
||||||
|
--
|
||||||
addLocalScopes
|
addLocalScopes
|
||||||
:: HasRange (Product xs)
|
:: HasRange (Product xs)
|
||||||
=> Pascal (Product xs)
|
=> Pascal (Product xs)
|
||||||
@ -104,11 +95,6 @@ addRef r n env = Map.union (go range) env
|
|||||||
$ filter (r <?)
|
$ filter (r <?)
|
||||||
$ Map.keys env
|
$ Map.keys env
|
||||||
|
|
||||||
-- decls' list = do
|
|
||||||
-- r' <- range
|
|
||||||
-- decls <- Map.lookup r' env
|
|
||||||
-- return $ (r', updateOnly n r addRefToDecl decls)
|
|
||||||
|
|
||||||
addRefToDecl sd = sd
|
addRefToDecl sd = sd
|
||||||
{ _sdRefs = r : _sdRefs sd
|
{ _sdRefs = r : _sdRefs sd
|
||||||
}
|
}
|
||||||
@ -175,49 +161,10 @@ data Kind = Star
|
|||||||
instance Pretty Kind where
|
instance Pretty Kind where
|
||||||
pp _ = "TYPE"
|
pp _ = "TYPE"
|
||||||
|
|
||||||
-- observe :: String -> CollectM a -> CollectM a
|
-- | Search for a name inside a local scope.
|
||||||
-- observe what act = do
|
|
||||||
-- s <- get
|
|
||||||
-- traceShowM (what, "BEFORE", s)
|
|
||||||
-- a <- act
|
|
||||||
-- s1 <- get
|
|
||||||
-- traceShowM (what, "AFTER", s1)
|
|
||||||
-- return a
|
|
||||||
|
|
||||||
lookupEnv :: Text -> [ScopedDecl] -> Maybe ScopedDecl
|
lookupEnv :: Text -> [ScopedDecl] -> Maybe ScopedDecl
|
||||||
lookupEnv name = listToMaybe . filter ((name ==) . ppToText . _sdName)
|
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.
|
-- | Add a type declaration to the current scope.
|
||||||
defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
|
defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
|
||||||
defType name kind body = do
|
defType name kind body = do
|
||||||
@ -229,37 +176,11 @@ defType name kind body = do
|
|||||||
(Just (Right kind))
|
(Just (Right kind))
|
||||||
[]
|
[]
|
||||||
|
|
||||||
observe :: Pretty i => Pretty res => Text -> i -> res -> res
|
-- observe :: Pretty i => Pretty res => Text -> i -> res -> res
|
||||||
observe msg i res
|
-- observe msg i res
|
||||||
= traceShow (pp msg, "INPUT", pp i)
|
-- = traceShow (pp msg, "INPUT", pp i)
|
||||||
$ traceShow (pp msg, "OUTPUT", pp res)
|
-- $ traceShow (pp msg, "OUTPUT", pp res)
|
||||||
$ 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
|
|
||||||
|
|
||||||
-- | Add a value declaration to the current scope.
|
-- | Add a value declaration to the current scope.
|
||||||
def
|
def
|
||||||
@ -352,66 +273,3 @@ instance HasRange a => UpdateOver CollectM Pattern (Pascal a) where
|
|||||||
instance UpdateOver CollectM QualifiedName (Pascal a)
|
instance UpdateOver CollectM QualifiedName (Pascal a)
|
||||||
instance UpdateOver CollectM Path (Pascal a)
|
instance UpdateOver CollectM Path (Pascal a)
|
||||||
instance UpdateOver CollectM Name (Pascal a) where
|
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