From b586838fb37d1ea5afa9cae2076f5e9b3ddb2c88 Mon Sep 17 00:00:00 2001
From: Pavel Kirilin <win10@list.ru>
Date: Sun, 14 Jun 2020 23:16:07 +0400
Subject: [PATCH] REPL is done. Description: - Added REPL functionality. -
REFACTOR NEEDED!!! - Added test.bf
Signed-off-by: Pavel Kirilin <win10@list.ru>
---
app/Main.hs | 3 +-
src/Definitions.hs | 12 +++-
src/LangParser.hs | 13 ++--
src/Lib.hs | 14 +----
src/REPL.hs | 146 +++++++++++++++++++++++++++++++++++++++++----
test.bf | 9 ++-
6 files changed, 162 insertions(+), 35 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
index 3ff761e..0da7cc9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,12 +1,13 @@
module Main where
import Lib
+import REPL
import Options
import MainOptions
import System.Environment
main :: IO ()
main = runCommand $ \opts args -> case (input opts, output opts) of
- ("" , "" ) -> startRepl
+ ("" , "" ) -> startREPL
(inFile, "" ) -> runFile inFile
(inFile, outFile) -> compileFile inFile outFile
diff --git a/src/Definitions.hs b/src/Definitions.hs
index 25b7c40..56cfcad 100644
--- a/src/Definitions.hs
+++ b/src/Definitions.hs
@@ -1,6 +1,7 @@
module Definitions where
-data BrainBreakOperation = Increment
+data BrainBreakOperation =
+ Increment
| Decrement
| MoveRight
| MoveLeft
@@ -12,6 +13,11 @@ data BrainBreakOperation = Increment
type BrainBreakBlock = [BrainBreakOperation]
-data REPLHelpers = PrintState deriving (Show)
+data REPLHelpers =
+ PrintState
+ | PrintBuf
+ | PrintBufChars deriving (Show)
-data REPLCode = Code BrainBreakBlock | Helper REPLHelpers deriving (Show)
+data REPLCode =
+ Code BrainBreakBlock
+ | Helper REPLHelpers deriving (Show)
diff --git a/src/LangParser.hs b/src/LangParser.hs
index 6e191e1..aa3c0cc 100644
--- a/src/LangParser.hs
+++ b/src/LangParser.hs
@@ -43,11 +43,12 @@ parseBrainBreak =
parseDecrement = symbolic '-' $> Decrement
parseReplHelpers :: Parser REPLHelpers
-parseReplHelpers = parsePrintState
- where parsePrintState = symbol ":state" $> PrintState
+parseReplHelpers = parsePrintState <|> parsePrintBufChars <|> parsePrintBuf
+ where
+ parsePrintBuf = symbol ":buf" $> PrintBuf
+ parsePrintState = symbol ":state" $> PrintState
+ parsePrintBufChars = symbol ":bufc" $> PrintBufChars
parseREPLCode :: Parser REPLCode
-parseREPLCode =
- Helper <$> parseReplHelpers
- <|> Code <$> parseBrainBreak
-
+parseREPLCode = Helper <$> parseReplHelpers <|> Code <$> parseBrainBreak
+
diff --git a/src/Lib.hs b/src/Lib.hs
index 978eebd..be98d25 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,27 +1,19 @@
module Lib where
import REPL
+import Data.List
import LangParser
import Definitions
import Text.Trifecta
-import Data.List
+import Control.Monad.State
-startRepl :: IO ()
-startRepl = do
- input <- getLine
- let parsed_string = parseString parseREPLCode mempty input
- case parsed_string of
- Success code -> runReplCode code
- Failure info -> print (_errDoc info)
- startRepl
runFile :: String -> IO ()
runFile filename = do
parse_result <- parseFromFileEx parseBrainBreak filename
case parse_result of
- Success code -> print (filterComments code)
+ Success code -> evalStateT (runBrainBreakCode code) defaultState
Failure info -> print (_errDoc info)
-
compileFile :: String -> String -> IO ()
compileFile input output = putStrLn "Compiling code developing is in progress."
diff --git a/src/REPL.hs b/src/REPL.hs
index 131fb5a..d863730 100644
--- a/src/REPL.hs
+++ b/src/REPL.hs
@@ -1,10 +1,14 @@
module REPL where
-import Control.Monad.State
+import LangParser
import Definitions
+import Text.Trifecta
+import Control.Monad.State
+import System.IO
data REPLState = REPLState{
buffer :: [Integer],
+ inputNumber :: Integer,
index :: Integer,
offset :: Integer
} deriving (Show)
@@ -18,9 +22,27 @@ data Direction =
replicaFactor :: Int
replicaFactor = 3000
+io :: IO a -> StateT REPLState IO a
+io = liftIO
+
+prompt :: String -> IO String
+prompt text = do
+ putStr text
+ hFlush stdout
+ getLine
+
defaultState :: REPLState
-defaultState =
- REPLState { buffer = replicate replicaFactor 0, index = 0, offset = 0 }
+defaultState = REPLState { buffer = replicate replicaFactor 0
+ , inputNumber = 0
+ , index = 0
+ , offset = 0
+ }
+
+updateListElement :: [Integer] -> Integer -> (Integer -> Integer) -> [Integer]
+updateListElement list index update = do
+ let element = update $ list !! fromInteger index
+ let (x,_:ys) = splitAt (fromInteger index) list
+ x ++ element : ys
expandIfNeeded :: [Integer] -> Integer -> [Integer]
-- Expand buffer to travel left but index is less than zero
@@ -32,31 +54,44 @@ expandIfNeeded old_buffer new_index = old_buffer
needed len | len >= 0 = replicate replicaFactor 0
| len < 0 = []
+increaseInputNumber :: REPLState -> REPLState
+increaseInputNumber state = state { inputNumber = inputNumber state + 1 }
+
-- Fuction to update state accordingly to walk direction
walkUpdate :: Direction -> REPLState -> REPLState
-- Walk left with buffer expnding if needed
-walkUpdate LeftDirection old_state = do
+walkUpdate LeftDirection old_state = do
let update_func t = t - 1
let updated_buffer =
expandIfNeeded (buffer old_state) (update_func $ index old_state)
-- Finding diff because we need to update current index correctly
let len_diff =
toInteger $ length updated_buffer - length (buffer old_state)
- REPLState { buffer = updated_buffer
+ old_state { buffer = updated_buffer
, index = update_func $ index old_state + len_diff
, offset = update_func $ offset old_state
}
-walkUpdate RightDirection old_state = do
+walkUpdate RightDirection old_state = do
let update_func t = t + 1
let updated_buffer =
expandIfNeeded (buffer old_state) (update_func $ index old_state)
- REPLState { buffer = updated_buffer
+ old_state { buffer = updated_buffer
, index = update_func $ index old_state
, offset = update_func $ offset old_state
}
-walk :: Direction -> State REPLState ()
+updateStateCell :: (Integer -> Integer) -> REPLState -> REPLState
+updateStateCell update_func old_state = do
+ let new_buffer = updateListElement (buffer old_state) (index old_state) update_func
+ old_state{
+ buffer = new_buffer
+ }
+
+updateCell :: (Integer->Integer) -> StateT REPLState IO ()
+updateCell update_func = modify (updateStateCell update_func)
+
+walk :: Direction -> StateT REPLState IO ()
walk direction = do
modify (walkUpdate direction)
return ()
@@ -64,8 +99,95 @@ walk direction = do
doAction :: REPLCode -> State REPLState ()
doAction = undefined
-runHelper :: REPLHelpers -> State REPLState ()
-runHelper = undefined
-runReplCode :: REPLCode -> IO ()
-runReplCode = undefined
\ No newline at end of file
+getBufferSlice :: Integer -> Integer -> [Integer] -> [Integer]
+getBufferSlice size current_index current_buffer = do
+ let start = fromInteger $ current_index - size
+ let end = fromInteger $ current_index + size
+ drop start $ take end current_buffer
+
+runHelper :: REPLHelpers -> StateT REPLState IO ()
+runHelper PrintState = do
+ current_state <- get
+ let buffer_slice = getBufferSlice 5 (index current_state) (buffer current_state)
+ io $ putStrLn $ "Current index: " ++ show (index current_state)
+ io $ putStrLn $ "Offset from start: " ++ show (offset current_state)
+ io $ putStrLn $ "part of curren buffer: \n" ++ show buffer_slice
+ return ()
+
+runHelper PrintBuf = do
+ current_state <- get
+ let buffer_slice = getBufferSlice 5 (index current_state) (buffer current_state)
+ io $ print buffer_slice
+ return ()
+
+runHelper PrintBufChars = do
+ current_state <- get
+ let buffer_slice = getBufferSlice 5 (index current_state) (buffer current_state)
+ io $ print $ map (\t -> toEnum (fromInteger t) :: Char) buffer_slice
+ return ()
+
+getCell :: StateT REPLState IO Integer
+getCell = do
+ state <- get
+ return $ buffer state !! fromInteger (index state)
+
+printCell :: StateT REPLState IO ()
+printCell = do
+ cell <- getCell
+ io $ putChar (toEnum (fromInteger cell) :: Char)
+ io $ hFlush stdout
+ return ()
+
+readCell :: StateT REPLState IO ()
+readCell = do
+ char <- io getChar
+ updateCell (const $ toInteger $ fromEnum char)
+ return ()
+
+runBrainCodeLoop :: BrainBreakBlock -> StateT REPLState IO ()
+runBrainCodeLoop code = do
+ runBrainBreakCode code
+ cell <- getCell
+ case cell of
+ 0 -> return ()
+ val -> runBrainCodeLoop code
+
+runBrainBreakOperation :: BrainBreakOperation -> StateT REPLState IO ()
+runBrainBreakOperation MoveLeft = walk LeftDirection
+runBrainBreakOperation MoveRight = walk RightDirection
+runBrainBreakOperation Increment = updateCell (+1)
+runBrainBreakOperation Decrement = updateCell (\t -> t - 1)
+runBrainBreakOperation Write = printCell
+runBrainBreakOperation Read = readCell
+runBrainBreakOperation (Loop code) = runBrainCodeLoop code
+runBrainBreakOperation Comment = return ()
+
+runBrainBreakCode :: BrainBreakBlock -> StateT REPLState IO ()
+runBrainBreakCode (x : xs) = do
+ runBrainBreakOperation x
+ runBrainBreakCode xs
+runBrainBreakCode [] = return ()
+
+
+replCodeRunner :: REPLCode -> StateT REPLState IO ()
+replCodeRunner code = case code of
+ Helper helper -> runHelper helper
+ Code bb_code -> runBrainBreakCode $ filterComments bb_code
+
+runREPL :: StateT REPLState IO ()
+runREPL = do
+ state <- get
+ io $ putStr $ "\nIn [" ++ show (inputNumber state) ++ "]: "
+ io $ hFlush stdout
+ input <- io getLine
+ let code = parseString parseREPLCode mempty input
+ case code of
+ Success code -> replCodeRunner code
+ Failure info -> io $ print (_errDoc info)
+ modify increaseInputNumber
+ runREPL
+
+
+startREPL :: IO ()
+startREPL = evalStateT runREPL defaultState
\ No newline at end of file
diff --git a/test.bf b/test.bf
index 609fbfe..7c7ddff 100644
--- a/test.bf
+++ b/test.bf
@@ -1,2 +1,7 @@
-This is test file to check how parser works;
-<++[-_-]++>
+++++++++++[
+ >+++++++>++++++++++>+++>+<<<<-
+ ]
+ >++.>+.+++++++..
+ +++.>++.<<+++++++++++++++.
+ >.+++
+.------.--------.>+.>.
\ No newline at end of file
--
GitLab