6ecd591 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #2256 from david-christiansen/name-highlights

6ecd591David Christiansen11 years ago

src/Idris/AbsSyntaxTree.hs+7−5

compare with master

unifiedsplit

@@ -600,7 +600,9 @@ data PDecl' t

600 | PCAF FC Name t -- ^ Top level constant

601 | PData (Docstring (Either Err PTerm)) [(Name, Docstring (Either Err PTerm))] SyntaxInfo FC DataOpts (PData' t) -- ^ Data declaration.

602 | PParams FC [(Name, t)] [PDecl' t] -- ^ Params block

603− | PNamespace String [PDecl' t] -- ^ New namespace

603+ | PNamespace String FC [PDecl' t]

604+ -- ^ New namespace, where FC is accurate location of the

605+ -- namespace in the file

604 | PRecord (Docstring (Either Err PTerm)) SyntaxInfo FC DataOpts

606 | PRecord (Docstring (Either Err PTerm)) SyntaxInfo FC DataOpts

605 Name -- Record name

607 Name -- Record name

606 FC -- Record name precise location

608 FC -- Record name precise location

@@ -742,7 +744,7 @@ declared (PData _ _ _ _ _ (PDatadecl n _ _ ts)) = n : map fstt ts

742 where fstt (_, _, a, _, _, _, _) = a

744 where fstt (_, _, a, _, _, _, _) = a

743declared (PData _ _ _ _ _ (PLaterdecl n _ _)) = [n]

745declared (PData _ _ _ _ _ (PLaterdecl n _ _)) = [n]

744declared (PParams _ _ ds) = concatMap declared ds

746declared (PParams _ _ ds) = concatMap declared ds

745−declared (PNamespace _ ds) = concatMap declared ds

747+declared (PNamespace _ _ ds) = concatMap declared ds

746declared (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

748declared (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

747declared (PClass _ _ _ _ n _ _ _ _ ms cn cd) = n : (map fst (maybeToList cn) ++ concatMap declared ms)

749declared (PClass _ _ _ _ n _ _ _ _ ms cn cd) = n : (map fst (maybeToList cn) ++ concatMap declared ms)

748declared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

750declared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

@@ -763,7 +765,7 @@ tldeclared (PData _ _ _ _ _ (PDatadecl n _ _ ts)) = n : map fstt ts

763 where fstt (_, _, a, _, _, _, _) = a

765 where fstt (_, _, a, _, _, _, _) = a

764tldeclared (PParams _ _ ds) = []

766tldeclared (PParams _ _ ds) = []

765tldeclared (PMutual _ ds) = concatMap tldeclared ds

767tldeclared (PMutual _ ds) = concatMap tldeclared ds

766−tldeclared (PNamespace _ ds) = concatMap tldeclared ds

768+tldeclared (PNamespace _ _ ds) = concatMap tldeclared ds

767tldeclared (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap tldeclared ms)

769tldeclared (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap tldeclared ms)

768tldeclared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

770tldeclared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

769tldeclared _ = []

771tldeclared _ = []

@@ -778,7 +780,7 @@ defined (PData _ _ _ _ _ (PDatadecl n _ _ ts)) = n : map fstt ts

778 where fstt (_, _, a, _, _, _, _) = a

780 where fstt (_, _, a, _, _, _, _) = a

779defined (PData _ _ _ _ _ (PLaterdecl n _ _)) = []

781defined (PData _ _ _ _ _ (PLaterdecl n _ _)) = []

780defined (PParams _ _ ds) = concatMap defined ds

782defined (PParams _ _ ds) = concatMap defined ds

781−defined (PNamespace _ ds) = concatMap defined ds

783+defined (PNamespace _ _ ds) = concatMap defined ds

782defined (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

784defined (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

783defined (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap defined ms)

785defined (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap defined ms)

784defined (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

786defined (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

@@ -1785,7 +1787,7 @@ showDeclImp o (PClauses _ _ n cs) = text "pat" <+> text (showCG n) <+> text "\t"

1785 indent 2 (vsep (map (showCImp o) cs))

1787 indent 2 (vsep (map (showCImp o) cs))

1786showDeclImp o (PData _ _ _ _ _ d) = showDImp o { ppopt_impl = True } d

1788showDeclImp o (PData _ _ _ _ _ d) = showDImp o { ppopt_impl = True } d

1787showDeclImp o (PParams _ ns ps) = text "params" <+> braces (text (show ns) <> line <> showDecls o ps <> line)

1789showDeclImp o (PParams _ ns ps) = text "params" <+> braces (text (show ns) <> line <> showDecls o ps <> line)

1788−showDeclImp o (PNamespace n ps) = text "namespace" <+> text n <> braces (line <> showDecls o ps <> line)

1790+showDeclImp o (PNamespace n fc ps) = text "namespace" <+> text n <> braces (line <> showDecls o ps <> line)

1789showDeclImp _ (PSyntax _ syn) = text "syntax" <+> text (show syn)

1791showDeclImp _ (PSyntax _ syn) = text "syntax" <+> text (show syn)

1790showDeclImp o (PClass _ _ _ cs n _ ps _ _ ds _ _)

1792showDeclImp o (PClass _ _ _ cs n _ ps _ _ ds _ _)

1791 = text "class" <+> text (show cs) <+> text (show n) <+> text (show ps) <> line <> showDecls o ds

1793 = text "class" <+> text (show cs) <+> text (show n) <+> text (show ps) <> line <> showDecls o ds

src/Idris/Chaser.hs+1−1

@@ -149,7 +149,7 @@ buildTree built fp = btree [] fp

149 (_, _, modules, _) <- parseImports f file

150 -- The chaser should never report warnings from sub-modules

151 clearParserWarnings

152− ms <- mapM (btree done) [realName | (_, realName, alias, fc) <- modules]

152+ ms <- mapM (btree done . import_path) modules

153 return (concat ms)

154 else return [] -- IBC with no source available

155-- (\c -> return []) -- error, can't chase modules here

src/Idris/Core/TT.hs+7

@@ -163,6 +163,13 @@ data OutputAnnotation = AnnName Name (Maybe NameOutput) (Maybe String) (Maybe St

163 | AnnTerm [(Name, Bool)] (TT Name) -- ^ pprint bound vars, original term

164 | AnnSearchResult Ordering -- ^ more general, isomorphic, or more specific

165 | AnnErr Err

166+ | AnnNamespace [T.Text] (Maybe FilePath)

167+ -- ^ A namespace (e.g. on an import line or in

168+ -- a namespace declaration). Stored starting

169+ -- at the root, with the hierarchy fully

170+ -- resolved. If a file path is present, then

171+ -- the namespace represents a module imported

172+ -- from that file.

166 deriving Show

173 deriving Show

167

174

168-- | Used for error reflection

175-- | Used for error reflection

src/Idris/DeepSeq.hs+1−1

@@ -146,7 +146,7 @@ instance (NFData t) => NFData (PDecl' t) where

146 rnf x2 `seq`

147 rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` ()

148 rnf (PParams x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()

149− rnf (PNamespace x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

149+ rnf (PNamespace x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()

150 rnf (PRecord x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)

151 = rnf x1 `seq`

152 rnf x2 `seq`

src/Idris/ElabDecls.hs+8−5

@@ -18,7 +18,7 @@ import Idris.Primitives

18import Idris.Inliner

19import Idris.PartialEval

20import Idris.DeepSeq

21−import Idris.Output (iputStrLn, pshow, iWarn)

21+import Idris.Output (iputStrLn, pshow, iWarn, sendHighlighting)

22import IRTS.Lang

24import Idris.Elab.Utils

@@ -227,11 +227,14 @@ elabDecl' what info (PParams f ns ps)

227 pblock i = map (expandParamsD False i id ns

228 (concatMap tldeclared ps)) ps

229

230−elabDecl' what info (PNamespace n ps) = mapM_ (elabDecl' what ninfo) ps

230+elabDecl' what info (PNamespace n nfc ps) =

231+ do mapM_ (elabDecl' what ninfo) ps

232+ let ns = reverse (map T.pack newNS)

233+ sendHighlighting [(nfc, AnnNamespace ns Nothing)]

231 where

234 where

232− ninfo = case namespace info of

235+ newNS = maybe [n] (n:) (namespace info)

233− Nothing -> info { namespace = Just [n] }

236+ ninfo = info { namespace = Just newNS }

234− Just ns -> info { namespace = Just (n:ns) }

237+

235elabDecl' what info (PClass doc s f cs n nfc ps pdocs fds ds cn cd)

238elabDecl' what info (PClass doc s f cs n nfc ps pdocs fds ds cn cd)

236 | what /= EDefns

239 | what /= EDefns

237 = do iLOG $ "Elaborating class " ++ show n

240 = do iLOG $ "Elaborating class " ++ show n

src/Idris/IBC.hs+6−4

@@ -1171,9 +1171,10 @@ instance (Binary t) => Binary (PDecl' t) where

1171 put x1

1172 put x2

1173 put x3

1174− PNamespace x1 x2 -> do putWord8 5

1174+ PNamespace x1 x2 x3 -> do putWord8 5

1175− put x1

1175+ put x1

1176− put x2

1176+ put x2

1177+ put x3

1177 PRecord x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ->

1178 PRecord x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ->

1178 do putWord8 6

1179 do putWord8 6

1179 put x1

1180 put x1

@@ -1284,7 +1285,8 @@ instance (Binary t) => Binary (PDecl' t) where

1284 return (PParams x1 x2 x3)

1285 return (PParams x1 x2 x3)

1285 5 -> do x1 <- get

1286 5 -> do x1 <- get

1286 x2 <- get

1287 x2 <- get

1288+ x3 <- get

1287− return (PNamespace x1 x2)

1289+ return (PNamespace x1 x2 x3)

1288 6 -> do x1 <- get

1290 6 -> do x1 <- get

1289 x2 <- get

1291 x2 <- get

1290 x3 <- get

1292 x3 <- get

src/Idris/IdeMode.hs+12−2

@@ -7,11 +7,12 @@ module Idris.IdeMode(parseMessage, convSExp, WhatDocs(..), IdeModeCommand(..), s

7import Text.Printf

8import Numeric

9import Data.List

10+import Data.Maybe (isJust)

10import qualified Data.Binary as Binary

11import qualified Data.Binary as Binary

11import qualified Data.ByteString.Base64 as Base64

12import qualified Data.ByteString.Base64 as Base64

12import qualified Data.ByteString.Lazy as Lazy

13import qualified Data.ByteString.Lazy as Lazy

13import qualified Data.ByteString.UTF8 as UTF8

14import qualified Data.ByteString.UTF8 as UTF8

14−-- import qualified Data.Text as T

15+import qualified Data.Text as T

15import Text.Trifecta hiding (Err)

16import Text.Trifecta hiding (Err)

16import Text.Trifecta.Delta

17import Text.Trifecta.Delta

17import System.IO

18import System.IO

@@ -115,11 +116,16 @@ constTy (B32 _) = "Bits32"

115constTy (B64 _) = "Bits64"

116constTy (B64 _) = "Bits64"

116constTy _ = "Type"

117constTy _ = "Type"

117

118

119+namespaceOf :: Name -> Maybe String

120+namespaceOf (NS _ ns) = Just (intercalate "." $ reverse (map T.unpack ns))

121+namespaceOf _ = Nothing

122+

118instance SExpable OutputAnnotation where

123instance SExpable OutputAnnotation where

119 toSExp (AnnName n ty d t) = toSExp $ [(SymbolAtom "name", StringAtom (show n)),

124 toSExp (AnnName n ty d t) = toSExp $ [(SymbolAtom "name", StringAtom (show n)),

120 (SymbolAtom "implicit", BoolAtom False)] ++

125 (SymbolAtom "implicit", BoolAtom False)] ++

121 maybeProps [("decor", ty)] ++

126 maybeProps [("decor", ty)] ++

122− maybeProps [("doc-overview", d), ("type", t)]

127+ maybeProps [("doc-overview", d), ("type", t)] ++

128+ maybeProps [("namespace", namespaceOf n)]

123 toSExp (AnnBoundName n imp) = toSExp [(SymbolAtom "name", StringAtom (show n)),

129 toSExp (AnnBoundName n imp) = toSExp [(SymbolAtom "name", StringAtom (show n)),

124 (SymbolAtom "decor", SymbolAtom "bound"),

130 (SymbolAtom "decor", SymbolAtom "bound"),

125 (SymbolAtom "implicit", BoolAtom imp)]

131 (SymbolAtom "implicit", BoolAtom imp)]

@@ -150,6 +156,10 @@ instance SExpable OutputAnnotation where

150 LT -> "more general than searched type"

156 LT -> "more general than searched type"

151 GT -> "more specific than searched type"

157 GT -> "more specific than searched type"

152 toSExp (AnnErr e) = toSExp [(SymbolAtom "error", StringAtom (encodeErr e))]

158 toSExp (AnnErr e) = toSExp [(SymbolAtom "error", StringAtom (encodeErr e))]

159+ toSExp (AnnNamespace ns file) =

160+ toSExp $ [(SymbolAtom "namespace", StringAtom (intercalate "." (map T.unpack ns)))] ++

161+ [(SymbolAtom "decor", SymbolAtom $ if isJust file then "module" else "namespace")] ++

162+ maybeProps [("source-file", file)]

153

163

154encodeTerm :: [(Name, Bool)] -> Term -> String

164encodeTerm :: [(Name, Bool)] -> Term -> String

155encodeTerm bnd tm = UTF8.toString . Base64.encode . Lazy.toStrict . Binary.encode $

165encodeTerm bnd tm = UTF8.toString . Base64.encode . Lazy.toStrict . Binary.encode $

src/Idris/Output.hs+8−5

@@ -195,7 +195,6 @@ prettyDocumentedIst ist (name, ty, docs) =

195 norm = normaliseAll (tt_ctxt ist) []

196

197sendHighlighting :: [(FC, OutputAnnotation)] -> Idris ()

198−sendHighlighting [] = return ()

199sendHighlighting highlights =

198sendHighlighting highlights =

200 do ist <- getIState

199 do ist <- getIState

201 case idris_outputmode ist of

200 case idris_outputmode ist of

@@ -204,10 +203,12 @@ sendHighlighting highlights =

204 let fancier = [ toSExp (fc, fancifyAnnots ist False annot)

203 let fancier = [ toSExp (fc, fancifyAnnots ist False annot)

205 | (fc, annot) <- highlights, fullFC fc

204 | (fc, annot) <- highlights, fullFC fc

206 ]

205 ]

206+ in case fancier of

207+ [] -> return ()

207− in runIO . hPutStrLn h $

208+ _ -> runIO . hPutStrLn h $

208− convSExp "output"

209+ convSExp "output"

209− (SymbolAtom "ok",

210+ (SymbolAtom "ok",

210− (SymbolAtom "highlight-source", fancier)) n

211+ (SymbolAtom "highlight-source", fancier)) n

211

212

212 where fullFC (FC _ _ _) = True

213 where fullFC (FC _ _ _) = True

213 fullFC _ = False

214 fullFC _ = False

@@ -254,6 +255,7 @@ renderExternal fmt width doc

254 decorate HTMLOutput (AnnTerm _ _) = id

255 decorate HTMLOutput (AnnTerm _ _) = id

255 decorate HTMLOutput (AnnSearchResult _) = id

256 decorate HTMLOutput (AnnSearchResult _) = id

256 decorate HTMLOutput (AnnErr _) = id

257 decorate HTMLOutput (AnnErr _) = id

258+ decorate HTMLOutput (AnnNamespace _ _) = id

257

259

258 decorate LaTeXOutput (AnnName _ (Just TypeOutput) _ _) =

260 decorate LaTeXOutput (AnnName _ (Just TypeOutput) _ _) =

259 latex "IdrisType"

261 latex "IdrisType"

@@ -281,6 +283,7 @@ renderExternal fmt width doc

281 decorate LaTeXOutput (AnnTerm _ _) = id

283 decorate LaTeXOutput (AnnTerm _ _) = id

282 decorate LaTeXOutput (AnnSearchResult _) = id

284 decorate LaTeXOutput (AnnSearchResult _) = id

283 decorate LaTeXOutput (AnnErr _) = id

285 decorate LaTeXOutput (AnnErr _) = id

286+ decorate LaTeXOutput (AnnNamespace _ _) = id

284

287

285 tag cls docs str = "<span class=\""++cls++"\""++title++">" ++ str ++ "</span>"

288 tag cls docs str = "<span class=\""++cls++"\""++title++">" ++ str ++ "</span>"

286 where title = maybe "" (\d->" title=\"" ++ d ++ "\"") docs

289 where title = maybe "" (\d->" title=\"" ++ d ++ "\"") docs

src/Idris/ParseHelpers.hs+1−1

@@ -632,7 +632,7 @@ collect (c@(PClauses _ o _ _) : ds)

632 fcOf (PClauses fc _ _ _) = fc

633collect (PParams f ns ps : ds) = PParams f ns (collect ps) : collect ds

634collect (PMutual f ms : ds) = PMutual f (collect ms) : collect ds

635−collect (PNamespace ns ps : ds) = PNamespace ns (collect ps) : collect ds

635+collect (PNamespace ns fc ps : ds) = PNamespace ns fc (collect ps) : collect ds

636collect (PClass doc f s cs n nfc ps pdocs fds ds cn cd : ds')

637 = PClass doc f s cs n nfc ps pdocs fds (collect ds) cn cd : collect ds'

638collect (PInstance doc argDocs f s cs n nfc ps t en ds : ds')

src/Idris/Parser.hs+72−28

@@ -92,38 +92,52 @@ import System.IO

92 ModuleHeader ::= DocComment_t? 'module' Identifier_t ';'?;

93@

94-}

95−moduleHeader :: IdrisParser (Maybe (Docstring ()), [String])

95+moduleHeader :: IdrisParser (Maybe (Docstring ()), [String], [(FC, OutputAnnotation)])

96moduleHeader = try (do docs <- optional docComment

97 noArgs docs

98 reserved "module"

99− i <- fst <$> identifier

99+ (i, ifc) <- identifier

100 option ';' (lchar ';')

101+ let modName = moduleName i

101− return (fmap fst docs, moduleName i))

102+ return (fmap fst docs,

103+ modName,

104+ [(ifc, AnnNamespace (map T.pack modName) Nothing)]))

102 <|> try (do lchar '%'; reserved "unqualified"

105 <|> try (do lchar '%'; reserved "unqualified"

103− return (Nothing, []))

106+ return (Nothing, [], []))

104− <|> return (Nothing, moduleName "Main")

107+ <|> return (Nothing, moduleName "Main", [])

105 where moduleName x = case span (/='.') x of

108 where moduleName x = case span (/='.') x of

106 (x, "") -> [x]

109 (x, "") -> [x]

107 (x, '.':y) -> x : moduleName y

110 (x, '.':y) -> x : moduleName y

108 noArgs (Just (_, args)) | not (null args) = fail "Modules do not take arguments"

111 noArgs (Just (_, args)) | not (null args) = fail "Modules do not take arguments"

109 noArgs _ = return ()

112 noArgs _ = return ()

110

113

114+data ImportInfo = ImportInfo { import_reexport :: Bool

115+ , import_path :: FilePath

116+ , import_rename :: Maybe (String, FC)

117+ , import_namespace :: [T.Text]

118+ , import_location :: FC

119+ , import_modname_location :: FC

120+ }

121+

111{- | Parses an import statement

122{- | Parses an import statement

112

123

113@

124@

114 Import ::= 'import' Identifier_t ';'?;

125 Import ::= 'import' Identifier_t ';'?;

115@

126@

116 -}

127 -}

117−import_ :: IdrisParser (Bool, String, Maybe String, FC)

128+import_ :: IdrisParser ImportInfo

118import_ = do fc <- getFC

129import_ = do fc <- getFC

119 reserved "import"

130 reserved "import"

120 reexport <- option False (do reserved "public"; return True)

131 reexport <- option False (do reserved "public"; return True)

121− id <- fst <$> identifier

132+ (id, idfc) <- identifier

122− newName <- optional (reserved "as" *> (fst <$> identifier))

133+ newName <- optional (reserved "as" *> identifier)

123 option ';' (lchar ';')

134 option ';' (lchar ';')

124− return (reexport, toPath id, toPath <$> newName, fc)

135+ return $ ImportInfo reexport (toPath id)

136+ (fmap (\(n, fc) -> (toPath n, fc)) newName)

137+ (map T.pack $ ns id) fc idfc

125 <?> "import statement"

138 <?> "import statement"

139+ where ns = Spl.splitOn "."

126− where toPath = foldl1' (</>) . Spl.splitOn "."

140+ toPath = foldl1' (</>) . ns

127

141

128{- | Parses program source

142{- | Parses program source

129

143

@@ -594,11 +608,12 @@ Namespace ::=

594-}

608-}

595namespace :: SyntaxInfo -> IdrisParser [PDecl]

609namespace :: SyntaxInfo -> IdrisParser [PDecl]

596namespace syn =

610namespace syn =

597− do reserved "namespace"; n <- fst <$> identifier

611+ do reserved "namespace"

612+ (n, nfc) <- identifier

598 openBlock

613 openBlock

599 ds <- some (decl syn { syn_namespace = n : syn_namespace syn })

614 ds <- some (decl syn { syn_namespace = n : syn_namespace syn })

600 closeBlock

615 closeBlock

601− return [PNamespace n (concat ds)]

616+ return [PNamespace n nfc (concat ds)]

602 <?> "namespace declaration"

617 <?> "namespace declaration"

603

618

604{- | Parses a methods block (for instances)

619{- | Parses a methods block (for instances)

@@ -1222,16 +1237,21 @@ parseTactic :: IState -> String -> Result PTactic

1222parseTactic st = runparser (fullTactic defaultSyntax) st "(input)"

1237parseTactic st = runparser (fullTactic defaultSyntax) st "(input)"

1223

1238

1224-- | Parse module header and imports

1239-- | Parse module header and imports

1225−parseImports :: FilePath -> String -> Idris (Maybe (Docstring ()), [String], [(Bool, String, Maybe String, FC)], Maybe Delta)

1240+parseImports :: FilePath -> String -> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe Delta)

1226parseImports fname input

1241parseImports fname input

1227 = do i <- getIState

1242 = do i <- getIState

1228 case parseString (runInnerParser (evalStateT imports i)) (Directed (UTF8.fromString fname) 0 0 0 0) input of

1243 case parseString (runInnerParser (evalStateT imports i)) (Directed (UTF8.fromString fname) 0 0 0 0) input of

1229− Failure err -> fail (show err)

1244+ Failure err -> fail (show err)

1245+ Success (x, annots, i) ->

1230− Success (x, i) -> do putIState i

1246+ do putIState i

1247+ sendHighlighting (addPath annots fname)

1231− return x

1248+ return x

1232− where imports :: IdrisParser ((Maybe (Docstring ()), [String], [(Bool, String, Maybe String, FC)], Maybe Delta), IState)

1249+ where imports :: IdrisParser ((Maybe (Docstring ()), [String],

1250+ [ImportInfo],

1251+ Maybe Delta),

1252+ [(FC, OutputAnnotation)], IState)

1233 imports = do whiteSpace

1253 imports = do whiteSpace

1234− (mdoc, mname) <- moduleHeader

1254+ (mdoc, mname, annots) <- moduleHeader

1235 ps <- many import_

1255 ps <- many import_

1236 mrk <- mark

1256 mrk <- mark

1237 isEof <- lookAheadMatches eof

1257 isEof <- lookAheadMatches eof

@@ -1239,7 +1259,12 @@ parseImports fname input

1239 then Nothing

1259 then Nothing

1240 else Just mrk

1260 else Just mrk

1241 i <- get

1261 i <- get

1242− return ((mdoc, mname, ps, mrk'), i)

1262+ return ((mdoc, mname, ps, mrk'), annots, i)

1263+ addPath :: [(FC, OutputAnnotation)] -> FilePath -> [(FC, OutputAnnotation)]

1264+ addPath [] _ = []

1265+ addPath ((fc, AnnNamespace ns Nothing) : annots) path =

1266+ (fc, AnnNamespace ns (Just path)) : addPath annots path

1267+ addPath (annot:annots) path = annot : addPath annots path

1243

1268

1244-- | There should be a better way of doing this...

1269-- | There should be a better way of doing this...

1245findFC :: Doc -> (FC, String)

1270findFC :: Doc -> (FC, String)

@@ -1351,23 +1376,37 @@ loadSource lidr f toline

1351 file <- if lidr then tclift $ unlit f file_in else return file_in

1376 file <- if lidr then tclift $ unlit f file_in else return file_in

1352 (mdocs, mname, imports_in, pos) <- parseImports f file

1377 (mdocs, mname, imports_in, pos) <- parseImports f file

1353 ai <- getAutoImports

1378 ai <- getAutoImports

1354− let imports = map (\n -> (True, n, Just n, emptyFC)) ai ++ imports_in

1379+ let imports = map (\n -> ImportInfo True n Nothing [] NoFC NoFC) ai ++ imports_in

1355 ids <- allImportDirs

1380 ids <- allImportDirs

1356 ibcsd <- valIBCSubDir i

1381 ibcsd <- valIBCSubDir i

1357− mapM_ (\(re, f) ->

1382+ mapM_ (\(re, f, ns, nfc) ->

1358 do fp <- findImport ids ibcsd f

1383 do fp <- findImport ids ibcsd f

1359 case fp of

1384 case fp of

1360 LIDR fn -> ifail $ "No ibc for " ++ f

1385 LIDR fn -> ifail $ "No ibc for " ++ f

1361 IDR fn -> ifail $ "No ibc for " ++ f

1386 IDR fn -> ifail $ "No ibc for " ++ f

1387+ IBC fn src ->

1362− IBC fn src -> loadIBC True fn)

1388+ do loadIBC True fn

1389+ let srcFn = case src of

1390+ IDR fn -> Just fn

1391+ LIDR fn -> Just fn

1392+ _ -> Nothing

1393+ sendHighlighting [(nfc, AnnNamespace ns srcFn)])

1363− [(re, fn) | (re, fn, _, _) <- imports]

1394+ [(re, fn, ns, nfc) | ImportInfo re fn _ ns _ nfc <- imports]

1364 reportParserWarnings

1395 reportParserWarnings

1365

1396

1366 -- process and check module aliases

1397 -- process and check module aliases

1367 let modAliases = M.fromList

1398 let modAliases = M.fromList

1368− [(prep alias, prep realName) | (reexport, realName, Just alias, fc) <- imports]

1399+ [ (prep alias, prep realName)

1400+ | ImportInfo { import_reexport = reexport

1401+ , import_path = realName

1402+ , import_rename = Just (alias, _)

1403+ , import_location = fc } <- imports

1404+ ]

1369 prep = map T.pack . reverse . Spl.splitOn [pathSeparator]

1405 prep = map T.pack . reverse . Spl.splitOn [pathSeparator]

1370− aliasNames = [(alias, fc) | (_, _, Just alias, fc) <- imports]

1406+ aliasNames = [ (alias, fc)

1407+ | ImportInfo { import_rename = Just (alias, _)

1408+ , import_location = fc } <- imports

1409+ ]

1371 histogram = groupBy ((==) `on` fst) . sortBy (comparing fst) $ aliasNames

1410 histogram = groupBy ((==) `on` fst) . sortBy (comparing fst) $ aliasNames

1372 case map head . filter ((/= 1) . length) $ histogram of

1411 case map head . filter ((/= 1) . length) $ histogram of

1373 [] -> logLvl 3 $ "Module aliases: " ++ show (M.toList modAliases)

1412 [] -> logLvl 3 $ "Module aliases: " ++ show (M.toList modAliases)

@@ -1379,7 +1418,12 @@ loadSource lidr f toline

1379 -- record package info in .ibc

1418 -- record package info in .ibc

1380 imps <- allImportDirs

1419 imps <- allImportDirs

1381 mapM_ addIBC (map IBCImportDir imps)

1420 mapM_ addIBC (map IBCImportDir imps)

1382− mapM_ (addIBC . IBCImport) [(reexport, realName) | (reexport, realName, alias, fc) <- imports]

1421+ mapM_ (addIBC . IBCImport)

1422+ [ (reexport, realName)

1423+ | ImportInfo { import_reexport = reexport

1424+ , import_path = realName

1425+ } <- imports

1426+ ]

1383 let syntax = defaultSyntax{ syn_namespace = reverse mname,

1427 let syntax = defaultSyntax{ syn_namespace = reverse mname,

1384 maxline = toline }

1428 maxline = toline }

1385 ist <- getIState

1429 ist <- getIState

@@ -1463,11 +1507,11 @@ loadSource lidr f toline

1463 where

1507 where

1464 namespaces :: [String] -> [PDecl] -> [PDecl]

1508 namespaces :: [String] -> [PDecl] -> [PDecl]

1465 namespaces [] ds = ds

1509 namespaces [] ds = ds

1466− namespaces (x:xs) ds = [PNamespace x (namespaces xs ds)]

1510+ namespaces (x:xs) ds = [PNamespace x NoFC (namespaces xs ds)]

1467

1511

1468 toMutual :: PDecl -> PDecl

1512 toMutual :: PDecl -> PDecl

1469 toMutual m@(PMutual _ d) = m

1513 toMutual m@(PMutual _ d) = m

1470− toMutual (PNamespace x ds) = PNamespace x (map toMutual ds)

1514+ toMutual (PNamespace x fc ds) = PNamespace x fc (map toMutual ds)

1471 toMutual x = let r = PMutual (fileFC "single mutual") [x] in

1515 toMutual x = let r = PMutual (fileFC "single mutual") [x] in

1472 case x of

1516 case x of

1473 PClauses{} -> r

1517 PClauses{} -> r