e914ae0 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Add check for module alias clashes.

e914ae0Matus Tejiscak13 years ago

src/Idris/Chaser.hs+1−1

compare with master

unifiedsplit

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

132 file_in <- runIO $ readFile f

133 file <- if lit then tclift $ unlit f file_in else return file_in

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

135− ms <- mapM (btree done . fst) modules

135+ ms <- mapM (btree done) [realName | (realName, alias, fc) <- modules]

136 return (concat ms)

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

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

src/Idris/Parser.hs+19−10

@@ -47,11 +47,13 @@ import Control.Monad

47import Control.Monad.Error (throwError, catchError)

48import Control.Monad.State.Strict

50+import Data.Function

50import Data.Maybe

51import Data.Maybe

51import qualified Data.List.Split as Spl

52import qualified Data.List.Split as Spl

52import Data.List

53import Data.List

53import Data.Monoid

54import Data.Monoid

54import Data.Char

55import Data.Char

56+import Data.Ord

55import qualified Data.Map as M

57import qualified Data.Map as M

56import qualified Data.HashSet as HS

58import qualified Data.HashSet as HS

57import qualified Data.Text as T

59import qualified Data.Text as T

@@ -92,12 +94,13 @@ moduleHeader = try (do reserved "module"

92{- | Parses an import statement

94{- | Parses an import statement

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

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

94 -}

96 -}

95−import_ :: IdrisParser (String, Maybe String)

97+import_ :: IdrisParser (String, Maybe String, FC)

98+import_ = do fc <- getFC

96−import_ = do reserved "import"

99+ reserved "import"

97 id <- identifier

100 id <- identifier

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

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

99 option ';' (lchar ';')

102 option ';' (lchar ';')

100− return (toPath id, toPath <$> newName)

103+ return (toPath id, toPath <$> newName, fc)

101 <?> "import statement"

104 <?> "import statement"

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

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

103

106

@@ -936,7 +939,7 @@ parseTactic :: IState -> String -> Result PTactic

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

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

937

940

938-- | Parse module header and imports

941-- | Parse module header and imports

939−parseImports :: FilePath -> String -> Idris ([String], [(String, Maybe String)], Maybe Delta)

942+parseImports :: FilePath -> String -> Idris ([String], [(String, Maybe String, FC)], Maybe Delta)

940parseImports fname input

943parseImports fname input

941 = do i <- getIState

944 = do i <- getIState

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

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

@@ -944,7 +947,7 @@ parseImports fname input

944 Success (x, i) -> do -- Discard state updates (there should be

947 Success (x, i) -> do -- Discard state updates (there should be

945 -- none anyway)

948 -- none anyway)

946 return x

949 return x

947− where imports :: IdrisParser (([String], [(String, Maybe String)], Maybe Delta), IState)

950+ where imports :: IdrisParser (([String], [(String, Maybe String, FC)], Maybe Delta), IState)

948 imports = do whiteSpace

951 imports = do whiteSpace

949 mname <- moduleHeader

952 mname <- moduleHeader

950 ps <- many import_

953 ps <- many import_

@@ -1056,15 +1059,21 @@ loadSource h lidr f

1056 file_in <- runIO $ readFile f

1059 file_in <- runIO $ readFile f

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

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

1058 (mname, imports, pos) <- parseImports f file

1061 (mname, imports, pos) <- parseImports f file

1059− let modules = map fst imports

1062+

1063+ -- process and check module aliases

1060− modAliases = M.fromList

1064+ let modAliases = M.fromList

1061− [(prep alias, prep realName) | (realName, Just alias) <- imports]

1065+ [(prep alias, prep realName) | (realName, Just alias, fc) <- imports]

1062 prep = map T.pack . reverse . Spl.splitOn "/"

1066 prep = map T.pack . reverse . Spl.splitOn "/"

1067+ aliasNames = [(alias, fc) | (_, Just alias, fc) <- imports]

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

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

1063− logLvl 3 $ "Module aliases: " ++ show (M.toList modAliases)

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

1071+ (n,fc):_ -> throwError . At fc . Msg $ "import alias not unique: " ++ show n

1072+

1064 i <- getIState

1073 i <- getIState

1065 putIState (i { default_access = Hidden, module_aliases = modAliases })

1074 putIState (i { default_access = Hidden, module_aliases = modAliases })

1066 clearIBC -- start a new .ibc file

1075 clearIBC -- start a new .ibc file

1067− mapM_ (addIBC . IBCImport) modules

1076+ mapM_ (addIBC . IBCImport) [realName | (realName, alias, fc) <- imports]

1068 let syntax = defaultSyntax{ syn_namespace = reverse mname }

1077 let syntax = defaultSyntax{ syn_namespace = reverse mname }

1069 ds' <- parseProg syntax f file pos

1078 ds' <- parseProg syntax f file pos

1070 unless (null ds') $ do

1079 unless (null ds') $ do

test/test038/Multiple.idrnew file+4

@@ -0,0 +1,4 @@

1+module Multiple

3+import Prelude.Vect as X

4+import Prelude.List as X

test/test038/expected+1

@@ -1,3 +1,4 @@

1MAIN-PASS

2Faulty.idr:6:7:When elaborating type of Faulty.fault:

3Can't disambiguate name: A.num, B.C.num

4+Multiple.idr:3:1:import alias not unique: "X"

test/test038/run+1

@@ -1,4 +1,5 @@

1#!/usr/bin/env bash

2idris $@ Main.idr --nocolour --check && echo MAIN-PASS

3idris $@ Faulty.idr --nocolour --check && echo FAULTY-PASS

4+idris $@ Multiple.idr --nocolour --check && echo MULTIPLE-PASS

4find -name \*.ibc -delete

5find -name \*.ibc -delete