Parsec permutation parser with separators - haskell

Question

I want to parse assembly programs. I have a fixed format for parsing an assembly address: [ register + offset + label ] I implemented parsers for registers, offsets and labels. Now I want to create a parser which parses the whole address.
The combinations I want to accept:
[register]
[offset]
[label]
[register + offset]
[register + label]
[offset + label]
[register + offset + label]
And what I don't want to accept:
[]
[register offset]
[register + ]
...
Of course the simple solution is to have something like:
choice $ try (parseRegister >>= \r -> Address (Just r) Nothing Nothing)
<|> try ...
But it is ugly and does not scale well with more types of elements. So I'm looking for a cleaner solution.

Answer 1

If you reorder your table, you see it’s a series of choices:
[register + offset + label]
[register + offset ]
[register + label]
[register ]
[ offset + label]
[ offset ]
[ label]
The grammar for which might be written:
address = '[' (register ('+' offset-label)? | offset-label) ']'
offset-label = offset ('+' label)? | label
Which in Applicative style is pretty straightforward, made only slightly noisy by wrapping everything in constructors:
parseAddress :: Parser Address
parseAddress = do
(register, (offset, label)) <- between (char '[') (char ']') parseRegisterOffsetLabel
return $ Address register offset label
parseRegisterOffsetLabel :: Parser (Maybe Register, (Maybe Offset, Maybe Label))
parseRegisterOffsetLabel = choice
[ (,)
<$> (Just <$> parseRegister)
<*> option (Nothing, Nothing) (char '+' *> parseOffsetLabel)
, (,) Nothing <$> parseOffsetLabel
]
parseOffsetLabel :: Parser (Maybe Offset, Maybe Label)
parseOffsetLabel = choice
[ (,)
<$> (Just <$> parseOffset)
<*> option Nothing (char '+' *> (Just <$> parseLabel))
, (,) Nothing . Just <$> parseLabel
]
If we add a couple of utility functions:
plus :: Parser a -> Parser a
plus x = char '+' *> x
just :: Parser a -> Parser (Maybe a)
just = fmap Just
We can clean up these implementations a bit:
parseRegisterOffsetLabel = choice
[ (,)
<$> just parseRegister
<*> option (Nothing, Nothing) (plus parseOffsetLabel)
, (,) Nothing <$> parseOffsetLabel
]
parseOffsetLabel = choice
[ (,)
<$> just parseOffset
<*> option Nothing (plus (just parseLabel))
, (,) Nothing <$> just parseLabel
]
Then factor out the repetition, giving us a decent final solution:
parseChain begin def rest = choice
[ (,) <$> just begin <*> option def (plus rest)
, (,) Nothing <$> rest
]
parseRegisterOffsetLabel = parseChain
parseRegister (Nothing, Nothing) parseOffsetLabel
parseOffsetLabel = parseChain
parseOffset Nothing (just parseLabel)
I’ll let you take care of whitespace around + and inside [].

Answer 2

Something like that:
parsePlus = many1 (char ' ') >> char '+' >> many1 (char ' ')
parseRegisterModified = parsePlus >> parseOffsetLabel
parseOffsetModified = parsePlus >> parseLabel
parseRegister' = do
Address r _ _ <- parseRegister
optionMaybe parseRegisterModified >>=
return $ maybe
(Address r Nothing Nothing)
(\Address _ o l -> Address r o l)
parseOffset' = do
Address _ o _ <- parseOffset
optionMaybe parseOffsetModified >>=
return $ maybe
(Address Nothing o Nothing)
(\Address _ _ l -> Address Nothing o l)
parseOffsetLabel = try parseOffset' <|> parseLabel
parseAddress =
try parseRegister'
<|> parseOffset'
<|> parseLabel

Answer 3

I've been looking for something like that and found
Control.Applicative.Permutation from action-permutations. Though my case may scale independently from low-level platform.
In your case might look like
operand = do
(r, o, l) <- runPermsSep (char '+') $ (,,)
<$> maybeAtom register
<*> maybeAtom offset
<*> maybeAtom label
-- backtrack on inappropriate combination
when (null $ catMaybes [r, o, l]) . fail $ "operand expected"
return (r, o, l)
Note that you actually want optional permutation parser that requires at least one optional element to be present which makes your wanted parsers combinator pretty specific.

Answer 4

You could have more elegant solution using Monoids and sepBy1.
But it allows to write [register + register] (in our case adding them both)
parsePlus = many1 (char ' ') >> char '+' >> many1 (char ' ')
parseAddress1 =
try parseRegister
<|> parseOffset
<|> parseLabel
parseAddress = sepBy1 parsePlus parseAddress1 >>= return . mconcat
instance Monoid Address where
mempty = Address Nothing Nothing Nothing
Address r o l `mappend` Address r' o' l' =
Address (r `mappendA` r') (o `mappendA` o') (l `mappendA` l')
where
a `mappendA` a' = fmap getSum $ fmap Sum a `mappend` fmap Sum a'
Choosing Monoid (Sum a, First a, Last a) for r o l, we change the behavior:
Sum adds each other, First chooses first one, Last chooses the last one
... where
a `mappendA` a' = getFirst $ First a `mappend` First a'