compiler: allow ext-types file to have comments
diff --git a/cogent/Main.hs b/cogent/Main.hs
index 96a9a29..7496b78 100644
--- a/cogent/Main.hs
+++ b/cogent/Main.hs
@@ -61,11 +61,6 @@
import Cogent.Util as UT
-- import BuildInfo_cogent (githash, buildtime)
-#if __GLASGOW_HASKELL__ < 709
-import Control.Applicative (liftA, (<$>))
-#else
-import Control.Applicative (liftA)
-#endif
import Control.Monad (forM, forM_, unless, when, (<=<))
import Control.Monad.Trans.Except (runExceptT)
-- import Control.Monad.Cont
@@ -647,7 +642,7 @@
parseWithIncludes source __cogent_include >>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right (parsed,pragmas) -> do
- prune <- T.forM __cogent_prune_call_graph $ return . parseEntryFuncs <=< readFile
+ prune <- T.forM __cogent_prune_call_graph simpleLineParser
putProgressLn "Resolving dependencies..."
case reorganize prune parsed of
Left err -> printError prettyRE [err] >> exitFailure
@@ -763,7 +758,7 @@
let stg = STGMono
putProgressLn "Monomorphising..."
efuns <- T.forM __cogent_entry_funcs $
- return . (,empty) <=< (readEntryFuncs tced tcst typedefs fts) <=< return . parseEntryFuncs <=< readFile
+ return . (,empty) <=< (readEntryFuncs tced tcst typedefs fts) <=< simpleLineParser
entryFuncs <- case efuns of
Nothing -> return Nothing
Just (Nothing, _) -> exitFailure
@@ -897,7 +892,7 @@
output csfile $ flip LJ.hPutDoc corresSetupThy
when cp $ do
putProgressLn "Generating C-refinement proofs..."
- ent <- T.forM __cogent_entry_funcs $ (liftA parseEntryFuncs) . readFile -- a simple parser
+ ent <- T.forM __cogent_entry_funcs simpleLineParser -- a simple parser
let corresProofThy = corresProof thy inputc (map SY.CoreFunName confns) (map SY.CoreFunName <$> ent) log
writeFileMsg cpfile
output cpfile $ flip LJ.hPutDoc corresProofThy
@@ -1049,8 +1044,6 @@
writeFileMsg bifile
output bifile $ flip hPutStrLn buildinfo
- -- --entry-funcs expects one function name per line; lines starting with -- are comments
- parseEntryFuncs = filter (not . isPrefixOf "--") . filter (not . null) . map (dropWhile isSpace) . lines
-- ------------------------------------------------------------------------
-- Helper functions
diff --git a/cogent/cogent.cabal b/cogent/cogent.cabal
index b459aa4..378c3d6 100644
--- a/cogent/cogent.cabal
+++ b/cogent/cogent.cabal
@@ -75,7 +75,7 @@
custom-setup
setup-depends:
- base >= 4.10 && < 4.14
+ base >= 4.10 && < 4.15
, Cabal >= 3.0
-- ^^^ 3.0 is needed as we use Cabal in Setup.hs
, directory >= 1.2
@@ -175,7 +175,7 @@
build-depends:
ansi-wl-pprint >= 0.6
- , base >= 4.10 && < 4.14
+ , base >= 4.10 && < 4.15
, binary
, bytestring >= 0.10
, containers >= 0.5.8
@@ -255,7 +255,7 @@
cogent
, ansi-wl-pprint >= 0.6
, atomic-write >= 0.2.0.4
- , base >= 4.10 && < 4.14
+ , base >= 4.10 && < 4.15
, binary
, containers >= 0.5.8
, directory >=1.2
@@ -302,7 +302,7 @@
main-is: test-util.hs
build-depends:
cogent
- , base >= 4.10 && < 4.14
+ , base >= 4.10 && < 4.15
, containers >= 0.5.8
, directory >=1.2
, filepath >= 1.4.0.0
@@ -324,7 +324,7 @@
, CogentTests.Core
build-depends:
cogent
- , base >= 4.10 && < 4.14
+ , base >= 4.10 && < 4.15
, Cabal >= 3.0
, containers >= 0.5.8
, mainland-pretty >= 0.2.6
diff --git a/cogent/examples/files/types.cfg b/cogent/examples/files/types.cfg
index c7152c4..1f0d456 100644
--- a/cogent/examples/files/types.cfg
+++ b/cogent/examples/files/types.cfg
@@ -1 +1,3 @@
FILE
+-- This line is a comment, and the next line is empty
+
diff --git a/cogent/src/Cogent/Glue.hs b/cogent/src/Cogent/Glue.hs
index d4fa4b7..4cefa67 100644
--- a/cogent/src/Cogent/Glue.hs
+++ b/cogent/src/Cogent/Glue.hs
@@ -103,7 +103,7 @@
let start = startPos filename
#endif
s <- lift $ B.readFile filename
- typnames <- case __cogent_ext_types of Nothing -> lift (return deftypnames); Just f -> lift $ getTypnames f
+ typnames <- case __cogent_ext_types of Nothing -> lift (return deftypnames); Just f -> lift $ simpleLineParser f
case CP.evalP (__fixme CP.parseUnit) (CP.emptyPState exts typnames s start) of -- FIXME: check for other antiquotes
Left err -> throwE $ "Error: Failed to parse C: " ++ show err
Right ds -> return ds
@@ -114,9 +114,6 @@
defaultTypnames :: [String]
defaultTypnames = []
-getTypnames :: FilePath -> IO [String]
-getTypnames = liftA lines . readFile
-
-- Desugaring, Monomorphising, and CG
diff --git a/cogent/src/Cogent/Util.hs b/cogent/src/Cogent/Util.hs
index 294f557..49778ba 100644
--- a/cogent/src/Cogent/Util.hs
+++ b/cogent/src/Cogent/Util.hs
@@ -428,6 +428,11 @@
getStdIncFullPath fp = do sdir <- getLibgumDir
return (sdir </> fp)
+-- reads a file, ignoring all lines starting with "--" and blank lines, eliminate spaces
+simpleLineParser :: FilePath -> IO [String]
+simpleLineParser = (return . filter (not . L.isPrefixOf "--") . filter (not . null) . map (dropWhile isSpace) . lines) <=< readFile
+
+
-- If the domain of some maps contains duplicate keys.
-- Returns Left ks for overlapping keys ks, Right ks for with the set of non-overlapping keys ks.
overlapping :: (Eq k) => [M.Map k v] -> Either [k] [k]
