diff --git a/app/VMCompiler.hs b/app/VMCompiler.hs index a5a193f..8413ad5 100644 --- a/app/VMCompiler.hs +++ b/app/VMCompiler.hs @@ -3,6 +3,7 @@ module Main (main) where import Control.Monad (forM, forM_) +import qualified Data.Text as T import qualified Data.Text.IO as TIO import Nand2Tetris.Hack (AsmLine (..), HackInstruction (..), canonicalRepresentation) @@ -13,6 +14,7 @@ import Options.Applicative (argument, execParser, fullDesc, header, help, helper, info, long, metavar, progDesc, short, some, str, strOption, (<**>)) +import System.FilePath (takeBaseName) import System.IO (IOMode (WriteMode), hPutStrLn, withFile) import Text.Megaparsec (runParser) import Text.Megaparsec.Error (ParseErrorBundle, @@ -31,7 +33,7 @@ main = do options <- execParser opts parsed <- mconcat <$> forM (inputFiles options) (\fname -> do txt <- TIO.readFile fname - let result = runParser parseInstructions fname txt + let result = runParser (parseInstructions (T.pack . takeBaseName $ fname)) fname txt case result of Left err -> putStrLn (errorBundlePretty err) >> return [] Right p -> return p) diff --git a/nand2tetris.cabal b/nand2tetris.cabal index d907c11..fcfed96 100644 --- a/nand2tetris.cabal +++ b/nand2tetris.cabal @@ -36,6 +36,7 @@ executable vmcompiler , optparse-applicative , containers , bytestring + , filepath library hs-source-dirs: src diff --git a/src/Nand2Tetris/VM.hs b/src/Nand2Tetris/VM.hs index 343a2ea..fe77c81 100644 --- a/src/Nand2Tetris/VM.hs +++ b/src/Nand2Tetris/VM.hs @@ -123,15 +123,15 @@ instrAnnotation (VMFunction FReturn) = "return" type Parser = Parsec Error T.Text -parseInstructions :: Parser [VMInstruction] -parseInstructions = many (sp *> parseInstruction <* sp) <* eof +parseInstructions :: T.Text -> Parser [VMInstruction] +parseInstructions modName = many (sp *> parseInstruction modName <* sp) <* eof where sp :: Parser () sp = L.space space1 (skipLineComment "//") empty -parseInstruction :: Parser VMInstruction -parseInstruction = - try parseMemAccess <|> +parseInstruction :: T.Text -> Parser VMInstruction +parseInstruction modName = + try (parseMemAccess modName) <|> try parseArithmetic <|> try parseBranching <|> parseFunction @@ -151,23 +151,23 @@ parseInstruction = string "if-goto" *> space1 *> (BIfGoto <$> parseId) ] - parseMemAccess :: Parser VMInstruction - parseMemAccess = VMMemAccess <$> + parseMemAccess :: T.Text -> Parser VMInstruction + parseMemAccess modName = VMMemAccess <$> parseAccessType <*> - parseSegment + parseSegment modName parseAccessType :: Parser AccessType parseAccessType = try (string "push" >> space1 $> ACPush) <|> (string "pop" >> space1 $> ACPop) - parseSegment :: Parser Segment - parseSegment = + parseSegment :: T.Text -> Parser Segment + parseSegment modName = choice [ parseSegmentInt "local" SLocal, parseSegmentInt "argument" SArgument, parseSegmentInt "this" SThis, parseSegmentInt "that" SThat, parseSegmentInt "constant" SConstant, - (string "static" *> space1) *> (SStatic <$> (try parseId <|> parseStaticOffset)), + (string "static" *> space1) *> (SStatic <$> (try parseId <|> parseStaticOffset modName)), parseSegmentInt "pointer" SPointer, parseSegmentInt "temp" STemp ] @@ -179,10 +179,10 @@ parseInstruction = hs <- many (alphaNumChar <|> char '.' <|> char '_') return $ T.pack (h : hs) - parseStaticOffset :: Parser T.Text - parseStaticOffset = do + parseStaticOffset :: T.Text -> Parser T.Text + parseStaticOffset modName = do h <- L.decimal - return $ "STATIC_" <> (T.pack . show) h + return $ modName <> "." <> (T.pack . show) h parseSegmentInt :: T.Text -> (Int -> Segment) -> Parser Segment parseSegmentInt sname f = try $ do