aboutsummaryrefslogtreecommitdiff
path: root/projects
diff options
context:
space:
mode:
authorYuchen Pei <me@ypei.me>2018-01-12 15:42:47 +0100
committerYuchen Pei <me@ypei.me>2018-01-12 15:42:47 +0100
commit459776159903ab583c0791b1599ec4fc47da8f79 (patch)
treef1ef3e0b4db5c835fe8e1fa11367a30b7f29f60d /projects
parent65a243999690af0927aa3f004c34746d2156359a (diff)
checkpoint
- compiled JackCompiler - need to add system functions into the SRTable
Diffstat (limited to 'projects')
-rw-r--r--projects/11/JackCompiler.hs66
1 files changed, 41 insertions, 25 deletions
diff --git a/projects/11/JackCompiler.hs b/projects/11/JackCompiler.hs
index 8d6f29e..4621bb1 100644
--- a/projects/11/JackCompiler.hs
+++ b/projects/11/JackCompiler.hs
@@ -12,6 +12,7 @@ import Data.List
import System.Environment
import System.Directory
import Control.Monad
+import Data.Char
import Data.Map (Map)
import qualified Data.Map as Map
@@ -335,20 +336,20 @@ vmWriter :: [JClass] -> [[Char]]
vmWriter xs = vClass (buildSRTable xs) <$> xs
vClass :: Table -> JClass -> [Char]
-vClass u (JClass name vars subs) = mconcat $ vSubroutine name t u n <$> subs where
+vClass u (JClass name vars subs) = mconcat $ vSubroutineDec name t u n <$> subs where
(t, n) = buildCTable vars
-vSubroutine :: ClassTable -> Table -> Table -> Int -> JSubroutineDec -> [Char]
-vSubroutine cName t u n sub =
+vSubroutineDec :: [Char] -> Table -> Table -> Int -> JSubroutineDec -> [Char]
+vSubroutineDec cName t u n sub =
vFunction (cName ++ "." ++ sName) nLcls ++ kindSpec ++
- mconcat (vStatement t s u sName 0 stmts) where
+ vStatement t s u sName 0 stmts where
JSubroutineDec (JSubroutineHeader _ (_, sName) args) (JSubroutineBody lcls stmts) = sub
nLcls = length lcls
s = buildLTable args lcls
kind = fst $ u Map.! (cName ++ "." ++ sName)
kindSpec = if kind == "constructor"
then vNew n
- else if kind = "method"
+ else if kind == "method"
then vPush "argument" 0 ++ vPop "pointer" 0
else ""
@@ -362,13 +363,14 @@ vStatement _ _ _ _ _ [] = ""
vStatement t s u name n ((JLetStatment var exp):stmts) =
-- vExpression: push the result of exp; vPopToVar: pop to the var addr
- vExpression t s u name exp ++ vPopToVar t s var ++ vStatement t s u name n stmts
+ vExpression t s u name exp ++ vPopToVar t s u name var ++ vStatement t s u name n stmts
vStatement t s u name n ((JIfStatement cond thenStmts elseStmts):stmts) =
vExpression t s u name cond ++ vNot ++ vThen thenStmts ++
maybe (vLabel labelElse) vElse elseStmts ++ vStatement t s u name (n + 1) stmts where
labelElse = name ++ ".Else" ++ show n
labelEndIf = name ++ ".Endif" ++ show n
+ labelIf = name ++ ".If" ++ show n
vThen xs = vIfGoto labelElse ++ vStatement t s u labelElse 0 xs
vElse xs = vGoto labelEndIf ++ vLabel labelElse ++
vStatement t s u labelIf 0 xs ++ vLabel labelEndIf
@@ -395,23 +397,20 @@ vStatement t s u name n ((JReturnStatement ret):stmts) =
-- | JExpUna JUOp JExpression -- JOp can only be - or ~ here
-- | JExpBin JExpression [(JBOp, JExpression)]
-vExpression t s _ _ (JIntConst n) = push "constant" n
+vExpression :: Table -> Table -> Table -> [Char] -> JExpression -> [Char]
+
+vExpression t s _ _ (JIntConst n) = vPush "constant" n
vExpression t s _ _ (JStrConst xs) =
vPush "constant" (length xs) ++ vCall "String.new" 1 ++ mconcat (go <$> xs) where
go x = vPush "constant" (ord x) ++ vCall "String.appendChar" 2
-vExpression t s u cName (JExpVar (JVarId name idx))
- | idx == Nothing = vPush seg n
- | idx == Maybe exp = vPush seg n ++ vExpression t s u cName exp ++ vAdd
- ++ vPop "pointer" 1 ++ vPush "that" 0
- where (seg, n) = getSegN t s name
+vExpression t s _ _ (JKeywordConst x)
+ | x == "null" || x == "false" = vPush "constant" 0
+ | x == "true" = vPush "constant" 1 ++ vNeg
+ | x == "this" = vPush "pointer" 0
-vPopToVar t s cName (JVarId name idx))
- | idx == Nothing = vPop seg n
- | idx == Maybe Exp = vPush seg n ++ vExpression t s u cName exp ++ vAdd ++
- vPop "pointer" 1 ++ vPop "that" 0
- where (seg, n) = getSegN t s name
+vExpression t s u cName (JExpVar (JVarId name idx)) = vVar t s u cName name idx vPush
vExpression t s u cName (JExpCall subCall) = vSubroutineCall t s u cName subCall
@@ -420,11 +419,23 @@ vExpression t s u cName (JExpUna op exp) = vExpression t s u cName exp ++ vOp op
vExpression t s u cName (JExpBin exp xs) =
vExpression t s u cName exp ++ mconcat (go <$> xs)
- where go (op, exp) = vExpression t s cName exp ++ vOp op
+ where go (op, exp) = vExpression t s u cName exp ++ vOp op
vOp '+' = vAdd; vOp '-' = vSub; vOp '*' = vMul; vOp '/' = vDiv;
vOp '&' = vAnd; vOp '|' = vOr; vOp '<' = vLt; vOp '>' = vGt;
vOp '=' = vEq;
+vPopToVar t s u cName (JVarId name idx) = vVar t s u cName name idx vPop
+
+vVar :: Table -> Table -> Table -> [Char] -> [Char] -> Maybe JExpression -> ([Char] -> Int -> [Char]) -> [Char]
+vVar t s u cName name idx vPushOrPop =
+ let (seg, n) = getSegN t s name in
+ case idx of
+ Nothing -> vPushOrPop seg n
+ Just exp -> vPush seg n ++ vExpression t s u cName exp ++ vAdd
+ ++ vPop "pointer" 1 ++ vPushOrPop "that" 0
+
+
+getRecord :: Table -> Table -> [Char] -> ([Char], ([Char], Int))
getRecord t s name = case Map.lookup name s of
Just x -> x
Nothing -> t Map.! name
@@ -432,7 +443,7 @@ getRecord t s name = case Map.lookup name s of
getSegN :: Table -> Table -> [Char] -> ([Char], Int)
getSegN t s name = snd $ getRecord t s name
-getType :: Table -> Table -> [Char] -> ([Char], Int)
+getType :: Table -> Table -> [Char] -> [Char]
getType t s name = fst $ getRecord t s name
-- data JSubroutineCall = JSubroutineCall JIdentifier (Maybe JIdentifier) [JExpression] deriving (Show, Eq)
@@ -440,14 +451,14 @@ vSubroutineCall t s u cName (JSubroutineCall name name' args) =
method ++ mconcat (vExpression t s u cName <$> args) ++ vCall name'' nArgs
where
name'' = if name' == Nothing
- then cName ++ '.' ++ name
+ then cName ++ "." ++ name
else if head name `elem` ['A' .. 'Z']
- then name ++ '.' ++ fromJust name'
- else getType t s name ++ '.' ++ fromJust name'
+ then name ++ "." ++ fromJust name'
+ else getType t s name ++ "." ++ fromJust name'
-- u is the SRTable
(method, nArgs) =
- if fst $ u Map.! name'' == "method"
- then let (seg, n) = getSegN name in (vPush seg n, length args + 1)
+ if fst (u Map.! name'') == "method"
+ then let (seg, n) = getSegN t s name in (vPush seg n, length args + 1)
else ("", length args)
vNew n = vPush "constant" n ++ vCall "Memory.alloc" 1 ++ vPop "pointer" 0
@@ -471,7 +482,12 @@ vCall xs n = "call " ++ xs ++ " " ++ show n ++ "\n"
vPush xs n = "push " ++ xs ++ " " ++ show n ++ "\n"
vPop xs n = "pop " ++ xs ++ " " ++ show n ++ "\n"
-vmWriter
+inputSeven = ["// This file is part of www.nand2tetris.org\n// and the book \"The Elements of Computing Systems\"\n// by Nisan and Schocken, MIT Press.\n// File name: projects/11/Seven/Main.jack\n\n/**\n * Computes the value of 1 + (2 * 3) and prints the result\n * at the top-left of the screen. \n */\nclass Main {\n\n function void main() {\n do Output.printInt(1 + (2 * 3));\n return;\n }\n}\n"]
+
+inputSeven1 = "do Output.printInt(1 + (2 * 3));"
+
+test reader writer x = let Right y = parse' reader x in writer y
+test' x = let Right y = parse' jStatement x in vStatement Map.empty Map.empty Map.empty "" 0 [y]
{--
fst3 (x, y, z) = x