From ccdba2fd30d28b59ee2dbc70106b4eb9165e0346 Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 19 Dec 2023 17:39:17 +0100 Subject: [PATCH 01/15] feat: compile Value to IR instruction --- LobsterLang/LobsterLang.cabal | 4 +++- LobsterLang/app/Main.hs | 13 ++++++++++++- LobsterLang/src/Compiler.hs | 16 ++++++++++++++++ 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 LobsterLang/src/Compiler.hs diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index c6ec70b..282c26a 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -27,6 +27,7 @@ library exposed-modules: AST AstEval + Compiler Lib Parse Scope @@ -40,7 +41,8 @@ library src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: - base >=4.7 && <5 + base >=4.7 && <5, + bytestring default-language: Haskell2010 executable LobsterLang-exe diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 89f6fe6..8668ade 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -12,6 +12,10 @@ import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) +import Compiler +import qualified AST + + -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else @@ -21,4 +25,11 @@ inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDO -- | Main main :: IO () -main = print "Start of Interpretation Lisp" >> inputLoop [] +main = + -- putStrLn ("VAL" ++ show 5) + putStrLn (compileAst (AST.Value 5)) + -- print "Start of Interpretation Lisp" >> inputLoop [] + +-- main :: IO () +-- main = do +-- BL.writeFile "out" (BLU.pack "test") diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs new file mode 100644 index 0000000..9853f79 --- /dev/null +++ b/LobsterLang/src/Compiler.hs @@ -0,0 +1,16 @@ +{- +-- EPITECH PROJECT, 2023 +-- LobsterLang +-- File description: +-- Compiler +-} + +module Compiler (compileAst) where + +import AST (Ast (..)) +-- import qualified Data.ByteString.Lazy as BL +-- import qualified Data.ByteString.Lazy.Char8 as BLU +-- import Data.Binary.Put + +compileAst :: Ast -> String +compileAst (Value v) = "VAL" ++ " " ++ show v From 426d08492a9a4872b61c8920212bda3693c70c37 Mon Sep 17 00:00:00 2001 From: Aldric Date: Wed, 20 Dec 2023 10:52:21 +0100 Subject: [PATCH 02/15] feat: add compilation instruction for Value, Symbol and Boolean --- LobsterLang/LobsterLang.cabal | 3 +-- LobsterLang/app/Main.hs | 2 +- LobsterLang/src/Compiler.hs | 11 +++++++++++ 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index 282c26a..8d442b0 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -41,8 +41,7 @@ library src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: - base >=4.7 && <5, - bytestring + base >=4.7 && <5 default-language: Haskell2010 executable LobsterLang-exe diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 8668ade..c63ef7b 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -27,7 +27,7 @@ inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDO main :: IO () main = -- putStrLn ("VAL" ++ show 5) - putStrLn (compileAst (AST.Value 5)) + putStrLn (compileAst (AST.Call "myFunc" [(AST.Value 5), (AST.Value 5), (AST.Boolean True), (AST.Symbol "is_neg")])) -- print "Start of Interpretation Lisp" >> inputLoop [] -- main :: IO () diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 9853f79..d5bff0c 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -12,5 +12,16 @@ import AST (Ast (..)) -- import qualified Data.ByteString.Lazy.Char8 as BLU -- import Data.Binary.Put +compileArg :: Ast -> String +compileArg (Value value) = show value +compileArg (Symbol symbol) = symbol +compileArg (Boolean bool) = show bool + +compileArgs :: [Ast] -> String +compileArgs [] = "" +compileArgs [x] = compileArg x +compileArgs (x:xs) = compileArg x ++ " " ++ compileArgs xs + compileAst :: Ast -> String compileAst (Value v) = "VAL" ++ " " ++ show v +compileAst (Call funcName args) = "CALL " ++ funcName ++ " " ++ compileArgs args From 380231e927eb5f14d838aa130d9f90647593199e Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 26 Dec 2023 19:43:01 +0100 Subject: [PATCH 03/15] feat: add writing compiled ast in file as bytes and Push instruction --- LobsterLang/LobsterLang.cabal | 3 ++ LobsterLang/app/Main.hs | 14 +++++---- LobsterLang/src/Compiler.hs | 52 ++++++++++++++++++++++++++++++---- LobsterLang/src/Parse.hs | 8 ++++++ foo.scm | 3 ++ test | Bin 0 -> 5 bytes 6 files changed, 69 insertions(+), 11 deletions(-) create mode 100644 test diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index 8d442b0..8699a50 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -42,6 +42,9 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , bytestring + , utf8-string + , binary default-language: Haskell2010 executable LobsterLang-exe diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index c63ef7b..de9240c 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -13,22 +13,24 @@ import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) import Compiler -import qualified AST +import Data.Maybe (fromMaybe) -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else - getLine >>= \line -> case parseLisp line new of + getLine >>= \line -> case parseTest line new of (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) - (res, stack') -> print res >> inputLoop stack' + (Just res, stack') -> writeCompiledAstToFile "test" (compileAst res) -- | Main main :: IO () -main = +main = do + -- let c = "(define foo 21)\n(define x 5)\n(define value (* x foo))" + -- let ast = parseLisp c [] -- putStrLn ("VAL" ++ show 5) - putStrLn (compileAst (AST.Call "myFunc" [(AST.Value 5), (AST.Value 5), (AST.Boolean True), (AST.Symbol "is_neg")])) - -- print "Start of Interpretation Lisp" >> inputLoop [] + -- putStrLn (compileAst (fst ast)) + print "Start of Interpretation Lisp" >> inputLoop [] -- main :: IO () -- main = do diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index d5bff0c..eb7441d 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,13 +5,43 @@ -- Compiler -} -module Compiler (compileAst) where +module Compiler (compileAst, writeCompiledAstToFile) where import AST (Ast (..)) -- import qualified Data.ByteString.Lazy as BL --- import qualified Data.ByteString.Lazy.Char8 as BLU +import qualified Data.ByteString as B +import Data.ByteString.UTF8 as BLU +import Data.ByteString.Char8 as C8 -- import Data.Binary.Put +import qualified Data.ByteString.Lazy as BL +import Data.Binary.Put + +data OpCode = PUSH +instance Enum OpCode where + fromEnum PUSH = 10 + +putOpCode :: OpCode -> Put +putOpCode opCode = putWord8 (fromIntegral (fromEnum opCode)) + +-- absCode = + -- PushArg 0 + -- Push 0 + -- Push Less + -- Call + -- JumpIfFalse 2 + -- PushArg 0 + -- Ret + -- PushArg 0 + -- Push -1 + -- Push Mul + -- Call + -- Ret +-- Push -42 +-- Push absCode +-- Call +-- Ret + compileArg :: Ast -> String compileArg (Value value) = show value compileArg (Symbol symbol) = symbol @@ -22,6 +52,18 @@ compileArgs [] = "" compileArgs [x] = compileArg x compileArgs (x:xs) = compileArg x ++ " " ++ compileArgs xs -compileAst :: Ast -> String -compileAst (Value v) = "VAL" ++ " " ++ show v -compileAst (Call funcName args) = "CALL " ++ funcName ++ " " ++ compileArgs args +compileAst :: Ast -> Put +-- compileAst (Call "+" args) = putWord "ADD " ++ compileArgs args +-- compileAst (Call "-" args) = "SUB " ++ compileArgs args +-- compileAst (Call "*" args) = "MUL " ++ compileArgs args +-- compileAst (Call "/" args) = "DIV " ++ compileArgs args +-- compileAst (Call "%" args) = "MOD " ++ compileArgs args +-- compileAst (Call funcName args) = "CALL " ++ funcName ++ " " ++ compileArgs args +-- compileAst (Define symbolName (Call funcName args)) = "CALLR " ++ funcName ++ " " ++ compileArgs args ++ " " ++ symbolName +-- compileAst (Define symbolName value) = putWord8 255 +-- "DEF " ++ symbolName ++ " " ++ compileArg value +compileAst (Value value) = putOpCode PUSH >> putInt32le (fromIntegral (value::Int)) -- push/10/0a arg0::i32 # push a 32bit int value on the stack + +writeCompiledAstToFile :: String -> Put -> IO() +-- writeCompiledAstToFile filepath compiledAst = B.writeFile filepath (C8.pack compiledAst) +writeCompiledAstToFile filepath compiledAst = B.writeFile filepath (B.concat $ BL.toChunks $ runPut compiledAst) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 35d29ab..4b31242 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -27,6 +27,7 @@ module Parse ( parseElem, parseValue, parseLisp, + parseTest, -- parseTuple, ) where @@ -245,3 +246,10 @@ parseLisp s stack = case runParser parseSExpr s of Just (res, _) -> case AstEval.sexprToAst res of Nothing -> (Nothing, []) Just value -> AstEval.evalAst stack value + +parseTest :: String -> [Scope.ScopeMb] -> (Maybe AST.Ast, [Scope.ScopeMb]) +parseTest s stack = case runParser parseSExpr s of + Nothing -> (Nothing, []) + Just (res, _) -> case AstEval.sexprToAst res of + Nothing -> (Nothing, []) + Just value -> (Just value, stack) diff --git a/foo.scm b/foo.scm index 62a7db8..c6434b8 100644 --- a/foo.scm +++ b/foo.scm @@ -5,3 +5,6 @@ p (* value 4) (define value (* 4 (+ 1 2))) value + +(define value (* (define x 5) (define foo 21))) +(define value (* 5 21)) \ No newline at end of file diff --git a/test b/test new file mode 100644 index 0000000000000000000000000000000000000000..2c99af55fc81581f75fab0b924032caabbfa39f8 GIT binary patch literal 5 Mcmd Date: Wed, 27 Dec 2023 16:05:32 +0100 Subject: [PATCH 04/15] feature: add compile instruction for 'add' built-in instruction --- LobsterLang/LobsterLang.cabal | 1 - LobsterLang/src/Compiler.hs | 34 +++++++++++++--------------------- test | Bin 5 -> 12 bytes 3 files changed, 13 insertions(+), 22 deletions(-) diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index 8699a50..3a8e86c 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -43,7 +43,6 @@ library build-depends: base >=4.7 && <5 , bytestring - , utf8-string , binary default-language: Haskell2010 diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index eb7441d..52f5f1c 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -8,18 +8,17 @@ module Compiler (compileAst, writeCompiledAstToFile) where import AST (Ast (..)) --- import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString as B -import Data.ByteString.UTF8 as BLU -import Data.ByteString.Char8 as C8 --- import Data.Binary.Put -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL import Data.Binary.Put +import Debug.Trace -data OpCode = PUSH +data OpCode = CALL | PUSH | ADD instance Enum OpCode where + fromEnum CALL = 5 fromEnum PUSH = 10 + fromEnum ADD = 15 putOpCode :: OpCode -> Put putOpCode opCode = putWord8 (fromIntegral (fromEnum opCode)) @@ -42,18 +41,12 @@ putOpCode opCode = putWord8 (fromIntegral (fromEnum opCode)) -- Call -- Ret -compileArg :: Ast -> String -compileArg (Value value) = show value -compileArg (Symbol symbol) = symbol -compileArg (Boolean bool) = show bool - -compileArgs :: [Ast] -> String -compileArgs [] = "" -compileArgs [x] = compileArg x -compileArgs (x:xs) = compileArg x ++ " " ++ compileArgs xs +compileArgs :: [Ast] -> Put +compileArgs [x] = compileAst x +compileArgs (x:xs) = compileAst x >> compileArgs xs compileAst :: Ast -> Put --- compileAst (Call "+" args) = putWord "ADD " ++ compileArgs args +compileAst (Call "+" args) = compileArgs args >> trace "ADD" putOpCode ADD >> trace "CALL" putOpCode CALL -- compileAst (Call "-" args) = "SUB " ++ compileArgs args -- compileAst (Call "*" args) = "MUL " ++ compileArgs args -- compileAst (Call "/" args) = "DIV " ++ compileArgs args @@ -61,9 +54,8 @@ compileAst :: Ast -> Put -- compileAst (Call funcName args) = "CALL " ++ funcName ++ " " ++ compileArgs args -- compileAst (Define symbolName (Call funcName args)) = "CALLR " ++ funcName ++ " " ++ compileArgs args ++ " " ++ symbolName -- compileAst (Define symbolName value) = putWord8 255 --- "DEF " ++ symbolName ++ " " ++ compileArg value -compileAst (Value value) = putOpCode PUSH >> putInt32le (fromIntegral (value::Int)) -- push/10/0a arg0::i32 # push a 32bit int value on the stack +-- "DEF " ++ symbolName ++ " " ++ compile value +compileAst (Value value) = putOpCode PUSH >> trace ("PUSH " ++ show value) putInt32le (fromIntegral (value::Int)) writeCompiledAstToFile :: String -> Put -> IO() --- writeCompiledAstToFile filepath compiledAst = B.writeFile filepath (C8.pack compiledAst) -writeCompiledAstToFile filepath compiledAst = B.writeFile filepath (B.concat $ BL.toChunks $ runPut compiledAst) +writeCompiledAstToFile filepath compiledAst = BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledAst) diff --git a/test b/test index 2c99af55fc81581f75fab0b924032caabbfa39f8..a8600859365fbe068a07a535db033e8cf569ed89 100644 GIT binary patch literal 12 Rcmd Date: Tue, 2 Jan 2024 02:37:22 +0100 Subject: [PATCH 05/15] feat: Add convertion from ast to instruction list and add compiling instructions to file --- test | Bin 12 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 test diff --git a/test b/test deleted file mode 100644 index a8600859365fbe068a07a535db033e8cf569ed89..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12 Rcmd Date: Tue, 2 Jan 2024 02:37:31 +0100 Subject: [PATCH 06/15] feat: Add convertion from ast to instruction list and add compiling instructions to file --- LobsterLang/LobsterLang.cabal | 1 + LobsterLang/app/Main.hs | 4 +- LobsterLang/src/Compiler.hs | 194 +++++++++++++++++++++++++++++----- 3 files changed, 169 insertions(+), 30 deletions(-) diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index 3a8e86c..8699a50 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -43,6 +43,7 @@ library build-depends: base >=4.7 && <5 , bytestring + , utf8-string , binary default-language: Haskell2010 diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index de9240c..25ac4c8 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -14,6 +14,7 @@ import System.Exit (exitWith, ExitCode (ExitFailure)) import Compiler import Data.Maybe (fromMaybe) +import Debug.Trace -- | Infinite loop until EOF from the user @@ -21,7 +22,8 @@ inputLoop :: [Scope.ScopeMb] -> IO () inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else getLine >>= \line -> case parseTest line new of (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) - (Just res, stack') -> writeCompiledAstToFile "test" (compileAst res) + -- (Just res, stack') -> print res >> writeCompiledAstToFile "test" (compileAst res) + (Just res, stack') -> print res >> compile res "test2" -- | Main main :: IO () diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 52f5f1c..2c5aa21 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,24 +5,17 @@ -- Compiler -} -module Compiler (compileAst, writeCompiledAstToFile) where +module Compiler (compile, astToInstructions, showInstructions) where import AST (Ast (..)) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.UTF8 as BSUTF8 +import Data.Binary import Data.Binary.Put -import Debug.Trace - -data OpCode = CALL | PUSH | ADD -instance Enum OpCode where - fromEnum CALL = 5 - fromEnum PUSH = 10 - fromEnum ADD = 15 - -putOpCode :: OpCode -> Put -putOpCode opCode = putWord8 (fromIntegral (fromEnum opCode)) +-- PushArg for when user define a function -- absCode = -- PushArg 0 -- Push 0 @@ -41,21 +34,164 @@ putOpCode opCode = putWord8 (fromIntegral (fromEnum opCode)) -- Call -- Ret -compileArgs :: [Ast] -> Put -compileArgs [x] = compileAst x -compileArgs (x:xs) = compileAst x >> compileArgs xs - -compileAst :: Ast -> Put -compileAst (Call "+" args) = compileArgs args >> trace "ADD" putOpCode ADD >> trace "CALL" putOpCode CALL --- compileAst (Call "-" args) = "SUB " ++ compileArgs args --- compileAst (Call "*" args) = "MUL " ++ compileArgs args --- compileAst (Call "/" args) = "DIV " ++ compileArgs args --- compileAst (Call "%" args) = "MOD " ++ compileArgs args --- compileAst (Call funcName args) = "CALL " ++ funcName ++ " " ++ compileArgs args --- compileAst (Define symbolName (Call funcName args)) = "CALLR " ++ funcName ++ " " ++ compileArgs args ++ " " ++ symbolName --- compileAst (Define symbolName value) = putWord8 255 --- "DEF " ++ symbolName ++ " " ++ compile value -compileAst (Value value) = putOpCode PUSH >> trace ("PUSH " ++ show value) putInt32le (fromIntegral (value::Int)) - -writeCompiledAstToFile :: String -> Put -> IO() -writeCompiledAstToFile filepath compiledAst = BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledAst) +-- All if statement's possible forms are built-in instructions in java. do we do the same ? +data Instruction = + -- Stack Instructions + PushI Int + | PushB Bool + | PushS String + -- Jump Instructions + | JumpIfFalse Int + -- Function Instructions + | Def String Int [Instruction] + | Call + | Ret + -- Built-in Functions / Operators + -- Arithmetic Operators + | Add + | Sub + | Mul + | Div + | Mod + -- Comparison Operators + | Eq + | Less + | LessEq + | Great + | GreatEq + -- Logical Operators + | And + | Or + | Not -- Used to invert if statements and Boolean values. + -- Unary Operators + | Neg -- Used only for negations that can not be determined at compile time (ex: Symbol negation) + deriving (Show) + +instance Enum Instruction where + -- Stack Instructions [10 - 30] + fromEnum (PushI _) = 10 + fromEnum (PushB _) = 11 + fromEnum (PushS _) = 12 + -- Jump Instructions [30 - 40] + fromEnum (JumpIfFalse _) = 30 + -- Function Instructions [40 - 50] + fromEnum (Def {}) = 40 + fromEnum Compiler.Call = 41 + fromEnum Ret = 42 + -- Built-in Functions / Operators [50 - 90] + -- Arithmetic Operators [50 - 60] + fromEnum Add = 50 + fromEnum Sub = 51 + fromEnum Mul = 52 + fromEnum Div = 53 + fromEnum Mod = 54 + -- Comparison Operators [60 - 70] + fromEnum Eq = 60 + fromEnum Less = 61 + fromEnum LessEq = 62 + fromEnum Great = 63 + fromEnum GreatEq = 64 + -- Logical Operators [70 - 80] + fromEnum And = 70 + fromEnum Or = 71 + fromEnum Not = 72 + -- Unary Operators [80 - 90] + fromEnum Neg = 80 + +astToInstructions :: Ast -> [Instruction] +astToInstructions (Value value) = [PushI value] +astToInstructions (Boolean bool) = [PushB bool] +astToInstructions (Symbol symbolName) = [PushS symbolName] +astToInstructions (AST.Call "-" [Value value]) = [PushI (-value)] -- Probably useless +astToInstructions (AST.Call "-" [Symbol symbolName]) = PushS symbolName : [Neg] +astToInstructions (AST.Call "!" [Boolean bool]) = [PushB (not bool)] +astToInstructions (AST.Call "+" args) = concatMap astToInstructions args ++ [Add] +astToInstructions (AST.Call "-" args) = concatMap astToInstructions args ++ [Sub] +astToInstructions (AST.Call "*" args) = concatMap astToInstructions args ++ [Mul] +astToInstructions (AST.Call "/" args) = concatMap astToInstructions args ++ [Div] +astToInstructions (AST.Call "%" args) = concatMap astToInstructions args ++ [Mod] +astToInstructions (AST.Call "==" args) = concatMap astToInstructions args ++ [Eq] +astToInstructions (AST.Call "<" args) = concatMap astToInstructions args ++ [Less] +astToInstructions (AST.Call "<=" args) = concatMap astToInstructions args ++ [LessEq] +astToInstructions (AST.Call ">" args) = concatMap astToInstructions args ++ [Great] +astToInstructions (AST.Call ">=" args) = concatMap astToInstructions args ++ [GreatEq] +astToInstructions (AST.Call "&&" args) = concatMap astToInstructions args ++ [And] +astToInstructions (AST.Call "||" args) = concatMap astToInstructions args ++ [Or] +astToInstructions (AST.Call "!" args) = concatMap astToInstructions args ++ [Not] +astToInstructions (AST.Call funcName args) = concatMap astToInstructions args ++ [PushS funcName] ++ [Compiler.Call] +astToInstructions (Define symbolName value) = let symbolValue = astToInstructions value + in [Def symbolName (length symbolValue) symbolValue] + +_showInstruction :: Instruction -> Int -> String +_showInstruction (PushI value) depth = concat (replicate depth "\t") ++ "PUSH_I " ++ show value ++ "\n" +_showInstruction (PushB bool) depth = concat (replicate depth "\t") ++ "PUSH_B " ++ show bool ++ "\n" +_showInstruction (PushS symbolName) depth = concat (replicate depth "\t") ++ "PUSH_S " ++ show symbolName ++ "\n" +_showInstruction (JumpIfFalse branchOffset) depth = concat (replicate depth "\t") ++ "JUMP_IF_FALSE " ++ show branchOffset ++ "\n" +_showInstruction Add depth = concat (replicate depth "\t") ++ "ADD" ++ "\n" +_showInstruction Sub depth = concat (replicate depth "\t") ++ "SUB" ++ "\n" +_showInstruction Mul depth = concat (replicate depth "\t") ++ "MUL" ++ "\n" +_showInstruction Div depth = concat (replicate depth "\t") ++ "DIV" ++ "\n" +_showInstruction Mod depth = concat (replicate depth "\t") ++ "MOD" ++ "\n" +_showInstruction Eq depth = concat (replicate depth "\t") ++ "EQ" ++ "\n" +_showInstruction Less depth = concat (replicate depth "\t") ++ "LESS" ++ "\n" +_showInstruction LessEq depth = concat (replicate depth "\t") ++ "LESS_EQ" ++ "\n" +_showInstruction Great depth = concat (replicate depth "\t") ++ "GREAT" ++ "\n" +_showInstruction GreatEq depth = concat (replicate depth "\t") ++ "GREAT_EQ" ++ "\n" +_showInstruction And depth = concat (replicate depth "\t") ++ "AND" ++ "\n" +_showInstruction Or depth = concat (replicate depth "\t") ++ "OR" ++ "\n" +_showInstruction Not depth = concat (replicate depth "\t") ++ "NOT" ++ "\n" +_showInstruction Neg depth = concat (replicate depth "\t") ++ "NEG" ++ "\n" +_showInstruction Compiler.Call depth = concat (replicate depth "\t") ++ "CALL" ++ "\n" +_showInstruction (Def symbolName nbInstruction instructions) depth + = concat (replicate depth "\t") ++ "DEF " ++ show symbolName ++ " <" ++ show nbInstruction ++ "> =\n" ++ _showInstructions instructions (depth + 1) + +_showInstructions :: [Instruction] -> Int -> String +_showInstructions instructions depth = concatMap lambda instructions where lambda x = _showInstruction x depth + +showInstructions :: [Instruction] -> IO() +showInstructions instructions = putStr (_showInstructions instructions 0) + +_putOpCodeFromInstruction :: Instruction -> Put +_putOpCodeFromInstruction instruction = putWord8 (fromIntegral (fromEnum instruction)) + +_putString :: String -> Put +_putString string = let byteString = BSUTF8.fromString string in putInt32le (fromIntegral (BS.length byteString)) >> putByteString byteString + +_putInt32 :: Int -> Put +_putInt32 value = putInt32le (fromIntegral (value::Int)) + +_putBool :: Bool -> Put +_putBool bool = putWord8 (fromIntegral (fromEnum bool)) + +_compileInstruction :: Instruction -> Put +_compileInstruction (PushI value) = _putOpCodeFromInstruction (PushI value) >> _putInt32 value +_compileInstruction (PushB bool) = _putOpCodeFromInstruction (PushB bool) >> _putBool bool +_compileInstruction (PushS symbolName) = _putOpCodeFromInstruction (PushS symbolName) >> _putString symbolName +_compileInstruction (JumpIfFalse branchOffset) = _putOpCodeFromInstruction (JumpIfFalse branchOffset) >> _putInt32 branchOffset +_compileInstruction Add = _putOpCodeFromInstruction Add +_compileInstruction Sub = _putOpCodeFromInstruction Sub +_compileInstruction Mul = _putOpCodeFromInstruction Mul +_compileInstruction Div = _putOpCodeFromInstruction Div +_compileInstruction Mod = _putOpCodeFromInstruction Mod +_compileInstruction Eq = _putOpCodeFromInstruction Eq +_compileInstruction Less = _putOpCodeFromInstruction Less +_compileInstruction LessEq = _putOpCodeFromInstruction LessEq +_compileInstruction Great = _putOpCodeFromInstruction Great +_compileInstruction GreatEq = _putOpCodeFromInstruction GreatEq +_compileInstruction And = _putOpCodeFromInstruction And +_compileInstruction Or = _putOpCodeFromInstruction Or +_compileInstruction Not = _putOpCodeFromInstruction Not +_compileInstruction Neg = _putOpCodeFromInstruction Neg +_compileInstruction Compiler.Call = _putOpCodeFromInstruction Compiler.Call +_compileInstruction (Def symbolName nbInstruction instructions) + = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> _compileInstructions instructions + +_compileInstructions :: [Instruction] -> Put +_compileInstructions [instruction] = _compileInstruction instruction +_compileInstructions (instruction:instructions) = _compileInstruction instruction >> _compileInstructions instructions + +writeCompiledInstructionsToFile :: String -> Put -> IO() +writeCompiledInstructionsToFile filepath compiledInstructions = BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledInstructions) + +compile :: Ast -> String -> IO() +compile ast filepath = writeCompiledInstructionsToFile filepath (_compileInstructions (astToInstructions ast)) \ No newline at end of file From e2dfaf543ff09e290a5fcc737b484e823d78a725 Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 10:52:56 +0100 Subject: [PATCH 07/15] feat: exporting compileInstructions --- LobsterLang/src/Compiler.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 2c5aa21..e5933ec 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,7 +5,7 @@ -- Compiler -} -module Compiler (compile, astToInstructions, showInstructions) where +module Compiler (compile, astToInstructions, compileInstructions, showInstructions) where import AST (Ast (..)) @@ -184,14 +184,14 @@ _compileInstruction Not = _putOpCodeFromInstruction Not _compileInstruction Neg = _putOpCodeFromInstruction Neg _compileInstruction Compiler.Call = _putOpCodeFromInstruction Compiler.Call _compileInstruction (Def symbolName nbInstruction instructions) - = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> _compileInstructions instructions + = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> compileInstructions instructions -_compileInstructions :: [Instruction] -> Put -_compileInstructions [instruction] = _compileInstruction instruction -_compileInstructions (instruction:instructions) = _compileInstruction instruction >> _compileInstructions instructions +compileInstructions :: [Instruction] -> Put +compileInstructions [instruction] = _compileInstruction instruction +compileInstructions (instruction:instructions) = _compileInstruction instruction >> compileInstructions instructions writeCompiledInstructionsToFile :: String -> Put -> IO() writeCompiledInstructionsToFile filepath compiledInstructions = BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledInstructions) compile :: Ast -> String -> IO() -compile ast filepath = writeCompiledInstructionsToFile filepath (_compileInstructions (astToInstructions ast)) \ No newline at end of file +compile ast filepath = writeCompiledInstructionsToFile filepath (compileInstructions (astToInstructions ast)) \ No newline at end of file From 6fc0a86a3fab21e93b8bc50ccfd5ec9d3e06e5dc Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 15:35:18 +0100 Subject: [PATCH 08/15] feat: add unit tests for astToInstructions --- LobsterLang/app/Main.hs | 5 +-- LobsterLang/src/Compiler.hs | 8 ++-- LobsterLang/test/CompilerSpec.hs | 75 ++++++++++++++++++++++++++++++++ 3 files changed, 81 insertions(+), 7 deletions(-) create mode 100644 LobsterLang/test/CompilerSpec.hs diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 25ac4c8..8264690 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -23,7 +23,7 @@ inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDO getLine >>= \line -> case parseTest line new of (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) -- (Just res, stack') -> print res >> writeCompiledAstToFile "test" (compileAst res) - (Just res, stack') -> print res >> compile res "test2" + (Just res, stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions -- | Main main :: IO () @@ -34,6 +34,3 @@ main = do -- putStrLn (compileAst (fst ast)) print "Start of Interpretation Lisp" >> inputLoop [] --- main :: IO () --- main = do --- BL.writeFile "out" (BLU.pack "test") diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index e5933ec..41372a7 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,7 +5,7 @@ -- Compiler -} -module Compiler (compile, astToInstructions, compileInstructions, showInstructions) where +module Compiler (compile, astToInstructions, compileInstructions, showInstructions, Instruction(..)) where import AST (Ast (..)) @@ -39,7 +39,7 @@ data Instruction = -- Stack Instructions PushI Int | PushB Bool - | PushS String + | PushS String -- rename to not be confused with push string -- Jump Instructions | JumpIfFalse Int -- Function Instructions @@ -65,7 +65,7 @@ data Instruction = | Not -- Used to invert if statements and Boolean values. -- Unary Operators | Neg -- Used only for negations that can not be determined at compile time (ex: Symbol negation) - deriving (Show) + deriving (Show, Eq) instance Enum Instruction where -- Stack Instructions [10 - 30] @@ -142,6 +142,7 @@ _showInstruction Or depth = concat (replicate depth "\t") ++ "OR" ++ "\n" _showInstruction Not depth = concat (replicate depth "\t") ++ "NOT" ++ "\n" _showInstruction Neg depth = concat (replicate depth "\t") ++ "NEG" ++ "\n" _showInstruction Compiler.Call depth = concat (replicate depth "\t") ++ "CALL" ++ "\n" +_showInstruction Ret depth = concat (replicate depth "\t") ++ "RET" ++ "\n" _showInstruction (Def symbolName nbInstruction instructions) depth = concat (replicate depth "\t") ++ "DEF " ++ show symbolName ++ " <" ++ show nbInstruction ++ "> =\n" ++ _showInstructions instructions (depth + 1) @@ -183,6 +184,7 @@ _compileInstruction Or = _putOpCodeFromInstruction Or _compileInstruction Not = _putOpCodeFromInstruction Not _compileInstruction Neg = _putOpCodeFromInstruction Neg _compileInstruction Compiler.Call = _putOpCodeFromInstruction Compiler.Call +_compileInstruction Ret = _putOpCodeFromInstruction Ret _compileInstruction (Def symbolName nbInstruction instructions) = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> compileInstructions instructions diff --git a/LobsterLang/test/CompilerSpec.hs b/LobsterLang/test/CompilerSpec.hs new file mode 100644 index 0000000..0097b75 --- /dev/null +++ b/LobsterLang/test/CompilerSpec.hs @@ -0,0 +1,75 @@ +{- +-- EPITECH PROJECT, 2023 +-- GLaDOS +-- File description: +-- CompilerSpec +-} + +module CompilerSpec where + +import Test.Hspec +import Compiler +import qualified AST + +spec :: Spec +spec = do + describe "CompilerTest" $ do + it "Check astToInstructions Value not empty" $ do + astToInstructions (AST.Value 5) `shouldNotBe` [] + it "Check astToInstructions Value success" $ do + astToInstructions (AST.Value 5) `shouldBe` [PushI 5] + it "Check astToInstructions Boolean not empty" $ do + astToInstructions (AST.Boolean True) `shouldNotBe` [] + it "Check astToInstructions Boolean success" $ do + astToInstructions (AST.Boolean True) `shouldBe` [PushB True] + it "Check astToInstructions Symbol not empty" $ do + astToInstructions (AST.Symbol "foo") `shouldNotBe` [] + it "Check astToInstructions Symbol success" $ do + astToInstructions (AST.Symbol "foo") `shouldBe` [PushS "foo"] + + -- Call - User defined functions + it "Check astToInstructions Call not empty" $ do + astToInstructions (AST.Call "foo" [(AST.Value 42)]) `shouldNotBe` [] + it "Check astToInstructions Call user defined" $ do + astToInstructions (AST.Call "foo" [(AST.Value 42)]) `shouldBe` [PushI 42, PushS "foo", Call] + + -- Call - Built-in functions + it "Check astToInstructions Call built-in \"+\"" $ do + astToInstructions (AST.Call "+" [(AST.Value 42), (AST.Value 84)]) `shouldBe` [PushI 42, PushI 84, Add] + it "Check astToInstructions Call built-in \"-\"" $ do + astToInstructions (AST.Call "-" [(AST.Value 42), (AST.Value 84)]) `shouldBe` [PushI 42, PushI 84, Sub] + it "Check astToInstructions Call built-in \"-\" (Symbol Negation)" $ do + astToInstructions (AST.Call "-" [(AST.Symbol "foo")]) `shouldBe` [PushS "foo", Neg] + it "Check astToInstructions Call built-in \"!\" (Bool Invertion)" $ do + astToInstructions (AST.Call "!" [(AST.Boolean True)]) `shouldBe` [PushB False] + it "Check astToInstructions Call built-in \"*\"" $ do + astToInstructions (AST.Call "*" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Mul] + it "Check astToInstructions Call built-in \"/\"" $ do + astToInstructions (AST.Call "/" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Div] + it "Check astToInstructions Call built-in \"%\"" $ do + astToInstructions (AST.Call "%" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Mod] + + it "Check astToInstructions Call built-in \"==\"" $ do + astToInstructions (AST.Call "==" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Eq] + it "Check astToInstructions Call built-in \"<\"" $ do + astToInstructions (AST.Call "<" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Less] + it "Check astToInstructions Call built-in \"<=\"" $ do + astToInstructions (AST.Call "<=" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, LessEq] + it "Check astToInstructions Call built-in \">\"" $ do + astToInstructions (AST.Call ">" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, Great] + it "Check astToInstructions Call built-in \">=\"" $ do + astToInstructions (AST.Call ">=" [(AST.Value 42), (AST.Value 2)]) `shouldBe` [PushI 42, PushI 2, GreatEq] + + it "Check astToInstructions Call built-in \"&&\"" $ do + astToInstructions (AST.Call "&&" [(AST.Boolean True), (AST.Boolean False)]) `shouldBe` [PushB True, PushB False, And] + it "Check astToInstructions Call built-in \"||\"" $ do + astToInstructions (AST.Call "||" [(AST.Boolean True), (AST.Boolean False)]) `shouldBe` [PushB True, PushB False, Or] + + it "Check astToInstructions Define not empty" $ do + astToInstructions (AST.Define "foo" (AST.Value 42)) `shouldNotBe` [] + it "Check astToInstructions Define success" $ do + astToInstructions (AST.Define "foo" (AST.Value 42)) `shouldBe` [Def "foo" 1 [PushI 42]] + it "Check astToInstructions Define with nested Define" $ do + astToInstructions (AST.Define "foo" (AST.Define "bar" (AST.Value 42))) `shouldBe` [Def "foo" 1 [Def "bar" 1 [PushI 42]]] + it "Check astToInstructions Define with call" $ do + astToInstructions (AST.Define "foo" (AST.Call "func" [AST.Value 42])) `shouldBe` [Def "foo" 3 [PushI 42, PushS "func", Call]] From bfb1582fc8aeedcb0318ace3b46f019c079f85a4 Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 15:46:10 +0100 Subject: [PATCH 09/15] feat: showing Instructions in a human readable form and compiling instructions directly from main --- .gitignore | 1 + LobsterLang/app/Main.hs | 8 ++------ LobsterLang/src/Compiler.hs | 2 +- 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/.gitignore b/.gitignore index ce70109..066e455 100644 --- a/.gitignore +++ b/.gitignore @@ -24,3 +24,4 @@ cabal.project.local~ .stack-work glados .vscode +output diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 8264690..65811a9 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -22,15 +22,11 @@ inputLoop :: [Scope.ScopeMb] -> IO () inputLoop new = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else getLine >>= \line -> case parseTest line new of (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) - -- (Just res, stack') -> print res >> writeCompiledAstToFile "test" (compileAst res) - (Just res, stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions + (res, stack') -> print res >> inputLoop stack' + -- Compile (Just res, stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) -- | Main main :: IO () main = do - -- let c = "(define foo 21)\n(define x 5)\n(define value (* x foo))" - -- let ast = parseLisp c [] - -- putStrLn ("VAL" ++ show 5) - -- putStrLn (compileAst (fst ast)) print "Start of Interpretation Lisp" >> inputLoop [] diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 41372a7..e662092 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,7 +5,7 @@ -- Compiler -} -module Compiler (compile, astToInstructions, compileInstructions, showInstructions, Instruction(..)) where +module Compiler (compile, astToInstructions, compileInstructions, showInstructions, writeCompiledInstructionsToFile, Instruction(..)) where import AST (Ast (..)) From 468a2b07476fb084a2835a8db76920f1380bfb7f Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 16:01:27 +0100 Subject: [PATCH 10/15] style: fixing coding style in Compiler.hs (too long lines) --- LobsterLang/src/Compiler.hs | 149 ++++++++++++++++++++++++------------ 1 file changed, 101 insertions(+), 48 deletions(-) diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index e662092..8db3b8a 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -105,58 +105,99 @@ astToInstructions (Symbol symbolName) = [PushS symbolName] astToInstructions (AST.Call "-" [Value value]) = [PushI (-value)] -- Probably useless astToInstructions (AST.Call "-" [Symbol symbolName]) = PushS symbolName : [Neg] astToInstructions (AST.Call "!" [Boolean bool]) = [PushB (not bool)] -astToInstructions (AST.Call "+" args) = concatMap astToInstructions args ++ [Add] -astToInstructions (AST.Call "-" args) = concatMap astToInstructions args ++ [Sub] -astToInstructions (AST.Call "*" args) = concatMap astToInstructions args ++ [Mul] -astToInstructions (AST.Call "/" args) = concatMap astToInstructions args ++ [Div] -astToInstructions (AST.Call "%" args) = concatMap astToInstructions args ++ [Mod] -astToInstructions (AST.Call "==" args) = concatMap astToInstructions args ++ [Eq] -astToInstructions (AST.Call "<" args) = concatMap astToInstructions args ++ [Less] -astToInstructions (AST.Call "<=" args) = concatMap astToInstructions args ++ [LessEq] -astToInstructions (AST.Call ">" args) = concatMap astToInstructions args ++ [Great] -astToInstructions (AST.Call ">=" args) = concatMap astToInstructions args ++ [GreatEq] -astToInstructions (AST.Call "&&" args) = concatMap astToInstructions args ++ [And] -astToInstructions (AST.Call "||" args) = concatMap astToInstructions args ++ [Or] -astToInstructions (AST.Call "!" args) = concatMap astToInstructions args ++ [Not] -astToInstructions (AST.Call funcName args) = concatMap astToInstructions args ++ [PushS funcName] ++ [Compiler.Call] -astToInstructions (Define symbolName value) = let symbolValue = astToInstructions value - in [Def symbolName (length symbolValue) symbolValue] +astToInstructions (AST.Call "+" args) = + concatMap astToInstructions args ++ [Add] +astToInstructions (AST.Call "-" args) = + concatMap astToInstructions args ++ [Sub] +astToInstructions (AST.Call "*" args) = + concatMap astToInstructions args ++ [Mul] +astToInstructions (AST.Call "/" args) = + concatMap astToInstructions args ++ [Div] +astToInstructions (AST.Call "%" args) = + concatMap astToInstructions args ++ [Mod] +astToInstructions (AST.Call "==" args) = + concatMap astToInstructions args ++ [Eq] +astToInstructions (AST.Call "<" args) = + concatMap astToInstructions args ++ [Less] +astToInstructions (AST.Call "<=" args) = + concatMap astToInstructions args ++ [LessEq] +astToInstructions (AST.Call ">" args) = + concatMap astToInstructions args ++ [Great] +astToInstructions (AST.Call ">=" args) = + concatMap astToInstructions args ++ [GreatEq] +astToInstructions (AST.Call "&&" args) = + concatMap astToInstructions args ++ [And] +astToInstructions (AST.Call "||" args) = + concatMap astToInstructions args ++ [Or] +astToInstructions (AST.Call "!" args) = + concatMap astToInstructions args ++ [Not] +astToInstructions (AST.Call funcName args) = + concatMap astToInstructions args ++ [PushS funcName] ++ [Compiler.Call] +astToInstructions (Define symbolName value) = + let symbolValue = astToInstructions value + in [Def symbolName (length symbolValue) symbolValue] _showInstruction :: Instruction -> Int -> String -_showInstruction (PushI value) depth = concat (replicate depth "\t") ++ "PUSH_I " ++ show value ++ "\n" -_showInstruction (PushB bool) depth = concat (replicate depth "\t") ++ "PUSH_B " ++ show bool ++ "\n" -_showInstruction (PushS symbolName) depth = concat (replicate depth "\t") ++ "PUSH_S " ++ show symbolName ++ "\n" -_showInstruction (JumpIfFalse branchOffset) depth = concat (replicate depth "\t") ++ "JUMP_IF_FALSE " ++ show branchOffset ++ "\n" -_showInstruction Add depth = concat (replicate depth "\t") ++ "ADD" ++ "\n" -_showInstruction Sub depth = concat (replicate depth "\t") ++ "SUB" ++ "\n" -_showInstruction Mul depth = concat (replicate depth "\t") ++ "MUL" ++ "\n" -_showInstruction Div depth = concat (replicate depth "\t") ++ "DIV" ++ "\n" -_showInstruction Mod depth = concat (replicate depth "\t") ++ "MOD" ++ "\n" -_showInstruction Eq depth = concat (replicate depth "\t") ++ "EQ" ++ "\n" -_showInstruction Less depth = concat (replicate depth "\t") ++ "LESS" ++ "\n" -_showInstruction LessEq depth = concat (replicate depth "\t") ++ "LESS_EQ" ++ "\n" -_showInstruction Great depth = concat (replicate depth "\t") ++ "GREAT" ++ "\n" -_showInstruction GreatEq depth = concat (replicate depth "\t") ++ "GREAT_EQ" ++ "\n" -_showInstruction And depth = concat (replicate depth "\t") ++ "AND" ++ "\n" -_showInstruction Or depth = concat (replicate depth "\t") ++ "OR" ++ "\n" -_showInstruction Not depth = concat (replicate depth "\t") ++ "NOT" ++ "\n" -_showInstruction Neg depth = concat (replicate depth "\t") ++ "NEG" ++ "\n" -_showInstruction Compiler.Call depth = concat (replicate depth "\t") ++ "CALL" ++ "\n" +_showInstruction (PushI value) depth = + concat (replicate depth "\t") ++ "PUSH_I " ++ show value ++ "\n" +_showInstruction (PushB bool) depth = + concat (replicate depth "\t") ++ "PUSH_B " ++ show bool ++ "\n" +_showInstruction (PushS symbolName) depth = + concat (replicate depth "\t") ++ "PUSH_S " ++ show symbolName ++ "\n" +_showInstruction (JumpIfFalse branchOffset) depth = + concat (replicate depth "\t") + ++ "JUMP_IF_FALSE " + ++ show branchOffset ++ "\n" +_showInstruction Add depth = + concat (replicate depth "\t") ++ "ADD" ++ "\n" +_showInstruction Sub depth = + concat (replicate depth "\t") ++ "SUB" ++ "\n" +_showInstruction Mul depth = + concat (replicate depth "\t") ++ "MUL" ++ "\n" +_showInstruction Div depth = + concat (replicate depth "\t") ++ "DIV" ++ "\n" +_showInstruction Mod depth = + concat (replicate depth "\t") ++ "MOD" ++ "\n" +_showInstruction Eq depth = + concat (replicate depth "\t") ++ "EQ" ++ "\n" +_showInstruction Less depth = + concat (replicate depth "\t") ++ "LESS" ++ "\n" +_showInstruction LessEq depth = + concat (replicate depth "\t") ++ "LESS_EQ" ++ "\n" +_showInstruction Great depth = + concat (replicate depth "\t") ++ "GREAT" ++ "\n" +_showInstruction GreatEq depth = + concat (replicate depth "\t") ++ "GREAT_EQ" ++ "\n" +_showInstruction And depth = + concat (replicate depth "\t") ++ "AND" ++ "\n" +_showInstruction Or depth = + concat (replicate depth "\t") ++ "OR" ++ "\n" +_showInstruction Not depth = + concat (replicate depth "\t") ++ "NOT" ++ "\n" +_showInstruction Neg depth = + concat (replicate depth "\t") ++ "NEG" ++ "\n" +_showInstruction Compiler.Call depth = + concat (replicate depth "\t") ++ "CALL" ++ "\n" _showInstruction Ret depth = concat (replicate depth "\t") ++ "RET" ++ "\n" -_showInstruction (Def symbolName nbInstruction instructions) depth - = concat (replicate depth "\t") ++ "DEF " ++ show symbolName ++ " <" ++ show nbInstruction ++ "> =\n" ++ _showInstructions instructions (depth + 1) +_showInstruction (Def symbolName nbInstruction instructions) depth = + concat (replicate depth "\t") ++ "DEF " ++ show symbolName ++ " <" ++ + show nbInstruction ++ "> =\n" ++ _showInstructions instructions (depth + 1) _showInstructions :: [Instruction] -> Int -> String -_showInstructions instructions depth = concatMap lambda instructions where lambda x = _showInstruction x depth +_showInstructions instructions depth = + concatMap lambda instructions where lambda x = _showInstruction x depth showInstructions :: [Instruction] -> IO() showInstructions instructions = putStr (_showInstructions instructions 0) _putOpCodeFromInstruction :: Instruction -> Put -_putOpCodeFromInstruction instruction = putWord8 (fromIntegral (fromEnum instruction)) +_putOpCodeFromInstruction instruction = + putWord8 (fromIntegral (fromEnum instruction)) _putString :: String -> Put -_putString string = let byteString = BSUTF8.fromString string in putInt32le (fromIntegral (BS.length byteString)) >> putByteString byteString +_putString string = let byteString = BSUTF8.fromString string + in putInt32le (fromIntegral (BS.length byteString)) + >> putByteString byteString _putInt32 :: Int -> Put _putInt32 value = putInt32le (fromIntegral (value::Int)) @@ -165,10 +206,15 @@ _putBool :: Bool -> Put _putBool bool = putWord8 (fromIntegral (fromEnum bool)) _compileInstruction :: Instruction -> Put -_compileInstruction (PushI value) = _putOpCodeFromInstruction (PushI value) >> _putInt32 value -_compileInstruction (PushB bool) = _putOpCodeFromInstruction (PushB bool) >> _putBool bool -_compileInstruction (PushS symbolName) = _putOpCodeFromInstruction (PushS symbolName) >> _putString symbolName -_compileInstruction (JumpIfFalse branchOffset) = _putOpCodeFromInstruction (JumpIfFalse branchOffset) >> _putInt32 branchOffset +_compileInstruction (PushI value) = + _putOpCodeFromInstruction (PushI value) >> _putInt32 value +_compileInstruction (PushB bool) = + _putOpCodeFromInstruction (PushB bool) >> _putBool bool +_compileInstruction (PushS symbolName) = + _putOpCodeFromInstruction (PushS symbolName) >> _putString symbolName +_compileInstruction (JumpIfFalse branchOffset) = + _putOpCodeFromInstruction (JumpIfFalse branchOffset) + >> _putInt32 branchOffset _compileInstruction Add = _putOpCodeFromInstruction Add _compileInstruction Sub = _putOpCodeFromInstruction Sub _compileInstruction Mul = _putOpCodeFromInstruction Mul @@ -186,14 +232,21 @@ _compileInstruction Neg = _putOpCodeFromInstruction Neg _compileInstruction Compiler.Call = _putOpCodeFromInstruction Compiler.Call _compileInstruction Ret = _putOpCodeFromInstruction Ret _compileInstruction (Def symbolName nbInstruction instructions) - = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> compileInstructions instructions + = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) + >> _putString symbolName + >> _putInt32 nbInstruction + >> compileInstructions instructions compileInstructions :: [Instruction] -> Put compileInstructions [instruction] = _compileInstruction instruction -compileInstructions (instruction:instructions) = _compileInstruction instruction >> compileInstructions instructions +compileInstructions (instruction:instructions) = + _compileInstruction instruction >> compileInstructions instructions writeCompiledInstructionsToFile :: String -> Put -> IO() -writeCompiledInstructionsToFile filepath compiledInstructions = BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledInstructions) +writeCompiledInstructionsToFile filepath compiledInsts = + BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledInsts) compile :: Ast -> String -> IO() -compile ast filepath = writeCompiledInstructionsToFile filepath (compileInstructions (astToInstructions ast)) \ No newline at end of file +compile ast filepath = + writeCompiledInstructionsToFile + filepath (compileInstructions (astToInstructions ast)) \ No newline at end of file From 93c7fabfceda48f91ebc19d8e18182253728022e Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 16:32:46 +0100 Subject: [PATCH 11/15] fix: add bytestring, utf8-string, binary to all build-depends --- LobsterLang/LobsterLang.cabal | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index fa062f8..db38cf5 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -59,6 +59,9 @@ executable LobsterLang-exe build-depends: LobsterLang , base >=4.7 && <5 + , bytestring + , utf8-string + , binary default-language: Haskell2010 test-suite LobsterLang-test @@ -76,5 +79,8 @@ test-suite LobsterLang-test build-depends: LobsterLang , base >=4.7 && <5 + , bytestring + , utf8-string + , binary , hspec default-language: Haskell2010 From 6cee90e3ba980502437b8fd44df0cdb4f135f507 Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 17:19:10 +0100 Subject: [PATCH 12/15] feat: add dependencies to package.yaml --- LobsterLang/LobsterLang.cabal | 12 +++--------- LobsterLang/app/Main.hs | 7 +------ LobsterLang/package.yaml | 3 +++ LobsterLang/src/Parse.hs | 8 -------- 4 files changed, 7 insertions(+), 23 deletions(-) diff --git a/LobsterLang/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index 525f6b7..a41b95d 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -43,9 +43,9 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 - , bytestring - , utf8-string - , binary + , bytestring + , utf8-string + , binary default-language: Haskell2010 executable LobsterLang-exe @@ -60,9 +60,6 @@ executable LobsterLang-exe build-depends: LobsterLang , base >=4.7 && <5 - , bytestring - , utf8-string - , binary default-language: Haskell2010 test-suite LobsterLang-test @@ -81,8 +78,5 @@ test-suite LobsterLang-test build-depends: LobsterLang , base >=4.7 && <5 - , bytestring - , utf8-string - , binary , hspec default-language: Haskell2010 diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index d0c1bca..64f3187 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -12,15 +12,10 @@ import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) -import Compiler -import Data.Maybe (fromMaybe) -import Debug.Trace - - -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GLaDOS" else - getLine >>= \line -> case parseTest line new of + getLine >>= \line -> case parseLisp line new of (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new (Right Nothing, stack) -> inputLoop stack (Right (Just res), stack') -> print res >> inputLoop stack' diff --git a/LobsterLang/package.yaml b/LobsterLang/package.yaml index b5e08f8..5a8e84b 100644 --- a/LobsterLang/package.yaml +++ b/LobsterLang/package.yaml @@ -21,6 +21,9 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- bytestring +- utf8-string +- binary ghc-options: - -Wall diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index e13d25f..8dac2c5 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -27,7 +27,6 @@ module Parse ( parseElem, parseValue, parseLisp, - parseTest, -- parseTuple, ) where @@ -246,10 +245,3 @@ parseLisp s stack = case runParser parseSExpr s of Just (res, _) -> case AstEval.sexprToAst res of Nothing -> (Left "Cannot convert input in AST", []) Just value -> AstEval.evalAst stack value - -parseTest :: String -> [Scope.ScopeMb] -> (Maybe AST.Ast, [Scope.ScopeMb]) -parseTest s stack = case runParser parseSExpr s of - Nothing -> (Nothing, []) - Just (res, _) -> case AstEval.sexprToAst res of - Nothing -> (Nothing, []) - Just value -> (Just value, stack) From e5fad7ffd0847ae5b8a58154cf8d84787a6bd587 Mon Sep 17 00:00:00 2001 From: Aldric Date: Tue, 2 Jan 2024 17:34:47 +0100 Subject: [PATCH 13/15] fix: add missing pattern matching for [] in compileInstructions --- LobsterLang/app/Main.hs | 5 +++-- LobsterLang/src/Compiler.hs | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 64f3187..56b1d5b 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -11,6 +11,7 @@ import Parse import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) +import Compiler -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () @@ -18,8 +19,8 @@ inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GL getLine >>= \line -> case parseLisp line new of (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new (Right Nothing, stack) -> inputLoop stack - (Right (Just res), stack') -> print res >> inputLoop stack' - -- Compile (Just res, stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) + -- (Right (Just res), stack') -> print res >> inputLoop stack' + (Right (Just res), stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) -- | Main main :: IO () diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 8db3b8a..d19b03d 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -238,6 +238,7 @@ _compileInstruction (Def symbolName nbInstruction instructions) >> compileInstructions instructions compileInstructions :: [Instruction] -> Put +compileInstructions [] = putStringUtf8 "" compileInstructions [instruction] = _compileInstruction instruction compileInstructions (instruction:instructions) = _compileInstruction instruction >> compileInstructions instructions From 58747ad2e3ac0fc369a39feab4372fef2f422550 Mon Sep 17 00:00:00 2001 From: Aldric Date: Mon, 8 Jan 2024 11:28:58 +0100 Subject: [PATCH 14/15] feat: compiling FunctionValue and Cond --- LobsterLang/app/Main.hs | 4 +- LobsterLang/src/Compiler.hs | 310 +++++++++++++++++++++++++++++------- 2 files changed, 252 insertions(+), 62 deletions(-) diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 56b1d5b..0bf4576 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -19,8 +19,8 @@ inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GL getLine >>= \line -> case parseLisp line new of (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new (Right Nothing, stack) -> inputLoop stack - -- (Right (Just res), stack') -> print res >> inputLoop stack' - (Right (Just res), stack') -> print res >> let instructions = (astToInstructions res) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) + (Right (Just res), stack') -> print res >> inputLoop stack' + -- (Right (Just res), stack') -> let instructions = (astToInstructions (AST.Cond (Boolean True) (Value 1) (Just (AST.Call "CallHere" [(Value 0)])))) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) -- | Main main :: IO () diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index d19b03d..bf00a95 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -5,7 +5,14 @@ -- Compiler -} -module Compiler (compile, astToInstructions, compileInstructions, showInstructions, writeCompiledInstructionsToFile, Instruction(..)) where +module Compiler ( + compile, + astToInstructions, + compileInstructions, + showInstructions, + writeCompiledInstructionsToFile, + Instruction(..) +) where import AST (Ast (..)) @@ -15,69 +22,60 @@ import qualified Data.ByteString.UTF8 as BSUTF8 import Data.Binary import Data.Binary.Put --- PushArg for when user define a function --- absCode = - -- PushArg 0 - -- Push 0 - -- Push Less - -- Call - -- JumpIfFalse 2 - -- PushArg 0 - -- Ret - -- PushArg 0 - -- Push -1 - -- Push Mul - -- Call - -- Ret --- Push -42 --- Push absCode --- Call --- Ret - -- All if statement's possible forms are built-in instructions in java. do we do the same ? data Instruction = - -- Stack Instructions - PushI Int - | PushB Bool - | PushS String -- rename to not be confused with push string - -- Jump Instructions - | JumpIfFalse Int - -- Function Instructions - | Def String Int [Instruction] - | Call - | Ret - -- Built-in Functions / Operators - -- Arithmetic Operators - | Add - | Sub - | Mul - | Div - | Mod - -- Comparison Operators - | Eq - | Less - | LessEq - | Great - | GreatEq - -- Logical Operators - | And - | Or - | Not -- Used to invert if statements and Boolean values. - -- Unary Operators - | Neg -- Used only for negations that can not be determined at compile time (ex: Symbol negation) - deriving (Show, Eq) + NoOp + -- Stack Instructions + | PushI Int + | PushB Bool + | PushS String -- rename to not be confused with push string + -- Jump Instructions + | Jump Int + | JumpIfFalse Int + -- Function Instructions + | Def String Int [Instruction] + | Fnv Int [String] Int [Instruction] [Int] (Maybe [[Instruction]]) + | Call + | Ret + -- Logical Instructions + | Cond Int [Instruction] Int [Instruction] Int (Maybe [Instruction]) + -- Built-in Functions / Operators + -- Arithmetic Operators + | Add + | Sub + | Mul + | Div + | Mod + -- Comparison Operators + | Eq + | Less + | LessEq + | Great + | GreatEq + -- Logical Operators + | And + | Or + | Not -- Used to invert if statements and Boolean values. + -- Unary Operators + | Neg -- Used only for negations that can not be determined at compile time (ex: Symbol negation) + deriving (Show, Eq) instance Enum Instruction where + fromEnum NoOp = 0 -- Stack Instructions [10 - 30] fromEnum (PushI _) = 10 fromEnum (PushB _) = 11 fromEnum (PushS _) = 12 -- Jump Instructions [30 - 40] - fromEnum (JumpIfFalse _) = 30 - -- Function Instructions [40 - 50] + fromEnum (Jump _) = 30 + fromEnum (JumpIfFalse _) = 31 + -- Function Instructions [40 - 45] fromEnum (Def {}) = 40 - fromEnum Compiler.Call = 41 - fromEnum Ret = 42 + fromEnum (Fnv {}) = 41 + fromEnum Compiler.Call = 42 + fromEnum Ret = 43 + -- Logical Instructions [45 - 50] + fromEnum (Compiler.Cond {}) = 45 -- Built-in Functions / Operators [50 - 90] -- Arithmetic Operators [50 - 60] fromEnum Add = 50 @@ -98,6 +96,33 @@ instance Enum Instruction where -- Unary Operators [80 - 90] fromEnum Neg = 80 + toEnum 0 = (NoOp) + toEnum 10 = (PushI 0) + toEnum 11 = (PushB False) + toEnum 12 = (PushS "") + toEnum 30 = (Jump 0) + toEnum 31 = (JumpIfFalse 0) + toEnum 40 = (Def "" 0 []) + toEnum 41 = (Fnv 0 [] 0 [] [] Nothing) + toEnum 42 = Compiler.Call + toEnum 43 = Ret + toEnum 45 = (Compiler.Cond 0 [] 0 [] 0 Nothing) + toEnum 50 = (Add) + toEnum 51 = (Sub) + toEnum 52 = (Mul) + toEnum 53 = (Div) + toEnum 54 = (Mod) + toEnum 60 = (Eq) + toEnum 61 = (Less) + toEnum 62 = (LessEq) + toEnum 63 = (Great) + toEnum 64 = (GreatEq) + toEnum 70 = (And) + toEnum 71 = (Or) + toEnum 72 = (Not) + toEnum 80 = (Neg) + toEnum _ = (NoOp) + astToInstructions :: Ast -> [Instruction] astToInstructions (Value value) = [PushI value] astToInstructions (Boolean bool) = [PushB bool] @@ -136,14 +161,71 @@ astToInstructions (AST.Call funcName args) = astToInstructions (Define symbolName value) = let symbolValue = astToInstructions value in [Def symbolName (length symbolValue) symbolValue] +astToInstructions (FunctionValue argsNames funcBody Nothing) = \ + [ Fnv + (length argsNames) + argsNames + (length funcBodyInstructions) + funcBodyInstructions + [] + Nothing ] + where + funcBodyInstructions = astToInstructions funcBody +astToInstructions (FunctionValue argsNames funcBody (Just argsValues)) = \ + [ Fnv + (length argsNames) + argsNames + (length funcBodyInstructions) + funcBodyInstructions + nbArgsValuesInstructions + argsValuesInstructions ] + where + funcBodyInstructions = astToInstructions funcBody + argsValuesInstructions = (Just (map astToInstructions argsValues)) + nbArgsValuesInstructions = (_instructionListLengths argsValuesInstructions) +astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) = \ + [ Compiler.Cond + nbCondInstructions + condInstructions + nbTrueBlockInstructions + trueBlockInstructions + nbFalseBlockInstructions + (Just falseBlockInstructions) ] + where + condInstructions = astToInstructions cond + nbCondInstructions = length condInstructions + falseBlockInstructions = astToInstructions falseBlock + nbFalseBlockInstructions = length falseBlockInstructions + trueBlockInstructions = + astToInstructions trueBlock ++ [Jump nbFalseBlockInstructions] + nbTrueBlockInstructions = length trueBlockInstructions +astToInstructions (AST.Cond cond trueBlock Nothing) = \ + [ Compiler.Cond + nbCondInstructions + condInstructions + nbTrueBlockInstructions + trueBlockInstructions + 0 + Nothing ] + where + condInstructions = astToInstructions cond + nbCondInstructions = length condInstructions + trueBlockInstructions = astToInstructions trueBlock + nbTrueBlockInstructions = length trueBlockInstructions _showInstruction :: Instruction -> Int -> String +_showInstruction (NoOp) depth = + concat (replicate depth "\t") ++ "NO_OP\n" _showInstruction (PushI value) depth = concat (replicate depth "\t") ++ "PUSH_I " ++ show value ++ "\n" _showInstruction (PushB bool) depth = concat (replicate depth "\t") ++ "PUSH_B " ++ show bool ++ "\n" _showInstruction (PushS symbolName) depth = concat (replicate depth "\t") ++ "PUSH_S " ++ show symbolName ++ "\n" +_showInstruction (Jump branchOffset) depth = + concat (replicate depth "\t") + ++ "JUMP " + ++ show branchOffset ++ "\n" _showInstruction (JumpIfFalse branchOffset) depth = concat (replicate depth "\t") ++ "JUMP_IF_FALSE " @@ -182,6 +264,64 @@ _showInstruction Ret depth = concat (replicate depth "\t") ++ "RET" ++ "\n" _showInstruction (Def symbolName nbInstruction instructions) depth = concat (replicate depth "\t") ++ "DEF " ++ show symbolName ++ " <" ++ show nbInstruction ++ "> =\n" ++ _showInstructions instructions (depth + 1) +_showInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions nbArgsValuesInstructions + (Just argsValuesInstructions)) depth = + concat (replicate depth "\t") ++ + "FNV " ++ + "(" ++ show nbArgsNames ++ ")" ++ + show argsNames ++ + " (" ++ show nbArgsValuesInstructions ++ ")" ++ + "(\n" ++ _showInstructionList argsValuesInstructions (depth + 1) ++ ")" ++ + " = (" ++ show nbFuncBodyInstructions ++ + "){\n" ++ _showInstructions funcBodyInstructions (depth + 1) ++ "}\n" + +_showInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions _ Nothing) depth = + concat (replicate depth "\t") ++ + "FNV " ++ + "(" ++ show nbArgsNames ++ ")" ++ + show argsNames ++ + " = (" ++ show nbFuncBodyInstructions ++ + "){\n" ++ _showInstructions funcBodyInstructions (depth + 1) ++ "}\n" +_showInstruction (Compiler.Cond nbCondInstructions condInstructions + nbTrueBlockInstructions trueBlockInstructions nbFalseBlockInstructions + (Just falseBlockInstructions)) depth = + concat (replicate depth "\t") ++ + "COND " ++ + "(" ++ show nbCondInstructions ++ ")" ++ + "(\n" ++ _showInstructions condInstructions (depth + 1) ++ + (_showInstruction (JumpIfFalse nbTrueBlockInstructions) 0) ++ ")" ++ + " true: (" ++ show nbTrueBlockInstructions ++ + "){\n" ++ (_showInstructions trueBlockInstructions (depth + 1)) ++ "}" ++ + " false: (" ++ show nbFalseBlockInstructions ++ + "){\n" ++ (_showInstructions falseBlockInstructions (depth + 1)) ++ "}\n" +_showInstruction (Compiler.Cond nbCondInstructions condInstructions + nbTrueBlockInstructions trueBlockInstructions _ + Nothing) depth = + concat (replicate depth "\t") ++ + "COND " ++ + "(" ++ show nbCondInstructions ++ ")" ++ + "(\n" ++ _showInstructions condInstructions (depth + 1) ++ + (_showInstruction (JumpIfFalse nbTrueBlockInstructions) 0) ++ ")" ++ + " true: (" ++ show nbTrueBlockInstructions ++ + "){\n" ++ (_showInstructions trueBlockInstructions (depth + 1)) ++ "}" ++ + " false: {}\n" + +_instructionListLengths :: (Maybe [[Instruction]]) -> [Int] +_instructionListLengths (Just []) = [0] +_instructionListLengths (Just [instructionList]) = [length instructionList] +_instructionListLengths (Just (instructionList:instructionLists)) = + [length instructionList] ++ _instructionListLengths (Just instructionLists) +_instructionListLengths Nothing = [] + +_showInstructionList :: [[Instruction]] -> Int -> String +_showInstructionList [] _ = "" +_showInstructionList [instructions] depth = + _showInstructions instructions depth +_showInstructionList (instructions:instructionsList) depth = + _showInstructions instructions depth ++ + "\n" ++ _showInstructionList instructionsList depth _showInstructions :: [Instruction] -> Int -> String _showInstructions instructions depth = @@ -194,6 +334,11 @@ _putOpCodeFromInstruction :: Instruction -> Put _putOpCodeFromInstruction instruction = putWord8 (fromIntegral (fromEnum instruction)) +_fputList :: (a -> Put) -> [a] -> Put +_fputList _ [] = _putString "" +_fputList func [element] = func element +_fputList func (element:elements) = func element >> _fputList func elements + _putString :: String -> Put _putString string = let byteString = BSUTF8.fromString string in putInt32le (fromIntegral (BS.length byteString)) @@ -206,12 +351,16 @@ _putBool :: Bool -> Put _putBool bool = putWord8 (fromIntegral (fromEnum bool)) _compileInstruction :: Instruction -> Put +_compileInstruction (NoOp) = _putOpCodeFromInstruction (NoOp) _compileInstruction (PushI value) = _putOpCodeFromInstruction (PushI value) >> _putInt32 value _compileInstruction (PushB bool) = _putOpCodeFromInstruction (PushB bool) >> _putBool bool _compileInstruction (PushS symbolName) = _putOpCodeFromInstruction (PushS symbolName) >> _putString symbolName +_compileInstruction (Jump branchOffset) = + _putOpCodeFromInstruction (Jump branchOffset) + >> _putInt32 branchOffset _compileInstruction (JumpIfFalse branchOffset) = _putOpCodeFromInstruction (JumpIfFalse branchOffset) >> _putInt32 branchOffset @@ -232,16 +381,57 @@ _compileInstruction Neg = _putOpCodeFromInstruction Neg _compileInstruction Compiler.Call = _putOpCodeFromInstruction Compiler.Call _compileInstruction Ret = _putOpCodeFromInstruction Ret _compileInstruction (Def symbolName nbInstruction instructions) - = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) + = _putOpCodeFromInstruction (Def symbolName nbInstruction instructions) >> _putString symbolName >> _putInt32 nbInstruction >> compileInstructions instructions +_compileInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions nbArgsValuesInstructions + (Just argsValuesInstructions)) = + _putOpCodeFromInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions nbArgsValuesInstructions + (Just argsValuesInstructions)) + >> _putInt32 nbArgsNames + >> _fputList _putString argsNames + >> _putInt32 nbFuncBodyInstructions + >> _fputList _compileInstruction funcBodyInstructions + >> _putInt32 (length nbArgsValuesInstructions) + >> _fputList _putInt32 nbArgsValuesInstructions + >> _fputList compileInstructions argsValuesInstructions +_compileInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions nbArgsValuesInstructions Nothing) = + _putOpCodeFromInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions + funcBodyInstructions nbArgsValuesInstructions Nothing) + >> _putInt32 nbArgsNames + >> _fputList _putString argsNames + >> _putInt32 nbFuncBodyInstructions + >> _fputList _compileInstruction funcBodyInstructions +_compileInstruction (Compiler.Cond nbCondInstructions condInstructions + nbTrueBlockInstructions trueBlockInstructions nbFalseBlockInstructions + (Just falseBlockInstructions)) = + _putOpCodeFromInstruction (Compiler.Cond nbCondInstructions + condInstructions nbTrueBlockInstructions trueBlockInstructions + nbFalseBlockInstructions (Just falseBlockInstructions)) + >> _putInt32 nbCondInstructions + >> _fputList _compileInstruction condInstructions + >> _compileInstruction (JumpIfFalse nbTrueBlockInstructions) + >> _fputList _compileInstruction trueBlockInstructions + >> _putInt32 nbFalseBlockInstructions + >> _fputList _compileInstruction falseBlockInstructions +_compileInstruction (Compiler.Cond nbCondInstructions condInstructions + nbTrueBlockInstructions trueBlockInstructions nbFalseBlockInstructions + Nothing) = + _putOpCodeFromInstruction (Compiler.Cond nbCondInstructions + condInstructions nbTrueBlockInstructions trueBlockInstructions + nbFalseBlockInstructions Nothing) + >> _putInt32 nbCondInstructions + >> _fputList _compileInstruction condInstructions + >> _compileInstruction (JumpIfFalse nbTrueBlockInstructions) + >> _fputList _compileInstruction trueBlockInstructions + >> _putInt32 nbFalseBlockInstructions compileInstructions :: [Instruction] -> Put -compileInstructions [] = putStringUtf8 "" -compileInstructions [instruction] = _compileInstruction instruction -compileInstructions (instruction:instructions) = - _compileInstruction instruction >> compileInstructions instructions +compileInstructions instructions = _fputList _compileInstruction instructions writeCompiledInstructionsToFile :: String -> Put -> IO() writeCompiledInstructionsToFile filepath compiledInsts = @@ -250,4 +440,4 @@ writeCompiledInstructionsToFile filepath compiledInsts = compile :: Ast -> String -> IO() compile ast filepath = writeCompiledInstructionsToFile - filepath (compileInstructions (astToInstructions ast)) \ No newline at end of file + filepath (_fputList _compileInstruction (astToInstructions ast)) \ No newline at end of file From 421592f2438029db2ae4a45525b729831df9b3d9 Mon Sep 17 00:00:00 2001 From: Aldric Date: Mon, 8 Jan 2024 12:30:24 +0100 Subject: [PATCH 15/15] style: fixing coding style in Compiler.hs --- LobsterLang/src/Compiler.hs | 80 ++++++++++++++++++------------------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index bf00a95..c0dd2b5 100644 --- a/LobsterLang/src/Compiler.hs +++ b/LobsterLang/src/Compiler.hs @@ -96,32 +96,32 @@ instance Enum Instruction where -- Unary Operators [80 - 90] fromEnum Neg = 80 - toEnum 0 = (NoOp) - toEnum 10 = (PushI 0) - toEnum 11 = (PushB False) - toEnum 12 = (PushS "") - toEnum 30 = (Jump 0) - toEnum 31 = (JumpIfFalse 0) - toEnum 40 = (Def "" 0 []) - toEnum 41 = (Fnv 0 [] 0 [] [] Nothing) + toEnum 0 = NoOp + toEnum 10 = PushI 0 + toEnum 11 = PushB False + toEnum 12 = PushS "" + toEnum 30 = Jump 0 + toEnum 31 = JumpIfFalse 0 + toEnum 40 = Def "" 0 [] + toEnum 41 = Fnv 0 [] 0 [] [] Nothing toEnum 42 = Compiler.Call toEnum 43 = Ret - toEnum 45 = (Compiler.Cond 0 [] 0 [] 0 Nothing) - toEnum 50 = (Add) - toEnum 51 = (Sub) - toEnum 52 = (Mul) - toEnum 53 = (Div) - toEnum 54 = (Mod) - toEnum 60 = (Eq) - toEnum 61 = (Less) - toEnum 62 = (LessEq) - toEnum 63 = (Great) - toEnum 64 = (GreatEq) - toEnum 70 = (And) - toEnum 71 = (Or) - toEnum 72 = (Not) - toEnum 80 = (Neg) - toEnum _ = (NoOp) + toEnum 45 = Compiler.Cond 0 [] 0 [] 0 Nothing + toEnum 50 = Add + toEnum 51 = Sub + toEnum 52 = Mul + toEnum 53 = Div + toEnum 54 = Mod + toEnum 60 = Eq + toEnum 61 = Less + toEnum 62 = LessEq + toEnum 63 = Great + toEnum 64 = GreatEq + toEnum 70 = And + toEnum 71 = Or + toEnum 72 = Not + toEnum 80 = Neg + toEnum _ = NoOp astToInstructions :: Ast -> [Instruction] astToInstructions (Value value) = [PushI value] @@ -161,7 +161,7 @@ astToInstructions (AST.Call funcName args) = astToInstructions (Define symbolName value) = let symbolValue = astToInstructions value in [Def symbolName (length symbolValue) symbolValue] -astToInstructions (FunctionValue argsNames funcBody Nothing) = \ +astToInstructions (FunctionValue argsNames funcBody Nothing) = [ Fnv (length argsNames) argsNames @@ -171,7 +171,7 @@ astToInstructions (FunctionValue argsNames funcBody Nothing) = \ Nothing ] where funcBodyInstructions = astToInstructions funcBody -astToInstructions (FunctionValue argsNames funcBody (Just argsValues)) = \ +astToInstructions (FunctionValue argsNames funcBody (Just argsValues)) = [ Fnv (length argsNames) argsNames @@ -181,9 +181,9 @@ astToInstructions (FunctionValue argsNames funcBody (Just argsValues)) = \ argsValuesInstructions ] where funcBodyInstructions = astToInstructions funcBody - argsValuesInstructions = (Just (map astToInstructions argsValues)) - nbArgsValuesInstructions = (_instructionListLengths argsValuesInstructions) -astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) = \ + argsValuesInstructions = Just (map astToInstructions argsValues) + nbArgsValuesInstructions = _instructionListLengths argsValuesInstructions +astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) = [ Compiler.Cond nbCondInstructions condInstructions @@ -199,7 +199,7 @@ astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) = \ trueBlockInstructions = astToInstructions trueBlock ++ [Jump nbFalseBlockInstructions] nbTrueBlockInstructions = length trueBlockInstructions -astToInstructions (AST.Cond cond trueBlock Nothing) = \ +astToInstructions (AST.Cond cond trueBlock Nothing) = [ Compiler.Cond nbCondInstructions condInstructions @@ -214,7 +214,7 @@ astToInstructions (AST.Cond cond trueBlock Nothing) = \ nbTrueBlockInstructions = length trueBlockInstructions _showInstruction :: Instruction -> Int -> String -_showInstruction (NoOp) depth = +_showInstruction NoOp depth = concat (replicate depth "\t") ++ "NO_OP\n" _showInstruction (PushI value) depth = concat (replicate depth "\t") ++ "PUSH_I " ++ show value ++ "\n" @@ -291,11 +291,11 @@ _showInstruction (Compiler.Cond nbCondInstructions condInstructions "COND " ++ "(" ++ show nbCondInstructions ++ ")" ++ "(\n" ++ _showInstructions condInstructions (depth + 1) ++ - (_showInstruction (JumpIfFalse nbTrueBlockInstructions) 0) ++ ")" ++ + _showInstruction (JumpIfFalse nbTrueBlockInstructions) 0 ++ ")" ++ " true: (" ++ show nbTrueBlockInstructions ++ - "){\n" ++ (_showInstructions trueBlockInstructions (depth + 1)) ++ "}" ++ + "){\n" ++ _showInstructions trueBlockInstructions (depth + 1) ++ "}" ++ " false: (" ++ show nbFalseBlockInstructions ++ - "){\n" ++ (_showInstructions falseBlockInstructions (depth + 1)) ++ "}\n" + "){\n" ++ _showInstructions falseBlockInstructions (depth + 1) ++ "}\n" _showInstruction (Compiler.Cond nbCondInstructions condInstructions nbTrueBlockInstructions trueBlockInstructions _ Nothing) depth = @@ -303,16 +303,16 @@ _showInstruction (Compiler.Cond nbCondInstructions condInstructions "COND " ++ "(" ++ show nbCondInstructions ++ ")" ++ "(\n" ++ _showInstructions condInstructions (depth + 1) ++ - (_showInstruction (JumpIfFalse nbTrueBlockInstructions) 0) ++ ")" ++ + _showInstruction (JumpIfFalse nbTrueBlockInstructions) 0 ++ ")" ++ " true: (" ++ show nbTrueBlockInstructions ++ - "){\n" ++ (_showInstructions trueBlockInstructions (depth + 1)) ++ "}" ++ + "){\n" ++ _showInstructions trueBlockInstructions (depth + 1) ++ "}" ++ " false: {}\n" -_instructionListLengths :: (Maybe [[Instruction]]) -> [Int] +_instructionListLengths :: Maybe [[Instruction]] -> [Int] _instructionListLengths (Just []) = [0] _instructionListLengths (Just [instructionList]) = [length instructionList] _instructionListLengths (Just (instructionList:instructionLists)) = - [length instructionList] ++ _instructionListLengths (Just instructionLists) + length instructionList : _instructionListLengths (Just instructionLists) _instructionListLengths Nothing = [] _showInstructionList :: [[Instruction]] -> Int -> String @@ -351,7 +351,7 @@ _putBool :: Bool -> Put _putBool bool = putWord8 (fromIntegral (fromEnum bool)) _compileInstruction :: Instruction -> Put -_compileInstruction (NoOp) = _putOpCodeFromInstruction (NoOp) +_compileInstruction NoOp = _putOpCodeFromInstruction NoOp _compileInstruction (PushI value) = _putOpCodeFromInstruction (PushI value) >> _putInt32 value _compileInstruction (PushB bool) = @@ -431,7 +431,7 @@ _compileInstruction (Compiler.Cond nbCondInstructions condInstructions >> _putInt32 nbFalseBlockInstructions compileInstructions :: [Instruction] -> Put -compileInstructions instructions = _fputList _compileInstruction instructions +compileInstructions = _fputList _compileInstruction writeCompiledInstructionsToFile :: String -> Put -> IO() writeCompiledInstructionsToFile filepath compiledInsts =