diff options
| -rw-r--r-- | projects/10/JackParser.hs | 142 |
1 files changed, 118 insertions, 24 deletions
diff --git a/projects/10/JackParser.hs b/projects/10/JackParser.hs index a6fe7b3..d23b878 100644 --- a/projects/10/JackParser.hs +++ b/projects/10/JackParser.hs @@ -1,26 +1,120 @@ -- Jack Parser, as the coursework of Project 10 of Nand2Tetris course. -- Author: Yuchen Pei -data JClass = JClass JIdentifier [JClassVarDec] [JSubroutineDec] -data JIdentifier = JIdentifier [Char] -data JClassVarDec = JClassVarDec JClassVarScope JType JIdentifier -data JClassVarScope = JStatic | JField -data JType = JInt | JChar | JBoolean | JVoid -data JSubroutineDec = JSubroutineDec JSubroutineType JType JIdentifier [JParameter] JSubroutineBody -data JSubroutineType = JConstructor | JFunction | JMethod -data JParameter = JParameter JType JIdentifier -data JSubroutineBody = JSubroutineBody [JVarDec] [JStatement] -data JVarDec = JVarDec JType JIdentifier -data JStatement = JLetStatement | JIfStatement | JWhileStatment | JDoStatement | JReturnStatement -data JLetStatement = JLetStatment JLeftVarId JExpression -data JIfStatement = JIfStatement JExpression [JStatement] (Maybe [JStatement]) -data JWhileStatment = JWhileStatment JExpression [JStatement] -type JDoStatement = JSubroutineCall -type JReturnStatement = Maybe JExpression -data JExpression = JTerm [(JOp, JTerm)] -data JTerm = JIntConst | JStrConst | JKeywordConst | JLeftVarId | JSubroutineCall | JExpression | JUnaryOpTerm -data JLeftVarId = JIdentifier | JLeftVarId JIdentifier (Maybe JExpression) -data JSubroutineCall = JSubroutineCall Identifier [JExpression] | JSubroutineCall Identifier Identifier [JExpression] -type JOp = Char -data JUnaryOpTerm = JUnaryOpTerm JUnaryOp Term -type JUnaryOp = Char -data JKeywordConst = JTrue | JFalse | JNull | JThis +{-# LANGUAGE FlexibleContexts #-} +import Text.Parsec.Prim +import Text.Parsec.Char +import Text.Parsec.Combinator +import Data.Functor.Identity +import Data.Either + +--turingParse :: Stream s Identity Char => Parsec s () (Int, Char, Rule) +--solve1 xs = let (initN, initSt, rule) = fromRight (0, 'A', Map.empty) $ parse turingParse "" xs in + --sum $ run initN 0 initSt [0] rule + +data JClass = JClass JIdentifier [JClassVarDec] [JSubroutineDec] deriving (Show, Eq) +data JClassVarDec = JClassVarDec JClassVarScope JTypeAndId deriving (Show, Eq) +data JSubroutineDec = JSubroutineDec JSubroutineHeader JSubroutineBody deriving (Show, Eq) +data JSubroutineHeader = JSubroutineHeader JSubroutineType JTypeAndId [JParameter] deriving (Show, Eq) +data JSubroutineBody = JSubroutineBody [JVarDec] [JStatement] deriving (Show, Eq) +data JClassVarScope = JStatic | JField deriving (Show, Eq) +data JType = JInt | JChar | JBoolean | JVoid deriving (Show, Eq) +data JSubroutineType = JConstructor | JFunction | JMethod deriving (Show, Eq) +data JStatement = JLetStatment JLeftVarId 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 + | 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 + deriving (Show, Eq) +data JLeftVarId = JLeftVarId JIdentifier (Maybe JExpression) deriving (Show, Eq) +data JSubroutineCall = JSubroutineCall JIdentifier (Maybe JIdentifier) [JExpression] deriving (Show, Eq) +type JBOp = Char +type JUOp = Char +type JIdentifier = [Char] +type JackParser = Parsec [Char] () +type JTypeAndId = (JType, JIdentifier) +type JParameter = JTypeAndId +type JVarDec = JTypeAndId + + +binaryOpChars = "+-*/&|<>=" +unaryOpChars = "-~" +keywordConstStrs = ["true", "false", "null", "this"] +typeStrs' = ["int", "char", "boolean"] +typeStrs = typeStrs' ++ ["void"] +classVarScopeStrs = ["static", "field"] +subroutineTypeStrs = ["constructor", "function", "method"] +alphaUnderscore = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['_'] +alphaNumUnderscore = alphaUnderscore ++ ['0'..'9'] + +str2JType xs = case xs of "int" -> JInt; "char" -> JChar; "boolean" -> JBoolean; "void" -> JVoid; +str2JClassVarScope xs = case xs of "static" -> JStatic; "field" -> JField; +str2JSubroutineType xs = case xs of "constructor" -> JConstructor; "function" -> JFunction; "method" -> JMethod; + +parse' parser = parse parser "" + +skipSpaces = space >> skipMany space + +jack = jClass + +jClass :: JackParser JClass +jClass = undefined + +jBOp :: JackParser JBOp +jBOp = oneOf binaryOpChars + +jUOp :: JackParser JUOp +jUOp = oneOf unaryOpChars + +jType :: JackParser JType +jType = fmap str2JType $ choice $ fmap string typeStrs + +jType' :: JackParser JType +jType' = fmap str2JType $ choice $ fmap string typeStrs' + +jClassVarScope :: JackParser JClassVarScope +jClassVarScope = fmap str2JClassVarScope $ choice $ fmap string classVarScopeStrs + +jIdentifier :: JackParser [Char] +jIdentifier = do + x <- oneOf alphaUnderscore + xs <- many $ oneOf alphaNumUnderscore + return $ x:xs + +jClassVarDec :: JackParser JClassVarDec +jClassVarDec = do + scope <- jClassVarScope + skipSpaces + typeAndId <- jTypeAndId + many space >> char ';' + return $ JClassVarDec scope typeAndId + +jTypeAndId :: JackParser JTypeAndId +jTypeAndId = do + type_ <- jType' + skipSpaces + id <- jIdentifier + return (type_, id) +jParameter = many space >> jTypeAndId <* many space + +jSubroutineType :: JackParser JSubroutineType +jSubroutineType = fmap str2JSubroutineType $ choice $ fmap string subroutineTypeStrs + +{-- +jSubroutineHeader :: JackParser JSubroutineHeader +jSubroutineHeader = do + subtype <- jSubroutineType + skipSpaces + typeAndId <- jTypeAndId + char '(' + params <- sepBy jParameter (char ',') + char ')' +--} |