From 2b1e8b34016e9357fff2a6b6ef54ead7c68f1cfc Mon Sep 17 00:00:00 2001
From: Yuchen Pei <me@ypei.me>
Date: Wed, 10 Jan 2018 09:22:00 +0100
Subject: checkpoint

---
 projects/10/JackParser.hs | 142 ++++++++++++++++++++++++++++++++++++++--------
 1 file 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 ')'
+--}
-- 
cgit v1.2.3