From 76c3c37d3d5ed4c96747a47d79a28ca4a5ee9d56 Mon Sep 17 00:00:00 2001 From: Billy Moore Date: Tue, 20 Jan 2026 13:00:37 +0000 Subject: [PATCH] Support for variables in the main program block. --- README.md | 2 +- haskell-pascal.cabal | 3 +- src/HSPC/CodeGen.hs | 92 ++++++++++++----- src/HSPC/Parse.hs | 98 ++++++++++++++----- src/HSPC/Tokenize.hs | 8 ++ test/Main.hs | 3 +- .../variables_single_var.golden | 0 test/sample_programs/variables_single_var.pas | 8 ++ 8 files changed, 159 insertions(+), 55 deletions(-) create mode 100644 test/sample_programs/variables_single_var.golden create mode 100644 test/sample_programs/variables_single_var.pas diff --git a/README.md b/README.md index 6d31bda..013174b 100644 --- a/README.md +++ b/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) diff --git a/haskell-pascal.cabal b/haskell-pascal.cabal index 074bed2..cb7f5eb 100644 --- a/haskell-pascal.cabal +++ b/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 diff --git a/src/HSPC/CodeGen.hs b/src/HSPC/CodeGen.hs index 7294d4c..b89fd0d 100644 --- a/src/HSPC/CodeGen.hs +++ b/src/HSPC/CodeGen.hs @@ -1,27 +1,61 @@ 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 @@ -29,32 +63,40 @@ generateStatement (Halt ast) = -- 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" diff --git a/src/HSPC/Parse.hs b/src/HSPC/Parse.hs index aca788b..03ddc86 100644 --- a/src/HSPC/Parse.hs +++ b/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 diff --git a/src/HSPC/Tokenize.hs b/src/HSPC/Tokenize.hs index 3b4964b..7edf8bf 100644 --- a/src/HSPC/Tokenize.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index f41be51..a9ee010 100644 --- a/test/Main.hs +++ b/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 () diff --git a/test/sample_programs/variables_single_var.golden b/test/sample_programs/variables_single_var.golden new file mode 100644 index 0000000..e69de29 diff --git a/test/sample_programs/variables_single_var.pas b/test/sample_programs/variables_single_var.pas new file mode 100644 index 0000000..20a4775 --- /dev/null +++ b/test/sample_programs/variables_single_var.pas @@ -0,0 +1,8 @@ +program VariableExample; + +var + i : integer; +begin + i := 10; + halt(i); +end.