Add support for local labels

app/Assembler/Emitter.hs

@@ -2,27 +2,28 @@ module Assembler.Emitter where
 
 import Control.Monad (when)
 import Control.Monad.Trans (lift)
-import Control.Monad.State (State, execState, get, put)
+import Control.Monad.State (State, evalState, get, put)
 import Control.Monad.Except (throwError)
 import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Data.Word (Word8)
 
 import qualified Data.Map as M
 
-import Assembler.Parser (AST(..))
+import Assembler.Parser (AST(..), Scope(..))
 
 
 data Bean = Byte Word8 
           | Reference String
           deriving (Show, Eq)
 
-data Context = Context { _beans   :: [Bean]
-                       , _labels  :: M.Map String Int 
+data Context = Context { _beans        :: [Bean]
+                       , _labels       :: M.Map String Int 
+                       , _currentLabel :: Maybe String
                        } deriving (Show, Eq)
 type Emitter = AST -> ExceptT String (State Context) ()
 
 empty :: Context
-empty = Context { _beans = [], _labels = M.fromList [] }
+empty = Context { _beans = [], _labels = M.fromList [], _currentLabel = Nothing }
 
 emitBean :: Bean -> ExceptT String (State Context) ()
 emitBean bean = lift $ do
@@ -35,17 +36,34 @@ emitByte byte = emitBean $ Byte $ byte
 
 emitParam :: Emitter
 emitParam (Param (Integer x))  = emitByte $ fromIntegral $ x
-emitParam (Param (LabelRef l)) = emitBean $ Reference $ l
+emitParam (Param (LabelRef Global l)) = emitBean $ Reference $ l
+emitParam (Param (LabelRef Local l)) = do
+  ctx <- lift get
+  scope <- case _currentLabel ctx of
+    (Just s) -> return s
+    Nothing  -> throwError $ "Local label ('." ++ l ++ "') reference is allowed only in the global label scope"
+  emitBean $ Reference $ (scope ++ "." ++ l)
 emitParam _ = throwError "Number or label reference expected"
 
 emitLabelDef :: Emitter
-emitLabelDef (LabelDef label) = do
+emitLabelDef (LabelDef Global label) = do
   ctx <- lift get
   let labels = _labels ctx
   let current = length (_beans ctx)
   when (label `M.member` labels) (throwError $ "Label '" ++ (label) ++ "' is already defined")
-  put ctx { _labels = M.insert label current labels }
+  put ctx { _labels = M.insert label current labels, _currentLabel = Just label }
   return ()
+emitLabelDef (LabelDef Local label) = do
+  ctx <- lift get
+  let labels = _labels ctx
+  scope <- case _currentLabel ctx of
+    (Just s) -> return s
+    Nothing  -> throwError $ "Local label ('." ++ label ++ "') can be defined only in the global label scope"
+  let canonicalLabel = scope ++ "." ++ label
+  let current = length (_beans ctx)
+  when (canonicalLabel `M.member` labels) (throwError $ "Label '" ++ (label) ++ "' is already defined in the global label '" ++ scope ++ "' scope")
+  put ctx { _labels = M.insert canonicalLabel current labels }
+  return ()  
 emitLabelDef _ = throwError "Label definition expected"
 
 emitInstr :: Emitter

app/Assembler/Parser.hs

@@ -7,6 +7,7 @@ import qualified Assembler.Tokenizer as T (Token(..))
 import VirtualMachine.VM (Op)
 import Util (explode)
 
+data Scope = Local | Global deriving (Eq, Show, Enum, Bounded)
 
 data AST = Empty
          | Operator Op 
@@ -14,8 +15,9 @@ data AST = Empty
          | Identifier String
          | Colon
          | Ampersand
-         | LabelDef String
-         | LabelRef String
+         | Dot
+         | LabelDef Scope String
+         | LabelRef Scope String
          | Param AST
          | Params [AST]
          | Instruction AST AST
@@ -53,15 +55,24 @@ parseAmpersand :: Parser
 parseAmpersand ((T.Ampersand):_) = Just $ ParseResult Ampersand 1
 parseAmpersand _                 = Nothing
 
--- label_def := ID ':'
+-- '.'
+parseDot :: Parser
+parseDot ((T.Dot):_) = Just $ ParseResult Dot 1
+parseDot _           = Nothing
+
+-- label_def := '.'? ID ':'
 parseLabelDef :: Parser
-parseLabelDef = parseSeq [parseIdentifier, parseColon] combine
-  where combine = (\[(Identifier iden), _] -> LabelDef iden)
+parseLabelDef = parseSeq [parseOptionally parseDot, parseIdentifier, parseColon] combine  
+  where
+    combine [Dot, (Identifier iden), _] = LabelDef Local iden
+    combine [_,   (Identifier iden), _] = LabelDef Global iden
 
 -- label_ref := '&' ID
 parseLabelRef :: Parser
-parseLabelRef = parseSeq [parseAmpersand, parseIdentifier] combine
-  where combine = (\[_, (Identifier iden)] -> LabelRef iden)
+parseLabelRef = parseSeq [parseAmpersand, parseOptionally parseDot, parseIdentifier] combine
+  where
+    combine [_, Dot, (Identifier iden)] = LabelRef Local iden
+    combine [_, _,   (Identifier iden)] = LabelRef Global iden
 
 -- param := INT | label_ref
 parseParam :: Parser

app/Assembler/Tokenizer.hs

@@ -14,6 +14,7 @@ data Token = Operator Op
            | Identifier String
            | Colon
            | Ampersand
+           | Dot
            | NewLine
            | WhiteSpace
            | Comment String
@@ -138,6 +139,7 @@ tokenize input = tokens >>= (\t -> Right $ filter tokenFilter t)
       , tokenizeIdentifier
       , keywordTokenizer False ":" Colon
       , keywordTokenizer False "&" Ampersand
+      , keywordTokenizer False "." Dot
       , tokenizeChar
       , tokenizeString
       ]