From 27ce74984711c1fcf8c6b0d5baef41e1f4282423 Mon Sep 17 00:00:00 2001 From: Kamil Adam Date: Tue, 2 Jun 2020 19:43:55 +0200 Subject: [PATCH] Add Evaluator of BrainFuck and WhiteSpace Add WrapperIO, FilterIf0, MockIO and tests for WrapperIf0 --- alias.sh | 4 + docs/CHANGELOG.md | 5 + docs/INSTALL.md | 6 + docs/NEWS.md | 4 +- docs/ROADMAP.md | 4 +- docs/TODO.md | 7 +- helcam.cabal | 69 +++++-- .../BrainFuck/Evaluator/InteractEvaluator.hs | 57 ++++++ .../BrainFuck/Evaluator/MonadicEvaluator.hs | 57 ++++++ .../HelCam/BrainFuck/{Tokens.hs => Lexer.hs} | 28 ++- src/main/eta/HelVM/HelCam/BrainFuck/Symbol.hs | 62 +++++++ .../HelCam/BrainFuck/TableOfInstructions.hs | 31 ++++ .../HelVM/HelCam/BrainFuck/TapeOfSymbols.hs | 43 +++++ src/main/eta/HelVM/HelCam/BrainFuck/Token.hs | 19 +- src/main/eta/HelVM/HelCam/Common/FilterIf0.hs | 78 ++++++++ src/main/eta/HelVM/HelCam/Common/Util.hs | 40 ++++- src/main/eta/HelVM/HelCam/Common/WrapperIO.hs | 33 ++++ .../WhiteSpace/Evaluator/InteractEvaluator.hs | 102 +++++++++++ .../WhiteSpace/Evaluator/MonadicEvaluator.hs | 97 ++++++++++ .../HelVM/HelCam/WhiteSpace/EvaluatorUtil.hs | 47 +++++ .../HelVM/HelCam/WhiteSpace/Instruction.hs | 62 ++++--- src/main/eta/HelVM/HelCam/WhiteSpace/Lexer.hs | 27 +++ .../HelVM/HelCam/WhiteSpace/OperandParsers.hs | 61 +++++++ .../eta/HelVM/HelCam/WhiteSpace/Parser.hs | 127 ++++++------- src/main/eta/HelVM/HelCam/WhiteSpace/Token.hs | 36 ++-- .../eta/HelVM/HelCam/WhiteSpace/Tokens.hs | 29 --- src/main/eta/Main.hs | 6 +- .../Evaluator/InteractEvaluatorTest.hs | 26 +++ .../Evaluator/MonadicEvaluatorTest.hs | 26 +++ .../HelCam/BrainFuck/EvaluatorTestData.hs | 88 +++++++++ .../eta/HelVM/HelCam/BrainFuck/TokensTest.hs | 67 +------ .../eta/HelVM/HelCam/Common/FilterIf0Test.hs | 14 ++ src/test/eta/HelVM/HelCam/Common/MockIO.hs | 63 +++++++ src/test/eta/HelVM/HelCam/Common/UtilTest.hs | 11 ++ .../Evaluator/InteractEvaluatorTest.hs | 28 +++ .../Evaluator/MonadicEvaluatorTest.hs | 27 +++ .../HelCam/WhiteSpace/EvaluatorTestData.hs | 168 ++++++++++++++++++ .../HelCam/WhiteSpace/OperandParsersTest.hs | 71 ++++++++ .../eta/HelVM/HelCam/WhiteSpace/ParserTest.hs | 165 +---------------- src/test/eta/Test.hs | 18 +- 40 files changed, 1511 insertions(+), 402 deletions(-) create mode 100644 src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluator.hs create mode 100644 src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluator.hs rename src/main/eta/HelVM/HelCam/BrainFuck/{Tokens.hs => Lexer.hs} (80%) create mode 100644 src/main/eta/HelVM/HelCam/BrainFuck/Symbol.hs create mode 100644 src/main/eta/HelVM/HelCam/BrainFuck/TableOfInstructions.hs create mode 100644 src/main/eta/HelVM/HelCam/BrainFuck/TapeOfSymbols.hs create mode 100644 src/main/eta/HelVM/HelCam/Common/FilterIf0.hs create mode 100644 src/main/eta/HelVM/HelCam/Common/WrapperIO.hs create mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluator.hs create mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluator.hs create mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/EvaluatorUtil.hs create mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/Lexer.hs create mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/OperandParsers.hs delete mode 100644 src/main/eta/HelVM/HelCam/WhiteSpace/Tokens.hs create mode 100644 src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluatorTest.hs create mode 100644 src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluatorTest.hs create mode 100644 src/test/eta/HelVM/HelCam/BrainFuck/EvaluatorTestData.hs create mode 100644 src/test/eta/HelVM/HelCam/Common/FilterIf0Test.hs create mode 100644 src/test/eta/HelVM/HelCam/Common/MockIO.hs create mode 100644 src/test/eta/HelVM/HelCam/Common/UtilTest.hs create mode 100644 src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluatorTest.hs create mode 100644 src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluatorTest.hs create mode 100644 src/test/eta/HelVM/HelCam/WhiteSpace/EvaluatorTestData.hs create mode 100644 src/test/eta/HelVM/HelCam/WhiteSpace/OperandParsersTest.hs diff --git a/alias.sh b/alias.sh index eab142887..f33628a2b 100755 --- a/alias.sh +++ b/alias.sh @@ -1,2 +1,6 @@ #!/bin/bash alias etlas='../etlas' + +etlas clean && etlas build && etlas test + +git check-whitespace diff --git a/docs/CHANGELOG.md b/docs/CHANGELOG.md index 54f0b0610..a3221c795 100644 --- a/docs/CHANGELOG.md +++ b/docs/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for HelCam +## 0.4.0.0 -- 2020-06-15 + +* Add Evaluator of BrainFuck and WhiteSpace +* Add WrapperIO, FilterIf0, MockIO and tests for FilterIf0 + ## 0.3.0.0 -- 2020-05-30 * Add WhiteSpace Parser diff --git a/docs/INSTALL.md b/docs/INSTALL.md index 7557a9a5f..e52346405 100644 --- a/docs/INSTALL.md +++ b/docs/INSTALL.md @@ -9,6 +9,12 @@ git clone https://github.com/helvm/helcam.git cd helcam ``` +## HLint + +```bash +curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s . +``` + ## Cabal Compile and run with `cabal`: diff --git a/docs/NEWS.md b/docs/NEWS.md index 8e4071ffe..ea6f21623 100644 --- a/docs/NEWS.md +++ b/docs/NEWS.md @@ -2,7 +2,7 @@ **New features.** -* Add Parser for WhiteSpace -* Add Lexer for BrainFuck +* Add Lexer and Evaluator for BrainFuck +* Add Parser and Evaluator for WhiteSpace For more see [CHANGELOG](CHANGELOG.md). diff --git a/docs/ROADMAP.md b/docs/ROADMAP.md index 508fa29c0..76841b987 100644 --- a/docs/ROADMAP.md +++ b/docs/ROADMAP.md @@ -5,8 +5,8 @@ For short version see [TODO](TODO.md). * [BrainFuck](https://esolangs.org/wiki/Brainfuck) -* [SubLeq](http://mazonka.com/subleq/) * [ETA](http://www.miketaylor.org.uk/tech/eta/doc/manual.html) -* [Piet](https://www.dangermouse.net/esoteric/piet.html) * [Funge](https://web.archive.org/web/20010417044912/http://cantor.res.cmu.edu/bozeman/befunge/beffaq.html) +* [Piet](https://www.dangermouse.net/esoteric/piet.html) +* [SubLeq](http://mazonka.com/subleq/) * [WhiteSpace](http://web.archive.org/web/20150623025348/http://compsoc.dur.ac.uk/whitespace/) diff --git a/docs/TODO.md b/docs/TODO.md index fbe613ac4..c92e1a618 100644 --- a/docs/TODO.md +++ b/docs/TODO.md @@ -4,10 +4,11 @@ Features to do: * [x] BrainFuck Lexer -* [ ] BrainFuck Evaluator +* [X] BrainFuck Evaluator * [ ] BrainFuck Interpreter -* [x] WhiteSpace Parser -* [ ] WhiteSpace Evaluator +* [x] WhiteSpace Lexer +* [x] WhiteSpace Parser +* [x] WhiteSpace Evaluator * [ ] WhiteSpace Interpreter You can propose feature by [GitHub](https://github.com/helvm/helcam/issues). diff --git a/helcam.cabal b/helcam.cabal index 336451aaf..8ab9e4c82 100644 --- a/helcam.cabal +++ b/helcam.cabal @@ -1,8 +1,8 @@ --- Initial helcam.cabal generated by etlas init. For further +-- Initial helcam.cabal generated by etlas init. For further -- documentation, see http://eta-lang.org/docs/ name: helcam -version: 0.3.0.0 +version: 0.5.0.0 synopsis: Heavenly Esoteric Little Concrete Absolute Machine description: Please see the README on GitHub at @@ -26,15 +26,29 @@ source-repository head library other-modules: - HelVM.HelCam.Common.Util - HelVM.HelCam.BrainFuck.Token + HelVM.HelCam.BrainFuck.Token + HelVM.HelCam.BrainFuck.Symbol + HelVM.HelCam.BrainFuck.TableOfInstructions + HelVM.HelCam.WhiteSpace.EvaluatorUtil + HelVM.HelCam.WhiteSpace.Lexer exposed-modules: - HelVM.HelCam.BrainFuck.Tokens - HelVM.HelCam.WhiteSpace.Token - HelVM.HelCam.WhiteSpace.Instruction - HelVM.HelCam.WhiteSpace.Parser + HelVM.HelCam.Common.Util + HelVM.HelCam.Common.WrapperIO + HelVM.HelCam.Common.FilterIf0 + HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluator + HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluator + HelVM.HelCam.BrainFuck.Lexer + HelVM.HelCam.BrainFuck.TapeOfSymbols + HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluator + HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluator + HelVM.HelCam.WhiteSpace.Instruction + HelVM.HelCam.WhiteSpace.OperandParsers + HelVM.HelCam.WhiteSpace.Parser + HelVM.HelCam.WhiteSpace.Token other-extensions: - build-depends: base >=4.8 + build-depends: + base >=4.8 + , mtl == 2.2.2 hs-source-dirs: src/main/eta default-language: Haskell2010 ghc-options: -Wall @@ -43,11 +57,21 @@ test-suite helcam-test type: exitcode-stdio-1.0 main-is: Test.hs other-modules: - HelVM.HelCam.BrainFuck.TokensTest - HelVM.HelCam.WhiteSpace.ParserTest + HelVM.HelCam.Common.MockIO + HelVM.HelCam.Common.FilterIf0Test + HelVM.HelCam.BrainFuck.TokensTest + HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluatorTest + HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluatorTest + HelVM.HelCam.BrainFuck.EvaluatorTestData + HelVM.HelCam.WhiteSpace.ParserTest + HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluatorTest + HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluatorTest + HelVM.HelCam.WhiteSpace.EvaluatorTestData + HelVM.HelCam.WhiteSpace.OperandParsersTest other-extensions: build-depends: base >=4.8 + , mtl == 2.2.2 , helcam , HUnit hs-source-dirs: src/test/eta @@ -57,9 +81,28 @@ test-suite helcam-test executable helcam main-is: Main.hs other-modules: + HelVM.HelCam.Common.Util + HelVM.HelCam.Common.FilterIf0 + HelVM.HelCam.Common.WrapperIO + HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluator + HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluator + HelVM.HelCam.BrainFuck.Lexer + HelVM.HelCam.BrainFuck.Symbol + HelVM.HelCam.BrainFuck.TableOfInstructions + HelVM.HelCam.BrainFuck.TapeOfSymbols + HelVM.HelCam.BrainFuck.Token + HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluator + HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluator + HelVM.HelCam.WhiteSpace.EvaluatorUtil + HelVM.HelCam.WhiteSpace.Instruction + HelVM.HelCam.WhiteSpace.Lexer + HelVM.HelCam.WhiteSpace.OperandParsers + HelVM.HelCam.WhiteSpace.Parser + HelVM.HelCam.WhiteSpace.Token other-extensions: - build-depends: base >=4.8 + build-depends: + base >=4.8 + , mtl == 2.2.2 hs-source-dirs: src/main/eta default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N - diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluator.hs b/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluator.hs new file mode 100644 index 000000000..2464d33ac --- /dev/null +++ b/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluator.hs @@ -0,0 +1,57 @@ +module HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluator (batchEvalBFInt8, batchEvalBFWord8) where + +import HelVM.HelCam.BrainFuck.Symbol +import HelVM.HelCam.BrainFuck.TableOfInstructions +import HelVM.HelCam.BrainFuck.TapeOfSymbols +import HelVM.HelCam.BrainFuck.Token +import HelVM.HelCam.BrainFuck.Lexer + +import HelVM.HelCam.Common.Util + +import Data.Int +import Data.Word + +batchEvalBFInt8 :: Source -> Output +batchEvalBFInt8 = flip evalBFInt8 ([]::String) + +batchEvalBFWord8 :: Source -> Output +batchEvalBFWord8 = flip evalBFWord8 ([]::String) + +evalBFInt8 :: Source -> Interact +evalBFInt8 = flip evalBF (newTape :: Tape Int8) + +evalBFWord8 :: Source -> Interact +evalBFWord8 = flip evalBF (newTape :: Tape Word8) + +evalBF :: Symbol s => Source -> Tape s -> Interact +evalBF source = doInstruction ([], tokenizeBF source) + +doInstruction :: Symbol s => Table -> Tape s -> Interact +doInstruction table@(_, MoveR :_) tape = doInstruction (nextInst table) (moveHeadRight tape) +doInstruction table@(_, MoveL :_) tape = doInstruction (nextInst table) (moveHeadLeft tape) +doInstruction table@(_, Inc :_) tape = doInstruction (nextInst table) (wSuccSymbol tape) +doInstruction table@(_, Dec :_) tape = doInstruction (nextInst table) (wPredSymbol tape) +doInstruction table@(_, JmpPast :_) tape = doJmpPast table tape +doInstruction table@(_, JmpBack :_) tape = doJmpBack table tape +doInstruction table@(_, Output :_) tape = doOutput table tape +doInstruction table@(_, Input :_) tape = doInput table tape +doInstruction (_, [] ) _ = doEnd + +doJmpPast :: Symbol s => Table -> Tape s -> Interact +doJmpPast table tape@(_, 0:_) = doInstruction (jumpPast table) tape +doJmpPast table tape = doInstruction (nextInst table) tape + +doJmpBack :: Symbol s => Table -> Tape s -> Interact +doJmpBack table tape@(_, 0:_) = doInstruction (nextInst table) tape +doJmpBack table tape = doInstruction (jumpBack table) tape + +doInput :: Symbol s => Table -> Tape s -> Interact +doInput _ _ [] = error "Empty input" +doInput table tape (char:input) = doInstruction (nextInst table) (writeSymbol char tape) input + +doOutput :: Symbol s => Table -> Tape s -> Interact +doOutput _ (_, []) _ = error "Illegal State" +doOutput table tape@(_, symbol:_) input = toChar symbol : doInstruction (nextInst table) tape input + +doEnd :: Interact +doEnd _ = [] diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluator.hs b/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluator.hs new file mode 100644 index 000000000..eced18a31 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluator.hs @@ -0,0 +1,57 @@ +module HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluator (evalBFInt8, evalBFWord8, evalBF) where + +import HelVM.HelCam.BrainFuck.Symbol +import HelVM.HelCam.BrainFuck.TableOfInstructions +import HelVM.HelCam.BrainFuck.TapeOfSymbols +import HelVM.HelCam.BrainFuck.Token +import HelVM.HelCam.BrainFuck.Lexer + +import HelVM.HelCam.Common.WrapperIO +import HelVM.HelCam.Common.Util + +import Data.Int +import Data.Word + +evalBFInt8 :: WrapperIO m => Source -> m () +evalBFInt8 = flip evalBF (newTape :: Tape Int8) + +evalBFWord8 :: WrapperIO m => Source -> m () +evalBFWord8 = flip evalBF (newTape :: Tape Word8) + +evalBF :: (Symbol s, WrapperIO m) => Source -> Tape s -> m () +evalBF source = doInstruction ([], tokenizeBF source) + +-- + +doInstruction :: (Symbol s, WrapperIO m) => Table -> Tape s -> m() +doInstruction table@(_, MoveR :_) tape = doInstruction (nextInst table) (moveHeadRight tape) +doInstruction table@(_, MoveL :_) tape = doInstruction (nextInst table) (moveHeadLeft tape) +doInstruction table@(_, Inc :_) tape = doInstruction (nextInst table) (wSuccSymbol tape) +doInstruction table@(_, Dec :_) tape = doInstruction (nextInst table) (wPredSymbol tape) +doInstruction table@(_, JmpPast :_) tape = doJmpPast table tape +doInstruction table@(_, JmpBack :_) tape = doJmpBack table tape +doInstruction table@(_, Output :_) tape = doOutput table tape +doInstruction table@(_, Input :_) tape = doInput table tape +doInstruction (_, [] ) _ = doEnd + +doJmpPast :: (Symbol s, WrapperIO m) => Table -> Tape s -> m() +doJmpPast table tape@(_, 0:_) = doInstruction (jumpPast table) tape +doJmpPast table tape = doInstruction (nextInst table) tape + +doJmpBack :: (Symbol s, WrapperIO m) => Table -> Tape s -> m() +doJmpBack table tape@(_, 0:_) = doInstruction (nextInst table) tape +doJmpBack table tape = doInstruction (jumpBack table) tape + +doInput :: (Symbol s, WrapperIO m) => Table -> Tape s -> m() +doInput table tape = do + char <- wGetChar + doInstruction (nextInst table) (writeSymbol char tape) + +doOutput :: (Symbol s, WrapperIO m) => Table -> Tape s -> m() +doOutput _ (_, []) = error "Illegal State" +doOutput table tape@(_, symbol:_) = do + wPutChar $ toChar symbol + doInstruction (nextInst table) tape + +doEnd :: WrapperIO m => m() +doEnd = return () diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/Tokens.hs b/src/main/eta/HelVM/HelCam/BrainFuck/Lexer.hs similarity index 80% rename from src/main/eta/HelVM/HelCam/BrainFuck/Tokens.hs rename to src/main/eta/HelVM/HelCam/BrainFuck/Lexer.hs index a1068c898..ef369c898 100644 --- a/src/main/eta/HelVM/HelCam/BrainFuck/Tokens.hs +++ b/src/main/eta/HelVM/HelCam/BrainFuck/Lexer.hs @@ -1,4 +1,4 @@ -module HelVM.HelCam.BrainFuck.Tokens where +module HelVM.HelCam.BrainFuck.Lexer where import HelVM.HelCam.BrainFuck.Token import HelVM.HelCam.Common.Util @@ -6,24 +6,22 @@ import HelVM.HelCam.Common.Util import Data.Maybe import Text.Read -newtype Tokens = Tokens TokenList +-- Lexer +tokenizeBF :: String -> TokenList +tokenizeBF = tokenList . readTokens + +readTokens :: String -> Tokens +readTokens source = read source :: Tokens --- +tokenList :: Tokens -> TokenList +tokenList (Tokens tokens) = tokens + +---- + +newtype Tokens = Tokens TokenList instance Show Tokens where show (Tokens tokens) = tokens >>= show instance Read Tokens where readsPrec _ source = [( Tokens $ source >>= maybeToList . readMaybe . charToString, "")] - --- - -tokenList :: Tokens -> TokenList -tokenList (Tokens tokens) = tokens - -readTokens :: String -> Tokens -readTokens source = read source :: Tokens - --- Lexer -tokenize :: String -> TokenList -tokenize = tokenList . readTokens diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/Symbol.hs b/src/main/eta/HelVM/HelCam/BrainFuck/Symbol.hs new file mode 100644 index 000000000..5fa9f0787 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/BrainFuck/Symbol.hs @@ -0,0 +1,62 @@ +module HelVM.HelCam.BrainFuck.Symbol where + +import Data.Char +import Data.Int +import Data.Word + +class (Num a, Eq a) => Symbol a where + blank :: a + fromChar :: Char -> a + toChar :: a -> Char + succSymbol :: a -> a + predSymbol :: a -> a + +-- + +instance Symbol Int where + blank = 0 + fromChar = fromIntegral . ord + toChar = chr . fromIntegral + succSymbol = succMod + predSymbol = predMod + +instance Symbol Word where + blank = 0 + fromChar = fromIntegral . ord + toChar = chr . fromIntegral + succSymbol = succMod + predSymbol = predMod + +instance Symbol Int8 where + blank = 0 + fromChar = fromIntegral . ord + toChar = chr . normalizeMod . fromIntegral + succSymbol = (+1) + predSymbol = subtract 1 + +instance Symbol Word8 where + blank = 0 + fromChar = fromIntegral . ord + toChar = chr . fromIntegral + succSymbol = (+1) + predSymbol = subtract 1 + +-- + +countSymbols :: (Integral a) => a +countSymbols = 256 + +modifyMod :: (Integral a) => (a -> a) -> a -> a +modifyMod f i = f (i + countSymbols) `mod` countSymbols + +normalizeMod :: (Integral a) => a -> a +normalizeMod = modifyMod id + +succMod :: (Integral a) => a -> a +succMod = modifyMod succ + +predMod :: (Integral a) => a -> a +predMod = modifyMod pred + +modifyChar :: (Int -> Int) -> Char -> Char +modifyChar modify = chr . modify . ord diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/TableOfInstructions.hs b/src/main/eta/HelVM/HelCam/BrainFuck/TableOfInstructions.hs new file mode 100644 index 000000000..f40baead1 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/BrainFuck/TableOfInstructions.hs @@ -0,0 +1,31 @@ +module HelVM.HelCam.BrainFuck.TableOfInstructions where + +import HelVM.HelCam.BrainFuck.Token + +type HalfTable = TokenList +type Table = (HalfTable, HalfTable) +type TableD = Table -> Table + +prevInst :: TableD +prevInst (inst:prev, next) = (prev, inst:next) +prevInst ([], _) = error "End of the table" + +nextInst :: TableD +nextInst (prev, inst:next) = (inst:prev, next) +nextInst (_, []) = error "End of the table" + +matchPrevJmp :: TableD +matchPrevJmp table@(JmpPast:_, _) = table +matchPrevJmp table@(JmpBack:_, _) = matchPrevJmp $ prevInst $ matchPrevJmp $ prevInst table +matchPrevJmp table = matchPrevJmp $ prevInst table + +matchNextJmp :: TableD +matchNextJmp table@(_, JmpBack:_) = nextInst table +matchNextJmp table@(_, JmpPast:_) = matchNextJmp $ matchNextJmp $ nextInst table +matchNextJmp table = matchNextJmp $ nextInst table + +jumpPast :: TableD +jumpPast table = matchNextJmp $ nextInst table + +jumpBack :: TableD +jumpBack table = matchPrevJmp $ prevInst table diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/TapeOfSymbols.hs b/src/main/eta/HelVM/HelCam/BrainFuck/TapeOfSymbols.hs new file mode 100644 index 000000000..5775adea7 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/BrainFuck/TapeOfSymbols.hs @@ -0,0 +1,43 @@ +module HelVM.HelCam.BrainFuck.TapeOfSymbols (Tape, newTape, moveHeadRight, moveHeadLeft, wSuccSymbol, wPredSymbol, writeSymbol) where + +import HelVM.HelCam.BrainFuck.Symbol + +import HelVM.HelCam.Common.Util + +type HalfTape a = [a] +type Tape a = (HalfTape a, HalfTape a) +type TapeD a = Tape a -> Tape a + +---- + +newTape :: (Symbol s) => Tape s +newTape = ([blank], [blank]) + +moveHeadRight :: (Symbol s) => TapeD s +moveHeadRight (cell:left, right) = pad (left, cell:right) +moveHeadRight ([], _) = error "End of the Tipe" + +moveHeadLeft :: (Symbol s) => TapeD s +moveHeadLeft (left, cell:right) = pad (cell:left, right) +moveHeadLeft (_, []) = error "End of the Tipe" + +pad :: (Symbol s) => TapeD s +pad ([], []) = newTape +pad ([], right) = ([blank], right) +pad (left, []) = (left, [blank]) +pad tape = tape + +---- + +wSuccSymbol :: (Symbol s) => TapeD s +wSuccSymbol = modifyCell succSymbol + +wPredSymbol :: (Symbol s) => TapeD s +wPredSymbol = modifyCell predSymbol + +writeSymbol :: (Symbol s) => Char -> TapeD s +writeSymbol symbol = modifyCell (const $ fromChar symbol) + +modifyCell :: (Symbol s) => D s -> TapeD s +modifyCell modify (left, cell:right) = (left, modify cell:right) +modifyCell _ (_, []) = error "End of the Tipe" diff --git a/src/main/eta/HelVM/HelCam/BrainFuck/Token.hs b/src/main/eta/HelVM/HelCam/BrainFuck/Token.hs index 9b55ab6d8..64ad34a21 100644 --- a/src/main/eta/HelVM/HelCam/BrainFuck/Token.hs +++ b/src/main/eta/HelVM/HelCam/BrainFuck/Token.hs @@ -1,14 +1,15 @@ module HelVM.HelCam.BrainFuck.Token where -data Token = MoveR - | MoveL - | Inc - | Dec - | Output - | Input - | JmpPast - | JmpBack - deriving (Eq, Ord, Enum) +data Token = + MoveR + | MoveL + | Inc + | Dec + | Output + | Input + | JmpPast + | JmpBack + deriving (Eq, Ord, Enum) type TokenList = [Token] diff --git a/src/main/eta/HelVM/HelCam/Common/FilterIf0.hs b/src/main/eta/HelVM/HelCam/Common/FilterIf0.hs new file mode 100644 index 000000000..2d4f0964f --- /dev/null +++ b/src/main/eta/HelVM/HelCam/Common/FilterIf0.hs @@ -0,0 +1,78 @@ +module HelVM.HelCam.Common.FilterIf0 where + +import HelVM.HelCam.Common.WrapperIO + +pipe :: IO () +pipe = do + char <- getChar + putChar char + pipe + +filterIf0 :: IO () +filterIf0 = do + char <- getChar + if char == '0' + then putChar '\n' + else do + putChar char + filterIf0 + +listFilterIf0 :: String -> String +listFilterIf0 [] = [] +listFilterIf0 (char:rest) = + if char == '0' + then ['\n'] + else char : listFilterIf0 rest + +---- + +-- getChar :: IO Char +-- putChar :: Char -> IO () + +type IOGetChar = IO Char +type IOPutChar = Char -> IO () + +ioFilterIf0 :: IO () +ioFilterIf0 = ioFilterIf0' getChar putChar + +ioFilterIf0' :: IOGetChar -> IOPutChar -> IO () +ioFilterIf0' ioGetChar ioPutChar = do + char <- ioGetChar + if char == '0' + then ioPutChar '\n' + else do + ioPutChar char + ioFilterIf0' ioGetChar ioPutChar + +---- + +mFilterIf0 :: Monad m => MGetChar m -> MPutChar m -> m () +mFilterIf0 mGetChar mPutChar = do + char <- mGetChar + if char == '0' + then mPutChar '\n' + else do + mPutChar char + mFilterIf0 mGetChar mPutChar + +ioMFilterIf0 :: IO () +ioMFilterIf0 = mFilterIf0 getChar putChar + +---- + +wFilterIf0 :: WrapperIO m => m () +wFilterIf0 = do + char <- wGetChar + if char == '0' + then wPutChar '\n' + else do + wPutChar char + wFilterIf0 + +ioWFilterIf0 :: IO () +ioWFilterIf0 = wFilterIf0 + +---- + +iFilterIf0 :: IO () +iFilterIf0 = interact listFilterIf0 diff --git a/src/main/eta/HelVM/HelCam/Common/Util.hs b/src/main/eta/HelVM/HelCam/Common/Util.hs index cb42a14d3..742bfb177 100644 --- a/src/main/eta/HelVM/HelCam/Common/Util.hs +++ b/src/main/eta/HelVM/HelCam/Common/Util.hs @@ -1,6 +1,44 @@ module HelVM.HelCam.Common.Util where +import Data.List +import Text.Read + +type D a = a -> a + +type Source = String +type Input = String +type Output = String + +type Interact = Input -> Output + +-- ListUtil + +chunksOf :: Int -> [a] -> [[a]] +chunksOf _ [] = [] +chunksOf n list + | n > 0 = take n list : chunksOf n (drop n list) + | otherwise = error "Non positive n" + +-- StringUtil + charToString :: Char -> String charToString = (:[]) -type D a = a -> a +splitStringByEndLine :: String -> (String, String) +splitStringByEndLine = splitBy '\n' + +splitBySeparator :: Eq a => a -> [a] -> ([a], [a]) +splitBySeparator _ [] = ([], []) +splitBySeparator separator (x:xs) + | separator == x = ([separator], xs) + | otherwise = (x:acc, xs') where (acc, xs') = splitBySeparator separator xs + +splitBy :: Eq a => a -> [a] -> ([a], [a]) +splitBy separator xs = split $ elemIndex separator xs where + split Nothing = (xs, []) + split (Just index) = (acc, xs') where (acc, (_:xs')) = splitAt index xs + +readOrError :: Read a => String -> a +readOrError raw = match $ readEither raw where + match (Right result) = result + match (Left message) = error $ message ++ " [" ++ raw ++ "]" diff --git a/src/main/eta/HelVM/HelCam/Common/WrapperIO.hs b/src/main/eta/HelVM/HelCam/Common/WrapperIO.hs new file mode 100644 index 000000000..0a2cc97c6 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/Common/WrapperIO.hs @@ -0,0 +1,33 @@ +module HelVM.HelCam.Common.WrapperIO where + +import System.IO + +type MGetChar m = m Char +type MPutChar m = Char -> m () + +type MGetLine m = m String +type MPutStr m = String -> m () + +type MChar m = (MGetChar m, MPutChar m) + +type MString m = (MGetChar m, MPutChar m, MGetLine m, MPutStr m) + +-- + +class Monad m => WrapperIO m where + wGetChar :: m Char + wPutChar :: Char -> m () + wGetLine :: m String + wPutStr :: String -> m () + wPutStrLn :: String -> m () + wFlush :: m () + wPutStrLn s = wPutStr $ s ++ "\n" + wFlush = return () + +instance WrapperIO IO where + wGetChar = getChar + wPutChar = putChar + wGetLine = getLine + wPutStr = putStr + wPutStrLn = putStrLn + wFlush = hFlush stdout diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluator.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluator.hs new file mode 100644 index 000000000..38d9a78ae --- /dev/null +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluator.hs @@ -0,0 +1,102 @@ +module HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluator (interactEvalWS, batchEvalWSTL, evalWSTL, batchEvalWSIL, evalWSIL) where + +import HelVM.HelCam.WhiteSpace.EvaluatorUtil +import HelVM.HelCam.WhiteSpace.Instruction +import HelVM.HelCam.WhiteSpace.Parser +import HelVM.HelCam.WhiteSpace.Token + +import HelVM.HelCam.Common.Util + +import Data.Char + +interactEvalWS :: Bool -> Source -> IO () +interactEvalWS ascii = interact . evalWSIL . parseWS ascii + +batchEvalWSTL :: Bool -> TokenList -> Output +batchEvalWSTL ascii = batchEvalWSIL . parseWSTL ascii + +batchEvalWSIL :: InstructionList -> Output +batchEvalWSIL = flip evalWSIL ([]::String) + +evalWSTL :: Bool -> TokenList -> Interact +evalWSTL ascii = evalWSIL . parseWSTL ascii + +evalWSIL :: InstructionList -> Interact +evalWSIL il = next (IC 0 (IS []) il) (DS []) (H []) + +---- + +next ::InstructionControl -> DataStack -> Heap -> Interact +next (IC ip is il) = doInstruction (il!!ip) (IC (ip+1) is il) + +doInstruction ::Instruction -> InstructionControl -> DataStack -> Heap -> Interact +doInstruction (Label _) = next +-- IO instructions +doInstruction OutputChar = doOutputChar +doInstruction OutputNum = doOutputNum +doInstruction InputChar = doInputChar +doInstruction InputNum = doInputNum +-- Other +doInstruction instruction = doInstruction' instruction + +doInstruction' ::Instruction -> InstructionControl -> DataStack -> Heap -> Interact +-- Stack instructions +doInstruction' (Const value) ic (DS ds ) = next ic (DS (value:ds)) +doInstruction' Dup ic (DS (value:ds)) = next ic (DS (value:value:ds)) +doInstruction' (Ref index) ic (DS ds ) = next ic (DS ((ds!!index):ds)) +doInstruction' (Slide index) ic (DS (value:ds)) = next ic (DS (value:drop index ds)) +doInstruction' Swap ic (DS (value:value':ds)) = next ic (DS (value':value:ds)) +doInstruction' Discard ic (DS (_:ds)) = next ic (DS ds ) +-- Arithmetic +doInstruction' (Binary op) ic (DS (value:value':ds)) = next ic (DS (doBinary op value value':ds)) +-- Control +doInstruction' Return (IC _ (IS (address:is)) il) ds = next (IC address (IS is) il) ds +doInstruction' (Call l) (IC ip (IS is) il) ds = next (IC (findAddress il l) (IS (ip:is)) il) ds +doInstruction' (Jump l) (IC _ is il) ds = next (IC (findAddress il l) is il) ds +doInstruction' (Branch test l) (IC ip is il) (DS (value:ds)) + | doBranchTest test value = next (IC (findAddress il l) is il) (DS ds) + | otherwise = next (IC ip is il) (DS ds) +-- Other +doInstruction' instruction ic ds = doInstruction'' instruction ic ds + +doInstruction'' ::Instruction -> InstructionControl -> DataStack -> Heap -> Interact +-- Heap access +doInstruction'' Load ic (DS (pointer:ds)) h = next ic (DS ((load pointer h):ds)) h +doInstruction'' Store ic (DS (value:pointer:ds)) h = next ic (DS ds) (store value pointer h) +-- Other +doInstruction'' End _ _ _ = doEnd +doInstruction'' i _ _ _ = error $ "Can't do " ++ show i + +emptyStackError :: Instruction -> Interact +emptyStackError i = error $ "Empty stack for instruction " ++ show i + +-- IO instructions + +doOutputChar :: InstructionControl -> DataStack -> Heap -> Interact +doOutputChar _ (DS []) _ input = emptyStackError OutputChar input +doOutputChar ic (DS (value:ds)) h input = chr (fromInteger value) : next ic (DS ds) h input + +doOutputNum :: InstructionControl -> DataStack -> Heap -> Interact +doOutputNum _ (DS []) _ input = emptyStackError OutputNum input +doOutputNum ic (DS (value:ds)) h input = show value ++ next ic (DS ds) h input + +doInputChar :: InstructionControl -> DataStack -> Heap -> Interact +doInputChar _ _ _ [] = emptyInputError InputChar +doInputChar _ (DS []) _ input = emptyStackError InputChar input +doInputChar ic (DS (pointer:ds)) h (char:input) = next ic (DS ds) (store (toInteger (ord char)) pointer h) input + +doInputNum :: InstructionControl -> DataStack -> Heap -> Interact +doInputNum _ _ _ [] = emptyInputError InputNum +doInputNum _ (DS []) _ input = emptyStackError InputNum input +doInputNum ic (DS (pointer:ds)) h input = next ic (DS ds) (storeNum line pointer h) input' + where (line, input') = splitStringByEndLine input + +---- + +doEnd :: Interact +doEnd _ = [] + +---- + +emptyInputError :: Instruction -> Output +emptyInputError i = error $ "Empty input for instruction " ++ show i diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluator.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluator.hs new file mode 100644 index 000000000..40be50a72 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluator.hs @@ -0,0 +1,97 @@ +module HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluator (monadicEvalWS, evalWSTL, evalWSIL) where + +import HelVM.HelCam.WhiteSpace.EvaluatorUtil +import HelVM.HelCam.WhiteSpace.Instruction +import HelVM.HelCam.WhiteSpace.Parser +import HelVM.HelCam.WhiteSpace.Token + +import HelVM.HelCam.Common.Util +import HelVM.HelCam.Common.WrapperIO + +import Data.Char + +monadicEvalWS :: Bool -> Source -> IO () +monadicEvalWS ascii = evalWSIL . parseWS ascii + +evalWSTL :: WrapperIO m => Bool -> TokenList -> m () +evalWSTL ascii = evalWSIL . parseWSTL ascii + +evalWSIL :: WrapperIO m => InstructionList -> m () +evalWSIL il = next (IC 0 (IS []) il) (DS []) (H []) + +---- + +next :: WrapperIO m => InstructionControl -> DataStack -> Heap -> m () +next (IC ip is il) = doInstruction (il!!ip) (IC (ip+1) is il) + +doInstruction :: WrapperIO m => Instruction -> InstructionControl -> DataStack -> Heap -> m () +doInstruction (Label _) = next +-- IO instructions +doInstruction OutputChar = doOutputChar +doInstruction OutputNum = doOutputNum +doInstruction InputChar = doInputChar +doInstruction InputNum = doInputNum +-- Other +doInstruction instruction = doInstruction' instruction + +doInstruction' :: WrapperIO m => Instruction -> InstructionControl -> DataStack -> Heap -> m () +-- Stack instructions +doInstruction' (Const value) ic (DS ds ) = next ic (DS (value:ds)) +doInstruction' Dup ic (DS (value:ds)) = next ic (DS (value:value:ds)) +doInstruction' (Ref index) ic (DS ds ) = next ic (DS ((ds!!index):ds)) +doInstruction' (Slide index) ic (DS (value:ds)) = next ic (DS (value:drop index ds)) +doInstruction' Swap ic (DS (value:value':ds)) = next ic (DS (value':value:ds)) +doInstruction' Discard ic (DS (_:ds)) = next ic (DS ds ) +-- Arithmetic +doInstruction' (Binary op) ic (DS (value:value':ds)) = next ic (DS (doBinary op value value':ds)) +-- Control +doInstruction' Return (IC _ (IS (address:is)) il) ds = next (IC address (IS is) il) ds +doInstruction' (Call l) (IC ip (IS is) il) ds = next (IC (findAddress il l) (IS (ip:is)) il) ds +doInstruction' (Jump l) (IC _ is il) ds = next (IC (findAddress il l) is il) ds +doInstruction' (Branch test l) (IC ip is il) (DS (value:ds)) + | doBranchTest test value = next (IC (findAddress il l) is il) (DS ds) + | otherwise = next (IC ip is il) (DS ds) +-- Other +doInstruction' instruction ic ds = doInstruction'' instruction ic ds + +doInstruction'' :: WrapperIO m => Instruction -> InstructionControl -> DataStack -> Heap -> m () +-- Heap access +doInstruction'' Load ic (DS (pointer:ds)) h = next ic (DS ((load pointer h):ds)) h +doInstruction'' Store ic (DS (value:pointer:ds)) h = next ic (DS ds) (store value pointer h) +-- Other +doInstruction'' End _ _ _ = doEnd +doInstruction'' i _ _ _ = error $ "Can't do " ++ show i + +emptyStackError :: Instruction -> m () +emptyStackError i = error $ "Empty stack for instruction " ++ show i + +-- IO instructions + +doOutputChar :: WrapperIO m => InstructionControl -> DataStack -> Heap -> m () +doOutputChar _ (DS []) _ = emptyStackError OutputChar +doOutputChar ic (DS (value:ds)) h = do + wPutChar (chr (fromInteger value)) + next ic (DS ds) h + +doOutputNum :: WrapperIO m => InstructionControl -> DataStack -> Heap -> m () +doOutputNum _ (DS []) _ = emptyStackError OutputNum +doOutputNum ic (DS (value:ds)) h = do + wPutStr $ show value + next ic (DS ds) h + +doInputChar :: WrapperIO m => InstructionControl -> DataStack -> Heap -> m () +doInputChar _ (DS []) _ = emptyStackError InputChar +doInputChar ic (DS (pointer:ds)) h = do + char <- wGetChar + next ic (DS ds) (store (toInteger (ord char)) pointer h) + +doInputNum :: WrapperIO m => InstructionControl -> DataStack -> Heap -> m () +doInputNum _ (DS []) _ = emptyStackError InputNum +doInputNum ic (DS (pointer:ds)) h = do + line <- wGetLine + next ic (DS ds) (storeNum line pointer h) + +---- + +doEnd :: WrapperIO m => m () +doEnd = return () diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/EvaluatorUtil.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/EvaluatorUtil.hs new file mode 100644 index 000000000..1d7126127 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/EvaluatorUtil.hs @@ -0,0 +1,47 @@ +module HelVM.HelCam.WhiteSpace.EvaluatorUtil where + +import HelVM.HelCam.WhiteSpace.Instruction +import HelVM.HelCam.Common.Util +import Data.List + +type InstructionCounter = Address +newtype InstructionStack = IS [Address] +type Memory = [Value] +newtype DataStack = DS Memory +newtype Heap = H Memory + +data InstructionControl = IC InstructionCounter InstructionStack InstructionList + +doBinary :: BinaryOperator -> Value -> Value -> Value +doBinary Add v v' = v' + v +doBinary Sub v v' = v' - v +doBinary Mul v v' = v' * v +doBinary Div v v' = v' `div` v +doBinary Mod v v' = v' `mod` v + +doBranchTest :: BranchTest -> Value -> Bool +doBranchTest EZ value = value == 0 +doBranchTest Neg value = value < 0 + +findAddress :: InstructionList -> Identifier -> Address +findAddress = findAddress' 0 + +findAddress' :: Address -> InstructionList -> Identifier -> Address +findAddress' _ [] identifier = error $ "Undefined identifier (" ++ show identifier ++ ")" +findAddress' address ((Label identifier'):il) identifier + | identifier == identifier' = address + | otherwise = findAddress' (address+1) il identifier +findAddress' address (_:il) identifier = findAddress' (address+1) il identifier + +load :: Value -> Heap -> Value +load pointer (H h) = genericIndex h pointer + +store :: Value -> Value -> Heap -> Heap +store value pointer (H heap) = H $ store' value pointer heap where + store' v 0 [] = [v] + store' v 0 (_:h) = v:h + store' v p [] = 0 : (store' v (p-1) []) + store' v p (v':h) = v': (store' v (p-1) h) + +storeNum :: String -> Value -> Heap -> Heap +storeNum line = store (readOrError line :: Integer) diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Instruction.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Instruction.hs index a31b727d2..a6e8e66b0 100644 --- a/src/main/eta/HelVM/HelCam/WhiteSpace/Instruction.hs +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Instruction.hs @@ -1,28 +1,28 @@ module HelVM.HelCam.WhiteSpace.Instruction where -import Numeric.Natural +import HelVM.HelCam.WhiteSpace.OperandParsers data Instruction = - Const Value - | Dup - | Ref Index - | Slide Index - | Swap - | Discard - | Binary BinaryOperator - | Store - | Load - | Label Identifier - | Call Identifier - | Jump Identifier - | Branch BranchTest Identifier - | Return - | OutputChar - | OutputNum - | InputChar - | InputNum - | End - deriving (Eq, Show, Read) + Const Value + | Dup + | Ref Index + | Slide Index + | Swap + | Discard + | Binary BinaryOperator + | Store + | Load + | Label Identifier + | Call Identifier + | Jump Identifier + | Branch BranchTest Identifier + | Return + | OutputChar + | OutputNum + | InputChar + | InputNum + | End + deriving (Eq, Show, Read) type InstructionList = [Instruction] @@ -32,7 +32,19 @@ data BinaryOperator = Add | Sub | Mul | Div | Mod data BranchTest = EZ | Neg deriving (Eq, Show, Read) -type Value = Integer -type Index = Int -type Address = Int -type Identifier = Natural +---- + +type Address = Int + +type Index = Int +parseIndex :: OperandParser Index +parseIndex = parseInt + +type Value = Integer +parseValue :: OperandParser Value +parseValue = parseInteger + +type Identifier = String +parseIdentifier :: Bool -> OperandParser Identifier +parseIdentifier False = parseBitString +parseIdentifier True = parseAsciiString diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Lexer.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Lexer.hs new file mode 100644 index 000000000..4646e115e --- /dev/null +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Lexer.hs @@ -0,0 +1,27 @@ +module HelVM.HelCam.WhiteSpace.Lexer where + +import HelVM.HelCam.WhiteSpace.Token +import HelVM.HelCam.Common.Util + +import Data.Maybe +import Text.Read + +-- Lexer +tokenizeWS :: String -> TokenList +tokenizeWS = tokenList . readTokens + +readTokens :: String -> WhiteTokens +readTokens source = read source :: WhiteTokens + +tokenList :: WhiteTokens -> TokenList +tokenList (WhiteTokens tokens) = map whiteTokenToToken tokens + +---- + +newtype WhiteTokens = WhiteTokens WhiteTokenList + +instance Show WhiteTokens where + show (WhiteTokens tokens) = tokens >>= show + +instance Read WhiteTokens where + readsPrec _ source = [( WhiteTokens $ source >>= maybeToList . readMaybe . charToString, "")] diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/OperandParsers.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/OperandParsers.hs new file mode 100644 index 000000000..cb7eeee63 --- /dev/null +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/OperandParsers.hs @@ -0,0 +1,61 @@ +module HelVM.HelCam.WhiteSpace.OperandParsers where + +import HelVM.HelCam.WhiteSpace.Token +import HelVM.HelCam.Common.Util + +import Data.Char +import Numeric.Natural + +type OperandParser a = TokenList -> (a, TokenList) + +parseInt :: OperandParser Int +parseInt tokens = (fromIntegral integer, tokens') where (integer, tokens') = parseInteger tokens + +parseInteger :: OperandParser Integer +parseInteger [] = error "EOL" +parseInteger (S:tokens) = parseUtil makeIntegral tokens +parseInteger (T:tokens) = negationIntegral $ parseUtil makeIntegral tokens +parseInteger (N:tokens) = (0,tokens) + +negationIntegral :: (Integer, TokenList) -> (Integer, TokenList) +negationIntegral (i,l) = (-i,l) + +parseNatural :: OperandParser Natural +parseNatural = parseUtil makeIntegral + +parseUtil :: (TokenList -> a) -> OperandParser a +parseUtil maker = parseUtil' ([]::TokenList) where + parseUtil' acc [] = error $ show acc + parseUtil' acc (N:tokens) = (maker acc, tokens) + parseUtil' acc (t:tokens) = parseUtil' (t:acc) tokens + +parseBitString :: OperandParser String +parseBitString = parseString' makeBitString + +parseAsciiString :: OperandParser String +parseAsciiString = parseString' makeAsciiString + +parseString' :: (TokenList -> a) -> OperandParser a +parseString' maker tokens = (maker acc, tokens') where (acc, tokens') = splitByN tokens + +splitByN :: OperandParser TokenList +splitByN [] = error $ show "Empty list" +splitByN (N:tokens) = ([], tokens) +splitByN (t:tokens) = (t:acc, tokens') where (acc, tokens') = splitByN tokens + +---- + +makeIntegral :: (Integral a) => TokenList -> a +makeIntegral = foldr (shiftAndAdd . toBit) 0 + +shiftAndAdd :: (Integral a) => a -> a -> a +shiftAndAdd bit acc = acc * 2 + bit + +makeBitString :: TokenList -> String +makeBitString = map toBitChar + +makeAsciiString :: TokenList -> String +makeAsciiString tokens = map makeChar $ chunksOf 8 tokens + +makeChar :: TokenList -> Char +makeChar = chr . makeIntegral . reverse diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Parser.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Parser.hs index 396767157..871aca8c2 100644 --- a/src/main/eta/HelVM/HelCam/WhiteSpace/Parser.hs +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Parser.hs @@ -1,81 +1,60 @@ module HelVM.HelCam.WhiteSpace.Parser where import HelVM.HelCam.WhiteSpace.Token +import HelVM.HelCam.WhiteSpace.Lexer import HelVM.HelCam.WhiteSpace.Instruction - -import Numeric.Natural - -parse :: TokenList -> InstructionList -parse [] = [] --- Stack instructions -parse (S:S:xs) = (Const integer) :(parse xs') where (integer, xs') = parseInteger xs -parse (S:T:S:_) = panic "STS" -parse (S:T:T:xs) = (Ref int) :(parse xs') where (int, xs') = parseInt xs -parse (S:T:N:xs) = (Slide int) :(parse xs') where (int, xs') = parseInt xs -parse (S:N:S:xs) = Dup :(parse xs) -parse (S:N:T:xs) = Swap :(parse xs) -parse (S:N:N:xs) = Discard :(parse xs) ---Arithmetic -parse (T:S:S:S:xs) = (Binary Add) :(parse xs) -parse (T:S:S:T:xs) = (Binary Sub) :(parse xs) -parse (T:S:S:N:xs) = (Binary Mul) :(parse xs) -parse (T:S:T:S:xs) = (Binary Div) :(parse xs) -parse (T:S:T:T:xs) = (Binary Mod) :(parse xs) -parse (T:S:T:N:_) = panic "TSTN" -parse (T:S:N:S:_) = panic "TSNS" -parse (T:S:N:T:_) = panic "TSNT" -parse (T:S:N:N:_) = panic "TSNN" --- Heap access -parse (T:T:S:xs) = Store :(parse xs) -parse (T:T:T:xs) = Load :(parse xs) -parse (T:T:N:_) = panic "TTN" --- Control -parse (N:S:S:xs) = (Label label) :(parse xs') where (label, xs') = parseNatural xs -parse (N:S:T:xs) = (Call label) :(parse xs') where (label, xs') = parseNatural xs -parse (N:S:N:xs) = (Jump label) :(parse xs') where (label, xs') = parseNatural xs -parse (N:T:S:xs) = (Branch EZ label) :(parse xs') where (label, xs') = parseNatural xs -parse (N:T:T:xs) = (Branch Neg label) :(parse xs') where (label, xs') = parseNatural xs -parse (N:T:N:xs) = Return :(parse xs) -parse (N:N:S:_) = panic "NNS" -parse (N:N:T:_) = panic "NNT" -parse (N:N:N:xs) = End :(parse xs) --- IO instructions -parse (T:N:S:S:xs) = OutputChar :(parse xs) -parse (T:N:S:T:xs) = OutputNum :(parse xs) -parse (T:N:S:N:_) = panic "TNSN" -parse (T:N:T:S:xs) = InputChar :(parse xs) -parse (T:N:T:T:xs) = InputNum :(parse xs) -parse (T:N:T:N:_) = panic "TNTN" -parse (T:N:N:S:_) = panic "TNNS" -parse (T:N:N:T:_) = panic "TNNT" -parse (T:N:N:N:_) = panic "TNNN" -parse tokens = panic $ show tokens +import HelVM.HelCam.Common.Util + +parseWS :: Bool -> Source -> InstructionList +parseWS ascii = parseWSTL ascii . tokenizeWS + +parseWSTL :: Bool -> TokenList -> InstructionList +parseWSTL ascii = parse where + parse :: TokenList -> InstructionList + parse [] = [] + -- Stack instructions + parse (S:S:tokens) = Const value : parse tokens' where (value, tokens') = parseValue tokens + parse (S:T:S:tokens) = Ref index : parse tokens' where (index, tokens') = parseIndex tokens + parse (S:T:T:_) = panic "STT" + parse (S:T:N:tokens) = Slide index : parse tokens' where (index, tokens') = parseIndex tokens + parse (S:N:S:tokens) = Dup : parse tokens + parse (S:N:T:tokens) = Swap : parse tokens + parse (S:N:N:tokens) = Discard : parse tokens + --Arithmetic + parse (T:S:S:S:tokens) = Binary Add : parse tokens + parse (T:S:S:T:tokens) = Binary Sub : parse tokens + parse (T:S:S:N:tokens) = Binary Mul : parse tokens + parse (T:S:T:S:tokens) = Binary Div : parse tokens + parse (T:S:T:T:tokens) = Binary Mod : parse tokens + parse (T:S:T:N:_) = panic "TSTN" + parse (T:S:N:S:_) = panic "TSNS" + parse (T:S:N:T:_) = panic "TSNT" + parse (T:S:N:N:_) = panic "TSNN" + -- Heap access + parse (T:T:S:tokens) = Store : parse tokens + parse (T:T:T:tokens) = Load : parse tokens + parse (T:T:N:_) = panic "TTN" + -- Control + parse (N:S:S:tokens) = Label identifier : parse tokens' where (identifier, tokens') = parseIdentifier ascii tokens + parse (N:S:T:tokens) = Call identifier : parse tokens' where (identifier, tokens') = parseIdentifier ascii tokens + parse (N:S:N:tokens) = Jump identifier : parse tokens' where (identifier, tokens') = parseIdentifier ascii tokens + parse (N:T:S:tokens) = Branch EZ identifier : parse tokens' where (identifier, tokens') = parseIdentifier ascii tokens + parse (N:T:T:tokens) = Branch Neg identifier : parse tokens' where (identifier, tokens') = parseIdentifier ascii tokens + parse (N:T:N:tokens) = Return : parse tokens + parse (N:N:S:_) = panic "NNS" + parse (N:N:T:_) = panic "NNT" + parse (N:N:N:tokens) = End : parse tokens + -- IO instructions + parse (T:N:S:S:tokens) = OutputChar : parse tokens + parse (T:N:S:T:tokens) = OutputNum : parse tokens + parse (T:N:S:N:_) = panic "TNSN" + parse (T:N:T:S:tokens) = InputChar : parse tokens + parse (T:N:T:T:tokens) = InputNum : parse tokens + parse (T:N:T:N:_) = panic "TNTN" + parse (T:N:N:S:_) = panic "TNNS" + parse (T:N:N:T:_) = panic "TNNT" + parse (T:N:N:N:_) = panic "TNNN" + parse tokens = panic $ show tokens panic :: String -> InstructionList panic token = error $ "Unrecognised " ++ token - -parseInt :: TokenList -> (Int, TokenList) -parseInt xs = (fromIntegral (integer), xs') where (integer, xs') = parseInteger xs - -parseInteger :: TokenList -> (Integer, TokenList) -parseInteger (S:xs) = parseIntegral' xs [] -parseInteger (T:xs) = revertIntegral $ parseIntegral' xs [] -parseInteger (N:xs) = (0,xs) -parseInteger [] = error "EOL" - -revertIntegral :: (Integer, TokenList) -> (Integer, TokenList) -revertIntegral (i,l) = (-i,l) - -parseNatural :: TokenList -> (Natural, TokenList) -parseNatural xs = parseIntegral' xs [] - -parseIntegral' :: (Integral a) => TokenList -> TokenList -> (a, TokenList) -parseIntegral' (N:xs) acc = (makeIntegral acc, xs) -parseIntegral' (x:xs) acc = parseIntegral' xs (x:acc) -parseIntegral' [] acc = error $ show acc - -makeIntegral :: (Integral a) => TokenList -> a -makeIntegral = foldr (shiftAndAdd) 0 . map toBit - -shiftAndAdd :: (Integral a) => a -> a -> a -shiftAndAdd bit acc = acc * 2 + bit diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Token.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Token.hs index f2a8a46e1..7055a452b 100644 --- a/src/main/eta/HelVM/HelCam/WhiteSpace/Token.hs +++ b/src/main/eta/HelVM/HelCam/WhiteSpace/Token.hs @@ -1,23 +1,39 @@ module HelVM.HelCam.WhiteSpace.Token where -data Token = S | T | N - deriving (Eq, Ord, Enum) +import Data.Char + +data Token = S | T | N + deriving (Eq, Ord, Enum, Show, Read) type TokenList = [Token] -instance Show Token where - show S = " " - show T = "\t" - show N = "\n" +---- + +newtype WhiteToken = WhiteToken Token + +instance Show WhiteToken where + show (WhiteToken S) = " " + show (WhiteToken T) = "\t" + show (WhiteToken N) = "\n" -- Scanner -instance Read Token where - readsPrec _ " " = [( S , "")] - readsPrec _ "\t" = [( T , "")] - readsPrec _ "\n" = [( N , "")] +instance Read WhiteToken where + readsPrec _ " " = [( WhiteToken S , "")] + readsPrec _ "\t" = [( WhiteToken T , "")] + readsPrec _ "\n" = [( WhiteToken N , "")] readsPrec _ _ = [] +type WhiteTokenList = [WhiteToken] + +---- + +whiteTokenToToken :: WhiteToken -> Token +whiteTokenToToken (WhiteToken token) = token + toBit :: (Num a) => Token -> a toBit S = 0 toBit T = 1 toBit N = error $ show N + +toBitChar :: Token -> Char +toBitChar = intToDigit . toBit diff --git a/src/main/eta/HelVM/HelCam/WhiteSpace/Tokens.hs b/src/main/eta/HelVM/HelCam/WhiteSpace/Tokens.hs deleted file mode 100644 index 502356fde..000000000 --- a/src/main/eta/HelVM/HelCam/WhiteSpace/Tokens.hs +++ /dev/null @@ -1,29 +0,0 @@ -module HelVM.HelCam.WhiteSpace.Tokens where - -import HelVM.HelCam.WhiteSpace.Tokens - -import Data.Maybe -import Text.Read - -newtype Tokens = Tokens TokenList - --- - -instance Show Tokens where - show (Tokens tokens) = tokens >>= show - --- Lexer -instance Read Tokens where - readsPrec _ source = [( Tokens $ source >>= maybeToList . readMaybe . charToString, "")] - --- - -tokenList :: Tokens -> TokenList -tokenList (Tokens tokens) = tokens - -readTokens :: String -> Tokens -readTokens source = read source :: Tokens - -tokenize :: String -> TokenList -tokenize = tokenList . readTokens - diff --git a/src/main/eta/Main.hs b/src/main/eta/Main.hs index 863b08ff1..7aff1aa21 100644 --- a/src/main/eta/Main.hs +++ b/src/main/eta/Main.hs @@ -1,4 +1,8 @@ module Main where +import HelVM.HelCam.Common.FilterIf0 + main :: IO () -main = putStrLn "Hello, Eta!" +main = do + putStrLn "Hello, Eta!" + iFilterIf0 diff --git a/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluatorTest.hs b/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluatorTest.hs new file mode 100644 index 000000000..c948e3641 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluatorTest.hs @@ -0,0 +1,26 @@ +module HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluatorTest where + +import HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluator +import HelVM.HelCam.BrainFuck.EvaluatorTestData + +import HelVM.HelCam.BrainFuck.TapeOfSymbols +import HelVM.HelCam.BrainFuck.Lexer + +import HelVM.HelCam.Common.MockIO + +import Control.Monad.State.Lazy + +import Test.HUnit + +import Data.Int +import Data.Word + +testsOfBFInteractEvaluator :: Test +testsOfBFInteractEvaluator = TestList + [ "test_value256_forInt8" ~: "puts '8 bit cells'" ~: "8 bit cells\n" ~=? batchEvalBFInt8 value256 + , "test_value256_forWord8" ~: "puts '8 bit cells" ~: "8 bit cells\n" ~=? batchEvalBFWord8 value256 + , "test_helloWorld" ~: "puts helloWorldExpected" ~: helloWorldExpected ~=? batchEvalBFWord8 helloWorld + , "test_fascistHelloWorld" ~: "puts helloWorldExpected" ~: helloWorldExpected ~=? batchEvalBFWord8 fascistHelloWorld + , "test_padHelloWorld" ~: "puts hello_WorldExpected" ~: hello_WorldExpected ~=? batchEvalBFWord8 padHelloWorld + , "test_theShortestHelloWorld" ~: "puts hello_WorldExpected" ~: hello_WorldExpected ~=? batchEvalBFWord8 theShortestHelloWorld + ] diff --git a/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluatorTest.hs b/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluatorTest.hs new file mode 100644 index 000000000..a3670738e --- /dev/null +++ b/src/test/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluatorTest.hs @@ -0,0 +1,26 @@ +module HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluatorTest where + +import HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluator +import HelVM.HelCam.BrainFuck.EvaluatorTestData + +import HelVM.HelCam.BrainFuck.TapeOfSymbols +import HelVM.HelCam.BrainFuck.Lexer + +import HelVM.HelCam.Common.MockIO + +import Control.Monad.State.Lazy + +import Test.HUnit + +import Data.Int +import Data.Word + +testsOfBFMonadicEvaluator :: Test +testsOfBFMonadicEvaluator = TestList + [ "test_value256_forInt8" ~: "puts '8 bit cells'" ~: "8 bit cells\n" ~=? batchExecMockIO (evalBFInt8 value256) + , "test_value256_forWord8" ~: "puts '8 bit cells" ~: "8 bit cells\n" ~=? batchExecMockIO (evalBFWord8 value256) + , "test_helloWorld" ~: "puts helloWorldExpected" ~: helloWorldExpected ~=? batchExecMockIO (evalBFWord8 helloWorld) + , "test_fascistHelloWorld" ~: "puts helloWorldExpected" ~: helloWorldExpected ~=? batchExecMockIO (evalBFWord8 fascistHelloWorld) + , "test_padHelloWorld" ~: "puts hello_WorldExpected" ~: hello_WorldExpected ~=? batchExecMockIO (evalBFWord8 padHelloWorld) + , "test_theShortestHelloWorld" ~: "puts hello_WorldExpected" ~: hello_WorldExpected ~=? batchExecMockIO (evalBFWord8 theShortestHelloWorld) + ] diff --git a/src/test/eta/HelVM/HelCam/BrainFuck/EvaluatorTestData.hs b/src/test/eta/HelVM/HelCam/BrainFuck/EvaluatorTestData.hs new file mode 100644 index 000000000..e781e5832 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/BrainFuck/EvaluatorTestData.hs @@ -0,0 +1,88 @@ +module HelVM.HelCam.BrainFuck.EvaluatorTestData where + +-------------------------------------------------------------------------------- + +value256 :: String +value256 = " \ +\Calculate the value 256 and test if it's zero \ +\ If the interpreter errors on overflow this is where it'll happen \ +\ ++++++++[>++++++++<-]>[<++++>-] \ +\ +<[>-< \ +\ Not zero so multiply by 256 again to get 65536 \ +\ [>++++<-]>[<++++++++>-]<[>++++++++<-] \ +\ +>[> \ +\ # Print \"32\" \ +\ ++++++++++[>+++++<-]>+.-.[-]< \ +\ <[-]<->] <[>> \ +\ # Print \"16\" \ +\ +++++++[>+++++++<-]>.+++++.[-]< \ +\ <<-]] >[> \ +\ # Print \"8\" \ +\ ++++++++[>+++++++<-]>.[-]< \ +\ <-]< \ +\ # Print \" bit cells\n\" \ +\ +++++++++++[>+++>+++++++++>+++++++++>+<<<<-]>-.>-.+++++++.+++++++++++.<.\ +\ >>.++.+++++++..<-.>>- \ +\ Clean up used cells. \ +\ [[-]<]" + +-------------------------------------------------------------------------------- + +helloWorldWithComments :: String +helloWorldWithComments = " \ +\ 1 +++++ +++ Set Cell #0 to 8 \ +\ 2 [ \ +\ 3 >++++ Add 4 to Cell #1; this will always set Cell #1 to 4 \ +\ 4 [ as the cell will be cleared by the loop \ +\ 5 >++ Add 4*2 to Cell #2 \ +\ 6 >+++ Add 4*3 to Cell #3 \ +\ 7 >+++ Add 4*3 to Cell #4 \ +\ 8 >+ Add 4 to Cell #5 \ +\ 9 <<<<- Decrement the loop counter in Cell #1 \ +\10 ] Loop till Cell #1 is zero \ +\11 >+ Add 1 to Cell #2 \ +\12 >+ Add 1 to Cell #3 \ +\13 >- Subtract 1 from Cell #4 \ +\14 >>+ Add 1 to Cell #6 \ +\15 [<] Move back to the first zero cell you find; this will \ +\16 be Cell #1 which was cleared by the previous loop \ +\17 <- Decrement the loop Counter in Cell #0 \ +\18 ] Loop till Cell #0 is zero \ +\19 \ +\20 The result of this is: \ +\21 Cell No : 0 1 2 3 4 5 6 \ +\22 Contents: 0 0 72 104 88 32 8 \ +\23 Pointer : ^ \ +\24 \ +\25 >>. Cell #2 has value 72 which is 'H' \ +\26 >---. Subtract 3 from Cell #3 to get 101 which is 'e' \ +\27 +++++ ++..+++. Likewise for 'llo' from Cell #3 \ +\28 >>. Cell #5 is 32 for the space \ +\29 <-. Subtract 1 from Cell #4 for 87 to give a 'W' \ +\30 <. Cell #3 was set to 'o' from the end of 'Hello' \ +\31 +++.----- -.----- ---. Cell #3 for 'rl' and 'd' \ +\32 >>+. Add 1 to Cell #5 gives us an exclamation point \ +\33 >++. And finally a newline from Cell #6 \ +\" + +-------------------------------------------------------------------------------- + +helloWorld :: String +helloWorld = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." + +fascistHelloWorld :: String +fascistHelloWorld = ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+." + +padHelloWorld :: String +padHelloWorld = "--<-<<+[+[<+>--->->->-<<<]>]<<--.<++++++.<<-..<<.<+.>>.>>.<<<.+++.>>.>>-.<<<+." + +theShortestHelloWorld :: String +theShortestHelloWorld = "+[-->-[>>+>-----<<]<--<---]>-.>>>+.>>..+++[.>]<<<<.+++.------.<<-.>>>>+." + +-------------------------------------------------------------------------------- + +helloWorldExpected :: String +helloWorldExpected = "Hello World!\n" + +hello_WorldExpected :: String +hello_WorldExpected = "Hello, World!" diff --git a/src/test/eta/HelVM/HelCam/BrainFuck/TokensTest.hs b/src/test/eta/HelVM/HelCam/BrainFuck/TokensTest.hs index cd40dc1df..a62ccf240 100644 --- a/src/test/eta/HelVM/HelCam/BrainFuck/TokensTest.hs +++ b/src/test/eta/HelVM/HelCam/BrainFuck/TokensTest.hs @@ -1,66 +1,17 @@ module HelVM.HelCam.BrainFuck.TokensTest where -import HelVM.HelCam.BrainFuck.Tokens +import HelVM.HelCam.BrainFuck.EvaluatorTestData -import Test.HUnit +import HelVM.HelCam.BrainFuck.Lexer -helloWorldWithComments :: String -helloWorldWithComments = " \ -\ 1 +++++ +++ Set Cell #0 to 8 \ -\ 2 [ \ -\ 3 >++++ Add 4 to Cell #1; this will always set Cell #1 to 4 \ -\ 4 [ as the cell will be cleared by the loop \ -\ 5 >++ Add 4*2 to Cell #2 \ -\ 6 >+++ Add 4*3 to Cell #3 \ -\ 7 >+++ Add 4*3 to Cell #4 \ -\ 8 >+ Add 4 to Cell #5 \ -\ 9 <<<<- Decrement the loop counter in Cell #1 \ -\10 ] Loop till Cell #1 is zero \ -\11 >+ Add 1 to Cell #2 \ -\12 >+ Add 1 to Cell #3 \ -\13 >- Subtract 1 from Cell #4 \ -\14 >>+ Add 1 to Cell #6 \ -\15 [<] Move back to the first zero cell you find; this will \ -\16 be Cell #1 which was cleared by the previous loop \ -\17 <- Decrement the loop Counter in Cell #0 \ -\18 ] Loop till Cell #0 is zero \ -\19 \ -\20 The result of this is: \ -\21 Cell No : 0 1 2 3 4 5 6 \ -\22 Contents: 0 0 72 104 88 32 8 \ -\23 Pointer : ^ \ -\24 \ -\25 >>. Cell #2 has value 72 which is 'H' \ -\26 >---. Subtract 3 from Cell #3 to get 101 which is 'e' \ -\27 +++++ ++..+++. Likewise for 'llo' from Cell #3 \ -\28 >>. Cell #5 is 32 for the space \ -\29 <-. Subtract 1 from Cell #4 for 87 to give a 'W' \ -\30 <. Cell #3 was set to 'o' from the end of 'Hello' \ -\31 +++.----- -.----- ---. Cell #3 for 'rl' and 'd' \ -\32 >>+. Add 1 to Cell #5 gives us an exclamation point \ -\33 >++. And finally a newline from Cell #6 \ -\" +import Test.HUnit -helloWorld :: String -helloWorld = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." +testsOfBFTokens :: Test +testsOfBFTokens = test + [ "tokenizeHelloWorld" ~: "tokenize helloWorld" ~: helloWorld ~=? show (readTokens helloWorld) + , "tokenizeHelloWorldWithComments" ~: "tokenize helloWorldWithComments" ~: helloWorld ~=? show (readTokens helloWorldWithComments) + , "testTokenAsList" ~: "testTokenAsList" ~: helloWorldAsList ~=? show (tokenList $ readTokens helloWorldWithComments) + ] helloWorldAsList :: String helloWorldAsList = "[+,+,+,+,+,+,+,+,[,>,+,+,+,+,[,>,+,+,>,+,+,+,>,+,+,+,>,+,<,<,<,<,-,],>,+,>,+,>,-,>,>,+,[,<,],<,-,],>,>,.,>,-,-,-,.,+,+,+,+,+,+,+,.,.,+,+,+,.,>,>,.,<,-,.,<,.,+,+,+,.,-,-,-,-,-,-,.,-,-,-,-,-,-,-,-,.,>,>,+,.,>,+,+,.]" - --------------------------------------------------------------------------------- - -testHelloWorld :: Test -testHelloWorld = TestCase (assertEqual "testHelloWorld" helloWorld (show $ readTokens helloWorld)) - -testHelloWorldWithComments :: Test -testHelloWorldWithComments = TestCase (assertEqual "testHelloWorldWithComments" helloWorld (show $ readTokens helloWorldWithComments)) - -testTokenAsList :: Test -testTokenAsList = TestCase (assertEqual "testTokenAsList" helloWorldAsList (show $ tokenList $ readTokens helloWorldWithComments)) - -testsOfTokens :: Test -testsOfTokens = TestList - [ TestLabel "testHelloWorld" testHelloWorld - , TestLabel "testHelloWorldWithComments" testHelloWorldWithComments - , TestLabel "testTokenAsList" testTokenAsList - ] \ No newline at end of file diff --git a/src/test/eta/HelVM/HelCam/Common/FilterIf0Test.hs b/src/test/eta/HelVM/HelCam/Common/FilterIf0Test.hs new file mode 100644 index 000000000..a2cec44b8 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/Common/FilterIf0Test.hs @@ -0,0 +1,14 @@ +module HelVM.HelCam.Common.FilterIf0Test where + +import HelVM.HelCam.Common.FilterIf0 +import HelVM.HelCam.Common.MockIO + +import Control.Monad.State.Lazy + +import Test.HUnit + +testsOfFilterIf0 :: Test +testsOfFilterIf0 = test + [ "testFilter0" ~: "test FilterIf0" ~: "qwerty\n" ~=? execMockIO (mFilterIf0 mockGetChar mockPutChar) "qwerty0uiop" + , "testWFilter0" ~: "test WFilterIf0" ~: "qwerty\n" ~=? execMockIO wFilterIf0 "qwerty0uiop" + ] diff --git a/src/test/eta/HelVM/HelCam/Common/MockIO.hs b/src/test/eta/HelVM/HelCam/Common/MockIO.hs new file mode 100644 index 000000000..93e8a6819 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/Common/MockIO.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module HelVM.HelCam.Common.MockIO (batchExecMockIO, execMockIO, mockGetChar, mockPutChar, mockGetLine, mockPutStr) where + +import HelVM.HelCam.Common.WrapperIO +import HelVM.HelCam.Common.Util + +import Control.Monad.State.Lazy + +batchExecMockIO :: MockIO () -> Output +batchExecMockIO = flip execMockIO [] + +execMockIO :: MockIO () -> Interact +execMockIO mockIO input = getOutput $ execState mockIO $ createMockIO input + +---- + +mockGetChar :: MockIO Char +mockGetChar = do + state <- get + let char = head $ input state + put state { input = tail $ input state } + return char + +mockPutChar :: Char -> MockIO () +mockPutChar char = do + state <- get + put state { output = char : output state } + +mockGetLine :: MockIO String +mockGetLine = do + state <- get + let pair = splitStringByEndLine (input state) + put state { input = snd pair } + return $ fst pair + +mockPutStr :: String -> MockIO () +mockPutStr string = do + state <- get + put $ state { output = reverse string ++ output state } + +instance WrapperIO MockIO where + wGetChar = mockGetChar + wPutChar = mockPutChar + wGetLine = mockGetLine + wPutStr = mockPutStr + +---- + +type MockIO = State MockIOData + +getOutput :: MockIOData -> String +getOutput (MockIOData input output) = reverse output + +createMockIO :: String -> MockIOData +createMockIO = flip MockIOData [] + +data MockIOData = MockIOData + { input :: String + , output :: String + } + deriving (Eq, Show, Read) diff --git a/src/test/eta/HelVM/HelCam/Common/UtilTest.hs b/src/test/eta/HelVM/HelCam/Common/UtilTest.hs new file mode 100644 index 000000000..4f2b018fa --- /dev/null +++ b/src/test/eta/HelVM/HelCam/Common/UtilTest.hs @@ -0,0 +1,11 @@ +module HelVM.HelCam.Common.UtilTest where + +import HelVM.HelCam.Common.Util + +import Test.HUnit + +testsUtil :: Test +testsOfFilterIf0 = test + [ "testFilter0" ~: "test FilterIf0" ~: "qwerty\n" ~=? execMockIO (mFilterIf0 mockGetChar mockPutChar) "qwerty0uiop" + , "testWFilter0" ~: "test WFilterIf0" ~: "qwerty\n" ~=? execMockIO wFilterIf0 "qwerty0uiop" + ] diff --git a/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluatorTest.hs b/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluatorTest.hs new file mode 100644 index 000000000..ba1846d57 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/InteractEvaluatorTest.hs @@ -0,0 +1,28 @@ +module HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluatorTest where + +import HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluator +import HelVM.HelCam.WhiteSpace.Instruction +import HelVM.HelCam.WhiteSpace.ParserTest + +import HelVM.HelCam.WhiteSpace.EvaluatorTestData + +import HelVM.HelCam.Common.MockIO + +import Control.Monad.State.Lazy + +import Test.HUnit + +testsOfWSInteractEvaluator :: Test +testsOfWSInteractEvaluator = test + [ "evalWSHelloWorld" ~: "test evalWSIL Hello, world" ~: "Hello, world" ~=? batchEvalWSIL helloWorldIL + , "evalWSTruthMachine0" ~: "test evalWSIL Truth-Machine" ~: "0" ~=? evalWSIL truthMachineIL "0\n" + , "evalCalcTL" ~: "test evalWSTL Calc" ~: calcO ~=? evalWSTL False calcTL "-1\n" + , "evalCountTL" ~: "test evalWSTL Count" ~: countO ~=? batchEvalWSTL False countTL + , "evalFactTL" ~: "test evalWSTL Fact" ~: factO ~=? evalWSTL False factTL "10\n" + , "evalHanoiTL" ~: "test evalWSTL Hanoi" ~: hanoiO ~=? evalWSTL False hanoiTL "1\n" + , "evalHelloWorldTL" ~: "test evalWSTL HelloWorld" ~: "Hello, world" ~=? batchEvalWSTL False helloWorldTL + , "evalHWorldTL" ~: "test evalWSTL HWorld" ~: hWorldO ~=? batchEvalWSTL False hWorldTL + , "evalLocTestTL" ~: "test evalWSTL LocTest" ~: locTestO ~=? evalWSTL False locTestTL "1\n2\n" + , "evalNameTL" ~: "test evalWSTL Name" ~: nameO ~=? evalWSTL False nameTL "WriteOnly\n" + , "evalTruthMachineTL" ~: "test evalWSTL TruthMachine" ~: "0" ~=? evalWSTL False truthMachineTL "0\n" + ] diff --git a/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluatorTest.hs b/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluatorTest.hs new file mode 100644 index 000000000..56f5d35d2 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/WhiteSpace/Evaluator/MonadicEvaluatorTest.hs @@ -0,0 +1,27 @@ +module HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluatorTest where + +import HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluator +import HelVM.HelCam.WhiteSpace.Instruction + +import HelVM.HelCam.WhiteSpace.EvaluatorTestData + +import HelVM.HelCam.Common.MockIO + +import Control.Monad.State.Lazy + +import Test.HUnit + +testsOfWSMonadicEvaluator :: Test +testsOfWSMonadicEvaluator = test + [ "evalWSHelloWorld" ~: "test evalWSIL Hello, world" ~: "Hello, world" ~=? batchExecMockIO (evalWSIL helloWorldIL ) + , "evalWSTruthMachine0" ~: "test evalWSIL Truth-Machine" ~: "0" ~=? execMockIO (evalWSIL truthMachineIL ) "0" + , "evalCalcTL" ~: "test evalWSTL Calc" ~: calcO ~=? execMockIO (evalWSTL False calcTL ) "-1\n" + , "evalCountTL" ~: "test evalWSTL Count" ~: countO ~=? batchExecMockIO (evalWSTL False countTL ) + , "evalFactTL" ~: "test evalWSTL Fact" ~: factO ~=? execMockIO (evalWSTL False factTL ) "10\n" + , "evalHanoiTL" ~: "test evalWSTL Hanoi" ~: hanoiO ~=? execMockIO (evalWSTL False hanoiTL ) "1\n" + , "evalHelloWorldTL" ~: "test evalWSTL HelloWorld" ~: "Hello, world" ~=? batchExecMockIO (evalWSTL False helloWorldTL ) + , "evalHWorldTL" ~: "test evalWSTL HWorld" ~: hWorldO ~=? batchExecMockIO (evalWSTL False hWorldTL ) + , "evalLocTestTL" ~: "test evalWSTL LocTest" ~: locTestO ~=? execMockIO (evalWSTL False locTestTL ) "1\n2\n" + , "evalNameTL" ~: "test evalWSTL Name" ~: nameO ~=? execMockIO (evalWSTL False nameTL ) "WriteOnly\n" + , "evalTruthMachineTL" ~: "test evalWSTL TruthMachine" ~: "0" ~=? execMockIO (evalWSTL False truthMachineTL) "0\n" + ] diff --git a/src/test/eta/HelVM/HelCam/WhiteSpace/EvaluatorTestData.hs b/src/test/eta/HelVM/HelCam/WhiteSpace/EvaluatorTestData.hs new file mode 100644 index 000000000..5be797eba --- /dev/null +++ b/src/test/eta/HelVM/HelCam/WhiteSpace/EvaluatorTestData.hs @@ -0,0 +1,168 @@ +module HelVM.HelCam.WhiteSpace.EvaluatorTestData where + +import HelVM.HelCam.WhiteSpace.Token +import HelVM.HelCam.WhiteSpace.Instruction + +import HelVM.HelCam.Common.Util + +calcTL :: TokenList +calcTL = + [S,S,S,S,N,S,S,S,T,S,S,S,T,S,T,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,S,S,S,T,S,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,S,S,T,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,S,T,S,N,S,S,S,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,S,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,T,S,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,S,T,S,T,N,S,S,S,T,T,S,T,S,S,S,N,T,T,S,S,S,S,T,S,T,T,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,T,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,T,S,S,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,S,T,N,S,S,S,T,S,T,T,S,T,N,T,T,S,S,S,S,T,T,S,T,S,N,S,S,S,T,T,S,S,S,T,N,T,T,S,S,S,S,T,T,S,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,T,S,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,T,S,T,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,T,T,T,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,T,T,T,N,S,S,S,T,T,S,S,T,T,S,N,T,T,S,S,S,S,T,S,S,S,S,S,N,S,S,S,T,T,S,T,S,S,T,N,T,T,S,S,S,S,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,S,T,S,N,S,S,S,T,T,S,T,S,S,T,N,T,T,S,S,S,S,T,S,S,S,T,T,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,S,T,S,S,N,S,S,S,T,T,S,T,S,S,S,N,T,T,S,S,S,S,T,S,S,T,S,T,N,S,S,S,S,N,T,T,S,S,S,S,T,S,T,S,T,S,N,S,S,S,T,S,S,T,T,T,S,N,T,T,S,S,S,S,T,S,T,S,T,T,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,S,T,T,S,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,S,T,N,S,S,S,T,T,S,S,S,T,S,N,T,T,S,S,S,S,T,S,T,T,T,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,T,T,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,T,S,S,S,S,N,S,S,S,T,T,T,S,T,S,N,T,T,S,S,S,S,T,T,S,S,S,T,N,S,S,S,S,N,T,T,S,S,S,S,T,T,T,T,S,S,N,S,S,S,T,S,T,S,T,S,S,N,T,T,S,S,S,S,T,T,T,T,S,T,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,T,T,T,T,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,T,T,T,T,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,S,S,S,S,S,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,S,S,S,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,S,T,S,N,S,S,S,T,T,S,T,S,S,T,N,T,T,S,S,S,S,T,S,S,S,S,T,T,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,S,S,T,S,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,T,S,T,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,S,S,S,S,N,T,T,S,N,S,S,S,T,T,S,T,T,S,S,S,T,T,S,T,T,T,T,S,T,T,S,T,T,T,T,S,T,T,T,S,S,S,S,N,S,S,S,T,S,T,S,T,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,N,T,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,S,N,S,S,S,T,T,N,T,S,S,T,N,T,S,S,T,T,T,S,S,S,S,S,T,T,T,S,S,T,S,S,T,T,S,T,T,T,T,S,T,T,S,S,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,S,S,T,T,S,S,T,S,S,N,T,T,T,T,S,S,S,S,S,S,T,T,S,S,T,S,S,N,S,N,T,T,T,S,N,S,N,S,T,T,S,T,T,S,S,S,T,T,S,T,T,T,T,S,T,T,S,T,T,T,T,S,T,T,T,S,S,S,S,N,N,S,S,S,T,T,T,S,S,S,S,S,T,T,T,S,S,T,S,S,T,T,S,T,T,T,T,S,T,T,S,S,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,T,T,T,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,T,T,T,N,S,T,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,N,N,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +catTL :: TokenList +catTL = + [N,S,S,S,N + ,S,S,S,T,N + ,T,N,T,S + ,S,S,S,T,N + ,T,T,T + ,T,N,S,S + ,S,S,S,T,N + ,N,T,S,T,N + ,N,S,N,S,N + ,N,S,S,T,N + ,N,N,N + ] + + +countTL :: TokenList +countTL = + [S,S,S,T,N,N,S,S,S,T,S,S,S,S,T,T,N,S,N,S,T,N,S,T,S,S,S,T,S,T,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,S,N,S,S,S,S,T,S,T,T,N,T,S,S,T,N,T,S,S,T,S,S,S,T,S,T,N,N,S,N,S,T,S,S,S,S,T,T,N,N,S,S,S,T,S,S,S,T,S,T,N,S,N,N,N,N,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +factTL :: TokenList +factTL = + [S,S,S,S,N,S,S,S,T,S,S,S,T,S,T,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,S,S,S,T,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,T,S,T,S,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,T,S,T,S,S,N,S,S,S,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,T,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,T,T,S,N,S,S,S,T,T,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,N,T,T,S,S,S,T,T,S,S,T,S,S,N,T,T,T,N,S,T,S,T,T,S,S,T,T,S,S,T,T,S,S,S,S,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,N,S,S,S,T,T,S,S,T,S,S,N,T,T,T,T,N,S,T,S,S,S,T,S,T,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,T,N,S,T,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,N,N,N,N,S,S,S,T,T,S,S,T,T,S,S,T,T,S,S,S,S,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,N,S,N,S,S,S,S,T,N,T,S,S,T,N,T,S,S,T,T,S,S,T,T,S,S,T,T,S,S,S,S,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,S,T,T,S,S,S,T,S,S,T,T,S,S,S,S,T,S,T,T,T,S,S,T,T,S,T,T,S,S,T,S,T,N,S,N,S,S,S,S,T,N,T,S,S,T,N,S,T,S,T,T,S,S,T,T,S,S,T,T,S,S,S,S,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,N,T,S,S,N,N,T,N,N,S,S,S,T,T,S,S,T,T,S,S,T,T,S,S,S,S,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,S,T,T,S,S,S,T,S,S,T,T,S,S,S,S,T,S,T,T,T,S,S,T,T,S,T,T,S,S,T,S,T,N,S,S,S,T,N,S,N,N,N,T,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +hanoiTL :: TokenList +hanoiTL = + [S,S,S,S,N,S,S,S,T,S,S,S,T,S,T,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,S,S,S,T,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,T,S,T,S,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,T,S,T,S,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,T,S,T,N,S,S,S,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,S,N,S,S,S,T,T,T,T,T,S,N,T,T,S,S,S,S,T,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,N,T,T,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,N,S,S,S,T,T,N,S,S,S,T,S,N,N,S,T,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,N,N,N,N,S,S,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,S,S,S,T,T,S,S,T,T,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,T,S,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,S,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,S,N,T,T,T,N,T,S,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,S,S,S,T,T,S,S,T,T,S,N,T,T,T,S,S,S,T,T,S,S,T,T,T,N,T,T,T,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,N,T,S,S,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,S,S,S,T,T,S,S,T,T,T,N,T,T,T,S,S,S,T,T,S,S,T,T,S,N,T,T,T,N,S,T,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,S,S,S,T,T,S,S,T,T,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,T,S,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,S,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,T,N,T,T,T,T,N,S,T,S,S,S,T,S,T,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,T,S,N,T,T,T,T,N,S,T,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,S,S,S,T,T,S,S,T,T,S,N,T,T,T,S,S,S,T,T,S,S,T,T,T,N,T,T,T,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,N,T,S,S,T,S,S,S,T,T,S,S,T,T,T,N,T,T,T,S,S,S,T,T,S,S,T,T,S,N,T,T,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,N,S,T,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,S,S,S,T,T,S,S,T,T,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,T,S,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,T,N,S,N,T,T,T,S,S,S,S,T,T,S,S,T,S,S,N,S,N,T,T,T,S,N,S,S,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,S,T,T,S,T,S,S,S,S,T,T,S,S,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,T,T,T,T,S,T,T,S,T,S,S,T,N,N,T,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +helloWorldTL :: TokenList +helloWorldTL = + [S,S,S,T,S,S,T,S,S,S,N + ,T,N,S,S + ,S,S,S,T,T,S,S,T,S,T,N + ,T,N,S,S + ,S,S,S,T,T,S,T,T,S,S,N + ,T,N,S,S + ,S,S,S,T,T,S,T,T,S,S,N + ,T,N,S,S + ,S,S,S,T,T,S,T,T,T,T,N + ,T,N,S,S + ,S,S,S,T,S,T,T,S,S,N + ,T,N,S,S + ,S,S,S,T,S,S,S,S,S,N + ,T,N,S,S + ,S,S,S,T,T,T,S,T,T,T,N + ,T,N,S,S + ,S,S,S,T,T,S,T,T,T,T,N + ,T,N,S,S + ,S,S,S,T,T,T,S,S,T,S,N + ,T,N,S,S + ,S,S,S,T,T,S,T,T,S,S,N + ,T,N,S,S + ,S,S,S,T,T,S,S,T,S,S,N + ,T,N,S,S + ,N,N,N + ] + +hWorldTL :: TokenList +hWorldTL = + [S,S,S,S,N,S,S,S,T,S,S,T,S,S,S,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,S,T,T,S,S,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,T,T,S,T,T,T,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,S,S,T,S,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,S,S,T,T,S,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,S,S,T,N,S,S,S,T,T,T,S,S,S,S,N,T,T,S,S,S,S,T,S,S,T,S,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,S,T,T,N,S,S,S,T,T,S,S,S,T,T,N,T,T,S,S,S,S,T,S,T,S,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,S,T,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,T,T,S,N,S,S,S,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,T,T,T,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,N,N,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +locTestTL :: TokenList +locTestTL = + [S,S,S,S,N,S,S,S,T,S,S,S,T,S,T,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,S,S,S,T,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,T,S,T,S,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,T,N,T,T,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,N,T,T,S,S,S,T,T,S,S,T,S,S,N,T,T,T,S,S,S,T,T,S,S,T,S,T,N,T,T,T,N,S,T,S,T,T,S,T,T,S,S,S,T,T,S,T,T,T,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,T,T,S,S,T,T,S,T,T,T,S,T,S,S,N,T,N,S,T,N,N,N,N,S,S,S,T,T,S,T,T,S,S,S,T,T,S,T,T,T,T,S,T,T,S,S,S,T,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,T,T,S,S,T,T,S,T,T,T,S,T,S,S,N,S,T,S,S,S,N,S,T,S,S,T,S,N,T,S,S,S,S,T,N,S,T,S,N,N,T,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +nameTL :: TokenList +nameTL = + [S,S,S,S,N,S,S,S,T,S,T,S,S,S,S,N,T,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,T,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,S,N,S,S,S,T,T,T,S,S,T,T,N,T,T,S,S,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,T,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,S,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,T,N,S,S,S,T,T,T,S,T,S,S,N,T,T,S,S,S,S,T,S,T,S,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,T,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,T,S,S,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,T,N,S,S,S,T,T,T,T,S,S,T,N,T,T,S,S,S,S,T,T,T,S,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,T,T,T,N,S,S,S,T,T,T,S,T,S,T,N,T,T,S,S,S,S,T,S,S,S,S,N,S,S,S,T,T,T,S,S,T,S,N,T,T,S,S,S,S,T,S,S,S,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,T,S,N,S,S,S,T,T,S,T,T,T,S,N,T,T,S,S,S,S,T,S,S,T,T,N,S,S,S,T,T,S,S,S,S,T,N,T,T,S,S,S,S,T,S,T,S,S,N,S,S,S,T,T,S,T,T,S,T,N,T,T,S,S,S,S,T,S,T,S,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,T,T,S,N,S,S,S,T,T,T,S,T,S,N,T,T,S,S,S,S,T,S,T,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,T,S,S,S,N,S,S,S,S,N,T,T,S,S,S,S,T,T,T,T,S,N,S,S,S,T,S,S,T,S,S,S,N,T,T,S,S,S,S,T,T,T,T,T,N,S,S,S,T,T,S,S,T,S,T,N,T,T,S,S,S,S,T,S,S,S,S,S,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,S,S,S,T,N,S,S,S,T,T,S,T,T,S,S,N,T,T,S,S,S,S,T,S,S,S,T,S,N,S,S,S,T,T,S,T,T,T,T,N,T,T,S,S,S,S,T,S,S,S,T,T,N,S,S,S,T,S,S,S,S,S,N,T,T,S,S,S,S,T,S,S,T,S,S,N,S,S,S,S,N,T,T,S,S,S,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,N,S,T,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,S,S,T,T,T,T,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,S,S,T,T,S,S,T,S,S,N,N,S,T,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,N,N,N,N,S,S,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,T,S,S,T,S,S,N,T,S,S,S,N,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,S,N,S,T,T,T,S,N,S,N,T,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,T,N,S,S,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,N,N,S,S,S,T,T,T,S,T,T,T,S,T,T,T,S,S,T,S,S,T,T,S,T,S,S,T,S,T,T,T,S,T,S,S,S,T,T,S,S,T,S,T,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,N,N,N,T,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,S,N,S,S,N,S,T,N,T,S,T,T,T,S,N,S,S,S,S,T,S,T,S,N,T,S,S,T,N,T,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,N,S,N,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,N,N,S,S,S,T,T,T,S,S,T,S,S,T,T,S,S,T,S,T,S,T,T,S,S,S,S,T,S,T,T,S,S,T,S,S,S,T,S,T,T,T,T,T,S,T,T,S,S,T,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,S,N,S,N,N,S,S,S,T,N,T,S,S,S,S,S,S,S,N,T,T,S,N,T,N,N,S,S,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,S,T,T,T,S,T,T,T,S,T,T,S,T,T,S,S,S,T,T,S,T,S,S,T,S,T,T,S,T,T,T,S,S,T,T,S,S,T,S,T,N,S,S,S,T,S,T,S,N,S,S,S,T,T,S,T,N,T,N,S,S,T,N,S,S,N,T,N] + +truthMachineTL :: TokenList +truthMachineTL = + [S,S,S,N + ,S,N,S + ,T,N,T,T + ,T,T,T + ,N,T,S,S,N + ,N,S,S,T,N + ,S,S,S,T,N + ,T,N,S,T + ,N,S,N,T,N + ,N,S,S,S,N + ,S,S,S,N + ,T,N,S,T + ,N,N,N + ] + +-------------------------------------------------------------------------------- + +catIL :: InstructionList +catIL = + [ Label "0" + , Const 1, InputChar + , Const 1, Load, OutputChar + , Const 1 + , Branch EZ "1" + , Jump "0" + + , Label "1" + , End + ] + +helloWorldIL :: InstructionList +helloWorldIL = + [ Const 72, OutputChar + , Const 101, OutputChar + , Const 108, OutputChar + , Const 108, OutputChar + , Const 111,OutputChar + , Const 44, OutputChar + , Const 32, OutputChar + , Const 119, OutputChar + , Const 111, OutputChar + , Const 114, OutputChar + , Const 108, OutputChar + , Const 100, OutputChar + , End + ] + +truthMachineIL :: InstructionList +truthMachineIL = + [ Const 0 + , Dup + , InputNum + , Load + , Branch EZ "0" + + , Label "1" + , Const 1, OutputNum + , Jump "1" + + , Label "0" + , Const 0, OutputNum + , End + ] + +---- + +calcO :: Output +calcO = "Enter some numbers, then -1 to finish\r\nNumber:Total is 0\r\n" + +countO :: Output +countO = "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n" + +factO :: Output +factO = "Enter a number: 10! = 3628800\r\n" + +hanoiO :: Output +hanoiO = "Enter a number: 1 -> 3\r\n" + +hWorldO :: Output +hWorldO = "Hello, world of spaces!\r\n" + +locTestO :: Output +locTestO = "Enter a number: Enter a number: 3" + +nameO :: Output +nameO = "Please enter your name: Hello WriteOnly\n\r\n" diff --git a/src/test/eta/HelVM/HelCam/WhiteSpace/OperandParsersTest.hs b/src/test/eta/HelVM/HelCam/WhiteSpace/OperandParsersTest.hs new file mode 100644 index 000000000..157f53d72 --- /dev/null +++ b/src/test/eta/HelVM/HelCam/WhiteSpace/OperandParsersTest.hs @@ -0,0 +1,71 @@ +module HelVM.HelCam.WhiteSpace.OperandParsersTest where + +import HelVM.HelCam.WhiteSpace.EvaluatorTestData + +import HelVM.HelCam.WhiteSpace.Parser +import HelVM.HelCam.WhiteSpace.OperandParsers +import HelVM.HelCam.WhiteSpace.Token +import HelVM.HelCam.WhiteSpace.Instruction + +import Numeric.Natural + +import Test.HUnit hiding (Label) + +testsOfWSOperandParsers :: Test +testsOfWSOperandParsers = TestList + [ TestLabel "testOfParseInteger" testOfParseInteger + , TestLabel "testOfParseNatural" testOfParseNatural + , TestLabel "testOfParseBitString" testOfParseBitString + ] + +---- + +testOfParseNatural :: Test +testOfParseNatural = test + [ "testParseNatural_" ~: "testParseNatural_" ~: 0 ~=? fst ( parseNatural [N]) + , "testParseNatural_S" ~: "testParseNatural_S" ~: 0 ~=? fst ( parseNatural [S, N]) + , "testParseNatural_T" ~: "testParseNatural_T" ~: 1 ~=? fst ( parseNatural [T, N]) + , "testParseNatural_SS" ~: "testParseNatural_SS" ~: 0 ~=? fst ( parseNatural [S, S, N]) + , "testParseNatural_ST" ~: "testParseNatural_ST" ~: 1 ~=? fst ( parseNatural [S, T, N]) + , "testParseNatural_TS" ~: "testParseNatural_TS" ~: 2 ~=? fst ( parseNatural [T, S, N]) + , "testParseNatural_TT" ~: "testParseNatural_TT" ~: 3 ~=? fst ( parseNatural [T, T, N]) + , "testParseNatural_SSS" ~: "testParseNatural_SSS" ~: 0 ~=? fst ( parseNatural [S, S, S, N]) + , "testParseNatural_SST" ~: "testParseNatural_SST" ~: 1 ~=? fst ( parseNatural [S, S, T, N]) + , "testParseNatural_STS" ~: "testParseNatural_STS" ~: 2 ~=? fst ( parseNatural [S, T, S, N]) + , "testParseNatural_STT" ~: "testParseNatural_STT" ~: 3 ~=? fst ( parseNatural [S, T, T, N]) + , "testParseNatural_TSS" ~: "testParseNatural_TSS" ~: 4 ~=? fst ( parseNatural [T, S, S, N]) + , "testParseNatural_TST" ~: "testParseNatural_TST" ~: 5 ~=? fst ( parseNatural [T, S, T, N]) + , "testParseNatural_TTS" ~: "testParseNatural_TTS" ~: 6 ~=? fst ( parseNatural [T, T, S, N]) + , "testParseNatural_TTT" ~: "testParseNatural_TTT" ~: 7 ~=? fst ( parseNatural [T, T, T, N]) + ] + +testOfParseInteger :: Test +testOfParseInteger = test + [ "testParseInteger_" ~: "testParseInteger_" ~: 0 ~=? fst ( parseInteger [N]) + , "testParseInteger_S" ~: "testParseInteger_S" ~: 0 ~=? fst ( parseInteger [S, N]) + , "testParseInteger_T" ~: "testParseInteger_T" ~: 0 ~=? fst ( parseInteger [T, N]) + , "testParseInteger_SS" ~: "testParseInteger_SS" ~: 0 ~=? fst ( parseInteger [S, S, N]) + , "testParseInteger_ST" ~: "testParseInteger_ST" ~: 1 ~=? fst ( parseInteger [S, T, N]) + , "testParseInteger_TS" ~: "testParseInteger_TS" ~: 0 ~=? fst ( parseInteger [T, S, N]) + , "testParseInteger_TT" ~: "testParseInteger_TT" ~: (-1) ~=? fst ( parseInteger [T, T, N]) + , "testParseInteger_SSS" ~: "testParseInteger_SSS" ~: 0 ~=? fst ( parseInteger [S, S, S, N]) + , "testParseInteger_SST" ~: "testParseInteger_SST" ~: 1 ~=? fst ( parseInteger [S, S, T, N]) + , "testParseInteger_STS" ~: "testParseInteger_STS" ~: 2 ~=? fst ( parseInteger [S, T, S, N]) + , "testParseInteger_STT" ~: "testParseInteger_STT" ~: 3 ~=? fst ( parseInteger [S, T, T, N]) + , "testParseInteger_TSS" ~: "testParseInteger_TSS" ~: 0 ~=? fst ( parseInteger [T, S, S, N]) + , "testParseInteger_TST" ~: "testParseInteger_TST" ~: (-1) ~=? fst ( parseInteger [T, S, T, N]) + , "testParseInteger_TTS" ~: "testParseInteger_TTS" ~: (-2) ~=? fst ( parseInteger [T, T, S, N]) + , "testParseInteger_TTT" ~: "testParseInteger_TTT" ~: (-3) ~=? fst ( parseInteger [T, T, T, N]) + ] + +testOfParseBitString :: Test +testOfParseBitString = test + [ "testParseBitString_SSS" ~: "testParseBitString_SSS" ~: "000" ~=? fst ( parseBitString [S, S, S, N]) + , "testParseBitString_SST" ~: "testParseBitString_SST" ~: "001" ~=? fst ( parseBitString [S, S, T, N]) + , "testParseBitString_STS" ~: "testParseBitString_STS" ~: "010" ~=? fst ( parseBitString [S, T, S, N]) + , "testParseBitString_STT" ~: "testParseBitString_STT" ~: "011" ~=? fst ( parseBitString [S, T, T, N]) + , "testParseBitString_TSS" ~: "testParseBitString_TSS" ~: "100" ~=? fst ( parseBitString [T, S, S, N]) + , "testParseBitString_TST" ~: "testParseBitString_TST" ~: "101" ~=? fst ( parseBitString [T, S, T, N]) + , "testParseBitString_TTS" ~: "testParseBitString_TTS" ~: "110" ~=? fst ( parseBitString [T, T, S, N]) + , "testParseBitString_TTT" ~: "testParseBitString_TTT" ~: "111" ~=? fst ( parseBitString [T, T, T, N]) + ] diff --git a/src/test/eta/HelVM/HelCam/WhiteSpace/ParserTest.hs b/src/test/eta/HelVM/HelCam/WhiteSpace/ParserTest.hs index 5fd868e77..00d0be961 100644 --- a/src/test/eta/HelVM/HelCam/WhiteSpace/ParserTest.hs +++ b/src/test/eta/HelVM/HelCam/WhiteSpace/ParserTest.hs @@ -1,6 +1,9 @@ module HelVM.HelCam.WhiteSpace.ParserTest where +import HelVM.HelCam.WhiteSpace.EvaluatorTestData + import HelVM.HelCam.WhiteSpace.Parser +import HelVM.HelCam.WhiteSpace.OperandParsers import HelVM.HelCam.WhiteSpace.Token import HelVM.HelCam.WhiteSpace.Instruction @@ -8,161 +11,9 @@ import Numeric.Natural import Test.HUnit hiding (Label) ---- - -testOfParseNatural :: Test -testOfParseNatural = TestList - [ TestLabel "testParseNatural_" (TestCase (assertEqual "testParseNatural_" 0 (fst $ parseNatural [N]))) - , TestLabel "testParseNatural_S" (TestCase (assertEqual "testParseNatural_S" 0 (fst $ parseNatural [S, N]))) - , TestLabel "testParseNatural_T" (TestCase (assertEqual "testParseNatural_T" 1 (fst $ parseNatural [T, N]))) - , TestLabel "testParseNatural_SS" (TestCase (assertEqual "testParseNatural_SS" 0 (fst $ parseNatural [S, S, N]))) - , TestLabel "testParseNatural_ST" (TestCase (assertEqual "testParseNatural_ST" 1 (fst $ parseNatural [S, T, N]))) - , TestLabel "testParseNatural_TS" (TestCase (assertEqual "testParseNatural_TS" 2 (fst $ parseNatural [T, S, N]))) - , TestLabel "testParseNatural_TT" (TestCase (assertEqual "testParseNatural_TT" 3 (fst $ parseNatural [T, T, N]))) - , TestLabel "testParseNatural_SSS" (TestCase (assertEqual "testParseNatural_SSS" 0 (fst $ parseNatural [S, S, S, N]))) - , TestLabel "testParseNatural_SST" (TestCase (assertEqual "testParseNatural_SST" 1 (fst $ parseNatural [S, S, T, N]))) - , TestLabel "testParseNatural_STS" (TestCase (assertEqual "testParseNatural_STS" 2 (fst $ parseNatural [S, T, S, N]))) - , TestLabel "testParseNatural_STT" (TestCase (assertEqual "testParseNatural_STT" 3 (fst $ parseNatural [S, T, T, N]))) - , TestLabel "testParseNatural_TSS" (TestCase (assertEqual "testParseNatural_TSS" 4 (fst $ parseNatural [T, S, S, N]))) - , TestLabel "testParseNatural_TST" (TestCase (assertEqual "testParseNatural_TST" 5 (fst $ parseNatural [T, S, T, N]))) - , TestLabel "testParseNatural_TTS" (TestCase (assertEqual "testParseNatural_TTS" 6 (fst $ parseNatural [T, T, S, N]))) - , TestLabel "testParseNatural_TTT" (TestCase (assertEqual "testParseNatural_TTT" 7 (fst $ parseNatural [T, T, T, N]))) - ] - -testOfParseInteger :: Test -testOfParseInteger = TestList - [ TestLabel "testParseInteger_" (TestCase (assertEqual "testParseInteger_" 0 (fst $ parseInteger [N]))) - , TestLabel "testParseInteger_S" (TestCase (assertEqual "testParseInteger_S" 0 (fst $ parseInteger [S, N]))) - , TestLabel "testParseInteger_T" (TestCase (assertEqual "testParseInteger_T" 0 (fst $ parseInteger [T, N]))) - , TestLabel "testParseInteger_SS" (TestCase (assertEqual "testParseInteger_SS" 0 (fst $ parseInteger [S, S, N]))) - , TestLabel "testParseInteger_ST" (TestCase (assertEqual "testParseInteger_ST" 1 (fst $ parseInteger [S, T, N]))) - , TestLabel "testParseInteger_TS" (TestCase (assertEqual "testParseInteger_TS" 0 (fst $ parseInteger [T, S, N]))) - , TestLabel "testParseInteger_TT" (TestCase (assertEqual "testParseInteger_TT" (-1) (fst $ parseInteger [T, T, N]))) - , TestLabel "testParseInteger_SSS" (TestCase (assertEqual "testParseInteger_SSS" 0 (fst $ parseInteger [S, S, S, N]))) - , TestLabel "testParseInteger_SST" (TestCase (assertEqual "testParseInteger_SST" 1 (fst $ parseInteger [S, S, T, N]))) - , TestLabel "testParseInteger_STS" (TestCase (assertEqual "testParseInteger_STS" 2 (fst $ parseInteger [S, T, S, N]))) - , TestLabel "testParseInteger_STT" (TestCase (assertEqual "testParseInteger_STT" 3 (fst $ parseInteger [S, T, T, N]))) - , TestLabel "testParseInteger_TSS" (TestCase (assertEqual "testParseInteger_TSS" 0 (fst $ parseInteger [T, S, S, N]))) - , TestLabel "testParseInteger_TST" (TestCase (assertEqual "testParseInteger_TST" (-1) (fst $ parseInteger [T, S, T, N]))) - , TestLabel "testParseInteger_TTS" (TestCase (assertEqual "testParseInteger_TTS" (-2) (fst $ parseInteger [T, T, S, N]))) - , TestLabel "testParseInteger_TTT" (TestCase (assertEqual "testParseInteger_TTT" (-3) (fst $ parseInteger [T, T, T, N]))) - ] - -catTokenList :: TokenList -catTokenList = [ - N,S,S,S,N, - S,S,S,T,N, - T,N,T,S, - S,S,S,T,N, - T,T,T, - T,N,S,S, - S,S,S,T,N, - N,T,S,T,N, - N,S,N,S,N, - N,S,S,T,N, - N,N,N] - -catIL :: InstructionList -catIL = [ - Label 0, - Const 1, InputChar, - Const 1, Load, OutputChar, - Const 1, - Branch EZ 1, - Jump 0, - - Label 1, - End] - -helloWorldTokenList :: TokenList -helloWorldTokenList = [ - S,S,S,T,S,S,T,S,S,S,N, - T,N,S,S, - S,S,S,T,T,S,S,T,S,T,N, - T,N,S,S, - S,S,S,T,T,S,T,T,S,S,N, - T,N,S,S, - S,S,S,T,T,S,T,T,S,S,N, - T,N,S,S, - S,S,S,T,T,S,T,T,T,T,N, - T,N,S,S, - S,S,S,T,S,T,T,S,S,N, - T,N,S,S, - S,S,S,T,S,S,S,S,S,N, - T,N,S,S, - S,S,S,T,T,T,S,T,T,T,N, - T,N,S,S, - S,S,S,T,T,S,T,T,T,T,N, - T,N,S,S, - S,S,S,T,T,T,S,S,T,S,N, - T,N,S,S, - S,S,S,T,T,S,T,T,S,S,N, - T,N,S,S, - S,S,S,T,T,S,S,T,S,S,N, - T,N,S,S, - N,N,N] - -helloWorldIL :: InstructionList -helloWorldIL = [ - Const 72, OutputChar, - Const 101, OutputChar, - Const 108, OutputChar, - Const 108, OutputChar, - Const 111,OutputChar, - Const 44, OutputChar, - Const 32, OutputChar, - Const 119, OutputChar, - Const 111, OutputChar, - Const 114, OutputChar, - Const 108, OutputChar, - Const 100, OutputChar, - End] - -truthMachineTokenList :: TokenList -truthMachineTokenList = [S,S,S,N, - S,N,S, - T,N,T,T, - T,T,T, - N,T,S,S,N, - N,S,S,T,N, - S,S,S,T,N, - T,N,S,T, - N,S,N,T,N, - N,S,S,S,N, - S,S,S,N, - T,N,S,T, - N,N,N] - -truthMachineIL :: InstructionList -truthMachineIL = [ - Const 0, - Dup, - InputNum, - Load, - Branch EZ 0, - - Label 1, - Const 1, OutputNum, - Jump 1, - - Label 0, - Const 0, OutputNum, - End] - -testOfParseCat :: Test -testOfParseCat = TestCase (assertEqual "cat" catIL (parse catTokenList)) - -testOfParseHelloWorld :: Test -testOfParseHelloWorld = TestCase (assertEqual "helloWorld" helloWorldIL (parse helloWorldTokenList)) - -testOfParseTruthMachine :: Test -testOfParseTruthMachine = TestCase (assertEqual "testOfParseTruthMachine" truthMachineIL (parse truthMachineTokenList)) - -testsOfParser :: Test -testsOfParser = TestList - [ TestLabel "testOfParseInteger" testOfParseInteger - , TestLabel "testOfParseNatural" testOfParseNatural - , TestLabel "testOfParseCat" testOfParseCat - , TestLabel "testOfParseHelloWorld" testOfParseHelloWorld - , TestLabel "testOfParseTruthMachine" testOfParseTruthMachine +testsOfWSParser :: Test +testsOfWSParser = TestList + [ "testOfParseCat" ~: "cat" ~: catIL ~=? parseWSTL False catTL + , "testOfParseHelloWorld" ~: "helloWorld" ~: helloWorldIL ~=? parseWSTL False helloWorldTL + , "testOfParseTruthMachine" ~: "testOfParseTruthMachine" ~: truthMachineIL ~=? parseWSTL False truthMachineTL ] diff --git a/src/test/eta/Test.hs b/src/test/eta/Test.hs index 1e1edcaae..fe9af51b0 100644 --- a/src/test/eta/Test.hs +++ b/src/test/eta/Test.hs @@ -1,7 +1,13 @@ module Main(main) where +import HelVM.HelCam.Common.FilterIf0Test import HelVM.HelCam.BrainFuck.TokensTest +import HelVM.HelCam.BrainFuck.Evaluator.InteractEvaluatorTest +import HelVM.HelCam.BrainFuck.Evaluator.MonadicEvaluatorTest +import HelVM.HelCam.WhiteSpace.OperandParsersTest import HelVM.HelCam.WhiteSpace.ParserTest +import HelVM.HelCam.WhiteSpace.Evaluator.InteractEvaluatorTest +import HelVM.HelCam.WhiteSpace.Evaluator.MonadicEvaluatorTest import Test.HUnit @@ -9,10 +15,16 @@ testExample :: Test testExample = TestCase (assertEqual "test" "test" "test") testList :: Test -testList = TestList +testList = TestList [ TestLabel "testExample" testExample - , TestLabel "testsOfTokens" testsOfTokens - , TestLabel "testOfParser" testsOfParser + , TestLabel "testsOfFilterIf0" testsOfFilterIf0 + , TestLabel "testsOfBFTokens" testsOfBFTokens + , TestLabel "testsOfBFInteractEvaluator" testsOfBFInteractEvaluator + , TestLabel "testsOfBFMonadicEvaluator" testsOfBFMonadicEvaluator + , TestLabel "testsOfWSOperandParsers" testsOfWSOperandParsers + , TestLabel "testsOfWSParser" testsOfWSParser + , TestLabel "testsOfWSInteractEvaluator" testsOfWSInteractEvaluator + , TestLabel "testsOfWSMonadicEvaluator" testsOfWSMonadicEvaluator ] main :: IO ()