2

I have worked through this Megaparsec tutorial and am trying now to write my own parser based on that. I want so write a simple parser for a made-up assembly language:

Label: lda $0ffe
       sta %10100110
       push $01, $02, $03

This are the simple data types I'm using:

-- Syntax.hs
module Syntax where

import  Data.Int

-- |A program is made up of one or more source lines
type Program = [SourceLine]

data SourceLine = SourceLine
    { label :: Maybe String     -- ^ Each line may contain a label
    , instr :: Maybe String     -- ^ This can either be an opcode or an assembler directive
    , operand :: Maybe String   -- ^ The opcode/instruction may need operand(s)
    }
    deriving (Show, Eq)

Here's the code of the parser:

--Parser.hs
module Parser where

import Syntax

import Control.Applicative (empty)
import Control.Monad (void)
import Control.Monad.Combinators.Expr
-- import Data.Scientific (toRealFloat)
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void String

-- | Parse a single source code line
sourceline :: Parser SourceLine
sourceline = do
    l <- optional labelfield
    i <- optional instrfield
    o <- optional oprfield
    return $ SourceLine l i o

-- TODO: forbid double underscores
-- | Parse the label field of a source line
labelfield :: Parser String
labelfield = (lexeme . try) $ do
    l <- identifier
    symbol ":"
    return l

-- TODO: parse assembler directives starting with an elipse (.)
-- | Parse the instruction field of a source line
instrfield :: Parser String
instrfield = (lexeme . try) $ do
    i <- some letterChar
    return i

-- | Parse the operand field of a source line
oprfield :: Parser String
oprfield = (lexeme . try) $ do
    o <- try identifier
         <|> datalist
         <|> number
    return o

-- | Parses a legal identifier; identifiers must start with a letter
--   and my contain underscores or numbers
identifier :: Parser String
identifier = ((:) <$> letterChar <*> many (alphaNumChar <|> char '_'))

-- | Parse a list of values separated by commas (,)
datalist :: Parser String
datalist = do
    x <- some datalist'
    y <- number
    return $ filter (/='\n') $ unlines x ++ y

datalist' :: Parser String
datalist' = try ((++) <$> number <*> (symbol ","))

-- | Parse numbers
number :: Parser String
number = try binnumber
         <|> decnumber
         <|> hexnumber

binnumber :: Parser String
binnumber = lexeme ((:) <$> char '%' <*> (some $ binDigitChar))

decnumber :: Parser String
decnumber = lexeme $ some digitChar

hexnumber :: Parser String
hexnumber = lexeme ((:) <$> char '$' <*> (some $ hexDigitChar))

----- Helper Function ----------------------------------------------------------
lineComment :: Parser ()
lineComment = L.skipLineComment "#"

-- eats all whitespace and newline
scn :: Parser ()
scn = L.space space1 lineComment empty

-- eats all whitespace but newline
sc :: Parser ()
sc = L.space (void $ takeWhile1P Nothing f) lineComment empty
  where
    f x = x == ' ' || x == '\t'

lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc

symbol :: String -> Parser String
symbol = L.symbol sc

-- this is giving me trouble
prog :: Parser Program
prog = between scn eof (sepEndBy sourceline scn)

I've put the function that is giving me trouble. I've written some tests for these functions, here's the tests:

-- file Spec.hs
import Syntax
import Parser

import Text.Megaparsec

import Test.Hspec
import Test.Hspec.Megaparsec
import Test.QuickCheck
import Control.Exception (evaluate)

main :: IO ()
main = hspec $ do
    describe "Label parsing" $ do
        it "Parse empty label field" $
            parse sourceline "" " " `shouldParse` SourceLine Nothing Nothing Nothing
        it "Parse single character lower-case label" $
            parse sourceline "" "x:" `shouldParse` SourceLine (Just "x") Nothing Nothing
        it "Parse multi-character label" $
            parse sourceline "" "label:" `shouldParse` SourceLine (Just "label") Nothing Nothing
        it "Parse multi-character label with trailing whitespace" $
            parse sourceline "" "label:   " `shouldParse` SourceLine (Just "label") Nothing Nothing
        it "Parse label with underscore" $
            parse sourceline "" "la_bel:   " `shouldParse` SourceLine (Just "la_bel") Nothing Nothing
        it "Parse label with underscores and numbers" $
            parse sourceline "" "l4_b3l:   " `shouldParse` SourceLine (Just "l4_b3l") Nothing Nothing

    describe "Label and opcode parsing" $ do
        it "Parse line with label and opcode" $
            parse sourceline "" "label: lda" `shouldParse` SourceLine (Just "label") (Just "lda") Nothing
        it "Parse line opcode only" $
            parse sourceline "" "lda" `shouldParse` SourceLine Nothing (Just "lda") Nothing

    describe "Opcodes and operands parsing" $ do
        it "Parse an opcode with symbol operand" $
            parse sourceline "" "lda label_2" `shouldParse` SourceLine Nothing (Just "lda") (Just "label_2")
        it "Parse an opcode with binary operand" $
            parse sourceline "" "lda %01101" `shouldParse` SourceLine Nothing (Just "lda") (Just "%01101")
        it "Parse an opcode with decimal operand" $
            parse sourceline "" "lda 1234" `shouldParse` SourceLine Nothing (Just "lda") (Just "1234")
        it "Parse an opcode with hexdecimal operand" $
            parse sourceline "" "lda $affe34" `shouldParse` SourceLine Nothing (Just "lda") (Just "$affe34")
        it "Parse a labeled opcode with symbol operand" $
            parse sourceline "" "label: lda label_2" `shouldParse` SourceLine (Just "label") (Just "lda") (Just "label_2")
        it "Parse a labeled opcode with binary operand" $
            parse sourceline "" "labe_l: lda %01101" `shouldParse` SourceLine (Just "labe_l") (Just "lda") (Just "%01101")
        it "Parse a labeled opcode with decimal operand" $
            parse sourceline "" "label_2: lda 1234" `shouldParse` SourceLine (Just "label_2") (Just "lda") (Just "1234")
        it "Parse a labeled opcode with hexdecimal operand" $
            parse sourceline "" "l4b3l: lda $affe34" `shouldParse` SourceLine (Just "l4b3l") (Just "lda") (Just "$affe34")

    describe "Operand parsing" $ do
        it "Parse a value/data list with decimal values" $
            parse sourceline "" "lda 12,23,23,43  " `shouldParse` SourceLine Nothing (Just "lda") (Just "12,23,23,43")
        it "Parse a value/data list with binary values" $
            parse sourceline "" "lda %101,%111,%000,%001  " `shouldParse` SourceLine Nothing (Just "lda") (Just "%101,%111,%000,%001")
        it "Parse a value/data list with hexdecimal values" $
            parse sourceline "" "lda $101,$affe,$AfF3,$c3D4  " `shouldParse` SourceLine Nothing (Just "lda") (Just "$101,$affe,$AfF3,$c3D4")
        it "Parse a value/data list with spaces" $
            parse sourceline "" "lda $101, $affe , $AfF3,$c3D4" `shouldParse` SourceLine Nothing (Just "lda") (Just "$101,$affe,$AfF3,$c3D4")
        it "Parse a value/data list with spaces and mixed values" $
            parse sourceline "" "lda %101, 1234 , $AfF3,$c3D4" `shouldParse` SourceLine Nothing (Just "lda") (Just "%101,1234,$AfF3,$c3D4")

    -- describe "Parse multiple lines" $ do
    --     it "Parse a 3-line program" $
    --         parse prog "" "label1: \n  lda $10\nsta %10011001" `shouldParse` [SourceLine (Just "label1") Nothing Nothing,
    --                                                                           SourceLine Nothing (Just "lda") (Just "$10"),
    --                                                                           SourceLine Nothing (Just "sta") (Just "%10011001")]

As usual with assembly files, I want to parse the source code line by line. All the tests above pass, except for the out-commented one. Running prog in ghci with parseTest yields the same result, it returns no result and crashes eventually:

*Main Parser Syntax Text.Megaparsec> parseTest sourceline "lda $10 # comment ignored"
SourceLine {label = Nothing, instr = Just "lda", operand = Just "$10"}
*Main Parser Syntax Text.Megaparsec> parseTest prog "lda $10\nsta %1010"
-- crashes

I'm assuming that I am somehow ab-/overusing lexeme in my code to remove trailing whitespace from the parsed strings. What am I missing?

koalag
  • 133
  • 1
  • 16

1 Answers1

5

The sepEndBy sourceline scn will keep iterating as long as it can get the sourceLine and scn parsers to match. However, both of those parsers can complete successfully without consuming any input, so they will always match. Since all of the branches of sourceLine have a try, any parse error will cause the parser to back off and just match an infinite number of empty source lines. Even without a parse error, reaching eof will produce an infinite number of source lines.

pat
  • 12,587
  • 1
  • 23
  • 52