diff --git a/.github/workflows/Tests.yml b/.github/workflows/Tests.yml index 218c673..261129a 100644 --- a/.github/workflows/Tests.yml +++ b/.github/workflows/Tests.yml @@ -14,32 +14,14 @@ jobs: check_style: runs-on: ubuntu-latest steps: - - name: Checkout - uses: actions/checkout@v3 - - name: Clone Epitech Coding style - run: git clone https://github.com/Epitech/coding-style-checker.git - - name: Access cloned repository content - run: | - chmod +x ./coding-style-checker/coding-style.sh - ./coding-style-checker/coding-style.sh . . - cat coding-style-reports.log - - name: Verify coding style - run: | - error=false - while IFS= read -r line; do - if [[ $line =~ (MAJOR|MINOR|INFO) ]]; then - IFS=': ' - read -r -a array <<< "$line" - echo "::error title=Coding style error:: file:${array[0]}, line:${array[1]}, coding-style:${array[2]}-${array[3]}" - error=true - fi - done < coding-style-reports.log - if [ $error = true ] - then - exit 1 - else - exit 0 - fi + - uses: actions/checkout@v3 + - name: Set up HLint + uses: haskell-actions/hlint-setup@v2 + - name: Run HLint + uses: haskell-actions/hlint-run@v2 + with: + path: '["LobsterLang/src/", "LobsterLang/app"]' + fail-on: warning check_compilation: runs-on: ubuntu-latest steps: 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/LobsterLang.cabal b/LobsterLang/LobsterLang.cabal index db06005..b6ca935 100644 --- a/LobsterLang/LobsterLang.cabal +++ b/LobsterLang/LobsterLang.cabal @@ -28,6 +28,7 @@ library AST AstEval AstOptimizer + Compiler Parse Scope SExpr @@ -42,6 +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 + , binary + , bytestring + , utf8-string default-language: Haskell2010 executable LobsterLang-exe @@ -56,6 +60,9 @@ executable LobsterLang-exe build-depends: LobsterLang , base >=4.7 && <5 + , binary + , bytestring + , utf8-string default-language: Haskell2010 test-suite LobsterLang-test @@ -64,6 +71,7 @@ test-suite LobsterLang-test other-modules: AstEvalSpec AstOptimizerSpec + CompilerSpec VmSpec Paths_LobsterLang autogen-modules: @@ -74,5 +82,8 @@ test-suite LobsterLang-test build-depends: LobsterLang , base >=4.7 && <5 + , binary + , bytestring , hspec + , utf8-string default-language: Haskell2010 diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 0113768..917a7d3 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -12,47 +12,58 @@ import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) import System.Environment (getArgs) +import qualified AstEval import Control.Exception -import SExpr (SExpr) +import qualified AST +-- import Compiler + +-- | Return a Result that contain the evaluation of our Lisp String +-- Takes as parameter the string that need to be evaluated and the Stack (Environment) +interpretateLisp :: AST.Ast -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) +interpretateLisp value stack = case AstEval.evalAst stack value of + (Left err, _) -> Left err + (Right res', stack') -> Right (res', stack') -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () -- inputLoop = print inputLoop stack = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else - getLine >>= \line -> case runParser parseLisp (0, 0) line of - Left err -> print err >> exitWith (ExitFailure 84) - Right (res, _, _) -> interpretateInfo res stack + getLine >>= \line -> case runParser parseLobster (0, 0) line of + Left err -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack + Right (res, [], _) -> interpretateInfo res stack + Right (_, _, pos) -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ errorParsing pos ++ "\ESC[0m") >> inputLoop stack -interpretateInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () -interpretateInfo [] _ = putStr "" +interpretateInfo :: [AST.Ast] -> [Scope.ScopeMb] -> IO () +interpretateInfo [] stack = inputLoop stack interpretateInfo (x:xs) stack = case interpretateLisp x stack of - Left err -> print err + Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack Right (res, stack') -> case res of Nothing -> interpretateInfo xs stack' - Just value -> print value >> print stack' >> interpretateInfo xs stack' + Just value -> print value >> interpretateInfo xs stack' + +compileInfo :: [AST.Ast] -> [Scope.ScopeMb] -> IO () +compileInfo [] _ = putStr "" +compileInfo (x:xs) stack = case interpretateLisp x stack of + Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> exitWith (ExitFailure 84) + Right (res, stack') -> case res of + Nothing -> compileInfo xs stack' + Just value -> print value >> compileInfo xs stack' compileFile :: String -> IO () -compileFile s = case runParser parseLisp (0, 0) s of +compileFile s = case runParser parseLobster (0, 0) s of Left err -> print err >> exitWith (ExitFailure 84) - Right (res, _, _) -> interpretateInfo res [] + Right (res, [], _) -> print res >> compileInfo res [] + Right (_, _, (row, col)) -> print ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + -- (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) + checkArgs :: [String] -> IO () -checkArgs ("-i": _) = print "Launch Interpreter" >> inputLoop [] +checkArgs [] = print "Launch Interpreter" >> inputLoop [] checkArgs (file:_) = either (\_ -> print "File doesn't exist" >> exitWith (ExitFailure 84)) compileFile =<< (try (readFile file) :: IO (Either SomeException String)) -checkArgs _ = exitWith (ExitFailure 84) -- | Main main :: IO () main = getArgs >>= \argv -> checkArgs argv --- inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GLaDOS" else --- 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' - --- -- | Main --- main :: IO () --- main = putStrLn "Start of Interpretation Lisp" >> inputLoop [] 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/AstEval.hs b/LobsterLang/src/AstEval.hs index f337933..606589c 100644 --- a/LobsterLang/src/AstEval.hs +++ b/LobsterLang/src/AstEval.hs @@ -6,8 +6,7 @@ -} module AstEval - ( sexprToAst, - evalAst, + ( evalAst, evalBiValOp, evalBiBoolOp, evalBiCompValOp, @@ -16,22 +15,8 @@ where import AST import Data.Bifunctor -import SExpr import Scope --- | Convert a S-expression into an 'Ast', --- return Nothing if the expression is invalid or Just the Ast -sexprToAst :: SExpr -> Maybe Ast -sexprToAst (SExpr.List [SExpr.Symbol "define", SExpr.Symbol s, t]) = - Define s <$> sexprToAst t -sexprToAst (SExpr.List (SExpr.Symbol f : xs)) = - Call f <$> mapM sexprToAst xs -sexprToAst (SExpr.List _) = Nothing -sexprToAst (SExpr.Value i) = Just (AST.Value i) -sexprToAst (SExpr.Symbol "true") = Just (Boolean True) -sexprToAst (SExpr.Symbol "false") = Just (Boolean False) -sexprToAst (SExpr.Symbol s) = Just (AST.Symbol s Nothing) - noEvaluationError :: String -> String noEvaluationError s = "No evaluation in one or more parameters of " ++ s diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs new file mode 100644 index 0000000..76df89c --- /dev/null +++ b/LobsterLang/src/Compiler.hs @@ -0,0 +1,443 @@ +{- +-- EPITECH PROJECT, 2023 +-- LobsterLang +-- File description: +-- Compiler +-} + +module Compiler ( + compile, + astToInstructions, + compileInstructions, + showInstructions, + writeCompiledInstructionsToFile, + Instruction(..) +) 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 + +-- All if statement's possible forms are built-in instructions in java. do we do the same ? +data Instruction = + 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 (Jump _) = 30 + fromEnum (JumpIfFalse _) = 31 + -- Function Instructions [40 - 45] + fromEnum (Def {}) = 40 + 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 + 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 + + 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] +astToInstructions (Symbol symbolName Nothing) = [PushS symbolName] +astToInstructions (AST.Call "-" [Value value]) = [PushI (-value)] -- Probably useless +astToInstructions (AST.Call "-" [Symbol symbolName Nothing]) = 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 (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 " + ++ 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 (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 = + 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)) + +_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)) + >> putByteString byteString + +_putInt32 :: Int -> Put +_putInt32 value = putInt32le (fromIntegral (value::Int)) + +_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 +_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 Ret = _putOpCodeFromInstruction Ret +_compileInstruction (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 = _fputList _compileInstruction + +writeCompiledInstructionsToFile :: String -> Put -> IO() +writeCompiledInstructionsToFile filepath compiledInsts = + BS.writeFile filepath (BS.concat $ BSL.toChunks $ runPut compiledInsts) + +compile :: Ast -> String -> IO() +compile ast filepath = + writeCompiledInstructionsToFile + filepath (_fputList _compileInstruction (astToInstructions ast)) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 83ebe38..8f7f7cc 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -22,35 +22,38 @@ module Parse ( parseSign, parseDigit, parseBool, - parseSExpr, - parseSymbol, + parseAst, parseElem, parseValue, - parseLisp, + parseLobster, parseAnyString, - parseSpace, - parseLine, - interpretateLisp, - -- parseTuple, + parseDefineValue, + parseUnaryOperation, + parseProduct, + parseSum, + parseExpr, + parseTrue, + parseFalse, + parseAstString, + parseWhiteSpace, + errorParsing ) where -import SExpr - -import Control.Applicative (Alternative (..)) -import qualified AstEval import qualified AST -import qualified Scope -import GHC.IO.SubSystem (IoSubSystem(IoPOSIX)) +import Control.Applicative +import Data.Maybe -type Col = Int -type Row = Int type Position = (Int, Int) data Parser a = Parser { runParser :: Position -> String -> Either String (a, String, Position) +} +data Token = Number Int + | Sym String + | Identifier String + deriving(Show, Eq) -} -- | Instance Functor of the data Parser instance Functor Parser where @@ -64,7 +67,7 @@ instance Functor Parser where -- | Instance Applicative of the data Parser instance Applicative Parser where - -- pure result = Parser (\_ -> Left (result, "",)) + pure result = Parser (\pos s -> Right (result, s, pos)) (<*>) parserA parserB = Parser @@ -99,6 +102,15 @@ instance Monad Parser where Right (res, s', pos') -> runParser (b res) pos' s' ) +errorParsing :: (Int, Int) -> String +errorParsing (row, col) = "Error on parsing on '" ++ show row ++ "' '" ++ show col ++ "'" + +startCharacter :: String +startCharacter = ['a'..'z'] ++ ['A'..'Z'] ++ "_" + +lobsterCharacter :: String +lobsterCharacter = startCharacter ++ ['0'..'9'] + -- | Parse a character c -- Takes the character that need to be parsed -- Returns a data Parser that contain the character and the rest of the string @@ -106,9 +118,13 @@ parseChar :: Char -> Parser Char parseChar c = Parser (f c) where f :: Char -> Position -> String -> Either String (Char, String, Position) - f '\n' (row, col) (x:xs) = if '\n' == x then Right ('\n', xs, (row + 1, 0)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) - f char (row, col) (x:xs) = if char == x then Right (char, xs, (row, col + 1)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) - f _ (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f '\n' (row, col) (x:xs) + | x == '\n' = Right ('\n', xs, (row + 1, 0)) + | otherwise = Left (errorParsing (row, col)) + f char (row, col) (x:xs) + | x == char = Right (char, xs, (row, col + 1)) + | otherwise = Left (errorParsing (row, col)) + f _ (row, col) _ = Left (errorParsing (row, col)) -- | Parse with the first or the second parser -- Takes two parsers @@ -130,7 +146,7 @@ parseAnd parserA parserB = Parser (f parserA parserB) Right (res', s'', pos'') -> Right ((res, res'), s'', pos'') -- | Parse with function after the two parsers --- Takes two parsers and a function +-- Takes two parsers and a fh (\x _ -> x) unction -- Returns the result of the function with the result of the parseAnd parseAndWith :: (a -> b -> c) -> Parser a -> Parser b -> Parser c parseAndWith f' parserA parseB = Parser (f f' parserA parseB) @@ -174,10 +190,7 @@ parseSign = parseChar '-' <|> parseChar '+' -- | Return a data Parser that parse a digit parseDigit :: Parser Char -parseDigit = parseChar '0' <|> parseChar '1' <|> parseChar '2' <|> - parseChar '3' <|> parseChar '4' <|> parseChar '5' <|> - parseChar '6' <|> parseChar '7' <|> parseChar '8' <|> - parseChar '9' +parseDigit = parseAnyChar ['0'..'9'] -- | Return a data Parser that parse a Int parseInt :: Parser Int @@ -187,38 +200,102 @@ parseInt = Parser f f pos ('-':xs) = runParser ((\x -> -x) <$> parseUInt) pos xs f pos s = runParser parseUInt pos s --- | Return a data Parser that parse multiple space -parseSpace :: Parser [Char] -parseSpace = parseMany (parseChar ' ') - -parseLine :: Parser [Char] -parseLine = parseMany (parseChar '\n') +parseWhiteSpace :: Parser [Char] +parseWhiteSpace = parseMany (parseAnyChar "\n\t ") -- | Parse with a parser and, if possible with a space -- Return a Parser that parse element with the given parser and, if possible with multiple space parseElem :: Parser a -> Parser a -parseElem parser = parseAndWith (\x _ -> x) parser parseSpace <|> parser +parseElem parser = parseAndWith (\x _ -> x) parser parseWhiteSpace <|> parser -- | Return a data Parser that parse a String parseString :: Parser String -parseString = parseSpace *> parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ "-*/%+#")) <* parseSpace +parseString = parseWhiteSpace *> Parser f <* parseWhiteSpace + where + f :: Position -> String -> Either String (String, String, Position) + f pos s = case runParser (parseSome (parseAnyChar startCharacter)) pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseMany (parseAnyChar lobsterCharacter)) pos' s' of + Left _ -> Right (res, s', pos') + Right (res', s'', pos'') -> Right (res ++ res', s'', pos'') -- | Return a data Parser that parse a String as a Symbol -parseSymbol :: Parser SExpr -parseSymbol = Symbol <$> parseElem parseString +parseAstString :: Parser AST.Ast +parseAstString = AST.String <$> (parseChar '"' *> parseElem parseString <* parseChar '"') + +-- parseSymbol :: Parser AST.Ast +-- parseSymbol = AST.Symbol <$> parseElem parseString + +parseExpr :: Parser AST.Ast +parseExpr = parseCombinatorOperator + +parseCombinatorOperator :: Parser AST.Ast +parseCombinatorOperator = do res <- parseBoolOperator + res' <- optional (parseWhiteSpace *> parseChar '$' + >>= \res' -> parseCombinatorOperator + >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' + +parseBoolOperator :: Parser AST.Ast +parseBoolOperator = do res <- parseCompOperator + res' <- optional (parseAnyString "&&" <|> + parseAnyString "||" <|> + parseAnyString "^^" + >>= \res' -> parseBoolOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' + +parseCompOperator :: Parser AST.Ast +parseCompOperator = do res <- parseSum + res' <- optional (parseWhiteSpace *> parseAnyString "==" <|> + parseWhiteSpace *> parseAnyString ">=" <|> + parseWhiteSpace *> parseAnyString "!=" <|> + parseWhiteSpace *> parseAnyString "<=" <|> + parseWhiteSpace *> parseAnyString ">" <|> + parseWhiteSpace *> parseAnyString "<" + >>= \res' -> parseCompOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' + +parseSum :: Parser AST.Ast +parseSum = do res <- parseProduct + res' <- optional (parseWhiteSpace *> parseAnyChar "+-" + >>= \res' -> parseSum + >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' + +parseProduct :: Parser AST.Ast +parseProduct = do res <- parseListOperator + res' <- optional (parseWhiteSpace *> parseAnyChar "*/%" + >>= \res' -> parseProduct + >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' + +parseListOperator :: Parser AST.Ast +parseListOperator = do res <- parseValue + res' <- optional (parseWhiteSpace *> parseAnyString "--" <|> + parseWhiteSpace *> parseAnyString "++" <|> + parseWhiteSpace *> parseAnyString "!!" + >>= \res' -> parseListOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' -- | Return a data Parser that parse a Int as a Value -parseValue :: Parser SExpr -parseValue = Value <$> parseElem parseInt +parseValue :: Parser AST.Ast +parseValue = parseWhiteSpace *> ( + parseWhiteSpace *> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <* parseWhiteSpace + <|> AST.Value <$> parseElem parseInt + <|> parseBool + ) -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' parseList :: Parser a -> Parser [a] parseList parser = parseStart *> parseListValue <* parseEnd where - parseEnd = parseChar ')' <* parseSpace <* parseLine - parseListValue = parseSpace *> parseMany (parseElem parser) <* parseSpace - parseStart = parseSpace *> parseChar '(' + parseEnd = parseChar ')' <* parseWhiteSpace + parseListValue = parseWhiteSpace *> parseMany (parseElem parser) <* parseWhiteSpace + parseStart = parseWhiteSpace *> parseChar '(' -- | Parse any character from a String -- Return a Parser that parse every character from a String @@ -226,7 +303,7 @@ parseAnyChar :: String -> Parser Char parseAnyChar s = Parser (f s) where f :: String -> Position -> String -> Either String (Char, String, Position) - f [] (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f [] (row, col) _ = Left (errorParsing (row, col)) f (x:xs) pos s' = case parsed of Left _ -> runParser (parseAnyChar xs) pos s' _ -> parsed @@ -247,15 +324,15 @@ parseAnyString s = Parser (f s s) f [] str pos s' = Right (str, s', pos) -- | Return a Parser that parse a Bool (#f or #t) -parseBool :: Parser Bool -parseBool = parseElem (parseTrue <|> parseFalse) +parseBool :: Parser AST.Ast +parseBool = AST.Boolean <$> (parseTrue <|> parseFalse) <* parseWhiteSpace -- | Return a PArser that parse a True (in lisp -> #t) parseTrue :: Parser Bool parseTrue = Parser f where f :: Position -> String -> Either String (Bool, String, Position) - f pos s = case runParser (parseAnyString "#t") pos s of + f pos s = case runParser (parseAnyString "true") pos s of Left err -> Left err Right (_, s', pos') -> Right (True, s', pos') @@ -264,42 +341,50 @@ parseFalse :: Parser Bool parseFalse = Parser f where f :: Position -> String -> Either String (Bool, String, Position) - f pos s = case runParser (parseAnyString "#f") pos s of + f pos s = case runParser (parseAnyString "false") pos s of Left err -> Left err Right (_, s', pos') -> Right (False, s', pos') +parseDefineValue :: Parser AST.Ast +parseDefineValue = Parser f + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseString pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseChar '=') pos' s' of + Left err' -> Left err' + Right (_, s'', pos'') -> case runParser parseAst pos'' s'' of + Left err'' -> Left err'' + Right (res'', s''', pos''') -> Right (AST.Define res res'', s''', pos''') + +parseUnaryOperator :: Parser String +parseUnaryOperator = parseWhiteSpace *> parseAnyString "!"<|> + parseWhiteSpace *> parseAnyString "@" <|> + parseWhiteSpace *> parseAnyString "~" + +parseUnaryOperation :: Parser AST.Ast +parseUnaryOperation = Parser f + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseUnaryOperator pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser parseAst pos' s' of + Left err' -> Left err' + Right (res', s'', pos'') -> Right (AST.Call res [res'], s'', pos'') + -- | Return a Parser that parse a SExpr -parseSExpr :: Parser SExpr -parseSExpr = - parseSpace *> parseSymbol <|> - parseSpace *> parseValue <|> - List <$> parseList (parseSpace *> parseValue <|> parseSpace *> parseSymbol <|> parseSpace *> parseSExpr) <* parseSpace - -parseLisp :: Parser [SExpr] -parseLisp = parseSome parseSExpr - --- | Return a Result that contain the evaluation of our Lisp String --- Takes as parameter the string that need to be evaluated and the Stack (Environment) -interpretateLisp :: SExpr -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) -interpretateLisp value stack = case AstEval.sexprToAst value of - Nothing -> Left "Error on evaluation" - Just res -> case AstEval.evalAst stack res of - (Left err, _) -> Left err - (Right res', stack') -> Right (res', stack') - - -- -- Right (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) --- - Right (res, stack') -> print res >> inputLoop stack' - -- Right (_, stack') -> interpretateLisp xs stack' stack --- interpretateLisp s stack new = case runParser (parseSome parseSExpr) (0, 0) s of - -- Left err -> Left err - -- Right (res, s', _) -> case AstEval.sexprToAst res of - -- Nothing -> Left "Error on evaluation" - -- Just value -> case AstEval.evalAst stack value of - -- (Nothing, stack') -> (if stack == new then Left "Error on evaluation" else parseLisp s' stack' new) - -- (_, stack'') -> parseLisp s' stack'' new --- parseLisp :: String -> [Scope.ScopeMb] -> (Either String (Maybe AST.Ast), [Scope.ScopeMb]) --- parseLisp s stack = case runParser parseSExpr s of --- Nothing -> (Left "Input is unparsable", []) --- Just (res, _) -> case AstEval.sexprToAst res of --- Nothing -> (Left "Cannot convert input in AST", []) --- Just value -> AstEval.evalAst stack value +parseAst :: Parser AST.Ast +parseAst = parseWhiteSpace *> + ( + parseDefineValue + <|> parseExpr + <|> parseBool + <|> parseUnaryOperation + <|> parseAstString + <|> parseValue + <|> parseAstString + ) + + +parseLobster :: Parser [AST.Ast] +parseLobster = parseSome (parseWhiteSpace *> parseAst) diff --git a/LobsterLang/test/CompilerSpec.hs b/LobsterLang/test/CompilerSpec.hs new file mode 100644 index 0000000..2b775bd --- /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" Nothing) `shouldNotBe` [] + it "Check astToInstructions Symbol success" $ do + astToInstructions (AST.Symbol "foo" Nothing) `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" Nothing)]) `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]] diff --git a/LobsterLang/test/ParserSpec.hs b/LobsterLang/test/ParserSpec.hs new file mode 100644 index 0000000..a14f74f --- /dev/null +++ b/LobsterLang/test/ParserSpec.hs @@ -0,0 +1,184 @@ +{- +-- EPITECH PROJECT, 2023 +-- ParserSpec.hs +-- File description: +-- ParserSpec +-} + +module ParserSpec where + +import Test.Hspec +import Parse +import Parse (parseExpr, parseDefineValue, errorParsing, parseBool, parseLobster, parseString, parseMany) +import qualified AST +import AST (Ast(Value)) + +spec :: Spec +spec = do + describe "ParserTest" $ do + it "Check parseChar Success" $ do + runParser (parseChar ' ') (0,0) " Hello" `shouldBe` Right (' ', "Hello", (0,1)) + it "Check parseChar Failure" $ do + runParser (parseChar ' ') (0,0) "Hello" `shouldBe` Left (errorParsing (0, 0)) + it "Check parseOr Success first arg" $ do + runParser (parseOr (parseChar 'a') (parseChar ' ')) (0,0) "aHello" `shouldBe` Right ('a', "Hello", (0,1)) + it "Check parseOr Success second arg" $ do + runParser (parseOr (parseChar 'a') (parseChar ' ')) (0,0) " Hello" `shouldBe` Right (' ', "Hello", (0,1)) + it "Check parseOr Failure" $ do + runParser (parseOr (parseChar 'f') (parseChar 'O')) (0,0) " Oui" `shouldBe` Left (errorParsing (0,0)) + it "Check parseAnd Success" $ do + runParser (parseAnd (parseChar 'a') (parseChar 'p')) (0,0) "apHello" `shouldBe` Right (('a', 'p'), "Hello", (0,2)) + it "Check parseAnd Failure" $ do + runParser (parseAnd (parseChar 'e') (parseChar 'p')) (0,0) "apHello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseAndWith Number Success" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) (0,0) "42Hello" `shouldBe` Right ("42", "Hello", (0, 2)) + it "Check parseAndWith Character Success" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) (0,0) "ohHello" `shouldBe` Right ("oh", "Hello", (0, 2)) + it "Check parseAndWith Failure" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) (0,0) "42Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseMany Character Success" $ do + runParser (parseMany (parseAnyChar ['a'..'z'])) (0,0) "bonjournoHello" `shouldBe` Right ("bonjourno", "Hello", (0,9)) + it "Check parseMany Number Success" $ do + runParser (parseMany (parseAnyChar ['0'..'9'])) (0,0) "424554Hello" `shouldBe` Right ("424554", "Hello", (0,6)) + it "Check parseMany Failure" $ do + runParser (parseMany (parseAnyChar ['0'..'9'])) (0,0) "Hello" `shouldBe` Right ("", "Hello", (0,0)) + it "Check parseSome Number Success" $ do + runParser (parseSome (parseAnyChar ['0'..'9'])) (0,0) "042Hello" `shouldBe` Right ("042", "Hello", (0,3)) + it "Check parseSome Character Success" $ do + runParser (parseSome (parseAnyChar ['a'..'z'])) (0,0) "buenos42Hello" `shouldBe` Right ("buenos", "42Hello", (0,6)) + it "Check parseSome Failure" $ do + runParser (parseSome (parseAnyChar ['0'..'9'])) (0,0) "HelloWorld" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Success" $ do + runParser parseUInt (0,0) "5463Hello" `shouldBe` Right (5463, "Hello", (0,4)) + it "Check parseUInt Failure" $ do + runParser parseUInt (0,0) "Hola" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Empty" $ do + runParser parseUInt (0,0) "" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Negative Value Failure" $ do + runParser parseUInt (0,0) "-42Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseInt Success" $ do + runParser parseInt (0,0) "4234Hello" `shouldBe` Right (4234, "Hello", (0, 4)) + it "Check parseInt Negative Value Success" $ do + runParser parseInt (0,0) "-42Hello" `shouldBe` Right (-42, "Hello", (0,2)) + it "Check parseInt Failure" $ do + runParser parseInt (0,0) "Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parsesign '-' Success" $ do + runParser parseSign (0,0) "-llg" `shouldBe` Right ('-', "llg", (0,1)) + it "Check parsesign '+' Success" $ do + runParser parseSign (0,0) "+llg" `shouldBe` Right ('+', "llg", (0,1)) + it "Check parsesign Failure" $ do + runParser parseSign (0,0) "lg" `shouldBe` Left (errorParsing (0,0)) + it "Check parseString Success n°1" $ do + runParser parseString (0,0) "bonjourno " `shouldBe` Right ("bonjourno", "", (0,10)) + it "Check parseString Success n°2" $ do + runParser parseString (0,0) "bon12*/p journo " `shouldBe` Right ("bon12", "*/p journo ", (0,5)) + it "Check parseString Failure" $ do + runParser parseString (0,0) "^bon12*/p journo " `shouldBe` Left (errorParsing (0,0)) + it "Check parseElem with parseInt Success" $ do + runParser (parseElem parseInt) (0,0) "12 " `shouldBe` Right (12, "", (0,3)) + it "Check parseElem with parseString Success" $ do + runParser (parseElem parseString) (0,0) "hello la " `shouldBe` Right ("hello", "la ", (0,6)) + it "Check parseValue Success" $ do + runParser parseValue (0,0) "432 la " `shouldBe` Right (AST.Value 432, "la ", (0,14)) + it "Check parseList with parseInt Success" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 4 5)" `shouldBe` Right ([1, 2 ,3 , 4, 5], "", (0, 13)) + it "Check parseList with parseInt Failure (without a number inside)" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 d 4 5) (0,0) " `shouldBe` Left (errorParsing (0,8)) + it "Check parseList with parseInt Failure (without a ending ')')" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 4 5 " `shouldBe` Left (errorParsing (0,12)) + it "Check parseList with parseInt Failure (without a starting '(')" $ do + runParser (parseList parseInt) (0,0) "1 2 3 4 5)" `shouldBe` Left (errorParsing (0,0)) + it "Check parseList with parseString Success" $ do + runParser (parseList parseString) (0,0) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Right (["buenos", "owow", "k", "ye"], "1 2 3 4 5)", (0, 22)) + it "Check parseList with parseString Failure" $ do + runParser (parseList parseString) (0,0) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Left (errorParsing (0,8)) + it "Check parseBool true Success" $ do + runParser parseBool (0,0) "true lp" `shouldBe` Right (AST.Boolean True, "lp", (0,5)) + it "Check parseBool false Success" $ do + runParser parseBool (0,0) "false lp" `shouldBe` Right (AST.Boolean False, "lp", (0,6)) + it "Check parseBool Failure" $ do + runParser parseBool (0,0) "#tlp" `shouldBe` Left (errorParsing (0,0)) + it "Check parseExpr Simple Addition Success" $ do + runParser parseExpr (0,0) "3 + 5" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Value 5],"",(0,5)) + it "Check parseExpr Simple Multiplication Success" $ do + runParser parseExpr (0,0) "3 * 3" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Substration Success" $ do + runParser parseExpr (0,0) "3 - 3" `shouldBe` Right (AST.Call "-" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Division Success" $ do + runParser parseExpr (0,0) "3 / 3" `shouldBe` Right (AST.Call "/" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Modulo Success" $ do + runParser parseExpr (0,0) "3 % 3" `shouldBe` Right (AST.Call "%" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Multiple Addition Success" $ do + runParser parseExpr (0, 0) "3 + 3 + 5 + 1" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Value 1]]],"",(0,13)) + it "Check parseExpr Multiple Multiplication Success" $ do + runParser parseExpr (0, 0) "3 * 3 * 5 * 4" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "*" [AST.Value 5,AST.Value 4]]],"",(0,13)) + it "Check parseExpr with parenthesis Success" $ do + runParser parseExpr (0, 0) "3 * (| 3 + 4 |)" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Value 4]],"",(0,15)) + it "Check parseExpr with Multiple parenthesis Success n°1" $ do + runParser parseExpr (0, 0) "3 * (| 3 + (| 3 * (| 6 - 2 |)|)|)" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "-" [AST.Value 6,AST.Value 2]]]],"",(0,33)) + it "Check parseExpr with Multiple parenthesis Success n°2" $ do + runParser parseExpr (0, 0) "3 + (| 64 - 34 |) + 54 * 43" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Call "-" [AST.Value 64,AST.Value 34],AST.Call "*" [AST.Value 54,AST.Value 43]]],"",(0,27)) + it "Check parseExpr with Multiple parenthesis Success n°3" $ do + runParser parseExpr (0, 0) "(| 34 + (| 43 - 123 |)|) + (| 4 + (| 23 - 4 |)|)" `shouldBe` Right (AST.Call "+" [AST.Call "+" [AST.Value 34,AST.Call "-" [AST.Value 43,AST.Value 123]],AST.Call "+" [AST.Value 4,AST.Call "-" [AST.Value 23,AST.Value 4]]],"",(0,48)) + it "Check parseExpr with Operator '==' Success" $ do + runParser parseExpr (0, 0) "3 == 3" `shouldBe` Right (AST.Call "==" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '>=' Success" $ do + runParser parseExpr (0, 0) "3 >= 3" `shouldBe` Right (AST.Call ">=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '<=' Success" $ do + runParser parseExpr (0, 0) "3 <= 3" `shouldBe` Right (AST.Call "<=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '>' Success" $ do + runParser parseExpr (0, 0) "3 > 3" `shouldBe` Right (AST.Call ">" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr with Operator '<' Success" $ do + runParser parseExpr (0, 0) "3 < 3" `shouldBe` Right (AST.Call "<" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr with Operator '!=' Success" $ do + runParser parseExpr (0, 0) "3 != 3" `shouldBe` Right (AST.Call "!=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '!!' Success" $ do + runParser parseExpr (0, 0) "3 !! 3" `shouldBe` Right (AST.Call "!!" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '++' Success" $ do + runParser parseExpr (0, 0) "3 ++ 3" `shouldBe` Right (AST.Call "++" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '--' Success" $ do + runParser parseExpr (0, 0) "3 -- 3" `shouldBe` Right (AST.Call "--" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '&&' Success" $ do + runParser parseExpr (0, 0) "3 && 3" `shouldBe` Right (AST.Call "&&" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '||' Success" $ do + runParser parseExpr (0, 0) "3 || 3" `shouldBe` Right (AST.Call "||" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '^^' Success" $ do + runParser parseExpr (0, 0) "3 ^^ 3" `shouldBe` Right (AST.Call "^^" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '$' Success" $ do + runParser parseExpr (0, 0) "3 $ 3" `shouldBe` Right (AST.Call "$" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr Big Expression Success n°1" $ do + runParser parseExpr (0, 0) "(|3 + (| 4 * 23 |) |) == (|3 + 5 + (|54 - 2|)|) && (| 4 * 43 |)" `shouldBe` Right (AST.Call "&&" [AST.Call "==" [AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 4,AST.Value 23]],AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Call "-" [AST.Value 54,AST.Value 2]]]],AST.Call "*" [AST.Value 4,AST.Value 43]],"",(0,63)) + it "Check parseExpr Big Expression Success n°2" $ do + runParser parseExpr (0, 0) "(|3 + (| 4 * 23 |) |) == (|3 + 5 + (|54 - 2|)|) && (| 4 * 43 |) $ (|3 + 3 * (| 65 - 4 |) |)" `shouldBe` Right (AST.Call "$" [AST.Call "&&" [AST.Call "==" [AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 4,AST.Value 23]],AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Call "-" [AST.Value 54,AST.Value 2]]]],AST.Call "*" [AST.Value 4,AST.Value 43]],AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "-" [AST.Value 65,AST.Value 4]]]],"",(0,91)) + it "Check parseExpr Define Value Success" $ do + runParser parseDefineValue (0,0) "a = 3" `shouldBe` Right (AST.Define "a" (AST.Value 3),"",(0,5)) + it "Check parseExpr Define Expression Success" $ do + runParser parseDefineValue (0,0) "a = (| 3 + 5 |)" `shouldBe` Right (AST.Define "a" (AST.Call "+" [AST.Value 3,AST.Value 5]),"",(0,15)) + it "Check parseExpr Define Value Boolean Success" $ do + runParser parseDefineValue (0, 0) "a=true" `shouldBe` Right (AST.Define "a" (AST.Boolean True),"",(0,6)) + it "Check parseExpr Define Failure (incorrect value name)" $ do + runParser parseDefineValue (0, 0) "23=true" `shouldBe` Left (errorParsing (0,0)) + it "Check parseExpr Define Failure (missing operator '=')" $ do + runParser parseDefineValue (0, 0) "a " `shouldBe` Left (errorParsing (0,2)) + it "Check parseExpr Define Failure (missing AST Value)" $ do + runParser parseDefineValue (0, 0) "a =" `shouldBe` Left (errorParsing (0,3)) + it "Check parseExpr String Value Success" $ do + runParser parseAstString (0, 0) "\"a\"" `shouldBe` Right (AST.String "a" ,"",(0,3)) + it "Check parseExpr WhiteSpace Value Success" $ do + runParser parseWhiteSpace (0, 0) "\t\t\n" `shouldBe` Right ("\t\t\n" ,"",(1,0)) + it "Check parseBool Failure" $ do + runParser parseBool (0, 0) "fla" `shouldBe` Left (errorParsing (0,1)) + it "Check parseTrue Failure" $ do + runParser parseTrue (0, 0) "fla" `shouldBe` Left (errorParsing (0,0)) + it "Check parseLobster Success" $ do + runParser parseLobster (0,0) "a = 3 \"a\"" `shouldBe` Right ([AST.Define "a" (AST.Value 3),AST.String "a"],"",(0,9)) + it "Check parseString Success" $ do + runParser parseString (0,0) "_Lob3ster*" `shouldBe` Right ("_Lob3ster","*",(0,9)) + it "Check parseMany Success" $ do + runParser (parseMany (parseChar ' ')) (0,0) " p" `shouldBe` Right (" ","p",(0,1)) + it "Check parseUnaryOperation Success" $ do + runParser parseUnaryOperation (0,0) "! true" `shouldBe` Right (AST.Call "!" [AST.Boolean True],"",(0,6)) + it "Check parseUnaryOperation Failure (incorrect AST)" $ do + runParser parseUnaryOperation (0,0) "! *" `shouldBe` Left (errorParsing (0,2)) + it "Check parseUnaryOperation Failure (missing operator)" $ do + runParser parseUnaryOperation (0,0) "error" `shouldBe` Left (errorParsing (0,0)) diff --git a/Makefile b/Makefile index 262a524..ef08070 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ fclean: clean re: fclean all tests_run: - cd $(PKG_NAME) && stack test --coverage + cd $(PKG_NAME) && stack test cov: cd $(PKG_NAME) && stack test --coverage 2> >(tail -n 1 > $(COV_PATH_FILE)) diff --git a/ParseSpec.hs b/ParseSpec.hs index 904daaa..b7a8c7a 100644 --- a/ParseSpec.hs +++ b/ParseSpec.hs @@ -14,104 +14,104 @@ import qualified AST import Data.Bool (Bool(True, False)) spec :: Spec -spec = do - describe "ParseTest" $ do - it "Check parseChar Success" $ do - runParser (parseChar ' ') " Hello" `shouldBe` Just (' ', "Hello") - it "Check parseChar Failure" $ do - runParser (parseChar ' ') "Hello" `shouldBe` Nothing - it "Check parseOr Success first arg" $ do - runParser (parseOr (parseChar 'a') (parseChar ' ')) "aHello" `shouldBe` Just ('a', "Hello") - it "Check parseOr Success second arg" $ do - runParser (parseOr (parseChar 'a') (parseChar ' ')) " Hello" `shouldBe` Just (' ', "Hello") - it "Check parseOr Failure" $ do - runParser (parseOr (parseChar 'f') (parseChar 'O')) " Oui" `shouldBe` Nothing - it "Check parseAnd Success" $ do - runParser (parseAnd (parseChar 'a') (parseChar 'p')) "apHello" `shouldBe` Just (('a', 'p'), "Hello") - it "Check parseAnd Failure" $ do - runParser (parseAnd (parseChar 'e') (parseChar 'p')) "apHello" `shouldBe` Nothing - it "Check parseAndWith Number Success" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Just ("42", "Hello") - it "Check parseAndWith Character Success" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) "ohHello" `shouldBe` Just ("oh", "Hello") - it "Check parseAndWith Failure" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Nothing - it "Check parseMany Character Success" $ do - runParser (parseMany (parseAnyChar ['a'..'z'])) "bonjournoHello" `shouldBe` Just ("bonjourno", "Hello") - it "Check parseMany Number Success" $ do - runParser (parseMany (parseAnyChar ['0'..'9'])) "424554Hello" `shouldBe` Just ("424554", "Hello") - it "Check parseMany Failure" $ do - runParser (parseMany (parseAnyChar ['0'..'9'])) "Hello" `shouldBe` Just ("", "Hello") - it "Check parseSome Number Success" $ do - runParser (parseSome (parseAnyChar ['0'..'9'])) "042Hello" `shouldBe` Just ("042", "Hello") - it "Check parseSome Character Success" $ do - runParser (parseSome (parseAnyChar ['a'..'z'])) "buenos42Hello" `shouldBe` Just ("buenos", "42Hello") - it "Check parseSome Failure" $ do - runParser (parseSome (parseAnyChar ['0'..'9'])) "HelloWorld" `shouldBe` Nothing - it "Check parseUInt Success" $ do - runParser parseUInt "5463Hello" `shouldBe` Just (5463, "Hello") - it "Check parseUInt Failure" $ do - runParser parseUInt "Hola" `shouldBe` Nothing - it "Check parseUInt Empty" $ do - runParser parseUInt "" `shouldBe` Nothing - it "Check parseUInt Negative value Failure" $ do - runParser parseUInt "-42Hello" `shouldBe` Nothing - it "Check parseInt Success" $ do - runParser parseInt "4234Hello" `shouldBe` Just (4234, "Hello") - it "Check parseInt Negative value Success" $ do - runParser parseInt "-42Hello" `shouldBe` Just (-42, "Hello") - it "Check parseInt Failure" $ do - runParser parseInt "Hello" `shouldBe` Nothing - it "Check parsesign '-' Success" $ do - runParser parseSign "-llg" `shouldBe` Just ('-', "llg") - it "Check parsesign '+' Success" $ do - runParser parseSign "+llg" `shouldBe` Just ('+', "llg") - it "Check parsesign Failure" $ do - runParser parseSign "lg" `shouldBe` Nothing - it "Check parseString Success n°1" $ do - runParser parseString "bonjourno " `shouldBe` Just ("bonjourno", "") - it "Check parseString Success n°2" $ do - runParser parseString "bon12*/p journo " `shouldBe` Just ("bon", "12*/p journo ") - it "Check parseString Failure" $ do - runParser parseString "^bon12*/p journo " `shouldBe` Nothing - it "Check parseElem with parseInt Success" $ do - runParser (parseElem parseInt) "12 " `shouldBe` Just (12, "") - it "Check parseElem with parseString Success" $ do - runParser (parseElem parseString) "hello la " `shouldBe` Just ("hello", "la ") - it "Check parseElem with parseSymbol Success" $ do - runParser (parseElem parseSymbol) "hello la " `shouldBe` Just (SExpr.Symbol "hello", "la ") - it "Check parseValue Success" $ do - runParser parseValue "432 la " `shouldBe` Just (SExpr.Value 432, "la ") - it "Check parseSymbol Success" $ do - runParser parseSymbol "symbol la " `shouldBe` Just (SExpr.Symbol "symbol", "la ") - it "Check parseList with parseInt Success" $ do - runParser (parseList parseInt) "(1 2 3 4 5) " `shouldBe` Just ([1, 2 ,3 , 4, 5], "") - it "Check parseList with parseInt Failure (without a number inside)" $ do - runParser (parseList parseInt) "(1 2 3 d 4 5) " `shouldBe` Nothing - it "Check parseList with parseInt Failure (without a ending ')')" $ do - runParser (parseList parseInt) "(1 2 3 4 5 " `shouldBe` Nothing - it "Check parseList with parseInt Failure (without a starting '(')" $ do - runParser (parseList parseInt) "1 2 3 4 5)" `shouldBe` Nothing - it "Check parseList with parseString Success" $ do - runParser (parseList parseString) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Just (["buenos", "owow", "k", "ye"], "1 2 3 4 5)") - it "Check parseList with parseString Failure" $ do - runParser (parseList parseString) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Nothing - it "Check parseBool true Success" $ do - runParser parseBool "#t lp" `shouldBe` Just (True, "lp") - it "Check parseBool false Success" $ do - runParser parseBool "#f lp" `shouldBe` Just (False, "lp") - it "Check parseBool Failure" $ do - runParser parseBool "#tlp" `shouldBe` Nothing - it "Check parseSExpr Success n°1" $ do - runParser parseSExpr "(define foo (* 3 3))" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.List [SExpr.Symbol "*",SExpr.Value 3,SExpr.Value 3]], "") - it "Check parseSExpr Success n°2" $ do - runParser parseSExpr "( define foo 3 )" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.Value 3], "") - it "Check ParseLisp Success n°1" $ do - parseLisp "(* 3 (+ 2 2))" [] `shouldBe` (Right (Just (AST.Value 12)), []) - it "Check ParseLisp Success n°2" $ do - parseLisp "(* 3 (+ 2 (/ 12 6)))" [] `shouldBe` (Right (Just (AST.Value 12)), []) - it "Check ParseLisp Failure n°1" $ do - parseLisp "(* 3 (+ 2 (/ 12 6))" [] `shouldBe` (Left "Input is unparsable", []) +-- spec = do +-- describe "ParseTest" $ do +-- it "Check parseChar Success" $ do +-- runParser (parseChar ' ') " Hello" `shouldBe` Just (' ', "Hello") +-- it "Check parseChar Failure" $ do +-- runParser (parseChar ' ') "Hello" `shouldBe` Nothing +-- it "Check parseOr Success first arg" $ do +-- runParser (parseOr (parseChar 'a') (parseChar ' ')) "aHello" `shouldBe` Just ('a', "Hello") +-- it "Check parseOr Success second arg" $ do +-- runParser (parseOr (parseChar 'a') (parseChar ' ')) " Hello" `shouldBe` Just (' ', "Hello") +-- it "Check parseOr Failure" $ do +-- runParser (parseOr (parseChar 'f') (parseChar 'O')) " Oui" `shouldBe` Nothing +-- it "Check parseAnd Success" $ do +-- runParser (parseAnd (parseChar 'a') (parseChar 'p')) "apHello" `shouldBe` Just (('a', 'p'), "Hello") +-- it "Check parseAnd Failure" $ do +-- runParser (parseAnd (parseChar 'e') (parseChar 'p')) "apHello" `shouldBe` Nothing +-- it "Check parseAndWith Number Success" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Just ("42", "Hello") +-- it "Check parseAndWith Character Success" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) "ohHello" `shouldBe` Just ("oh", "Hello") +-- it "Check parseAndWith Failure" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Nothing +-- it "Check parseMany Character Success" $ do +-- runParser (parseMany (parseAnyChar ['a'..'z'])) "bonjournoHello" `shouldBe` Just ("bonjourno", "Hello") +-- it "Check parseMany Number Success" $ do +-- runParser (parseMany (parseAnyChar ['0'..'9'])) "424554Hello" `shouldBe` Just ("424554", "Hello") +-- it "Check parseMany Failure" $ do +-- runParser (parseMany (parseAnyChar ['0'..'9'])) "Hello" `shouldBe` Just ("", "Hello") +-- it "Check parseSome Number Success" $ do +-- runParser (parseSome (parseAnyChar ['0'..'9'])) "042Hello" `shouldBe` Just ("042", "Hello") +-- it "Check parseSome Character Success" $ do +-- runParser (parseSome (parseAnyChar ['a'..'z'])) "buenos42Hello" `shouldBe` Just ("buenos", "42Hello") +-- it "Check parseSome Failure" $ do +-- runParser (parseSome (parseAnyChar ['0'..'9'])) "HelloWorld" `shouldBe` Nothing +-- it "Check parseUInt Success" $ do +-- runParser parseUInt "5463Hello" `shouldBe` Just (5463, "Hello") +-- it "Check parseUInt Failure" $ do +-- runParser parseUInt "Hola" `shouldBe` Nothing +-- it "Check parseUInt Empty" $ do +-- runParser parseUInt "" `shouldBe` Nothing +-- it "Check parseUInt Negative value Failure" $ do +-- runParser parseUInt "-42Hello" `shouldBe` Nothing +-- it "Check parseInt Success" $ do +-- runParser parseInt "4234Hello" `shouldBe` Just (4234, "Hello") +-- it "Check parseInt Negative value Success" $ do +-- runParser parseInt "-42Hello" `shouldBe` Just (-42, "Hello") +-- it "Check parseInt Failure" $ do +-- runParser parseInt "Hello" `shouldBe` Nothing +-- it "Check parsesign '-' Success" $ do +-- runParser parseSign "-llg" `shouldBe` Just ('-', "llg") +-- it "Check parsesign '+' Success" $ do +-- runParser parseSign "+llg" `shouldBe` Just ('+', "llg") +-- it "Check parsesign Failure" $ do +-- runParser parseSign "lg" `shouldBe` Nothing +-- it "Check parseString Success n°1" $ do +-- runParser parseString "bonjourno " `shouldBe` Just ("bonjourno", "") +-- it "Check parseString Success n°2" $ do +-- runParser parseString "bon12*/p journo " `shouldBe` Just ("bon", "12*/p journo ") +-- it "Check parseString Failure" $ do +-- runParser parseString "^bon12*/p journo " `shouldBe` Nothing +-- it "Check parseElem with parseInt Success" $ do +-- runParser (parseElem parseInt) "12 " `shouldBe` Just (12, "") +-- it "Check parseElem with parseString Success" $ do +-- runParser (parseElem parseString) "hello la " `shouldBe` Just ("hello", "la ") +-- it "Check parseElem with parseSymbol Success" $ do +-- runParser (parseElem parseSymbol) "hello la " `shouldBe` Just (SExpr.Symbol "hello", "la ") +-- it "Check parseValue Success" $ do +-- runParser parseValue "432 la " `shouldBe` Just (SExpr.Value 432, "la ") +-- it "Check parseSymbol Success" $ do +-- runParser parseSymbol "symbol la " `shouldBe` Just (SExpr.Symbol "symbol", "la ") +-- it "Check parseList with parseInt Success" $ do +-- runParser (parseList parseInt) "(1 2 3 4 5) " `shouldBe` Just ([1, 2 ,3 , 4, 5], "") +-- it "Check parseList with parseInt Failure (without a number inside)" $ do +-- runParser (parseList parseInt) "(1 2 3 d 4 5) " `shouldBe` Nothing +-- it "Check parseList with parseInt Failure (without a ending ')')" $ do +-- runParser (parseList parseInt) "(1 2 3 4 5 " `shouldBe` Nothing +-- it "Check parseList with parseInt Failure (without a starting '(')" $ do +-- runParser (parseList parseInt) "1 2 3 4 5)" `shouldBe` Nothing +-- it "Check parseList with parseString Success" $ do +-- runParser (parseList parseString) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Just (["buenos", "owow", "k", "ye"], "1 2 3 4 5)") +-- it "Check parseList with parseString Failure" $ do +-- runParser (parseList parseString) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Nothing +-- it "Check parseBool true Success" $ do +-- runParser parseBool "#t lp" `shouldBe` Just (True, "lp") +-- it "Check parseBool false Success" $ do +-- runParser parseBool "#f lp" `shouldBe` Just (False, "lp") +-- it "Check parseBool Failure" $ do +-- runParser parseBool "#tlp" `shouldBe` Nothing +-- it "Check parseSExpr Success n°1" $ do +-- runParser parseSExpr "(define foo (* 3 3))" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.List [SExpr.Symbol "*",SExpr.Value 3,SExpr.Value 3]], "") +-- it "Check parseSExpr Success n°2" $ do +-- runParser parseSExpr "( define foo 3 )" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.Value 3], "") +-- it "Check ParseLisp Success n°1" $ do +-- parseLisp "(* 3 (+ 2 2))" [] `shouldBe` (Right (Just (AST.Value 12)), []) +-- it "Check ParseLisp Success n°2" $ do +-- parseLisp "(* 3 (+ 2 (/ 12 6)))" [] `shouldBe` (Right (Just (AST.Value 12)), []) +-- it "Check ParseLisp Failure n°1" $ do +-- parseLisp "(* 3 (+ 2 (/ 12 6))" [] `shouldBe` (Left "Input is unparsable", []) -- "(define vie 42)" diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob index c36a726..883644c 100644 --- a/exemple/Fibonacci.lob +++ b/exemple/Fibonacci.lob @@ -1,9 +1,9 @@ -fn fibonacci(\ x: integer /) -> integer { +fn fibonacci(| x: integer |) -> integer { if x == 0 { 0 } else if x == 1 { 1 } else { - fibonacci(\ x - 1 /) + fibonacci(\ x - 2 /) + fibonacci(| x - 1 |) + fibonacci(| x - 2 |) } } diff --git a/exemple/Lambda.lob b/exemple/Lambda.lob index 13f82b2..5f3e156 100644 --- a/exemple/Lambda.lob +++ b/exemple/Lambda.lob @@ -8,7 +8,7 @@ add(\ 2, 9 /) # return 11 abs = λ (\ x: integer /) -> integer { if x < 0 { x * -1 - else { + } else { x } } diff --git a/foo.scm b/foo.scm deleted file mode 100644 index 62a7db8..0000000 --- a/foo.scm +++ /dev/null @@ -1,7 +0,0 @@ -(define foo 21) -(define x 5) -(define value (* x foo)) -p -(* value 4) -(define value (* 4 (+ 1 2))) -value