vmcompiler: fix static label generation

Apparently, static memaccess' take number as argument, which should
be converted to static label which is visible within one *.vm file,
but not from outside

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)

nand2tetris.cabal

@@ -36,6 +36,7 @@ executable vmcompiler
                      , optparse-applicative
                      , containers
                      , bytestring
+                     , filepath
 
 library
   hs-source-dirs:      src

src/Nand2Tetris/VM.hs

@@ -123,15 +123,15 @@ instrAnnotation (VMFunction FReturn) = "return"
 
 type Parser = Parsec Error T.Text
 
-parseInstructions :: Parser [VMInstruction]
+parseInstructions :: T.Text -> Parser [VMInstruction]
-parseInstructions = many (sp *> parseInstruction <* sp) <* eof
+parseInstructions modName = many (sp *> parseInstruction modName <* sp) <* eof
   where
     sp :: Parser ()
     sp = L.space space1 (skipLineComment "//") empty
 
-parseInstruction :: Parser VMInstruction
+parseInstruction :: T.Text -> Parser VMInstruction
-parseInstruction =
+parseInstruction modName =
-  try parseMemAccess <|>
+  try (parseMemAccess modName) <|>
   try parseArithmetic <|>
   try parseBranching <|>
       parseFunction
@@ -151,23 +151,23 @@ parseInstruction =
                string "if-goto" *> space1 *> (BIfGoto <$> parseId)
              ]
 
-    parseMemAccess :: Parser VMInstruction
+    parseMemAccess :: T.Text -> Parser VMInstruction
-    parseMemAccess = VMMemAccess <$>
+    parseMemAccess modName = VMMemAccess <$>
       parseAccessType <*>
-      parseSegment
+      parseSegment modName
 
     parseAccessType :: Parser AccessType
     parseAccessType = try (string "push" >> space1 $> ACPush) <|>
       (string "pop" >> space1 $> ACPop)
 
-    parseSegment :: Parser Segment
+    parseSegment :: T.Text -> Parser Segment
-    parseSegment =
+    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 :: T.Text -> Parser T.Text
-    parseStaticOffset = do
+    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