diff --git a/README.md b/README.md index 8a9d109..f3650f1 100644 --- a/README.md +++ b/README.md @@ -1,69 +1,194 @@ -# koaky - -A Blazzing Light Lisp Interpreter - -## Features - -- Condition -- [x] `if` -- [x] `eq?` -- [x] `diff?` -- [x] `<` -- [x] `>` -- [x] `>=` -- [x] `<=` -- Operator -- [x] `+` -- [x] `-` -- [x] `*` -- [x] `div` -- [x] `mod` -- Type -- [x] `Integer` -- [x] `Boolean` -- [x] `Symbol` -- Function -- [x] `lambda` -- [x] `define` -- Error Handling -- [x] Error handling at execution time -- [x] Nice error message at execution time -- [x] Error handling at parsing time -- [ ] Nice error message at parsing time - -## Install - -2 methods to use this interpreter: -- from available binary -- build from source - -### From Available Binary - -- Download the binary for your platform in the latest release. - -### Build From Source - -- Clone this repository: -- Install stack: -- `cd`'d in the repository you just cloned -- Run: `stack build --copy-bins --local-bin-path .` -- The binary will be available with the name `koaky-exe.exe`:windows `koaky-exe`:linux `koaky-exe`:macos - -## Usage - -``` -Usage: koaky-exe [OPTION] - -Interpret Lisp -With no options, koaky reads from standard input. - -Options: - -h, --help - Display this help and exit - -v, --version - Output version information and exit - -f FILE, --file FILE - Read FILE and Interpret it - - - Read from standard input and Interpret it +# Leviator + +The opinionated programing language + +## Documentation + +-- **Comentary** + +```c +// This is a comment +``` + +-- **Variables Declaration** + +```python +@Int a = 1; +@String b = "hello"; +``` + +-- **Variables Assignment** + +```c +a = 1; +b = "hello"; +``` + +- **Built-in Types** + +``` +@Bool a = True; +@Bool b = False; +@Int c = 1; +@List[Int] d = [1, 2, 3]; +@Char e = 'a'; +@String f = "hello"; +@List[Char] g = ['a', 'b', 'c']; +``` + +- **Built-in Global Variables** + +```c +@List[String] ARGS = ["programfilepath", "arg1", "arg2"]; +``` + +- **Function Declaration** + +```rust +fn add(a: Int, b: Int) -> Int +{ + // the next line is the `return` + <- a + b; +}; +``` + +- **Function Call** + +```rust +add(1, 2); +``` + +- **Function Polymorphism** + +```rust +fn add(a: Int, b: Int) -> Int +{ + <- a + b; +}; + +fn add(a: Float, b: Float) -> Float +{ + <- a + b; +}; + +fn add(a: Int, b: Int, c: Int) -> Int +{ + <- a + b + c; +}; +``` + +- **Built-in Functions** + +```c +// print to stdout +print("hello"); +// print to stderr +printErr("hello"); +// get a line from stdin +getLine(); +// transform a type to a string +str(1); +// get the type of a value in string format +type(a); +// call a function with string +call("add", [1, 2]); +``` + +- **Generic Functions** + +```rust +fn add[A](a: A, b: A) -> A +{ + <- a + b; +}; +``` + +- **Generic Functions Call** + +```rust +add[Int](1, 2); +``` + +- **Conditions** + +```c +if (a == 1) +{ + // do something +}; + +if (a == 1) +{ + // do something +} +else +{ + // do something else +}; +``` + +- **Loops** + +```c +@Int i = 0; +while (i < 10) +{ + // do something + i = i + 1; +}; +``` + +```c +@List[Int] lst = [1, 2, 3]; +foreach (a in lst) +{ + if (a == 2) + { + break; + } +}; +``` + +- **Imports** + +```c +// Circular imports are not allowed +#"path/to/file.lvt" +``` + +- **Entrypoint** + +```rust +// If you don't have this function, the program will not be run +fn start() -> Int +{ + <- 0; +}; +``` + +- **Operators** + +``` +a + b +a - b +a * b +a / b +``` + +- **Structs** + +```c +struct Point +{ + a: Int, +}; +``` + +- **Generic Structs** + +```c +struct Rect[A] +{ + a: A, +}; ``` diff --git a/app/Args.hs b/app/Args.hs deleted file mode 100644 index c502b03..0000000 --- a/app/Args.hs +++ /dev/null @@ -1,61 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- args --} - - -module Args - ( - Action(..), - Args(..), - RunOpt(..), - parseArgs, - printHelp - ) where - -data Action = ShowHelp | ShowVersion | Run -data RunOpt = RunStdin | RunFile - -data Args = Args { - action :: Action, - runOpt :: RunOpt, - filePath :: String -} - -parseArgs' :: [String] -> Args -> Either Args String -parseArgs' [] args = - Left args -parseArgs' ("--help":xs) args = - parseArgs' xs (args {action = ShowHelp}) -parseArgs' ("-h":xs) args = - parseArgs' xs (args {action = ShowHelp}) -parseArgs' ("--version":xs) args = - parseArgs' xs (args {action = ShowVersion}) -parseArgs' ("-v":xs) args = - parseArgs' xs (args {action = ShowVersion}) -parseArgs' ("-f":f:xs) args = - parseArgs' xs (args {action = Run, runOpt = RunFile, filePath = f}) -parseArgs' ["-f"] _ = - Right "No file specified" -parseArgs' ("-":xs) args = - parseArgs' xs (args {action = Run, runOpt = RunStdin}) -parseArgs' (x:_) _ = - Right ("Unknown option: " ++ x) - -parseArgs :: [String] -> Either Args String -parseArgs args = - parseArgs' args (Args {action = Run, runOpt = RunStdin, filePath = ""}) - -printHelp :: IO () -printHelp = putStr help - where - line1 = "Usage: koaky [OPTION]\n\nInterpret Lisp\n" - line2a = "With no options, koaky reads from standard input.\n\n" - line3 = "Options:\n" - line4 = "\t-h, --help\n\t\tDisplay this help and exit\n" - line5 = "\t-v, --version\n\t\tOutput version information and exit\n" - line6 = "\t-f FILE, --file FILE\n\t\tRead FILE and Interpret it\n" - line7 = "\t-\n\t\tRead from standard input and Interpret it\n" - help = line1 ++ line2a ++ line3 ++ line4 ++ line5 ++ line6 ++ line7 diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 index cf421bf..0000000 --- a/app/Main.hs +++ /dev/null @@ -1,21 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Main --} - -import System.Environment (getArgs) -import Args -import Run -import Version - -dispatchAction :: Either Args String -> IO () -dispatchAction (Right error_) = putStrLn error_ -dispatchAction (Left (Args ShowHelp _ _)) = printHelp -dispatchAction (Left (Args ShowVersion _ _)) = printVersion -dispatchAction (Left (Args Run RunFile f)) = runFile f -dispatchAction (Left (Args Run RunStdin _)) = runStdin - -main :: IO () -main = getArgs >>= (dispatchAction . parseArgs) diff --git a/app/Run.hs b/app/Run.hs deleted file mode 100644 index 6fea60d..0000000 --- a/app/Run.hs +++ /dev/null @@ -1,65 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- run --} - -module Run - ( - runStdin, - runFile - ) where - -import Computing.ComputeAST -import Parsing.Parser -import Types -import System.IO - -data HHHandle = HHHandle Handle Bool - -printErrors :: HHHandle -> Env -> IO () -printErrors hand (Env defines_ [] funcs_) = - printErrors hand (Env defines_ ["Unable to compute"] funcs_) -printErrors hand (Env defines_ errors_ funcs_) = - mapM_ putStrLn errors_ >> handleInput hand (Env defines_ [] funcs_) [] - -checkComputing :: HHHandle -> (Env, Result) -> IO () -checkComputing hand (env, Right _) = printErrors hand env -checkComputing hand (env, Left Nothing) = handleInput hand env [] -checkComputing hand (env, Left (Just result)) = - print result >> handleInput hand env [] - -checkParsing :: HHHandle -> String -> Maybe (Tree, String) -> Env -> IO () -checkParsing hand str Nothing env = handleInput hand env str -checkParsing hand _ (Just (tree, _)) env = - checkComputing hand (computeAST env tree) - -checkInput :: HHHandle -> String -> Env -> IO () -checkInput _ ":q" _ = return () -checkInput hand input env = - checkParsing hand input (runParser (parseTree) input) env - -checkEOF :: HHHandle -> Env -> String -> Bool -> IO () -checkEOF _ _ _ True = return () -checkEOF (HHHandle ff shouldClosee) env prevStr False = hGetLine ff >>= - (\x -> checkInput (HHHandle ff shouldClosee) (prevStr ++ x) env) - -handleInput :: HHHandle -> Env -> String -> IO () -handleInput (HHHandle ff shouldClosee) env prevStr = - hIsEOF ff >>= (\x -> checkEOF (HHHandle ff shouldClosee) env prevStr x) - -runStdin :: IO () -runStdin = runFileHandle stdin False - -runFile :: String -> IO () -runFile filePath = openFile filePath ReadMode >>= \x -> runFileHandle x True - -onEnd :: HHHandle -> IO () -onEnd (HHHandle ff True) = hClose ff -onEnd _ = return () - -runFileHandle :: Handle -> Bool -> IO () -runFileHandle ff shouldClosee = - handleInput (HHHandle ff shouldClosee) (Env [] [] []) [] >> - onEnd (HHHandle ff shouldClosee) diff --git a/app/Version.hs b/app/Version.hs deleted file mode 100644 index 815099c..0000000 --- a/app/Version.hs +++ /dev/null @@ -1,15 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- koaky --- File description: --- version --} - -module Version - ( printVersion - ) where - -import KoakyLibVersion - -printVersion :: IO () -printVersion = putStrLn koakyLibVersion diff --git a/koaky.cabal b/koaky.cabal deleted file mode 100644 index 06f416a..0000000 --- a/koaky.cabal +++ /dev/null @@ -1,79 +0,0 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.36.0. --- --- see: https://github.com/sol/hpack - -name: koaky -version: 0.1.0.0 -description: Please see the README on GitHub at -homepage: https://github.com/X-R-G-B/koaky#readme -bug-reports: https://github.com/X-R-G-B/koaky/issues -author: @guillaumeAbel, @TTENSHII, @Saverio976 -maintainer: example@example.com -copyright: 2023 X-R-G-B -license: MIT -license-file: LICENSE -build-type: Simple -extra-source-files: - README.md - CHANGELOG.md - -source-repository head - type: git - location: https://github.com/X-R-G-B/koaky - -library - exposed-modules: - AST - Computing.ComputeAST - Computing.Defines - Computing.Errors - Computing.Functions - Computing.ListContainList - Computing.Operators.Assert - Computing.Operators.Calculate - Computing.Operators.EvaluateSymbol - Computing.ReplaceFunctionParams - KoakyLibVersion - Parsing.Parser - Types - other-modules: - Paths_koaky - hs-source-dirs: - src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace - build-depends: - base >=4.7 && <5 - default-language: Haskell2010 - -executable koaky-exe - main-is: Main.hs - other-modules: - Args - Run - Version - Paths_koaky - hs-source-dirs: - app - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace -threaded -rtsopts -with-rtsopts=-N - build-depends: - base >=4.7 && <5 - , koaky - default-language: Haskell2010 - -test-suite koaky-test - type: exitcode-stdio-1.0 - main-is: Spec.hs - other-modules: - Paths_koaky - hs-source-dirs: - test - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace -threaded -rtsopts -with-rtsopts=-N - build-depends: - base >=4.7 && <5 - , koaky - , tasty - , tasty-html - , tasty-hunit - default-language: Haskell2010 diff --git a/lvtc/.gitignore b/lvtc/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/lvtc/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/lvtc/CHANGELOG.md b/lvtc/CHANGELOG.md new file mode 100644 index 0000000..c893e43 --- /dev/null +++ b/lvtc/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `lvtc` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/lvtc/LICENSE b/lvtc/LICENSE new file mode 100644 index 0000000..c5b6c16 --- /dev/null +++ b/lvtc/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2023 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/lvtc/Makefile b/lvtc/Makefile new file mode 100644 index 0000000..3df21cd --- /dev/null +++ b/lvtc/Makefile @@ -0,0 +1,42 @@ +## +## EPITECH PROJECT, 2023 +## Makefile +## File description: +## makefile that stack +## + +TARGET = koaky + +CP = cp +RM = rm -rf + +ifeq ($(OS),Windows_NT) + BIN_STACK = $(TARGET)-exe.exe +else + BIN_STACK = $(TARGET)-exe +endif + +all: $(TARGET) + +$(TARGET): + stack build --copy-bins --local-bin-path . + +clean: + stack clean + +fclean: clean + stack purge + $(RM) "$(BIN_STACK)" + +re: fclean $(TARGET) + +tests: + stack test + +tests-coverage: + stack test --coverage + +tests-coverage-html-path: + @stack path --local-hpc-root + +.PHONY: $(TARGET) fclean re clean all diff --git a/lvtc/README.md b/lvtc/README.md new file mode 100644 index 0000000..a1c8a99 --- /dev/null +++ b/lvtc/README.md @@ -0,0 +1 @@ +# lvtc diff --git a/Setup.hs b/lvtc/Setup.hs similarity index 100% rename from Setup.hs rename to lvtc/Setup.hs diff --git a/lvtc/app/Main.hs b/lvtc/app/Main.hs new file mode 100644 index 0000000..4c6b30f --- /dev/null +++ b/lvtc/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib + +main :: IO () +main = someFunc diff --git a/lvtc/lvtc.cabal b/lvtc/lvtc.cabal new file mode 100644 index 0000000..b102c44 --- /dev/null +++ b/lvtc/lvtc.cabal @@ -0,0 +1,67 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: lvtc +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/lvtc#readme +bug-reports: https://github.com/githubuser/lvtc/issues +author: Author name here +maintainer: example@example.com +copyright: 2023 Author name here +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/githubuser/lvtc + +library + exposed-modules: + Lib + other-modules: + Paths_lvtc + autogen-modules: + Paths_lvtc + hs-source-dirs: + 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 + default-language: Haskell2010 + +executable lvtc-exe + main-is: Main.hs + other-modules: + Paths_lvtc + autogen-modules: + Paths_lvtc + hs-source-dirs: + app + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , lvtc + default-language: Haskell2010 + +test-suite lvtc-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_lvtc + autogen-modules: + Paths_lvtc + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , lvtc + default-language: Haskell2010 diff --git a/package.yaml b/lvtc/package.yaml similarity index 75% rename from package.yaml rename to lvtc/package.yaml index b4a3ae8..d6fb3e5 100644 --- a/package.yaml +++ b/lvtc/package.yaml @@ -1,10 +1,10 @@ -name: koaky +name: lvtc version: 0.1.0.0 -github: "X-R-G-B/koaky" -license: MIT -author: "@guillaumeAbel, @TTENSHII, @Saverio976" +github: "githubuser/lvtc" +license: BSD-3-Clause +author: "Author name here" maintainer: "example@example.com" -copyright: "2023 X-R-G-B" +copyright: "2023 Author name here" extra-source-files: - README.md @@ -17,7 +17,7 @@ extra-source-files: # To avoid duplicated efforts in documentation and dealing with the # complications of embedding Haddock markup inside cabal files, it is # common to point users to the README.md file. -description: Please see the README on GitHub at +description: Please see the README on GitHub at dependencies: - base >= 4.7 && < 5 @@ -32,15 +32,12 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints -- -Wdefault -- -W -- -Woperator-whitespace library: source-dirs: src executables: - koaky-exe: + lvtc-exe: main: Main.hs source-dirs: app ghc-options: @@ -48,10 +45,10 @@ executables: - -rtsopts - -with-rtsopts=-N dependencies: - - koaky + - lvtc tests: - koaky-test: + lvtc-test: main: Spec.hs source-dirs: test ghc-options: @@ -59,7 +56,4 @@ tests: - -rtsopts - -with-rtsopts=-N dependencies: - - koaky - - tasty - - tasty-hunit - - tasty-html + - lvtc diff --git a/lvtc/src/Lib.hs b/lvtc/src/Lib.hs new file mode 100644 index 0000000..d36ff27 --- /dev/null +++ b/lvtc/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/stack.yaml b/lvtc/stack.yaml similarity index 86% rename from stack.yaml rename to lvtc/stack.yaml index a34bc4c..b2997b7 100644 --- a/stack.yaml +++ b/lvtc/stack.yaml @@ -8,16 +8,17 @@ # A snapshot resolver dictates the compiler version and the set of packages # to be used for project dependencies. For example: # -# resolver: lts-21.13 -# resolver: nightly-2023-09-24 -# resolver: ghc-9.6.2 +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 # # The location of a snapshot can be provided as a file or url. Stack assumes # a snapshot provided as a file might change, whereas a url resource does not. # # resolver: ./custom-snapshot.yaml -# resolver: https://example.com/snapshots/2023-01-01.yaml -resolver: lts-21.13 +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/0.yaml # User packages to be built. # Various formats can be used as shown in the example below. @@ -39,10 +40,7 @@ packages: # - git: https://github.com/commercialhaskell/stack.git # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # -extra-deps: -- tasty-1.4.2.2 -- tasty-hunit-0.10.1 -- tasty-html-0.4.2.1 +# extra-deps: [] # Override default flag values for local packages and extra-deps # flags: {} @@ -55,7 +53,7 @@ extra-deps: # # Require a specific version of Stack, using version ranges # require-stack-version: -any # Default -# require-stack-version: ">=2.13" +# require-stack-version: ">=2.11" # # Override the architecture used by Stack, especially useful on Windows # arch: i386 diff --git a/lvtc/test/Spec.hs b/lvtc/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/lvtc/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/lvtrun/.gitignore b/lvtrun/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/lvtrun/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/lvtrun/CHANGELOG.md b/lvtrun/CHANGELOG.md new file mode 100644 index 0000000..8fbf11a --- /dev/null +++ b/lvtrun/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `lvtrun` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/lvtrun/LICENSE b/lvtrun/LICENSE new file mode 100644 index 0000000..c5b6c16 --- /dev/null +++ b/lvtrun/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2023 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/lvtrun/Makefile b/lvtrun/Makefile new file mode 100644 index 0000000..474c67b --- /dev/null +++ b/lvtrun/Makefile @@ -0,0 +1,42 @@ +## +## EPITECH PROJECT, 2023 +## Makefile +## File description: +## makefile that stack +## + +TARGET = lvtrun + +CP = cp +RM = rm -rf + +ifeq ($(OS),Windows_NT) + BIN_STACK = $(TARGET)-exe.exe +else + BIN_STACK = $(TARGET)-exe +endif + +all: $(TARGET) + +$(TARGET): + stack build --copy-bins --local-bin-path . + +clean: + stack clean + +fclean: clean + stack purge + $(RM) "$(BIN_STACK)" + +re: fclean $(TARGET) + +tests: + stack test + +tests-coverage: + stack test --coverage + +tests-coverage-html-path: + @stack path --local-hpc-root + +.PHONY: $(TARGET) fclean re clean all diff --git a/lvtrun/README.md b/lvtrun/README.md new file mode 100644 index 0000000..163ee90 --- /dev/null +++ b/lvtrun/README.md @@ -0,0 +1 @@ +# lvtrun diff --git a/lvtrun/Setup.hs b/lvtrun/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/lvtrun/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/lvtrun/app/Main.hs b/lvtrun/app/Main.hs new file mode 100644 index 0000000..4c6b30f --- /dev/null +++ b/lvtrun/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib + +main :: IO () +main = someFunc diff --git a/lvtrun/lvtrun.cabal b/lvtrun/lvtrun.cabal new file mode 100644 index 0000000..4e28df2 --- /dev/null +++ b/lvtrun/lvtrun.cabal @@ -0,0 +1,67 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: lvtrun +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/lvtrun#readme +bug-reports: https://github.com/githubuser/lvtrun/issues +author: Author name here +maintainer: example@example.com +copyright: 2023 Author name here +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/githubuser/lvtrun + +library + exposed-modules: + Lib + other-modules: + Paths_lvtrun + autogen-modules: + Paths_lvtrun + hs-source-dirs: + 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 + default-language: Haskell2010 + +executable lvtrun-exe + main-is: Main.hs + other-modules: + Paths_lvtrun + autogen-modules: + Paths_lvtrun + hs-source-dirs: + app + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , lvtrun + default-language: Haskell2010 + +test-suite lvtrun-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_lvtrun + autogen-modules: + Paths_lvtrun + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , lvtrun + default-language: Haskell2010 diff --git a/lvtrun/package.yaml b/lvtrun/package.yaml new file mode 100644 index 0000000..e1a5e8f --- /dev/null +++ b/lvtrun/package.yaml @@ -0,0 +1,59 @@ +name: lvtrun +version: 0.1.0.0 +github: "githubuser/lvtrun" +license: BSD-3-Clause +author: "Author name here" +maintainer: "example@example.com" +copyright: "2023 Author name here" + +extra-source-files: +- README.md +- CHANGELOG.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints + +library: + source-dirs: src + +executables: + lvtrun-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - lvtrun + +tests: + lvtrun-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - lvtrun diff --git a/lvtrun/src/Lib.hs b/lvtrun/src/Lib.hs new file mode 100644 index 0000000..d36ff27 --- /dev/null +++ b/lvtrun/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/lvtrun/stack.yaml b/lvtrun/stack.yaml new file mode 100644 index 0000000..b2997b7 --- /dev/null +++ b/lvtrun/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/0.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of Stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.11" +# +# Override the architecture used by Stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by Stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/lvtrun/test/Spec.hs b/lvtrun/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/lvtrun/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/src/AST.hs b/src/AST.hs deleted file mode 100644 index 6485f2c..0000000 --- a/src/AST.hs +++ /dev/null @@ -1,17 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Abstract Syntax Tree --} - -module AST - ( - showMaybeTree - ) where - -import Types - -showMaybeTree :: Maybe Tree -> String -showMaybeTree Nothing = "Nothing" -showMaybeTree (Just tree) = show tree diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs deleted file mode 100644 index 64cb53e..0000000 --- a/src/Computing/ComputeAST.hs +++ /dev/null @@ -1,162 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- ComputeAST --} - -module Computing.ComputeAST - ( - computeAST - ) where - -import Types -import Computing.ListContainList -import Computing.ReplaceFunctionParams -import Computing.Defines -import Computing.Functions -import Computing.Errors -import Computing.Operators.Calculate -import Computing.Operators.Assert - -------------------------- CONDITIONS --------------------------------- - -handleIf :: Env -> [Tree] -> (Env, Result) -handleIf env (Boolean (True) : thenBranch : _ : []) - = computeASTWithoutList env thenBranch -handleIf env (Boolean (False) : _ : elseBranch : []) - = computeASTWithoutList env elseBranch -handleIf env _ = (registerError env "Bad if statement", Right (undefined)) - ----------------------------------------------------------------------------------- - --- Find nested lists and resolve them -resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) -resolveNestedLists env resolvedList [] = (env, Just resolvedList) -resolveNestedLists env resolvedList (List list : rest) - | not (doesListContainsList list) = - case handleSimpleList env list of - (newEnv, Left (Just resolved)) -> - resolveNestedLists newEnv (resolvedList ++ [resolved]) rest - (newEnv, _) -> (newEnv, Nothing) - | otherwise = case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Nothing) - (newEnv, Just rvd) - -> resolveNestedLists newEnv (resolvedList ++ [List rvd]) rest -resolveNestedLists env resolvedList (Number number : rest) = - resolveNestedLists env (resolvedList ++ [Number number]) rest -resolveNestedLists env resolvedList (Boolean value : rest) = - resolveNestedLists env (resolvedList ++ [Boolean value]) rest -resolveNestedLists env resolvedList (Symbol smbl : rest) = - resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest - ----------------------------------------------------------------------------------- - --- Compute simple lists (no nested lists) -handleSimpleList :: Env -> [Tree] -> (Env, Result) -handleSimpleList env (Symbol "+" : rest) = addition env rest -handleSimpleList env (Symbol "*" : rest) = multiplication env rest -handleSimpleList env (Symbol "-" : rest) = subtraction env rest -handleSimpleList env (Symbol "div" : rest) = division env rest -handleSimpleList env (Symbol "mod" : rest) = modulo env rest -handleSimpleList env (Symbol "eq?" : rest) = equal env rest -handleSimpleList env (Symbol "diff?" : rest) = notEqual env rest -handleSimpleList env (Symbol "<" : rest) = inferior env rest -handleSimpleList env (Symbol ">" : rest) = superior env rest -handleSimpleList env (Symbol "<=" : rest) = inferiorOrEqual env rest -handleSimpleList env (Symbol ">=" : rest) = superiorOrEqual env rest -handleSimpleList env (Symbol "if" : rest) = handleIf env rest -handleSimpleList env (Symbol smbl : rest) = - case getFunctionByName env smbl of - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), - Right (undefined)) - Just func -> - case computeFunction env func rest of - (_, Left (Just result)) -> (env, Left (Just result)) - (newEnv, _) -> (env {errors = errors newEnv}, Right(undefined)) -handleSimpleList env _ = - (registerError env "Bad function call", Right (undefined)) - ------------------------------------------------------------------------------ - -handleLambda :: Env -> Tree -> (Env, Result) -handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): - (List args): _)) = - computeFunction env - (Function "" (getParams (List fnParams)) fnBodies) args -handleLambda env _ = (registerError env "Bad lambda", Left (Nothing)) - ---------------------------- COMPUTE FUNCTIONS -------------------------------- - -computeFunctionBody :: Env -> Function -> [Tree] -> (Env, Result) -computeFunctionBody env (Function _ _ []) _ = (env, Left (Nothing)) -computeFunctionBody env (Function _ fnParams (x:_)) args = - case replaceFunctionParams env fnParams x args of - (newEnv, Nothing) -> (newEnv, Right (undefined)) - (newEnv, Just replaced) -> computeAST newEnv replaced -computeFunction :: Env -> Function -> [Tree] -> (Env, Result) -computeFunction env (Function fnName fnParams (x:xs:rest)) args = - case computeFunctionBody env (Function fnName fnParams [x]) args of - (newEnv, Left (Nothing)) -> - computeFunction newEnv (Function fnName fnParams (xs:rest)) args - (_, _) -> - (registerError env "Bad return placement", Right (undefined)) -computeFunction env (Function fnName fnParams (x:_)) args = - case computeFunctionBody env (Function fnName fnParams [x]) args of - (newEnv, Left (Just replaced)) -> computeAST newEnv replaced - (newEnv, _) -> - (registerError newEnv "Missing return in func", Right (undefined)) -computeFunction env _ _ = - (registerError env "Bad function call", Right (undefined)) - ----------------------------- REGISTER DEFINE ---------------------------------- - --- Register a define in the Defines list -registerDefine :: Env -> Symbol -> Tree -> Env -registerDefine env symb value@(Number _) = addDefineToEnv env symb value -registerDefine env symb value@(Boolean _) = addDefineToEnv env symb value -registerDefine env symb (List list) = case computeAST env (List list) of - (_, Left (Just result)) -> addDefineToEnv env symb result - (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) -registerDefine env symb (Symbol smbl) = case getSymbolValue env smbl of - (_, Just result) -> addDefineToEnv env symb result - (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) - ---------------------------- COMPUTE AST ------------------------------------- - -computeASTWithoutList :: Env -> Tree -> (Env, Result) -computeASTWithoutList env (Number nbr) = (env, Left (Just (Number nbr))) -computeASTWithoutList env (Boolean value) = (env, Left (Just (Boolean value))) -computeASTWithoutList env (Symbol smbl) - | Nothing <- value = (env, Right (undefined)) - | Just (List list) <- value = computeAST env (List list) - | Just result <- value = (env, Left (Just result)) - where (_, value) = getSymbolValue env smbl -computeASTWithoutList env _ = (env, Right (undefined)) - -computeAstWithList :: Env -> Tree -> (Env, Result) -computeAstWithList env (List list) - | not (doesListContainsList list) = handleSimpleList env list - | otherwise = case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Right (undefined)) - (newEnv, Just rvd) -> computeAST newEnv (List rvd) -computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) - -handleDefine :: Env -> Tree -> (Env, Result) -handleDefine env (List [Symbol _, Symbol smbl, - List (Symbol "lambda": List fnParams : fnBodies)]) = - (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) -handleDefine env (List [Symbol _, - (List (Symbol smbl : fnParams)), List fnBodies]) = - (registerFunction env smbl (List fnParams) - (List fnBodies : []), Left (Nothing)) -handleDefine env (List [Symbol _, Symbol smbl, expr]) = - (registerDefine env smbl expr, Left (Nothing)) -handleDefine env _ = (registerError env "Bad define", Right (undefined)) - -computeAST :: Env -> Tree -> (Env, Result) -computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree -computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = - handleLambda env tree -computeAST env tree@(List _) = computeAstWithList env tree -computeAST env tree = computeASTWithoutList env tree diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs deleted file mode 100644 index abc69fa..0000000 --- a/src/Computing/Defines.hs +++ /dev/null @@ -1,56 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Defines --} - -module Computing.Defines - ( - getSymbolValue, - addDefineToEnv, - registerFunction, - getParams - ) where - -import Types -import Computing.Errors - -getSymbolValue :: Env -> String -> (Env, Maybe Tree) -getSymbolValue (Env { defines = [], errors = _, functions = _ }) _ = - (Env { defines = [], errors = [], functions = [] }, Nothing) -getSymbolValue (Env { defines = (Define smbl value):xs, - errors = err, functions = fcts }) expr - | smbl == expr = - (Env { defines = xs, errors = err, functions = fcts }, Just value) - | otherwise = getSymbolValue - (Env { defines = xs, errors = err, functions = fcts }) expr - -isAlreadyDefined :: Env -> Symbol -> Bool -isAlreadyDefined env symb = symb `elem` map (\(Define s _) -> s) (defines env) - -addDefineToEnv :: Env -> Symbol -> Tree -> Env -addDefineToEnv env symb value - | isAlreadyDefined env symb = registerError env ("Symbol " ++ symb ++ - " is already defined") - | otherwise = Env (defines env ++ [Define symb value]) (errors env) - (functions env) - --- Add a function to the Functions list in the Env -addFunction :: Env -> String -> [String] -> [Tree] -> Env -addFunction env fnName fnParams fnBodies - = Env (defines env) (errors env) - (functions env ++ [Function fnName fnParams fnBodies]) - --- Get params from a function -getParams :: Tree -> [String] -getParams (List []) = [] -getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) -getParams _ = [] - --- Register a function in the Functions list -registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env -registerFunction env "" _ _ = - registerError env "function name must not be empty" -registerFunction env fnName fnParams fnBodies - = addFunction env fnName (getParams fnParams) fnBodies diff --git a/src/Computing/Errors.hs b/src/Computing/Errors.hs deleted file mode 100644 index 20360c0..0000000 --- a/src/Computing/Errors.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Errors --} - -module Computing.Errors - ( - registerError, - getErrors, - getLastError, - clearErrors, - printErrors, - printLastError - ) where - -import Types - --- Add a new error to env -registerError :: Env -> String -> Env -registerError env err = Env (defines env) (errors env ++ [err]) (functions env) - --- Get all errors -getErrors :: Env -> [String] -getErrors env = errors env - --- Get the last error -getLastError :: Env -> String -getLastError env = last (errors env) - --- Clear all errors -clearErrors :: Env -> Env -clearErrors env = Env (defines env) [] (functions env) - --- Print all errors -printErrors :: Env -> IO () -printErrors env = mapM_ putStrLn (map (\x -> "Error: " ++ x) (errors env)) - --- Print the last error -printLastError :: Env -> IO () -printLastError env = putStrLn (last (errors env)) diff --git a/src/Computing/Functions.hs b/src/Computing/Functions.hs deleted file mode 100644 index a31c75e..0000000 --- a/src/Computing/Functions.hs +++ /dev/null @@ -1,22 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Functions --} - -module Computing.Functions - ( getFunctionByName - ) where - -import Types - --- Find and execute user defined function -getFunctionByName :: Env -> String -> Maybe Function -getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function fnName fnParams body):xs, - defines = defs, errors = errs }) expr - | fnName == expr = Just (Function fnName fnParams body) - | otherwise = - getFunctionByName (Env { functions = xs, defines = defs, - errors = errs }) expr diff --git a/src/Computing/ListContainList.hs b/src/Computing/ListContainList.hs deleted file mode 100644 index 71689dc..0000000 --- a/src/Computing/ListContainList.hs +++ /dev/null @@ -1,18 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- ListContainList --} - -module Computing.ListContainList - ( - doesListContainsList - ) where - -import Types - -doesListContainsList :: [Tree] -> Bool -doesListContainsList [] = False -doesListContainsList (List _ : _) = True -doesListContainsList (_ : rest) = doesListContainsList rest diff --git a/src/Computing/Operators/Assert.hs b/src/Computing/Operators/Assert.hs deleted file mode 100644 index b1e583d..0000000 --- a/src/Computing/Operators/Assert.hs +++ /dev/null @@ -1,68 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Assert --} - -module Computing.Operators.Assert - ( - equal, - notEqual, - inferior, - inferiorOrEqual, - superior, - superiorOrEqual - ) where - -import Types -import Computing.Operators.EvaluateSymbol -import Data.Int (Int64) -import Computing.Errors - -assert :: Int64 -> Int64 -> Symbol -> Tree -assert a b ">" = Boolean (a > b) -assert a b "<" = Boolean (a < b) -assert a b ">=" = Boolean (a >= b) -assert a b "<=" = Boolean (a <= b) -assert a b "eq?" = Boolean (a == b) -assert a b "diff?" = Boolean (a /= b) -assert _ _ _ = Boolean (False) - -maybeAssert :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) -maybeAssert (Just (Number a)) (Just (Number b)) operator env = - (env, Left (Just (assert a b operator))) -maybeAssert _ _ _ env = - (registerError env "Symbol not found", Right (undefined)) - -assertOperator :: Env -> [Tree] -> Symbol -> (Env, Result) -assertOperator env [Number a, Number b] operator = - (env, Left (Just (assert a b operator))) -assertOperator env [Number a, Symbol b] operator = - maybeAssert (Just (Number a)) (evaluateSymbol env b) operator env -assertOperator env [Symbol a, Number b] operator = - maybeAssert (evaluateSymbol env a) (Just (Number b)) operator env -assertOperator env [Symbol a, Symbol b] operator = - maybeAssert (evaluateSymbol env a) (evaluateSymbol env b) operator env -assertOperator env list _ - | length list /= 2 = - (registerError env "assert need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in assert", Right (undefined)) - -equal :: Env -> [Tree] -> (Env, Result) -equal env trees = assertOperator env trees "eq?" - -notEqual :: Env -> [Tree] -> (Env, Result) -notEqual env trees = assertOperator env trees "diff?" - -inferior :: Env -> [Tree] -> (Env, Result) -inferior env trees = assertOperator env trees "<" - -superior :: Env -> [Tree] -> (Env, Result) -superior env trees = assertOperator env trees ">" - -inferiorOrEqual :: Env -> [Tree] -> (Env, Result) -inferiorOrEqual env trees = assertOperator env trees "<=" - -superiorOrEqual :: Env -> [Tree] -> (Env, Result) -superiorOrEqual env trees = assertOperator env trees ">=" diff --git a/src/Computing/Operators/Calculate.hs b/src/Computing/Operators/Calculate.hs deleted file mode 100644 index c6db955..0000000 --- a/src/Computing/Operators/Calculate.hs +++ /dev/null @@ -1,70 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Calculate --} - -module Computing.Operators.Calculate - ( - addition, - subtraction, - multiplication, - division, - modulo, - ) where - -import Types -import Data.Int (Int64) -import Computing.Errors -import Computing.Operators.EvaluateSymbol - --- Compute a "+ - div * mod" list, using defines if needed - -calculate :: Int64 -> Int64 -> Symbol -> Tree -calculate a b "+" = Number (a + b) -calculate a b "-" = Number (a - b) -calculate a b "*" = Number (a * b) -calculate a b "div" = Number (a `div` b) -calculate a b "mod" = Number (a `mod` b) -calculate _ _ _ = Number 0 - -maybeCalculate :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) -maybeCalculate _ (Just (Number 0)) "div" env - = (registerError env "Division by 0", Right (undefined)) -maybeCalculate (Just (Number a)) (Just (Number b)) operator env = - (env, Left (Just (calculate a b operator))) -maybeCalculate _ _ _ env = - (registerError env "Symbol not found", Right (undefined)) - -calculateOperator :: Env -> [Tree] -> Symbol -> (Env, Result) -calculateOperator env [_, Number 0] "div" = - (registerError env "Division by 0", Right (undefined)) -calculateOperator env [Number a, Number b] operator = - (env, Left (Just (calculate a b operator))) -calculateOperator env [Number a, Symbol b] operator = - maybeCalculate (Just (Number a)) (evaluateSymbol env b) operator env -calculateOperator env [Symbol a, Number b] operator = - maybeCalculate (evaluateSymbol env a) (Just (Number b)) operator env -calculateOperator env [Symbol a, Symbol b] operator = - maybeCalculate (evaluateSymbol env a) (evaluateSymbol env b) operator env -calculateOperator env list _ - | length list /= 2 = - (registerError env "Addition need 2 params", Right (undefined)) - | otherwise = - (registerError env "Bad types in addition", Right (undefined)) - -addition :: Env -> [Tree] -> (Env, Result) -addition env trees = calculateOperator env trees "+" - -subtraction :: Env -> [Tree] -> (Env, Result) -subtraction env trees = calculateOperator env trees "-" - -multiplication :: Env -> [Tree] -> (Env, Result) -multiplication env trees = calculateOperator env trees "*" - -division :: Env -> [Tree] -> (Env, Result) -division env trees = calculateOperator env trees "div" - -modulo :: Env -> [Tree] -> (Env, Result) -modulo env trees = calculateOperator env trees "mod" diff --git a/src/Computing/Operators/EvaluateSymbol.hs b/src/Computing/Operators/EvaluateSymbol.hs deleted file mode 100644 index aedac51..0000000 --- a/src/Computing/Operators/EvaluateSymbol.hs +++ /dev/null @@ -1,24 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- EvaluateSymbol --} - -module Computing.Operators.EvaluateSymbol - ( - evaluateSymbol - ) where - -import Types -import Computing.Defines - --- Evaluate a symbol and return its value -evaluateSymbol :: Env -> Symbol -> Maybe Tree -evaluateSymbol env smbl = - case getSymbolValue env smbl of - (_, Nothing) -> Nothing - (_, Just (Number number)) -> Just (Number number) - (_, Just (Boolean value)) -> Just (Boolean value) - (_, Just (List list)) -> Just (List list) - (_, _) -> Nothing diff --git a/src/Computing/ReplaceFunctionParams.hs b/src/Computing/ReplaceFunctionParams.hs deleted file mode 100644 index 34f26ed..0000000 --- a/src/Computing/ReplaceFunctionParams.hs +++ /dev/null @@ -1,30 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- ReplaceFunctionParams --} - -module Computing.ReplaceFunctionParams - ( - replaceFunctionParams - ) where - -import Types -import Computing.Errors - -replaceSymbol :: Tree -> String -> Tree -> Tree -replaceSymbol (Symbol smbl) toReplace replacement - | smbl == toReplace = replacement - | otherwise = Symbol smbl -replaceSymbol (List lst) toReplace replacement - = List (map (\t -> replaceSymbol t toReplace replacement) lst) -replaceSymbol t _ _ = t - -replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) -replaceFunctionParams env fnParams body args - | length fnParams /= length args = - (registerError env "Mismatched number of arguments", Nothing) - | otherwise = - (env, Just $ foldl (\acc (param, arg) -> replaceSymbol acc param arg) - body (zip fnParams args)) diff --git a/src/KoakyLibVersion.hs b/src/KoakyLibVersion.hs deleted file mode 100644 index 9fc9a5b..0000000 --- a/src/KoakyLibVersion.hs +++ /dev/null @@ -1,33 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- koaky --- File description: --- lib version --} - -module KoakyLibVersion - ( - koakyLibVersionPatch, - koakyLibVersionMinor, - koakyLibVersionMajor, - koakyLibVersion - ) - where - -koakyLibVersionPatch :: Int -koakyLibVersionPatch = 0 - -koakyLibVersionMinor :: Int -koakyLibVersionMinor = 4 - -koakyLibVersionMajor :: Int -koakyLibVersionMajor = 0 - - -koakyLibVersion :: String -koakyLibVersion = fullVersion - where - fMaj = show koakyLibVersionMajor - fMin = show koakyLibVersionMinor - fPat = show koakyLibVersionPatch - fullVersion = fMaj ++ "." ++ fMin ++ "." ++ fPat diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs deleted file mode 100644 index 5da5cd6..0000000 --- a/src/Parsing/Parser.hs +++ /dev/null @@ -1,130 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Parser --- File description: --- Parser --} - -module Parsing.Parser - ( - Parser (Parser, runParser), - parseTree - ) where - -import Types -import Control.Applicative -import Data.Int (Int64) - -data Parser a = Parser { - runParser :: String -> Maybe (a, String) -} - -instance Functor Parser where - fmap fct parser = Parser f - where - f str = case runParser parser str of - Just (x, xs) -> Just (fct x, xs) - Nothing -> Nothing - -instance Applicative Parser where - pure x = Parser f - where - f str = Just (x, str) - p1 <*> p2 = Parser f - where - f str = case runParser p1 str of - Just (x, xs) -> - case runParser p2 xs of - Just (y, ys) -> Just (x y, ys) - Nothing -> Nothing - Nothing -> Nothing - -instance Alternative Parser where - empty = Parser f - where - f _ = Nothing - p1 <|> p2 = Parser f - where - f str = case runParser p1 str of - Just (x, xs) -> Just (x, xs) - Nothing -> runParser p2 str - -instance Monad Parser where - parser >>= fct = Parser f - where - f str = case runParser parser str of - Just (x, xs) -> runParser (fct x) xs - Nothing -> Nothing - return = pure - -parseChar :: Char -> Parser Char -parseChar c = Parser f - where - f [] = Nothing - f (x:xs) | x == c = Just (x, xs) - | otherwise = Nothing - -parseAnyChar :: String -> Parser Char -parseAnyChar str = Parser f - where - f [] = Nothing - f (x:xs) | x `elem` str = Just (x, xs) - | otherwise = Nothing - -parseUInt :: Parser Int64 -parseUInt = read <$> some (parseAnyChar "0123456789") - -parseSign :: Parser Int64 -parseSign = Parser f - where - f str = case runParser (many (parseAnyChar "+-")) str of - Just (x, xs) | even (length (filter (== '-') x)) -> Just (1, xs) - | otherwise -> Just (-1, xs) - Nothing -> Nothing - -parseInt :: Parser Int64 -parseInt = (*) <$> parseSign <*> parseUInt - -parseSymbol :: Parser Symbol -parseSymbol = some - (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "*/+=-_!<>")) - -stringToBool :: String -> Bool -stringToBool "#t" = True -stringToBool "#f" = False -stringToBool _ = False - -parseBool :: Parser Bool -parseBool = stringToBool - <$> ((:) <$> (parseChar '#') <*> ((\x -> x:[]) <$> (parseAnyChar "tf"))) - -parseList'' :: Parser a -> Parser [a] -parseList'' p = Parser f - where - f str = case runParser p str of - Just (x, xs) -> - case runParser (many (parseChar ' ')) xs of - Just (_, xs') -> - runParser ((x :) <$> parseList' p) xs' - Nothing -> Nothing - Nothing -> Nothing - -parseList' :: Parser a -> Parser [a] -parseList' p = Parser f - where - f str = case runParser (parseChar ')') str of - Just (_, xs) -> Just ([], xs) - Nothing -> runParser (parseList'' p) str - -parseList :: Parser a -> Parser [a] -parseList p = Parser f - where - f str = case runParser (parseChar '(') str of - Just (_, xs) -> runParser (parseList' p) xs - Nothing -> Nothing - -parseTree :: Parser Tree -parseTree = ((\x -> List x) <$> (parseList parseTree)) - <|> ((\x -> Number x) <$> (parseInt)) - <|> ((\x -> Boolean x) <$> (parseBool)) - <|> ((\x -> Symbol x) <$> (parseSymbol)) diff --git a/src/Types.hs b/src/Types.hs deleted file mode 100644 index 9e6f4c3..0000000 --- a/src/Types.hs +++ /dev/null @@ -1,73 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Defines all types avoiding circular dependencies --} - -module Types - ( - Symbol, - Tree(..), - Define(..), - Env(..), - Result, - Function(..) - ) where - -import Data.Int (Int64) -import Data.Void (Void) - -type Symbol = String - -data Tree = Number Int64 | Symbol Symbol | Boolean Bool | List [Tree] - -data Define = Define { - symbol :: String, - expression :: Tree -} deriving (Show) - -data Function = Function { - name :: String, - params :: [String], - bodies :: [Tree] -} deriving (Show) - -data Env = Env { - defines :: [Define], - errors :: [String], - functions :: [Function] -} - -type Result = Either (Maybe Tree) Void - ----------- EQ INSTANCES ---------- - -instance Eq Tree where - Number a == Number b = a == b - Symbol a == Symbol b = a == b - Boolean a == Boolean b = a == b - List a == List b = a == b - _ == _ = False - -instance Eq Env where - Env { defines = def1, errors = err1 } - == Env { defines = def2, errors = err2 } - = def1 == def2 && err1 == err2 - -instance Eq Define where - Define smb expr == Define smb2 expr2 - = smb == smb2 && expr == expr2 - ----------- SHOW INSTANCES ---------- - -instance Show Tree where - show (Number a) = "N:'" ++ show a ++ "'" - show (Symbol a) = "S:'" ++ a ++ "'" - show (Boolean value) = "B: " ++ show value - show (List list) = "L: " ++ show list - -instance Show Env where - show (Env { defines = def, errors = err, functions = func }) = - "Defines: " ++ show def ++ "\nErrors: " - ++ show err ++ "\nFunctions: " ++ show func diff --git a/stack.yaml.lock b/stack.yaml.lock deleted file mode 100644 index 92ef11f..0000000 --- a/stack.yaml.lock +++ /dev/null @@ -1,33 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files - -packages: -- completed: - hackage: tasty-1.4.2.2@sha256:b987609178d70c0042b950302161a049be8a878aa8cee4a9c7ba81d22d29a3f5,2719 - pantry-tree: - sha256: a93f5e31aac66a82a885cb2ddc8eada9a8adefe8587da1c4085fae58b6bc4683 - size: 1944 - original: - hackage: tasty-1.4.2.2 -- completed: - hackage: tasty-hunit-0.10.1@sha256:ebc17b490750d4796b21d44001b852688cc39f9c34e387d5e7958e09b9b3f3b9,1602 - pantry-tree: - sha256: c00ed23d8281b6c6f4ec33dd1e9e3a7971b0a769b6140978cfaf2a6eff025c78 - size: 399 - original: - hackage: tasty-hunit-0.10.1 -- completed: - hackage: tasty-html-0.4.2.1@sha256:92ded1b794bfd6a46d5705f418c531f51aba3907b92d68a28aed349fc03a8e0d,1599 - pantry-tree: - sha256: 88f745a7d4904c2f663baeadb3fe14ec0986c02341b2663d7e7051a680fdca3c - size: 547 - original: - hackage: tasty-html-0.4.2.1 -snapshots: -- completed: - sha256: 8017c7970c2a8a9510c60cc70ac245d59e0c34eb932b91d37af09fe59855d854 - size: 640038 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/13.yaml - original: lts-21.13 diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 index 7d0f5a1..0000000 --- a/test/Spec.hs +++ /dev/null @@ -1,363 +0,0 @@ -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.Runners.Html - -import Computing.ComputeAST -import Types -import Parsing.Parser - -main :: IO () -main = defaultMainWithIngredients (htmlRunner : defaultIngredients) tests - -tests :: TestTree -tests = testGroup "Tests" - [ - unitTestsASTEqual, - unitTestComputeTypes, - unitTestsComputeDefines, - unitTestsComputeSimpleFunctions, - unitTestsComputeBasics, - unitTestsASTParse, - unitTestsComputeFunctions, - unitTestsComputeConditions - ] - -unitTestsASTEqual :: TestTree -unitTestsASTEqual = testGroup "AST Equal Tests" - [ testCase "Basic AST creation 0" $ - assertEqual "define x 42" - (List [Symbol "define", Symbol "x", Number 42]) - (List [Symbol "define", Symbol "x", Number 42]) - , testCase "Basic AST creation 1" $ - assertEqual "foo" - (Symbol "foo") - (Symbol "foo") - , testCase "Basic AST creation 2" $ - assertEqual "42" - (Number 42) - (Number 42) - , testCase "Basic AST creation 3" $ - assertEqual "#f" - (Boolean False) - (Boolean False) - , testCase "Basic AST creation 4" $ - assertEqual "#t" - (Boolean True) - (Boolean True) - ] - -testParser :: String -> Tree -> IO () -testParser str tree = case runParser (parseTree) str of - Nothing -> assertFailure "Parsing failed" - Just (t, _) -> assertEqual str tree t - -unitTestsASTParse :: TestTree -unitTestsASTParse = testGroup "AST Parse Tests" - [ testCase "(foo abc def hij)" $ - testParser "(foo abc def hij)" (List [Symbol "foo", Symbol "abc", Symbol "def", Symbol "hij"]) - , testCase "(define x 42)" $ - testParser "(define x 42)" (List [Symbol "define", Symbol "x", Number 42]) - , testCase "42" $ - testParser "42" (Number 42) - , testCase "#f" $ - testParser "#f" (Boolean False) - , testCase "#t" $ - testParser "#t" (Boolean True) - , testCase "foo" $ - testParser "foo" (Symbol "foo") - , testCase "(foo)" $ - testParser "(foo)" (List [Symbol "foo"]) - , testCase "(foo def)" $ - testParser "(foo def)" (List [Symbol "foo", Symbol "def"]) - , testCase "(foo def #t)" $ - testParser "(foo def #t)" (List [Symbol "foo", Symbol "def", Boolean True]) - , testCase "(foo def #f)" $ - testParser "(foo def #f)" (List [Symbol "foo", Symbol "def", Boolean False]) - , testCase "(foo #f def)" $ - testParser "(foo #f def)" (List [Symbol "foo", Boolean False, Symbol "def"]) - , testCase "(foo def #t #f)" $ - testParser "(foo def #t #f)" (List [Symbol "foo", Symbol "def", Boolean True, Boolean False]) - , testCase "(foo def #f #t)" $ - testParser "(foo def #f #t)" (List [Symbol "foo", Symbol "def", Boolean False, Boolean True]) - , testCase "(fst 1 (scd 2 3 4))" $ - testParser "(fst 1 (scd 2 3 4))" (List [Symbol "fst", Number 1, List [Symbol "scd", Number 2, Number 3, Number 4]]) - , testCase "(fst 1 (scd 2 3 4) 12)" $ - testParser "(fst 1 (scd 2 3 4) 12)" (List [Symbol "fst", Number 1, List [Symbol "scd", Number 2, Number 3, Number 4], Number 12]) - , testCase "(foo 42 )" $ - testParser "(foo 42 )" (List [Symbol "foo", Number 42]) - , testCase "(foo def )" $ - testParser "(foo def )" (List [Symbol "foo", Symbol "def"]) - , testCase "(foo ((def)) #t)" $ - testParser "(foo ((def)) #t)" (List [Symbol "foo", List [List [Symbol "def"]], Boolean True]) - , testCase "(do (re (mi)) 12)" $ - testParser "(do (re (mi)) 12)" (List [Symbol "do", List [Symbol "re", List [Symbol "mi"]], Number 12]) - , testCase "(do (re (mi)) 12 (re (mi)))" $ - testParser "(do (re (mi)) 12 (re (mi)))" (List [Symbol "do", List [Symbol "re", List [Symbol "mi"]], Number 12, List [Symbol "re", List [Symbol "mi"]]]) - ] - -computeAllAST :: Env -> [Tree] -> (Env, [Result]) -computeAllAST env [] = (env, []) -computeAllAST env (x:xs) = do - let (newEnv, result) = computeAST env x - case result of - Left (Just r) -> do - let (newEnv2, results) = computeAllAST newEnv xs - (newEnv2, (Left (Just r)):results) - _ -> do - let (newEnv2, results) = computeAllAST newEnv xs - (newEnv2, results) - -defaultEnv :: Env -defaultEnv = Env {defines = [], errors = [], functions = []} - -unitTestComputeTypes :: TestTree -unitTestComputeTypes = testGroup "Tests Compute Types" - [ testCase "bool true" $ - assertEqual "bool true" - (defaultEnv, Left (Just (Boolean True))) - (computeAST (defaultEnv) (Boolean True)) - , testCase "bool false" $ - assertEqual "bool false" - (defaultEnv, Left (Just (Boolean False))) - (computeAST (defaultEnv) (Boolean False)) - , testCase "number 42" $ - assertEqual "number 42" - (defaultEnv, Left (Just (Number 42))) - (computeAST (defaultEnv) (Number 42)) - , testCase "number -42" $ - assertEqual "number -42" - (defaultEnv, Left (Just (Number (-42)))) - (computeAST (defaultEnv) (Number (-42))) - ] - -unitTestsComputeDefines :: TestTree -unitTestsComputeDefines = testGroup "Tests Compute defines" - [ testCase "define x 42" $ - assertEqual "define x 42" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, Left (Nothing)) - (computeAST (defaultEnv) (List [Symbol "define", Symbol "x", Number 42])) - , testCase "define x 42; x" $ - assertEqual "define x 42; x" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 42))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) - , testCase "define x 42; define y 84" $ - assertEqual "define x 42; define y 84" - (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, []) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) - , testCase "define x 42; define y 84; x; y" $ - assertEqual "define x 42; define y 84; x; y" - (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, [Left (Just (Number 42)), Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) - , testCase "define x (42 + 6); x" $ - assertEqual "define x (42 + 6); x" - (Env {defines = [Define {symbol = "x", expression = Number 48}], errors = [], functions = []}, [Left (Just (Number 48))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) - , testCase "define foo (4 + 5); foo + foo" $ - assertEqual "define foo (4 + 5); foo + foo" - (Env {defines = [Define {symbol = "foo", expression = Number 9}], errors = [], functions = []}, [Left (Just (Number 18))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) - , testCase "define foo 42; define bar foo; bar + bar" $ - assertEqual "define foo 42; define bar foo; bar + bar" - (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Symbol "foo"]), (List [Symbol "+", Symbol "bar", Symbol "bar"])]) - , testCase "define foo 42; define foo 84" $ - assertEqual "define foo 42; define foo 84" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = ["Symbol foo is already defined"], functions = []}, []) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "foo", Number 84])]) - ] - -unitTestsComputeSimpleFunctions :: TestTree -unitTestsComputeSimpleFunctions = testGroup "Tests compute + - div mod" - [ testCase "42 + 42" $ - assertEqual "42 + 42" - (defaultEnv, Left (Just (Number 84))) - (computeAST (defaultEnv) (List [Symbol "+", Number 42, Number 42])) - , testCase "-42 + -42" $ - assertEqual "-42 + -42" - (defaultEnv, Left (Just (Number (-84)))) - (computeAST (defaultEnv) (List [Symbol "+", Number (-42), Number (-42)])) - , testCase "42 + dontexist" $ - assertEqual "42 + dontexist" - (Env {defines = [], errors = ["Symbol not found"], functions = []}, Right (undefined)) - (computeAST (defaultEnv) (List [Symbol "+", Number 42, Symbol "dontexist"])) - , testCase "bool + number" $ - assertEqual "bool + number" - (Env {defines = [], errors = ["Bad types in addition"], functions = []}, Right (undefined)) - (computeAST (defaultEnv) (List [Symbol "+", Boolean True, Number 42])) - , testCase "20 / 2 + 3 * 5 - 10" $ - assertEqual "20 / 2 + 3 * 5 - 10" - (defaultEnv, Left (Just (Number 15))) - (computeAST (defaultEnv) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) - , testCase "11 mod 3" $ - assertEqual "11 mod 3" - (defaultEnv, Left (Just (Number 2))) - (computeAST (defaultEnv) (List [Symbol "mod", Number 11, Number 3])) - ] - -unitTestsComputeBasics :: TestTree -unitTestsComputeBasics = testGroup "Tests compute basics" - [ testCase "define foo 42; foo + foo" $ - assertEqual "define foo 42; foo + foo" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) - , testCase "define foo 42; define bar 42; foo + bar" $ - assertEqual "define foo 42; define bar 42; foo + bar" - (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) - , testCase "2 + 2 * 5" $ - assertEqual "2 + 2 * 5" - (defaultEnv, [Left (Just (Number 12))]) - (computeAllAST (defaultEnv) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) - , testCase "2 + 2 * (foo + 10) = 106" $ - assertEqual "2 + 2 * (foo + 10) = 106" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 106))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) - , testCase "2 + 3 * (8 + (5* ( 2 + 3))) = 107" $ - assertEqual "2 + 3 * (8 + (5* ( 2 + 3))) = 107" - (defaultEnv, [Left (Just (Number 101))]) - (computeAllAST (defaultEnv) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) - , testCase "div 42 0" $ - assertEqual "div 42 0" - (Env {defines = [], errors = ["Division by 0"], functions = []}, Right (undefined)) - (computeAST (defaultEnv) (List [Symbol "div", Number 42, Number 0])) - ] - -unitTestsComputeFunctions :: TestTree -unitTestsComputeFunctions = testGroup "Tests compute functions" - [ testCase "(define add (lambda (a b) (+ a b))); (add 1 2)" $ - assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [(List [Symbol "+", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 3))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) - , testCase "(define sub (lambda (a b) (- a b))); (sub 84 42)" $ - assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], bodies = [(List [Symbol "-", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 42))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) - , testCase "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" $ - assertEqual "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], bodies = [(List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])]}]}, [Left (Just (Number 166))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) - , testCase "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" $ - assertEqual "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Left (Just (Number 3))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) - , testCase "((lambda (a b) (+ a b)) 1 2)" $ - assertEqual "((lambda (a b) (+ a b)) 1 2)" - (defaultEnv, Left (Just (Number 3))) - (computeAST (defaultEnv) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) - , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ - assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Left (Just (Number 42))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]]), (List [Symbol "func"])]) - , testCase "(define func (lambda () (+ 42 42))); (func)" $ - assertEqual "(define func (lambda () (+ 42 42))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) - , testCase "(define func (lambda (x) (+ 1 x))); (func 41)" $ - assertEqual "(define func (lambda (x) (+ 1 x))); (func 41)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Left (Just (Number 42))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) - , testCase "(define (add a b) (+ a b)); (add 1 2)" $ - assertEqual "(define (add a b) (+ a b)); (add 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [List [Symbol "+", Symbol "a", Symbol "b"]]}]}, [Left (Just (Number 3))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", List [Symbol "add", Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]]), (List [Symbol "add", Number 1, Number 2])]) - , testCase "(define (func x) (+ x 1)); (func 41)" $ - assertEqual "(define (func x) (+ x 1)); (func 41)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Symbol "x", Number 1]]}]}, [Left (Just (Number 42))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", List [Symbol "func", Symbol "x"], List [Symbol "+", Symbol "x", Number 1]]), (List [Symbol "func", Number 41])]) - , testCase "(define (fact n) (if (< n 2) 1 (* n (fact (- n 1))))); (fact 5)" $ - assertEqual "(define (fact n) (if (< n 2) 1 (* n (fact (- n 1))))); (fact 5)" - (Env { - defines = [], - errors = [], - functions = [ - Function { - name = "fact", - params = ["n"], - bodies = [ - List [ - Symbol "if", - List [Symbol "<", Symbol "n", Number 2], - Number 1, - List [ - Symbol "*", - Symbol "n", - List [ - Symbol "fact", - List [Symbol "-", Symbol "n", Number 1] - ] - ] - ] - ] - } - ] - }, [Left (Just (Number 120))]) - (computeAllAST (defaultEnv) [ - List [ - Symbol "define", - List [Symbol "fact", Symbol "n"], - List [ - Symbol "if", - List [Symbol "<", Symbol "n", Number 2], - Number 1, - List [ - Symbol "*", - Symbol "n", - List [ - Symbol "fact", - List [Symbol "-", Symbol "n", Number 1] - ] - ] - ] - ], - List [ - Symbol "fact", - Number 5 - ] - ] - ) - ] - -unitTestsComputeConditions :: TestTree -unitTestsComputeConditions = testGroup "Tests compute conditions" - [ testCase "(if #t 42 84)" $ - assertEqual "(if #t 42 84)" - (defaultEnv, Left (Just (Number 42))) - (computeAST (defaultEnv) (List [Symbol "if", Boolean True, Number 42, Number 84])) - , testCase "(if #f (3 + 3) (4 + 4))" $ - assertEqual "(if #f (3 + 3) (4 + 4))" - (defaultEnv, Left (Just (Number 8))) - (computeAST (defaultEnv) (List [Symbol "if", Boolean False, (List [Symbol "+", Number 3, Number 3]), (List [Symbol "+", Number 4, Number 4])])) - , testCase "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" $ - assertEqual "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 21))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "<", Symbol "foo", Number 10]), (List [Symbol "*", Symbol "foo", Number 3]), (List [Symbol "div", Symbol "foo", Number 2])])]) - , testCase "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" $ - assertEqual "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) - , testCase "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" $ - assertEqual "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 0))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) - , testCase "define foo 42; (if (diff? foo 22) (false) (true))" $ - assertEqual "define foo 42; (if (diff? foo 22) (false) (true))" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean True))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 22]), Boolean True, Boolean False])]) - , testCase "define foo 42; (if (diff? foo 42) (true) (false))" $ - assertEqual "define foo 42; (if (diff? foo 42) (true) (false))" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean False))]) - (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 42]), Boolean True, Boolean False])]) - , testCase "(define foo 9); (define (func x) (if (< x 10) #t #f)); (func foo)" $ - assertEqual "(define foo 9); (define (func x) (if (< x 10) #t #f)); (func foo)" - (Env {defines = [Define {symbol = "foo", expression = Number 9}], errors = [], functions = [ - Function {name = "func", params = ["x"], bodies = [ - (List [Symbol "if", (List [Symbol "<", Symbol "x", Number 10]), Boolean True, Boolean False]) - ]} - ]}, [Left (Just (Boolean True))]) - (computeAllAST - (defaultEnv) - [ - (List [Symbol "define", Symbol "foo", Number 9]), - (List [Symbol "define", (List [Symbol "func", Symbol "x"]), (List [Symbol "if", (List [Symbol "<", Symbol "x", Number 10]), Boolean True, Boolean False])]), - (List [Symbol "func", Symbol "foo"])]) - ]