Extract some label-related stuff

This commit is contained in:
Joscha 2019-11-19 07:59:49 +00:00
parent 23bd495521
commit 81fee29490
3 changed files with 25 additions and 13 deletions

View file

@ -10,24 +10,16 @@ import qualified Data.Text as T
import Mima.Format.Common
import Mima.Word
import Mima.Label
fAddress :: MimaAddress -> T.Text
fAddress = fixWidthHex 5 . toHex
type LabelName = T.Text
combineByAddress :: Map.Map LabelName MimaAddress -> Map.Map MimaAddress (Set.Set LabelName)
combineByAddress = ($ Map.empty )
. mconcat
. reverse
. map (\(l, a) -> Map.insertWith Set.union a (Set.singleton l))
. Map.assocs
fLabels :: Set.Set LabelName -> T.Text
fLabels = T.intercalate " " . Set.toAscList
fLine :: (MimaAddress, Set.Set LabelName) -> T.Text
fLine (a, s) = fAddress a <> ": " <> fLabels s <> "\n"
formatSymbolFile :: Map.Map LabelName MimaAddress -> T.Text
formatSymbolFile = mconcat . map fLine . Map.assocs . combineByAddress
formatSymbolFile :: LabelSpec -> T.Text
formatSymbolFile = mconcat . map fLine . Map.assocs . labelsByAddress

21
src/Mima/Label.hs Normal file
View file

@ -0,0 +1,21 @@
module Mima.Label
( LabelName
, LabelSpec
, labelsByAddress
) where
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Set as Set
import Mima.Word
type LabelName = T.Text
type LabelSpec = Map.Map LabelName MimaAddress
labelsByAddress :: LabelSpec -> Map.Map MimaAddress (Set.Set LabelName)
labelsByAddress = ($ Map.empty)
. mconcat
. reverse
. map (\(l, a) -> Map.insertWith Set.union a (Set.singleton l))
. Map.assocs

View file

@ -11,13 +11,12 @@ import qualified Data.Map as Map
import qualified Data.Text as T
import Text.Megaparsec
import Mima.Label
import Mima.Parse.Common
import Mima.Parse.Lexeme
import Mima.Parse.Weed
import Mima.Word
type LabelName = T.Text
{- Parsing -}
lWhitespace :: Parser Char