shithub: MicroHs

Info  •  Files  •  Log  •  Branches

Refactor a little.

--- a/src/MicroHs/Compile.hs

+++ b/src/MicroHs/Compile.hs

@@ -79,10 +79,7 @@

   ch <- gets cache

   case M.lookup mn ch of

     Nothing -> do

-      ws <- gets working

-      when (elem mn ws) $

-        error $ "recursive module: " ++ showIdent mn ++ ", import chain: " ++ unwords (map showIdent ws)

-      modify $ \ c -> updWorking (mn : working c) c

+      modify $ addWorking mn

       when (verbosityGT flags 0) $

         liftIO $ putStrLn $ "importing " ++ showIdent mn

       (cm, tp, tt, ts) <- compileModule flags mn

--- a/src/MicroHs/CompileCache.hs

+++ b/src/MicroHs/CompileCache.hs

@@ -1,12 +1,12 @@

 module MicroHs.CompileCache(

   CModule(..), tModuleOf,

-  Cache, cache, working, updWorking, emptyCache, deleteFromCache, workToDone,

+  Cache, cache, addWorking, emptyCache, deleteFromCache, workToDone,

   saveCache, loadCached,

   ) where

 import Prelude

 import MicroHs.Desugar(LDef)

 import MicroHs.Expr(IdentModule)

---import MicroHs.Ident

+import MicroHs.Ident(showIdent)

 import qualified MicroHs.IdentMap as M

 import MicroHs.TypeCheck(TModule)

 import System.IO

@@ -23,23 +23,25 @@

 tModuleOf :: CModule -> TModule [LDef]

 tModuleOf (CModule t _ _) = t

-data Cache = Cache [IdentModule] (M.Map CModule)

+data Cache = Cache {

+  working :: [IdentModule],             -- modules currently being processed (used to detected circular imports)

+  cache   :: M.Map CModule              -- cached compiled modules

+  }

 --  deriving (Show)

-working :: Cache -> [IdentModule]

-working (Cache x _) = x

-

-updWorking :: [IdentModule] -> Cache -> Cache

-updWorking w (Cache _ m) = Cache w m

-

-cache :: Cache -> M.Map CModule

-cache (Cache _ x) = x

-

 emptyCache :: Cache

 emptyCache = Cache [] M.empty

 deleteFromCache :: IdentModule -> Cache -> Cache

 deleteFromCache mn (Cache is m) = Cache is (M.delete mn m)

+

+addWorking :: IdentModule -> Cache -> Cache

+addWorking mn c =

+  let ws = working c

+  in  if elem mn ws then

+        error $ "recursive module: " ++ showIdent mn ++ ", import chain: " ++ unwords (map showIdent ws)

+      else

+        c{ working = mn : ws }

 workToDone :: CModule -> Cache -> Cache

 workToDone cm (Cache (mn:ws) m) = Cache ws (M.insert mn cm m)

-- 

⑨