ref: 613c8356864d6f7845b75af9832f6d368dcc65ea
parent: 1504dcde34c5573218f3cf4633bcfcbe53222e76
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Mar 5 14:17:45 EST 2024
Get rid of some extensions we don't really need.
--- a/MicroHs.cabal
+++ b/MicroHs.cabal
@@ -44,8 +44,8 @@
-fwrite-ide-info
main-is: MicroHs/Main.hs
default-extensions: ScopedTypeVariables PatternGuards TupleSections TypeSynonymInstances MultiParamTypeClasses
- FlexibleInstances OverloadedRecordDot DisambiguateRecordFields StandaloneKindSignatures
- OverloadedStrings BangPatterns
+ FlexibleInstances
+ BangPatterns
other-modules: MicroHs.Abstract
MicroHs.Compile
MicroHs.CompileCache
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -48,7 +48,7 @@
decodeArgs f mdls (arg:args) =
case arg of
"--" -> (f, mdls, args)
- "-v" -> decodeArgs f{verbose = f.verbose + 1} mdls args+ "-v" -> decodeArgs f{verbose = verbose f + 1} mdls args "-r" -> decodeArgs f{runIt = True} mdls args "-l" -> decodeArgs f{loading = True} mdls args "-CR" -> decodeArgs f{readCache = True} mdls args@@ -66,7 +66,7 @@
mainCompile :: Flags -> Ident -> IO ()
mainCompile flags mn = do
(rmn, allDefs) <-
- if flags.writeCache then do
+ if writeCache flags then do
cash <- getCached flags
(rds, cash') <- compileCacheTop flags mn cash
when (verbosityGT flags 0) $
@@ -119,8 +119,9 @@
ct1 <- getTimeMilli
mcc <- lookupEnv "MHSCC"
compiler <- fromMaybe "cc" <$> lookupEnv "CC"
- let conf = "unix-" ++ show _wordSize
- cc = fromMaybe (compiler ++ " -w -Wall -O3 -I" ++ mhsdir flags ++ "/src/runtime " ++ mhsdir flags ++ "/src/runtime/eval-" ++ conf ++ ".c " ++ " $IN -lm -o $OUT") mcc
+ let dir = mhsdir flags
+ conf = "unix-" ++ show _wordSize
+ cc = fromMaybe (compiler ++ " -w -Wall -O3 -I" ++ dir ++ "/src/runtime " ++ dir ++ "/src/runtime/eval-" ++ conf ++ ".c " ++ " $IN -lm -o $OUT") mcc
cmd = substString "$IN" fn $ substString "$OUT" outFile cc
when (verbosityGT flags 0) $
putStrLn $ "Execute: " ++ show cmd
--- a/src/MicroHs/TCMonad.hs
+++ b/src/MicroHs/TCMonad.hs
@@ -98,13 +98,13 @@
}
instTable :: TCState -> InstTable
-instTable = (.ctxTables._1)
+instTable tc = case ctxTables tc of (x,_,_) -> x
metaTable :: TCState -> MetaTable
-metaTable = (.ctxTables._2)
+metaTable tc = case ctxTables tc of (_,x,_) -> x
typeEqTable :: TCState -> TypeEqTable
-typeEqTable = (.ctxTables._3)
+typeEqTable tc = case ctxTables tc of (_,_,x) -> x
putValueTable :: ValueTable -> T ()
@@ -124,17 +124,17 @@
putInstTable :: InstTable -> T ()
putInstTable is = do
- (_,ms,eqs) <- gets (.ctxTables)
+ (_,ms,eqs) <- gets ctxTables
modify $ \ ts -> ts{ ctxTables = (is,ms,eqs) }putMetaTable :: MetaTable -> T ()
putMetaTable ms = do
- (is,_,eqs) <- gets (.ctxTables)
+ (is,_,eqs) <- gets ctxTables
modify $ \ ts -> ts{ ctxTables = (is,ms,eqs) }putTypeEqTable :: TypeEqTable -> T ()
putTypeEqTable eqs = do
- (is,ms,_) <- gets (.ctxTables)
+ (is,ms,_) <- gets ctxTables
modify $ \ ts -> ts{ ctxTables = (is,ms,eqs) }putCtxTables :: (InstTable, MetaTable, TypeEqTable) -> T ()
--
⑨