ref: db2e57c571aa84063ef01b8a5589db02cb9d5b4a
parent: eb6691cb4f14ed2613fd032f88e64e6ee31c7422
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 2 09:00:30 EDT 2023
Add a flag to see modules being loaded
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -21,23 +21,26 @@
--Ximport qualified CompatIO as IO
--Ximport System.IO(Handle)
-data Flags = Flags Int Bool [String] String
+data Flags = Flags Int Bool [String] String Bool
--Xderiving (Show)
type Time = Int
verbose :: Flags -> Int
-verbose (Flags x _ _ _) = x
+verbose (Flags x _ _ _ _) = x
runIt :: Flags -> Bool
-runIt (Flags _ x _ _) = x
+runIt (Flags _ x _ _ _) = x
paths :: Flags -> [String]
-paths (Flags _ _ x _) = x
+paths (Flags _ _ x _ _) = x
output :: Flags -> String
-output (Flags _ _ _ x) = x
+output (Flags _ _ _ x _) = x
+loading :: Flags -> Bool
+loading (Flags _ _ _ _ x) = x
+
-----------------
type CModule = TModule [LDef]
@@ -87,26 +90,28 @@
-- Compile a module with the given name.
-- If the module has already been compiled, return the cached result.
compileModuleCached :: Flags -> IdentModule -> StateIO Cache (CModule, Time)
-compileModuleCached flags nm = S.do
+compileModuleCached flags mn = S.do
ch <- gets cache
- case M.lookup nm ch of
+ case M.lookup mn ch of
Nothing -> S.do
ws <- gets working
- S.when (elem nm ws) $
- error $ "recursive module: " ++ showIdent nm
- modify $ \ c -> updWorking (nm : working c) c
+ S.when (elem mn ws) $
+ error $ "recursive module: " ++ showIdent mn
+ modify $ \ c -> updWorking (mn : working c) c
S.when (verbose flags > 0) $
- liftIO $ putStrLn $ "importing " ++ showIdent nm
- (cm, tp, tt, ts) <- compileModule flags nm
+ liftIO $ putStrLn $ "importing " ++ showIdent mn
+ (cm, tp, tt, ts) <- compileModule flags mn
S.when (verbose flags > 0) $
- liftIO $ putStrLn $ "importing done " ++ showIdent nm ++ ", " ++ showInt (tp + tt) ++
+ liftIO $ putStrLn $ "importing done " ++ showIdent mn ++ ", " ++ showInt (tp + tt) ++
"ms (" ++ showInt tp ++ " + " ++ showInt tt ++ ")"+ S.when (loading flags && mn /= mkIdent "Interactive") $
+ liftIO $ putStrLn $ "import " ++ showIdent mn
c <- get
- put $ Cache (tail (working c)) (M.insert nm cm (cache c))
+ put $ Cache (tail (working c)) (M.insert mn cm (cache c))
S.return (cm, tp + tt + ts)
Just cm -> S.do
S.when (verbose flags > 0) $
- liftIO $ putStrLn $ "importing cached " ++ showIdent nm
+ liftIO $ putStrLn $ "importing cached " ++ showIdent mn
S.return (cm, 0)
-- Find and compile a module with the given name.
--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -20,10 +20,11 @@
type I a = S.StateIO IState a
mainInteractive :: Flags -> IO ()
-mainInteractive flags = do
+mainInteractive (Flags a b c d _) = do
putStrLn "Welcome to interactive MicroHs!"
putStrLn "Type ':quit' to quit, ':help' for help"
- _ <- S.runStateIO repl (preamble, flags, emptyCache)
+ let flags' = Flags a b c d True
+ _ <- S.runStateIO repl (preamble, flags', emptyCache)
return ()
preamble :: String
@@ -65,6 +66,10 @@
[ ("quit", const $ S.return False) , ("clear", const $ S.doupdateLines (const preamble)
+ S.modify $ \ (ls, flgs, _) -> (ls, flgs, emptyCache)
+ S.return True
+ )
+ , ("reload", const $ S.doS.modify $ \ (ls, flgs, _) -> (ls, flgs, emptyCache)
S.return True
)
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -25,6 +25,7 @@
(elem "-r" args)
("." : catMaybes (map (stripPrefix "-i") args))(head $ catMaybes (map (stripPrefix "-o") args) ++ ["out.comb"])
+ (elem "-l" args)
case ss of
[] -> mainInteractive flags
[s] -> mainCompile flags (mkIdent s)
--
⑨