-
-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add Evaluator of BrainFuck and WhiteSpace
Add WrapperIO, FilterIf0, MockIO and tests for WrapperIf0
- Loading branch information
1 parent
4a51848
commit 27ce749
Showing
40 changed files
with
1,511 additions
and
402 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,2 +1,6 @@ | ||
| #!/bin/bash | ||
| alias etlas='../etlas' | ||
|
|
||
| etlas clean && etlas build && etlas test | ||
|
|
||
| git check-whitespace |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
57 changes: 57 additions & 0 deletions
57
src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/InteractEvaluator.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 _ = [] |
57 changes: 57 additions & 0 deletions
57
src/main/eta/HelVM/HelCam/BrainFuck/Evaluator/MonadicEvaluator.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 () |
28 changes: 13 additions & 15 deletions
28
...main/eta/HelVM/HelCam/BrainFuck/Tokens.hs → src/main/eta/HelVM/HelCam/BrainFuck/Lexer.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,29 +1,27 @@ | ||
| module HelVM.HelCam.BrainFuck.Tokens where | ||
| module HelVM.HelCam.BrainFuck.Lexer where | ||
|
|
||
| import HelVM.HelCam.BrainFuck.Token | ||
| 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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 |
Oops, something went wrong.