diff options
Diffstat (limited to 'projects')
| -rw-r--r-- | projects/10/JackParser.hs | 129 |
1 files changed, 77 insertions, 52 deletions
diff --git a/projects/10/JackParser.hs b/projects/10/JackParser.hs index e2962a7..a2418c0 100644 --- a/projects/10/JackParser.hs +++ b/projects/10/JackParser.hs @@ -12,22 +12,25 @@ data JClassVarDec = JClassVarDec JClassVarScope JTypeAndId deriving (Show, Eq) data JSubroutineDec = JSubroutineDec JSubroutineHeader JSubroutineBody deriving (Show, Eq) data JSubroutineHeader = JSubroutineHeader JSubroutineType JTypeAndId [JTypeAndId] deriving (Show, Eq) data JSubroutineBody = JSubroutineBody [JTypeAndId] [JStatement] deriving (Show, Eq) -data JStatement = JLetStatment JLeftVarId JExpression +data JStatement = JLetStatment JVarId JExpression | JIfStatement JExpression [JStatement] (Maybe [JStatement]) | JWhileStatment JExpression [JStatement] | JDoStatement JSubroutineCall | JReturnStatement (Maybe JExpression) deriving (Show, Eq) -data JExpression = JExpression JTerm [(JBOp, JTerm)] deriving (Show, Eq) -- JBOp can only be one of +-*/&|<>= -data JTerm = JIntConst Int +--data JExpression = JExpression JTerm [(JBOp, JTerm)] deriving (Show, Eq) -- JBOp can only be one of +-*/&|<>= +data JExpression = JIntConst Int | JStrConst [Char] | JKeywordConst [Char] -- can only be true, false, null or this - | JTermVarId JLeftVarId - | JTermCall JSubroutineCall - | JTermExp JExpression - | JUnaryOpTerm JUOp JTerm -- JOp can only be - or ~ here + | JExpVar JVarId + | JExpCall JSubroutineCall + | JExpUna JUOp JExpression -- JOp can only be - or ~ here + | JExpBin JExpression [(JBOp, JExpression)] + -- | JTermVarId JLeftVarId + -- | JTermCall JSubroutineCall + -- | JTermExp JExpression deriving (Show, Eq) -data JLeftVarId = JLeftVarId JIdentifier (Maybe JExpression) deriving (Show, Eq) +data JVarId = JVarId JIdentifier (Maybe JExpression) deriving (Show, Eq) data JSubroutineCall = JSubroutineCall JIdentifier (Maybe JIdentifier) [JExpression] deriving (Show, Eq) type JBOp = Char type JUOp = Char @@ -44,8 +47,8 @@ type JackParser = Parsec [Char] () binaryOpChars = "+-*/&|<>=" unaryOpChars = "-~" keywordConstStrs = ["true", "false", "null", "this"] -typeStrs' = ["int", "char", "boolean"] -typeStrs = typeStrs' ++ ["void"] +primTypeStrs = ["int", "char", "boolean"] +primTypeStrs' = primTypeStrs ++ ["void"] classVarScopeStrs = ["static", "field"] subroutineTypeStrs = ["constructor", "function", "method"] alphaUnderscore = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['_'] @@ -64,22 +67,36 @@ jClass = do string "class" >> many1 space id <- jIdentifier many space >> char '{' - classVarDecs <- sepBy jClassVarDecs (many space) - subroutineDecs <- sepBy jSubroutineDec (many space) + --classVarDecs <- sepBy jClassVarDecs (many space) + classVarDecs <- many $ try (many space >> jClassVarDecs) + --subroutineDecs <- sepBy jSubroutineDec (many space) + subroutineDecs <- many $ try (many space >> jSubroutineDec) many space >> char '}' return $ JClass id (mconcat classVarDecs) subroutineDecs +jClassType :: JackParser [Char] +jClassType = do + x <- oneOf ['A' .. 'Z'] + xs <- many $ oneOf alphaNumUnderscore + return $ x:xs + jBOp :: JackParser JBOp jBOp = oneOf binaryOpChars jUOp :: JackParser JUOp jUOp = oneOf unaryOpChars +jPrimType :: JackParser JType +jPrimType = choice $ string <$> primTypeStrs + jType :: JackParser JType -jType = choice $ string <$> typeStrs +jType = choice [jPrimType, jClassType] + +jPrimType' :: JackParser JType +jPrimType' = choice $ string <$> primTypeStrs' jType' :: JackParser JType -jType' = choice $ string <$> typeStrs' +jType' = choice [jPrimType', jClassType] jClassVarScope :: JackParser JClassVarScope jClassVarScope = choice $ string <$> classVarScopeStrs @@ -94,7 +111,7 @@ jIdentifier = do return $ x:xs jClassVarDecs :: JackParser [JClassVarDec] -jClassVarDecs = try $ do +jClassVarDecs = do scope <- jClassVarScope many1 space typeAndIds <- jTypeAndIds @@ -114,7 +131,7 @@ jTypeAndId p = do jTypeAndIds :: JackParser [JTypeAndId] jTypeAndIds = do - type_ <- jType' + type_ <- jType many1 space ids <- sepBy jIdentifier (many space >> char ',' >> many space) return $ (\x -> (type_, x)) <$> ids @@ -122,7 +139,7 @@ jTypeAndIds = do jParameters :: JackParser [JTypeAndId] jParameters = do char '(' >> many space - params <- sepBy (jTypeAndId jType') (many space >> char ',' >> many space) + params <- sepBy (jTypeAndId jType) (try $ many space >> char ',' >> many space) many space >> char ')' return params @@ -130,58 +147,58 @@ jSubroutineHeader :: JackParser JSubroutineHeader jSubroutineHeader = do subtype <- jSubroutineType many1 space - typeAndId <- jTypeAndId jType + typeAndId <- jTypeAndId jType' params <- jParameters return $ JSubroutineHeader subtype typeAndId params -jTerm :: JackParser JTerm -jTerm = choice [jIntConst, jStrConst, jKeywordConst, jTermVarId, jTermCall, jTermExp, jUnaryOpTerm, jTermInBraces] +jExpression :: JackParser JExpression +jExpression = jExpBin <|> jTerm + +jTerm :: JackParser JExpression +jTerm = choice [jIntConst, jStrConst, jKeywordConst, jExpCall, jExpVar, jExpUna, jExpInBraces] -jIntConst :: JackParser JTerm +jIntConst :: JackParser JExpression jIntConst = JIntConst <$> (read <$> many1 digit) -jStrConst :: JackParser JTerm +jStrConst :: JackParser JExpression jStrConst = JStrConst <$> between (char '"') (char '"') (many $ noneOf "\"") -jKeywordConst :: JackParser JTerm +jKeywordConst :: JackParser JExpression jKeywordConst = JKeywordConst <$> (choice $ string <$> keywordConstStrs) -jTermVarId :: JackParser JTerm -jTermVarId = JTermVarId <$> jLeftVarId +jExpVar :: JackParser JExpression +jExpVar = JExpVar <$> jVarId -jLeftVarId :: JackParser JLeftVarId -jLeftVarId = do +jVarId :: JackParser JVarId +jVarId = do id <- jIdentifier maybeArray <- optionMaybe $ try (char '[' >> jExpression <* char ']') - return $ JLeftVarId id maybeArray - -jTermCall :: JackParser JTerm -jTermCall = JTermCall <$> jSubroutineCall + return $ JVarId id maybeArray -jTermExp :: JackParser JTerm -jTermExp = JTermExp <$> jExpression +jExpCall :: JackParser JExpression +jExpCall = JExpCall <$> jSubroutineCall -jUnaryOpTerm :: JackParser JTerm -jUnaryOpTerm = do +jExpUna :: JackParser JExpression +jExpUna = do op <- oneOf unaryOpChars many space - term <- jTerm - return $ JUnaryOpTerm op term + x <- jTerm + return $ JExpUna op x -jTermInBraces :: JackParser JTerm -jTermInBraces = between (char '(') (char ')') jTerm +jExpInBraces :: JackParser JExpression +jExpInBraces = between (char '(') (char ')') jExpression -- expressions like a + () is not allowed -jExpression :: JackParser JExpression -jExpression = do +jExpBin :: JackParser JExpression +jExpBin = try $ do x <- jTerm - xs <- many jOpAndTerm - return $ JExpression x xs + xs <- many1 jOpAndTerm + return $ JExpBin x xs -jOpAndTerm :: JackParser (JBOp, JTerm) +jOpAndTerm :: JackParser (JBOp, JExpression) jOpAndTerm = do op <- many space >> jBOp - term <- many space >> jTerm - return (op, term) + x <- many space >> jTerm + return (op, x) jSubroutineDec :: JackParser JSubroutineDec jSubroutineDec = do @@ -192,9 +209,9 @@ jSubroutineDec = do jSubroutineBody :: JackParser JSubroutineBody jSubroutineBody = do - char '{' >> many space - varDecs <- sepBy jVarDecs (many space) - stmts <- sepBy jStatement (many space) + char '{' + varDecs <- many $ try (many space >> jVarDecs) + stmts <- many $ try (many space >> jStatement) many space >> char '}' return $ JSubroutineBody (mconcat varDecs) stmts @@ -204,7 +221,7 @@ jStatement = choice [jLetStatement, jIfStatement, jWhileStatement, jDoStatement, jLetStatement :: JackParser JStatement jLetStatement = do string "let" >> many1 space - leftVarId <- jLeftVarId + leftVarId <- jVarId many space >> char '=' >> many space exp <- jExpression many space >> char ';' @@ -248,10 +265,18 @@ jReturnStatement = do return $ JReturnStatement res jSubroutineCall :: JackParser JSubroutineCall -jSubroutineCall = do +jSubroutineCall = try $ do callee <- jIdentifier method <- optionMaybe $ try (char '.' >> jIdentifier) + args <- emptyArgs <|> someArgs + return $ JSubroutineCall callee method args + +emptyArgs :: JackParser [JExpression] +emptyArgs = return [] <* (try $ char '(' >> many space >> char ')') + +someArgs :: JackParser [JExpression] +someArgs = do char '(' >> many space exps <- sepBy jExpression (many space >> char ',' >> many space) many space >> char ')' - return $ JSubroutineCall callee method exps + return exps |