You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
55 lines
2.3 KiB
55 lines
2.3 KiB
{-# LANGUAGE OverloadedStrings #-} |
|
|
|
module Main (main) where |
|
|
|
import Control.Monad (forM, forM_) |
|
import qualified Data.Text.IO as TIO |
|
import Nand2Tetris.Hack (AsmLine (..), HackInstruction (..), |
|
canonicalRepresentation) |
|
import Nand2Tetris.VM (AnnotatedAsmLine (..), |
|
bootstrapPreamble, compileInstructions, |
|
parseInstructions) |
|
import Options.Applicative (argument, execParser, fullDesc, header, |
|
help, helper, info, long, metavar, |
|
progDesc, short, some, str, strOption, |
|
(<**>)) |
|
import System.IO (IOMode (WriteMode), hPutStrLn, withFile) |
|
import Text.Megaparsec (runParser) |
|
import Text.Megaparsec.Error (ParseErrorBundle, |
|
ShowErrorComponent (showErrorComponent), |
|
errorBundlePretty) |
|
|
|
data Options = |
|
Options |
|
{ |
|
inputFiles :: [FilePath], |
|
outputFile :: FilePath |
|
} |
|
|
|
main :: IO () |
|
main = do |
|
options <- execParser opts |
|
parsed <- mconcat <$> forM (inputFiles options) (\fname -> do |
|
txt <- TIO.readFile fname |
|
let result = runParser parseInstructions fname txt |
|
case result of |
|
Left err -> putStrLn (errorBundlePretty err) >> return [] |
|
Right p -> return p) |
|
let compiled = bootstrapPreamble <> compileInstructions parsed |
|
withFile (outputFile options) WriteMode $ \h -> forM_ (compiled) (\x -> TIO.hPutStrLn h (printLine x)) |
|
|
|
where |
|
printLine (Comment t) = "// " <> t |
|
printLine (Code i) = canonicalRepresentation (LineInstruction i) |
|
printLine (ALabel l) = canonicalRepresentation (LineLabel l) |
|
|
|
opts = info (hackAsmOptParser <**> helper) |
|
( fullDesc |
|
<> progDesc "Compiles Hack VM code to Hack assembly" |
|
<> header "vmcompiler - Hack VM compiler (nand2tetris)" ) |
|
hackAsmOptParser = Options <$> |
|
some (argument str (help "Input files" )) <*> |
|
strOption ( long "output" |
|
<> short 'o' |
|
<> metavar "FILENAME" |
|
<> help "Output file" )
|
|
|