compiler(#322): don't use name cache by default

[skip ci][skip lemma]
au-ts · Dec 11, 2019 · 1a825d6 · 1a825d6
1 parent 44231a4
commit 1a825d6
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 16 deletions.
diff --git a/cogent/Main.hs b/cogent/Main.hs
@@ -696,7 +696,7 @@ parseArgs args = case getOpt' Permute options args of
       let stg = STGNormal
       putProgress "Normalising..."
       nfed' <- case __cogent_fnormalisation of
-        NoNF -> putProgressLn "Skipped" >> return desugared
+        NoNF -> putProgressLn "Skipped." >> return desugared
         nf -> do putProgressLn (show nf)
                  let nfed = NF.normal $ map untypeD desugared
                  if not $ verifyNormal nfed
@@ -794,15 +794,17 @@ parseArgs args = case getOpt' Permute options args of
           hscName = mkOutputName' toHsModName source (Just __cogent_suffix_of_ffi_types)
           hsName  = mkOutputName' toHsModName source (Just __cogent_suffix_of_ffi)
           cNames  = map (\n -> takeBaseName n ++ __cogent_suffix_of_pp ++ __cogent_suffix_of_inferred <.> __cogent_ext_of_c) __cogent_infer_c_func_files
-          cacheFile = __cogent_name_cache
-      cacheExists <- doesFileExist __cogent_name_cache
-      if cacheExists then putProgressLn ("Using existing name cache file: " ++ __cogent_name_cache)
-                     else putProgressLn ("No name cache file found: " ++ __cogent_name_cache)
-      mcache <- if cacheExists then do decodeResult <- decodeFileOrFail __cogent_name_cache
-                                       case decodeResult of
-                                         Left (_, err) -> hPutStrLn stderr ("Decoding name cache file failed: " ++ err) >> exitFailure
-                                         Right cache -> return $ Just cache
-                               else return Nothing
+      (mcache, decodingFailed) <- case __cogent_name_cache of
+        Nothing -> return (Nothing, False)
+        Just cacheFile -> do
+          cacheExists <- doesFileExist cacheFile
+          if not cacheExists
+            then putProgressLn ("No name cache file found: " ++ cacheFile) >> return (Nothing, False)
+            else do putProgressLn ("Using existing name cache file: " ++ cacheFile)
+                    decodeResult <- decodeFileOrFail cacheFile
+                    case decodeResult of
+                      Left (_, err) -> hPutStrLn stderr ("Decoding name cache file failed: " ++ err ++ ".\nNot using name cache.") >> return (Nothing, True)
+                      Right cache -> return (Just cache, False)
       let (h,c,atm,ct,hsc,hs,genst) = cgen hName cNames hscName hsName monoed mcache ctygen log
       when (TableAbsTypeMono `elem` cmds) $ do
         let atmfile = mkFileName source Nothing __cogent_ext_of_atm
@@ -835,8 +837,10 @@ parseArgs args = case getOpt' Permute options args of
         output cf $ flip M.hPutDoc (ppr c </> M.line)       -- .c file gen
         unless (null $ __cogent_infer_c_func_files ++ __cogent_infer_c_type_files) $
           glue cmds tced tcst typedefs fts insts genst buildinfo log
-        putProgressLn ("Writing name cache file: " ++ __cogent_name_cache)
-        encodeFile __cogent_name_cache genst
+        forM_ __cogent_name_cache $ \cacheFile -> do
+          unless decodingFailed $ do
+            putProgressLn ("Writing name cache file: " ++ cacheFile)
+            encodeFile cacheFile genst
 
     c_refinement source monoed insts log (False,False,False) = return ()
     c_refinement source monoed insts log (ac,cs,cp) = do

diff --git a/cogent/src/Cogent/Compiler.hs b/cogent/src/Cogent/Compiler.hs
@@ -182,7 +182,7 @@ set_flag_fwrapPutInLet = writeIORef __cogent_fwrap_put_in_let_ref True
 set_flag_inferCFunc = writeIORef __cogent_infer_c_func_files_ref
 set_flag_inferCType = writeIORef __cogent_infer_c_type_files_ref
 set_flag_interactive = writeIORef __cogent_interactive_ref True
-set_flag_nameCache = writeIORef __cogent_name_cache_ref
+set_flag_nameCache = writeIORef __cogent_name_cache_ref . Just
 set_flag_O Nothing = return ()
 set_flag_O (Just n :: Maybe String)
   | n == "0" = do set_flag_fnormalisation Nothing
@@ -661,12 +661,12 @@ __cogent_interactive_ref :: IORef Bool
 {-# NOINLINE __cogent_interactive_ref #-}
 __cogent_interactive_ref = unsafePerformIO $ newIORef False
 
-__cogent_name_cache :: FilePath
+__cogent_name_cache :: Maybe FilePath
 __cogent_name_cache = unsafePerformIO $ readIORef __cogent_name_cache_ref
 
-__cogent_name_cache_ref :: IORef FilePath
+__cogent_name_cache_ref :: IORef (Maybe FilePath)
 {-# NOINLINE __cogent_name_cache_ref #-}
-__cogent_name_cache_ref = unsafePerformIO $ newIORef ".name-cache"
+__cogent_name_cache_ref = unsafePerformIO $ newIORef Nothing
 
 __cogent_output_name :: Maybe String
 __cogent_output_name = unsafePerformIO $ readIORef __cogent_output_name_ref