Satisfy hlint
This commit is contained in:
parent
616a991e21
commit
bbd0707a6d
14 changed files with 46 additions and 54 deletions
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Mima.Flag
|
||||
|
|
@ -122,7 +121,7 @@ getFlagSpec af =
|
|||
isInSet f s = flagChar f `Set.member` s
|
||||
getAddressSpec :: Flag -> AddressSpec
|
||||
getAddressSpec f = rangesToSpec $ map fst $ filter (isInSet f . snd) $ Map.assocs af
|
||||
in pure getAddressSpec <*> rawFlags
|
||||
in getAddressSpec <$> rawFlags
|
||||
|
||||
interpretFlagSpec :: FlagSpec -> Flags (MimaAddress -> Bool)
|
||||
interpretFlagSpec spec =
|
||||
|
|
|
|||
|
|
@ -113,9 +113,9 @@ fAddress :: MimaAddress -> Formatter
|
|||
fAddress a = do
|
||||
env <- ask
|
||||
let conf = feConf env
|
||||
dec = if fcShowAddressDec conf then [fAddressDec] else []
|
||||
hex = if fcShowAddressHex conf then [fAddressHex] else []
|
||||
bin = if fcShowAddressBin conf then [fAddressBin] else []
|
||||
dec = [fAddressDec | fcShowAddressDec conf]
|
||||
hex = [fAddressHex | fcShowAddressHex conf]
|
||||
bin = [fAddressBin | fcShowAddressBin conf]
|
||||
formats = (dec ++ hex ++ bin) <*> pure a
|
||||
pure $ "[" <> T.intercalate ", " formats <> "]"
|
||||
|
||||
|
|
@ -134,9 +134,9 @@ fWord :: MimaWord -> Formatter
|
|||
fWord a = do
|
||||
env <- ask
|
||||
let conf = feConf env
|
||||
dec = if fcShowWordDec conf then [fWordDec] else []
|
||||
hex = if fcShowWordHex conf then [fWordHex] else []
|
||||
bin = if fcShowWordBin conf then [fWordBin] else []
|
||||
dec = [fWordDec | fcShowWordDec conf]
|
||||
hex = [fWordHex | fcShowWordHex conf]
|
||||
bin = [fWordBin | fcShowWordBin conf]
|
||||
formats = (dec ++ hex ++ bin) <*> pure a
|
||||
pure $ "{" <> T.intercalate ", " formats <> "}"
|
||||
|
||||
|
|
|
|||
|
|
@ -112,8 +112,8 @@ parseSmallInstruction mw = do
|
|||
parseSmallOpcode :: Opcode -> Either T.Text SmallOpcode
|
||||
parseSmallOpcode w = case smallOpcodeMap Map.!? w of
|
||||
Just oc -> pure oc
|
||||
Nothing -> Left $ "Unknown small opcode " <> toDec w <> " (" <> (fixWidthHex 1 $ toHex w)
|
||||
<> ", " <> (fixWidthBin 4 $ toBin w) <> ")"
|
||||
Nothing -> Left $ "Unknown small opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
|
||||
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
|
||||
|
||||
parseLargeInstruction :: MimaWord -> Either T.Text Instruction
|
||||
parseLargeInstruction mw = do
|
||||
|
|
@ -125,8 +125,8 @@ parseLargeInstruction mw = do
|
|||
parseLargeOpcode :: Opcode -> Either T.Text LargeOpcode
|
||||
parseLargeOpcode w = case largeOpcodeMap Map.!? w of
|
||||
Just oc -> pure oc
|
||||
Nothing -> Left $ "Unknown large opcode " <> toDec w <> " (" <> (fixWidthHex 1 $ toHex w)
|
||||
<> ", " <> (fixWidthBin 4 $ toBin w) <> ")"
|
||||
Nothing -> Left $ "Unknown large opcode " <> toDec w <> " (" <> fixWidthHex 1 (toHex w)
|
||||
<> ", " <> fixWidthBin 4 (toBin w) <> ")"
|
||||
|
||||
instructionToWord :: Instruction -> MimaWord
|
||||
instructionToWord (SmallInstruction so lv) = wordFromSmallOpcode (smallOpcodeNr so) lv
|
||||
|
|
|
|||
|
|
@ -29,11 +29,11 @@ instance Binary (LD MimaWord) where
|
|||
|
||||
instance Binary (LD LargeValue) where
|
||||
put = put . LD . largeValueToWord . unLD
|
||||
get = (LD . getLargeValue) <$> unLD <$> get
|
||||
get = LD . getLargeValue . unLD <$> get
|
||||
|
||||
instance Binary (LD MimaMemory) where
|
||||
put = mapM_ (put . LD) . memoryToWords . unLD
|
||||
get = (LD . wordsToMemory . map unLD) <$> many get
|
||||
get = LD . wordsToMemory . map unLD <$> many get
|
||||
|
||||
instance Binary (LD MimaState) where
|
||||
put ldms = do
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ almostWordToWord (ALiteral w) = w
|
|||
|
||||
formatAssembly :: WeedResult MimaAddress -> (MimaState, LabelSpec, RawFlags)
|
||||
formatAssembly res =
|
||||
let mem = fmap almostWordToWord $ wrMemory res
|
||||
let mem = almostWordToWord <$> wrMemory res
|
||||
s = registersToState (wrRegisters res) (mapToMemory mem)
|
||||
in (s, wrLabels res, wrFlags res)
|
||||
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ lRawInstruction = label "instruction" $ smallInstruction <|> largeInstruction
|
|||
where
|
||||
smallInstruction = do
|
||||
so <- smallOpcode
|
||||
void $ lSpace
|
||||
void lSpace
|
||||
lv <- lexeme address
|
||||
pure $ RawSmallInstruction so lv
|
||||
largeInstruction = do
|
||||
|
|
|
|||
|
|
@ -34,8 +34,8 @@ emptyRegisters = Registers
|
|||
}
|
||||
|
||||
registersToState :: Registers MimaAddress -> MimaMemory -> MimaState
|
||||
registersToState r mem = MimaState (fromMaybe 0 $ rIAR r) (fromMaybe 0 $ rACC r)
|
||||
(fromMaybe 0 $ rRA r) (fromMaybe 0 $ rSP r) (fromMaybe 0 $ rFP r) mem
|
||||
registersToState r = MimaState (fromMaybe 0 $ rIAR r) (fromMaybe 0 $ rACC r)
|
||||
(fromMaybe 0 $ rRA r) (fromMaybe 0 $ rSP r) (fromMaybe 0 $ rFP r)
|
||||
|
||||
data AlmostWord a
|
||||
= AInstruction (RawInstruction a)
|
||||
|
|
|
|||
|
|
@ -141,15 +141,14 @@ turnFlagsOff thing flags = do
|
|||
{- Weeding at a larger scale -}
|
||||
|
||||
weedDirective :: WithOffset a -> Directive Address -> SWeed ()
|
||||
weedDirective thing d = do
|
||||
case d of
|
||||
DReg sr -> setRegister thing sr
|
||||
DOrg addr -> setAddressTo thing addr
|
||||
DLit w -> addAlmostWord thing (ALiteral w)
|
||||
DArr ws -> mapM_ (addAlmostWord thing . ALiteral) ws
|
||||
DFlag flags -> setFlags thing flags
|
||||
DFlagOn flags -> turnFlagsOn thing flags
|
||||
DFlagOff flags -> turnFlagsOff thing flags
|
||||
weedDirective thing d = case d of
|
||||
DReg sr -> setRegister thing sr
|
||||
DOrg addr -> setAddressTo thing addr
|
||||
DLit w -> addAlmostWord thing (ALiteral w)
|
||||
DArr ws -> mapM_ (addAlmostWord thing . ALiteral) ws
|
||||
DFlag flags -> setFlags thing flags
|
||||
DFlagOn flags -> turnFlagsOn thing flags
|
||||
DFlagOff flags -> turnFlagsOff thing flags
|
||||
|
||||
weedInstruction :: WithOffset a -> RawInstruction Address -> SWeed ()
|
||||
weedInstruction thing i = addAlmostWord thing $ AInstruction i
|
||||
|
|
@ -164,7 +163,7 @@ weedStep thing =
|
|||
weedStatements :: [WithOffset (Statement Address)] -> Weed WeedError (WeedResult Address)
|
||||
weedStatements statements = do
|
||||
result <- execStateT (mapM_ weedStep statements) initialState
|
||||
when (not $ Set.null $ wsOpenFlags result)
|
||||
unless (Set.null $ wsOpenFlags result)
|
||||
$ harmless
|
||||
$ errorAt' (lastOffset statements)
|
||||
$ "Flags were never closed: " ++ T.unpack (formatFlagSet (wsOpenFlags result))
|
||||
|
|
|
|||
|
|
@ -41,4 +41,4 @@ parseFlagFile :: Parser RawFlags
|
|||
parseFlagFile = space *> many lNewline *> (Map.fromList <$> many lLine) <* hidden eof
|
||||
|
||||
readFlagFile :: FilePath -> T.Text -> Either WeedErrorBundle RawFlags
|
||||
readFlagFile filename input = parse parseFlagFile filename input
|
||||
readFlagFile = parse parseFlagFile
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Mima.Parse.Weed
|
||||
( Weed
|
||||
, runWeed
|
||||
|
|
@ -94,7 +92,7 @@ withOffset :: Parser a -> Parser (WithOffset a)
|
|||
withOffset p = WithOffset <$> getOffset <*> p
|
||||
|
||||
errorAt :: WithOffset a -> String -> WeedError
|
||||
errorAt wo errorMsg = errorAt' (woOffset wo) errorMsg
|
||||
errorAt wo = errorAt' (woOffset wo)
|
||||
|
||||
errorAt' :: Int -> String -> WeedError
|
||||
errorAt' o errorMsg = errorsAt' o [errorMsg]
|
||||
|
|
|
|||
|
|
@ -45,10 +45,10 @@ wordsToMemory = mapToMemory
|
|||
. zip [minBound..]
|
||||
|
||||
memoryToWords :: MimaMemory -> [MimaWord]
|
||||
memoryToWords mem = map (\addr -> readAt addr mem) $ continuousUsedAddresses mem
|
||||
memoryToWords mem = map (`readAt` mem) $ continuousUsedAddresses mem
|
||||
|
||||
maxAddress :: MimaMemory -> MimaAddress
|
||||
maxAddress (MimaMemory m) = fromMaybe minBound $ fst <$> Map.lookupMax m
|
||||
maxAddress (MimaMemory m) = maybe minBound fst $ Map.lookupMax m
|
||||
|
||||
usedAddresses :: MimaMemory -> [MimaAddress]
|
||||
usedAddresses (MimaMemory m) = Map.keys m
|
||||
|
|
@ -178,7 +178,7 @@ step' :: Flags (MimaAddress -> Bool) -> MimaState -> Either AbortReason MimaStat
|
|||
step' flags ms = runExecution flags $ step ms
|
||||
|
||||
run :: Flags (MimaAddress -> Bool) -> MimaState -> (MimaState, AbortReason, Integer)
|
||||
run f ms = helper 0 ms
|
||||
run f = helper 0
|
||||
where
|
||||
helper completed s =
|
||||
case step' f s of
|
||||
|
|
@ -186,7 +186,7 @@ run f ms = helper 0 ms
|
|||
Right s' -> helper (completed + 1) s'
|
||||
|
||||
runN :: Flags (MimaAddress -> Bool) -> Integer -> MimaState -> (MimaState, Maybe AbortReason, Integer)
|
||||
runN f n ms = helper 0 ms
|
||||
runN f n = helper 0
|
||||
where
|
||||
helper completed s =
|
||||
if completed >= n
|
||||
|
|
|
|||
|
|
@ -1,6 +1,4 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
module Mima.Util
|
||||
(
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue