aboutsummaryrefslogtreecommitdiff
path: root/projects/08/VMTranslator.hs
blob: d5a7075a9d241f9962f85231842b3947972959a9 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
--usage: ./VMTranslator path/to/dir/
--will produce path/to/dir/dir.asm from path/to/dir/*.vm
import Data.Char (toUpper)
import Data.List.Split (splitOn)
import System.Environment (getArgs)
import Data.Maybe (fromJust)
import Data.List (elemIndex)
import System.Directory (listDirectory)

--preamble = "@256\nD=A\n@SP\nM=D\n"
--For ProgramFlow and SimpleFunction preamble should be set as ""
--preamble = ""
--For StaticsTest and FibonacciElement, preamble should be setSP ++ callInit
preamble = setSP ++ callInit
  where setSP = "@256\nD=A\n@SP\nM=D\n"
        callInit = parse' "call" ["Sys.init", "0"] 0 "" ""

--epilogue = "(END)\n@END\n0;JMP"
epilogue = ""

-- parse' command restOfCommand vmLineNumber fileName functionName = asm code
parse' :: [Char] -> [[Char]] -> Int -> [Char] -> [Char] -> [Char]

parse' "return" [] _ _ _ = backupLCL ++ backupRet ++ popToARG ++ moveSP ++ restore "THAT" 
                           ++ restore "THIS" ++ restore "ARG" ++ restore "LCL"
                           ++ gotoRet
  where backupLCL = "@LCL\nD=M\n@R13\nM=D\n"
        backupRet = "@5\nA=D-A\nD=M\n@R14\nM=D\n"
        popToARG = pop "M" ++ "@ARG\nA=M\nM=D\n"
        moveSP = "@ARG\nD=M+1\n@SP\nM=D\n"
        restore name = "@R13\nAM=M-1\nD=M\n@" ++ name ++ "\nM=D\n"
        gotoRet = "@R14\nA=M\n0;JMP\n"

parse' op [] n fileName _
  | op `elem` ["add", "sub", "and", "or"] = pop "M" ++ pop ('M':(f op):"D") ++ push "D"
  | op `elem` ["eq", "gt", "lt"] = pop "M" ++ pop "M-D" ++ ifThenElse op n fileName
  | otherwise = pop "M" ++ push (f op:"D")
    where f "add" = '+'; f "sub" = '-'; f "and" = '&'; 
          f "or" = '|'; f "neg" = '-'; f "not" = '!'

parse' "push" ["constant", x] _ _ _ = "@" ++ x ++ "\nD=A\n" ++ push "D"

parse' cmd [seg, x] _ _ _ | seg `elem` ["local", "argument", "this", "that"] =
  case cmd of 
    "push" -> getAddr seg x ++ "A=D\nD=M\n" ++ push "D"
    "pop" -> getAddr seg x ++ "@R13\nM=D\n" ++ pop "M" ++ "@R13\nA=M\nM=D\n"

parse' cmd [seg, x] _ _ _ | seg `elem` ["pointer", "temp"] = 
  case cmd of 
    "push" -> getAddr' seg x ++ "D=M\n" ++ push "D"
    "pop" -> pop "M" ++ getAddr' seg x ++ "M=D\n"

parse' cmd ["static", x] _ filename _ =
  case cmd of
    "push" -> getAddr'' x filename ++ "D=M\n" ++ push "D"
    "pop" -> pop "M" ++ getAddr'' x filename ++ "M=D\n"

parse' "label" [x] _ _ fName = "(" ++ fName ++ "$" ++ x ++ ")\n"

parse' "goto" [x] _ _ fName = "@" ++ fName ++ "$" ++ x ++ "\n0;JMP\n" 

parse' "if-goto" [x] _ _ fName = pop "M" ++ "@" ++ fName ++ "$" ++ x ++ "\nD;JNE\n"

parse' "function" [f, n] _ _ _ = "(" ++ f ++ ")\n" ++ (mconcat $ replicate (read n) $ push "0")

parse' "call" [f, m] n _ _ = pushRet ++ save "LCL" ++ save "ARG" ++ save "THIS" 
                             ++ save "THAT" ++ setLCL ++ setARG ++ gotoF ++ placeRet
  where pushRet = "@RET" ++ show n ++ "\nD=A\n" ++ push "D"
        save x = "@" ++ x ++ "\nD=M\n" ++ push "D"
        setLCL = "@SP\nD=M\n@LCL\nM=D\n"
        setARG = "@5\nD=D-A\n@" ++ m ++ "\nD=D-A\n@ARG\nM=D\n"
        placeRet = "(RET" ++ show n ++ ")\n"
        gotoF = "@" ++ f ++ "\n0;JMP\n" 
--To do the return-addr: generate label RET582 if say n==582, place the label after the goto f jump

getAddr seg x = "@" ++ seg2Lab seg ++ "\nD=M\n@" ++ x ++ "\nD=A+D\n"

getAddr' seg x = "@" ++ show (read x + (if seg == "pointer" then 3 else 5)) ++ "\n"

getAddr'' x filename = "@" ++ filename ++ "." ++ x ++ "\n"

seg2Lab seg = case seg of
  "local" -> "LCL"
  "argument" -> "ARG"
  "this" -> "THIS" 
  "that" -> "THAT"

push :: [Char] -> [Char]
push xs = "@SP\nA=M\nM=" ++ xs ++ "\n@SP\nM=M+1\n"

-- should change @label to @IFlabel
ifThenElse :: [Char] -> Int -> [Char] -> [Char]
ifThenElse cond n fileName = "@IF" ++ label ++ "\nD;J" ++ cond' ++ "\n" ++ push "0"
                             ++ "@ENDIF" ++ label ++ "\n0;JMP\n(IF" ++ label ++ ")\n" 
                             ++ push "-1" ++ "(ENDIF" ++ label ++ ")\n"
  where label = fileName ++ show n
        cond' = toUpper <$> cond

pop :: [Char] -> [Char]
pop xs = "@SP\nAM=M-1\nD=" ++ xs ++ "\n"

parseline :: [[Char]] -> Int -> [Char] -> [Char] -> [Char] -> [Char]
parseline [] _ acc _ _ = acc
parseline (line:lines) n acc filename funName = parseline lines (n + 1) (acc ++ parse' cmd target n filename funName') filename funName'
  where cmd:target = words line
        funName' = if cmd == "function" then head target else funName

stripJunk :: [Char] -> [[Char]]
stripJunk = filter (not . isEmptyLine) . fmap (head . splitOn "//") . lines . replCrWithNl

isEmptyLine :: [Char] -> Bool
isEmptyLine = null . filter (not . flip elem " \t") 

parseCode :: [Char] -> [Char] -> [Char]
parseCode xs filename = (parseline (stripJunk xs) 0 "" filename "")

parseCodes :: [[Char]] -> [[Char]] -> [Char]
parseCodes codes filenames = preamble ++ (mconcat $ zipWith parseCode codes filenames) ++ epilogue

replCrWithNl :: [Char] -> [Char]
replCrWithNl = fmap cr2nl 
  where cr2nl '\r' = '\n'
        cr2nl c = c

lastSplit c xs = (take (prefix - 1) xs, drop prefix xs)
  where prefix = length xs - (fromJust . elemIndex c . reverse) xs


-- assuming the input is a dir with a trailing '/'
main = do
  dir <- head <$> getArgs
  filesWODir <- filter isVMfile <$> listDirectory dir 
  let vmFiles = (dir++) <$> filesWODir
  let ofPath = dir ++ (snd $ lastSplit '/' $ init dir) ++ ".asm"
  let filenames = removeExt <$> filesWODir
  codes <- sequence $ readFile <$> vmFiles
  writeFile ofPath $ parseCodes codes filenames
    where isVMfile xs = drop (length xs - 3) xs == ".vm"
          removeExt xs = take (length xs - 3) xs