Support for variables in the main program block.

README.md

@@ -14,7 +14,7 @@ Increments:
 - [X] Integers
 - [X] Binary Operators on Ints
 - [X] Unary Operators on Ints
-- [ ] Local Variables and Assignment
+- [X] Local Variables and Assignment
 - [ ] Booleans and Comparisons
 - [ ] WriteLn("Hello World") (finally)
 - [ ] Branching (if statements)

haskell-pascal.cabal

@@ -49,7 +49,8 @@ library
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.21.0.0,
                       binary,
-                      bytestring
+                      bytestring,
+                      containers
 
     -- Directories containing source files.
     hs-source-dirs:   src

src/HSPC/CodeGen.hs

@@ -1,60 +1,102 @@
 module HSPC.CodeGen (generate) where
 
-import Data.Binary.Put (putInt64le, runPut)
+import Data.Binary.Put (putInt32le, putInt64le, runPut)
 import Data.ByteString.Lazy qualified as LBS
-import Data.Int (Int64)
+import Data.Int (Int32, Int64)
+import Data.List (mapAccumL)
+import Data.Map qualified as Map
 import Data.Word (Word8)
 import HSPC.ELF (getELFheader)
-import HSPC.Parse (Expression (..), Program (..), Statement (..))
+import HSPC.Parse (Block (MainProgramBlock), Expression (..), HSPCDataType (..), Program (..), Statement (..))
+
+type OffsetMap = Map.Map String Int32
+
+dataTypeToSize :: HSPCDataType -> Int
+dataTypeToSize IntegerType = 64
+
+buildOffsetMap :: [(String, HSPCDataType)] -> (Int32, OffsetMap)
+buildOffsetMap vars = (totalSize, Map.fromList mappedVars)
+  where
+    (totalSize, mappedVars) = mapAccumL calculateOffset 0 vars
+
+    calculateOffset :: Int32 -> (String, HSPCDataType) -> (Int32, (String, Int32))
+    calculateOffset currentDepth (name, dtype) =
+      let size = (fromIntegral . dataTypeToSize) dtype
+          newDepth = currentDepth + size
+          rbpOffset = -newDepth
+       in (newDepth, (name, rbpOffset))
 
 int64ToLE :: Int64 -> [Word8]
 int64ToLE n = LBS.unpack $ runPut (putInt64le n)
 
+int32ToLE :: Int32 -> [Word8]
+int32ToLE n = LBS.unpack $ runPut (putInt32le n)
+
 generate :: Program -> [Word8]
 generate ast =
   let code = generateProgram ast
    in getELFheader (fromIntegral (length code)) ++ code
 
 generateProgram :: Program -> [Word8]
-generateProgram (Program _ body) = concatMap generateStatement body
+generateProgram (Program _ body) = concatMap generateBlock body
+
+generateBlock :: Block -> [Word8]
+generateBlock (MainProgramBlock vars body) =
+  let (size, offsetMap) = buildOffsetMap vars
+      leSize = int32ToLE size
+   in [0x55] -- push rpb
+        ++ [0x48, 0x89, 0xe5] -- mov rbp rsp
+        ++ [0x48, 0x81, 0xec]
+        ++ leSize -- sub rsb size
+        ++ concatMap (generateStatement offsetMap) body
+        ++ [0x48, 0x81, 0xc4]
+        ++ leSize -- add rsb size
+        ++ [0x5d] -- pop rbp
 
-generateStatement :: Statement -> [Word8]
-generateStatement (Block body) = concatMap generateStatement body
-generateStatement (Halt ast) =
-  generateExpression ast
+generateStatement :: OffsetMap -> Statement -> [Word8]
+generateStatement offsetMap (Halt ast) =
+  generateExpression offsetMap ast
     -- copy rax -> rdi but maxed out at 255
     ++ [0xbf, 0xff, 0, 0, 0] -- mov edi 255
     ++ [0x48, 0x3d, 0xff, 0, 0, 0] -- cmp rax 255
     ++ [0x48, 0x0f, 0x4c, 0xf8] -- cmovl rax rdi
     -- exit_group syscall, exit code is in rdi
     ++ [0xb8, 0x3c, 00, 00, 00] -- mov rax 60
     ++ [0x0f, 0x05] -- Syscall
-generateStatement ast = error $ "CodeGen for " ++ show ast ++ " not implemented"
+generateStatement offsetMap (Assignment name op) =
+  generateExpression offsetMap op
+    ++ case Map.lookup name offsetMap of
+      Just offset -> [0x48, 0x89, 0x85] ++ int32ToLE offset -- mov [rbp + offset] rax
+      Nothing -> error $ "Variable " ++ name ++ " doesn't exist."
+generateStatement _ ast = error $ "CodeGen for " ++ show ast ++ " not implemented"
 
-generateExpression :: Expression -> [Word8]
-generateExpression (IntLiteral i) =
-  [0x48, 0xb8] ++ int64ToLE i -- movabs rax i
-generateExpression (Add op1 op2) =
-  generateExpression op1
+generateExpression :: OffsetMap -> Expression -> [Word8]
+generateExpression _ (IntLiteral i) = [0x48, 0xb8] ++ int64ToLE i -- movabs rax i
+generateExpression offsetMap (Identifier str) =
+  case Map.lookup str offsetMap of
+    Just offset -> [0x48, 0x8b, 0x85] ++ int32ToLE offset -- mov rax [rbp - n]
+    Nothing -> error $ "Variable " ++ str ++ " doesn't exist."
+generateExpression offsetMap (Add op1 op2) =
+  generateExpression offsetMap op1
     ++ [0x50] -- push rax
-    ++ generateExpression op2
+    ++ generateExpression offsetMap op2
     ++ [0x48, 0x03, 0x04, 0x24] -- add rax [rsp]
     ++ [0x48, 0x83, 0xc4, 0x08] -- add rsp 8 (release stack space)
-generateExpression (Multiply op1 op2) =
-  generateExpression op1
+generateExpression offsetMap (Multiply op1 op2) =
+  generateExpression offsetMap op1
     ++ [0x50] -- push rax
-    ++ generateExpression op2
+    ++ generateExpression offsetMap op2
     ++ [0x48, 0x0f, 0xaf, 0x04, 0x24] -- imul rax [rsp]
     ++ [0x48, 0x83, 0xc4, 0x08] -- add rsp 8 (release stack space)
-generateExpression (UnaryPlus op) = generateExpression op -- unary + is a nop
-generateExpression (UnaryMinus op) =
-  generateExpression op
+generateExpression offsetMap (UnaryPlus op) = generateExpression offsetMap op -- unary + is a nop
+generateExpression offsetMap (UnaryMinus op) =
+  generateExpression offsetMap op
     ++ [0x48, 0xf7, 0xd8]
-generateExpression (IntDivide op1 op2) =
-  generateExpression op2
+generateExpression offsetMap (IntDivide op1 op2) =
+  generateExpression offsetMap op2
     ++ [0x50] -- push rax
-    ++ generateExpression op1
+    ++ generateExpression offsetMap op1
     ++ [0x48, 0x99] -- cqo
     ++ [0x48, 0xf7, 0x3c, 0x24] -- idiv qword [rsp]
     ++ [0x48, 0x83, 0xc4, 0x08] -- add rsp 8 (release stack space)
-generateExpression ast = error $ "CodeGen for " ++ show ast ++ " not implemented"
+generateExpression _ ast = error $ "CodeGen for " ++ show ast ++ " not implemented"

src/HSPC/Parse.hs

@@ -1,18 +1,31 @@
-module HSPC.Parse (parse, Program (..), Statement (..), Expression (..), ParseError) where
+module HSPC.Parse
+  ( parse,
+    Program (..),
+    Block (..),
+    Statement (..),
+    Expression (..),
+    ParseError,
+    HSPCDataType (..),
+  )
+where
 
 import Data.Int (Int64)
 import HSPC.Tokenize (HSPCToken (..))
 
-data Program = Program String [Statement]
+data Program = Program String [Block]
   deriving (Show, Eq)
 
-data DataType = Integer Int64
+data HSPCDataType = IntegerType
+  deriving (Show, Eq)
+
+data Block
+  = -- Block locals body
+    MainProgramBlock [(String, HSPCDataType)] [Statement]
   deriving (Show, Eq)
 
 data Statement
-  = VarDecl String DataType
-  | VarAssign String Expression
-  | Block [Statement]
+  = VarAssign String Expression
+  | Assignment String Expression
   | Halt Expression
   | ExprStmt Expression
   deriving (Show, Eq)
@@ -31,35 +44,57 @@ data Expression
 data ParseError
   = MustStartWithProgramStatement
   | ExpectedEndStatement
-  | BlockMustStartWithBegin
+  | InvalidStartOfBlock
   | BracketNotClosed
+  | ExpectedVariableDeclaration [HSPCToken]
   | ExpectedOperand String
   | UnmatchedBracket
+  | InvalidDataType HSPCToken
   | UnexpectedToken HSPCToken
   | ExpectedToken HSPCToken
   | NotImplemented [HSPCToken]
   deriving (Show)
 
+toDataType :: HSPCToken -> Either ParseError HSPCDataType
+toDataType IntegerTypeTok = Right IntegerType
+toDataType toc = Left $ InvalidDataType toc
+
 parse :: [HSPCToken] -> Either ParseError Program
 parse (ProgramKeyWordTok : IdentifierTok name : SemiColonTok : xs) = do
-  block <- parseBlock xs
+  block <- parseMainProgramBlock xs
   Right $ Program name [block]
 parse _ = Left MustStartWithProgramStatement
 
--- Blocks in pascal start with Begin and end with End.
-parseBlock :: [HSPCToken] -> Either ParseError Statement
-parseBlock (BeginKeyWordTok : tocs) = do
-  (res, _) <- parseBlockInternal [] tocs
-  return res
-  where
-    -- Parse a single expression and acc
-    parseBlockInternal :: [Statement] -> [HSPCToken] -> Either ParseError (Statement, [HSPCToken])
-    parseBlockInternal acc (EndKeyWordTok : xs) = Right (Block (reverse acc), xs)
-    parseBlockInternal _ [] = Left ExpectedEndStatement
-    parseBlockInternal acc xs = do
-      (expr, rest) <- parseStatement xs
-      parseBlockInternal (expr : acc) rest
-parseBlock _ = Left BlockMustStartWithBegin
+-- Block = {VarSection} "BEGIN" BlockInternal
+-- VarSection = "VAR" {VarDeclaration}
+-- BlockInternal = {Statement} "END."
+parseMainProgramBlock :: [HSPCToken] -> Either ParseError Block
+parseMainProgramBlock (VarKeyWordTok : tocs) = do
+  (vars, rest) <- parseVariableDeclarations [] tocs
+  (res, _) <- parseStatements [] rest
+  return $ MainProgramBlock vars res
+parseMainProgramBlock (BeginKeyWordTok : tocs) = do
+  (res, _) <- parseStatements [] tocs
+  return $ MainProgramBlock [] res
+parseMainProgramBlock _ = Left InvalidStartOfBlock
+
+removeLeadingSemiColon :: [HSPCToken] -> Either ParseError [HSPCToken]
+removeLeadingSemiColon (SemiColonTok : rest) = Right rest
+removeLeadingSemiColon _ = Left $ ExpectedToken SemiColonTok
+
+-- Standard pascal form i.e. cannot be initialized in the var block
+parseVariableDeclarations :: [(String, HSPCDataType)] -> [HSPCToken] -> Either ParseError ([(String, HSPCDataType)], [HSPCToken])
+parseVariableDeclarations acc (BeginKeyWordTok : xs) = Right (reverse acc, xs)
+parseVariableDeclarations acc xs = do
+  (expr, rest) <- parseVariableDeclaration xs
+  parseVariableDeclarations (expr : acc) rest
+
+parseVariableDeclaration :: [HSPCToken] -> Either ParseError ((String, HSPCDataType), [HSPCToken])
+parseVariableDeclaration (IdentifierTok name : ColonTok : dataTypeToc : xs) = do
+  datatype <- toDataType dataTypeToc
+  rest <- removeLeadingSemiColon xs
+  return ((name, datatype), rest)
+parseVariableDeclaration toks = Left $ ExpectedVariableDeclaration toks
 
 breakLastOuter :: (HSPCToken -> Bool) -> [HSPCToken] -> ([HSPCToken], [HSPCToken])
 breakLastOuter breakCond toks = go (reverse toks) [] 0
@@ -84,19 +119,27 @@ splitToMatchingBracket toks = go toks [] 0
     go (x : xs) acc i = go xs (x : acc) i
     go [] _ _ = Left UnmatchedBracket
 
+parseStatements :: [Statement] -> [HSPCToken] -> Either ParseError ([Statement], [HSPCToken])
+parseStatements acc (EndKeyWordTok : xs) = Right (reverse acc, xs)
+parseStatements _ [] = Left ExpectedEndStatement
+parseStatements acc xs = do
+  (expr, rest) <- parseStatement xs
+  parseStatements (expr : acc) rest
+
 parseStatement :: [HSPCToken] -> Either ParseError (Statement, [HSPCToken])
+parseStatement (IdentifierTok name : AssignmentTok : xs) = do
+  let (rhs, rawRest) = break (== SemiColonTok) xs
+  rest <- removeLeadingSemiColon rawRest
+  op <- parseIntOperand rhs
+  return (Assignment name op, rest)
 parseStatement
   (HaltBuiltInTok : OpenBracketTok : CloseBracketTok : SemiColonTok : xs) = Right (Halt (IntLiteral 0), xs)
 parseStatement
   (HaltBuiltInTok : OpenBracketTok : xs) = do
     (internal, rawRest) <- splitToMatchingBracket xs
-    rest <- removeSemiColonHead rawRest
+    rest <- removeLeadingSemiColon rawRest
     op <- parseIntOperand internal
     return (Halt op, rest)
-    where
-      removeSemiColonHead :: [HSPCToken] -> Either ParseError [HSPCToken]
-      removeSemiColonHead (SemiColonTok : rest) = Right rest
-      removeSemiColonHead _ = Left $ ExpectedToken SemiColonTok
 parseStatement tok = Left $ NotImplemented tok
 
 -- IntOperand  = Term { ("+" | "-") Term }
@@ -138,6 +181,7 @@ parseTerm toks = case breakLastOuter (`elem` [IntDivideTok, MultiplyTok]) toks o
 
 parseFactor :: [HSPCToken] -> Either ParseError Expression
 parseFactor [LiteralIntTok n] = Right $ IntLiteral n
+parseFactor [IdentifierTok name] = Right $ Identifier name
 parseFactor (PlusTok : xs) = do
   operand <- parseFactor xs
   return $ UnaryPlus operand

src/HSPC/Tokenize.hs

@@ -7,11 +7,15 @@ import Data.List (isPrefixOf)
 data HSPCToken
   = LiteralIntTok Int64
   | ProgramKeyWordTok
+  | IntegerTypeTok
+  | VarKeyWordTok
   | BeginKeyWordTok
   | EndKeyWordTok
   | HaltBuiltInTok
   | OpenBracketTok
   | CloseBracketTok
+  | AssignmentTok
+  | ColonTok
   | SemiColonTok
   | IntDivideTok
   | PlusTok
@@ -39,12 +43,16 @@ tokenize (c : cs)
 
 tokenizeIdentifierOrKeyWord :: String -> HSPCToken
 tokenizeIdentifierOrKeyWord "PROGRAM" = ProgramKeyWordTok
+tokenizeIdentifierOrKeyWord "VAR" = VarKeyWordTok
 tokenizeIdentifierOrKeyWord "BEGIN" = BeginKeyWordTok
 tokenizeIdentifierOrKeyWord "HALT" = HaltBuiltInTok
 tokenizeIdentifierOrKeyWord "DIV" = IntDivideTok
+tokenizeIdentifierOrKeyWord "INTEGER" = IntegerTypeTok
 tokenizeIdentifierOrKeyWord s = IdentifierTok s
 
 tokenizeOperator :: String -> [HSPCToken]
+tokenizeOperator (':' : '=' : xs) = AssignmentTok : tokenize xs
+tokenizeOperator (':' : xs) = ColonTok : tokenize xs
 tokenizeOperator (';' : xs) = SemiColonTok : tokenize xs
 tokenizeOperator ('(' : xs) = OpenBracketTok : tokenize xs
 tokenizeOperator (')' : xs) = CloseBracketTok : tokenize xs

test/Main.hs

@@ -34,7 +34,8 @@ testSuite =
     TestSpec "Unary minus with literal ints" "operators_unary_minus_int" 75,
     TestSpec "Unary plus with literal ints" "operators_unary_plus_int" 25,
     TestSpec "{} comments" "comments_curly_brace" 12,
-    TestSpec "// comments" "comments_single_line" 12
+    TestSpec "// comments" "comments_single_line" 12,
+    TestSpec "Single variable" "variables_single_var" 10
   ]
 
 main :: IO ()

test/sample_programs/variables_single_var.pas

@@ -0,0 +1,8 @@
+program VariableExample;
+
+var 
+    i : integer;
+begin
+    i := 10;
+    halt(i); 
+end.