blob: 289c0d480a025851ef99fb289e18fb0874ec9e0d (
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
|
import Data.Char (toUpper)
import Data.List.Split (splitOn)
import System.Environment (getArgs)
preamble = "@256\nD=A\n@SP\nM=D\n"
epilogue = "(END)\n@END\n0;JMP"
parse' :: [Char] -> [[Char]] -> Int -> [Char]
parse' op [] n
| 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
| 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"
push :: [Char] -> [Char]
push xs = "@SP\nA=M\nM=" ++ xs ++ "\n@SP\nM=M+1\n"
ifThenElse :: [Char] -> Int -> [Char]
ifThenElse cond n = "@" ++ cond' ++ show n ++ "\nD;J" ++ cond' ++ "\n" ++ push "0"
++ "@ENDIF" ++ cond' ++ show n ++ "\n0;JMP\n(" ++ cond' ++ show n ++ ")\n"
++ push "-1" ++ "(ENDIF" ++ cond' ++ show n ++ ")\n"
where cond' = toUpper <$> cond
pop :: [Char] -> [Char]
pop xs = "@SP\nAM=M-1\nD=" ++ xs ++ "\n"
parseline :: [[Char]] -> Int -> [Char] -> [Char]
parseline [] _ acc = acc
parseline (line:lines) n acc = parseline lines (n + 1) (acc ++ parse' cmd target n)
where cmd:target = words line
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]
parseCode xs = preamble ++ (parseline (stripJunk xs) 0 "") ++ epilogue
replCrWithNl :: [Char] -> [Char]
replCrWithNl = fmap cr2nl
where cr2nl '\r' = '\n'
cr2nl c = c
--input = "push constant 17\npush constant 17\neq"
main = do
args <- getArgs
let filename = head args
code <- readFile $ filename
writeFile (head (splitOn "." filename) ++ ".asm") (parseCode code)
--}
|