aboutsummaryrefslogtreecommitdiff
path: root/Semestr 3/pf/lista10/l10.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Semestr 3/pf/lista10/l10.hs')
-rw-r--r--Semestr 3/pf/lista10/l10.hs233
1 files changed, 0 insertions, 233 deletions
diff --git a/Semestr 3/pf/lista10/l10.hs b/Semestr 3/pf/lista10/l10.hs
deleted file mode 100644
index 647fa30..0000000
--- a/Semestr 3/pf/lista10/l10.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE GADTs #-}
-
-
-import Data.Char (toLower)
-import System.IO (IOMode(ReadMode, ReadWriteMode), openFile, stdout, hIsEOF, hGetChar, hPutChar, Handle, isEOF, BufferMode(NoBuffering), hSetBuffering, stdin )
-import Control.Monad (when)
-import Control.Monad.State
-import Control.Concurrent (threadDelay)
-import Control.Monad.Trans.Maybe
-import System.Environment (getArgs)
-
--- Zadanie 1
-
-int :: (String -> a) -> String -> Integer -> a
-int f s n = f (s ++ show n)
-
-str :: (String -> a) -> String -> String -> a
-str f s1 s2 = f (s1 ++ s2)
-
-lit :: String -> (String -> a) -> String -> a
-lit s f s2 = f (s2 ++ s)
-
-(^^) :: (b -> c) -> (a -> b) -> a -> c
-(^^) f g x = f (g x)
-
-sprintf :: ((a -> a) -> [Char] -> t) -> t
-sprintf f = f id ""
-
--- Zadanie 2
-
-data Format a b where
- Lit :: String -> Format a a
- Int :: Format a (Int -> a)
- Str :: Format a (String -> a)
- (:^:) :: Format c b -> Format a c -> Format a b
-
-
-ksprintf :: Format a b -> (String -> a) -> String -> b
-ksprintf (Lit s1) cont = \s2 -> cont (s2 ++ s1)
-ksprintf Int cont = \s n -> cont (s ++ show n)
-ksprintf Str cont = \s1 s2 -> cont (s1 ++ s2)
-ksprintf (a :^: b) cont = ksprintf a (ksprintf b cont)
-
-kprintf :: Format a b -> (IO () -> a) -> b
-kprintf (Lit s1) cont = cont (putStr s1)
-kprintf Int cont = \n -> cont (putStr (show n))
-kprintf Str cont = \s -> cont (putStr s)
-kprintf (a :^: b) cont = kprintf a (\s1 -> kprintf b (\s2 -> cont (s1 >> s2)))
-
-printf :: Format (IO ()) b -> b
-printf frmt = kprintf frmt id
-
-sprintf2 :: Format String b -> b
-sprintf2 frmt = ksprintf frmt id ""
-
-
--- Zadanie 3
-
-echoLower :: IO ()
-echoLower = do x <- getChar
- putChar (toLower x)
- echoLower
-
--- Zadanie 4
-
-data StreamTrans i o a
- = Return a
- | ReadS (Maybe i -> StreamTrans i o a)
- | WriteS o (StreamTrans i o a)
-
-myToLower :: StreamTrans Char Char ()
-myToLower = ReadS f where
- f (Just i) = WriteS (toLower i) myToLower
- f Nothing = Return ()
-
-runStreams :: StreamTrans Char Char a -> IO a
-runStreams (Return a) = return a
-runStreams (ReadS f) = do
- eof <- isEOF
- if eof
- then runStreams (f Nothing)
- else do
- c <- getChar
- runStreams (f (Just c))
-runStreams (WriteS out str) = do
- putChar out
- runStreams str
-
--- Zadanie 5
-
-listTrans :: StreamTrans i o a -> [i] -> ([o], a)
-listTrans (Return a) xs = ([], a)
-listTrans (ReadS f) [] = listTrans (f Nothing) []
-listTrans (ReadS f) (x:xs) = listTrans (f (Just x)) xs
-listTrans (WriteS out str) xs =
- let (ys, a) = listTrans str xs
- in (out : ys, a)
-
--- Zadanie 6
-
-runCycle :: StreamTrans a a b -> b
-runCycle (Return b) = b
-runCycle (ReadS f) = runCycle (f Nothing)
-runCycle (WriteS out (ReadS f)) = runCycle (f (Just out))
-runCycle (WriteS _ str) = runCycle str
-
--- Zadanie 7
-
-(|>|) :: StreamTrans i m a -> StreamTrans m o b -> StreamTrans i o b
-_ |>| Return b = Return b
-ReadS f |>| stream = ReadS (\input -> (f input) |>| stream)
-WriteS out stream |>| ReadS f = stream |>| f (Just out)
-stream1 |>| WriteS out stream2 = WriteS out (stream1 |>| stream2)
-stream |>| ReadS f = stream |>| f Nothing
-
--- Zadanie 8
-
-catchOutput :: StreamTrans i o a -> StreamTrans i b (a, [o])
-catchOutput = aux []
- where
- aux xs (Return a) = Return (a, xs)
- aux xs (ReadS f) = ReadS (\i -> aux xs (f i))
- aux xs (WriteS out stream) = aux (out : xs) stream
-
--- Zadanie 9
-
-data BF
- = MoveR -- >
- | MoveL -- <
- | Inc -- +
- | Dec -- -
- | Output -- .
- | Input -- ,
- | While [BF] -- [ ]
- deriving Show
-
-brainfuckParser :: StreamTrans Char BF Bool
-brainfuckParser = ReadS $ \x -> case x of
- Nothing -> Return False
- Just '>' -> WriteS MoveR brainfuckParser
- Just '<' -> WriteS MoveL brainfuckParser
- Just '+' -> WriteS Inc brainfuckParser
- Just '-' -> WriteS Dec brainfuckParser
- Just '.' -> WriteS Output brainfuckParser
- Just ',' -> WriteS Input brainfuckParser
- Just '[' -> do (b, loop) <- catchOutput brainfuckParser
- if b then WriteS (While loop) brainfuckParser
- else Return False
- Just ']' -> Return True
- Just _ -> brainfuckParser
-
--- Zadanie 10
-
-type Tape = ([Integer], [Integer])
-evalBF :: Tape -> BF -> StreamTrans Char Char Tape
-evalBF (xs, y : ys) MoveR = Return (y : xs, ys)
-evalBF (x : xs, ys) MoveL = Return (xs, x : ys)
-evalBF (xs, y : ys) Inc = Return (xs, (y + 1) : ys)
-evalBF (xs, y : ys) Dec = Return (xs, (y - 1) : ys)
-evalBF (xs, y : ys) Output = WriteS (coerceEnum y :: Char) (Return (xs, y : ys))
-evalBF (xs, y : ys) Input = ReadS (\i -> case i of
- Nothing -> Return (xs, y : ys)
- Just i -> Return (xs, (coerceEnum i :: Integer) : ys))
-evalBF (xs, y : ys) (While loop) =
- if y == 0 then Return (xs, y : ys)
- else do
- loopTape <- evalBFBlock (xs, y : ys) loop
- evalBF loopTape (While loop)
-
-evalBFBlock :: Tape -> [BF] -> StreamTrans Char Char Tape
-evalBFBlock tape [] = Return tape
-evalBFBlock tape (bf : bfcode) =
- do result <- evalBF tape bf
- evalBFBlock result bfcode
-
-coerceEnum :: (Enum a, Enum b) => a -> b
-coerceEnum = toEnum . fromEnum
-
-runBF :: [BF] -> StreamTrans Char Char ()
-runBF bfcode = do evalBFBlock (repeat 0, repeat 0) bfcode
- return ()
-
-runIOStreamTransWithHandles :: Handle -> Handle -> StreamTrans Char Char a -> IO a
-runIOStreamTransWithHandles inp out (Return a) = return a
-runIOStreamTransWithHandles inp out (ReadS f) = do
- eof <- hIsEOF inp
- if eof then
- runIOStreamTransWithHandles inp out $ f Nothing
- else do
- ch <- hGetChar inp
- runIOStreamTransWithHandles inp out $ f (Just ch)
-runIOStreamTransWithHandles inp out (WriteS o str) = do
- hPutChar out o
- runIOStreamTransWithHandles inp out str
-
-runIOStreamTrans :: StreamTrans Char Char a -> IO a
-runIOStreamTrans = runIOStreamTransWithHandles stdin stdout
-
-instance Functor (StreamTrans i o) where
- fmap f (Return a) = Return $ f a
- fmap f (ReadS g) = ReadS $ fmap f . g
- fmap f (WriteS o s) = WriteS o $ fmap f s
-
-instance Applicative (StreamTrans i o) where
- Return f <*> s = fmap f s
- WriteS o sf <*> sa = WriteS o (sf <*> sa)
- ReadS g <*> s = ReadS $ (<*> s) . g
- pure = Return
-
-instance Monad (StreamTrans i o) where
- Return a >>= f = f a
- ReadS g >>= f = ReadS $ (>>= f) . g
- WriteS o s >>= f = WriteS o (s >>= f)
-
--- main = do
--- filename : _ <- getArgs
--- handle <- openFile filename ReadMode
--- (_, bfs) <- runIOStreamTransWithHandles handle handle $ catchOutput brainfuckParser
--- runIOStreamTrans $ runBF bfs
-
-
-data BT a = L a | N (BT a) (BT a)
- -- deriving show
-
-tt = N (N (N (L 1) (L 2)) (L 4)) (L 3)
-
-traverseBt :: BT a -> [a]
-traverseBt (L x) = [x]
-traverseBt (N tl tr) = (traverseBt tr) ++ (traverseBt tl)
-
-witaj :: IO ()
-witaj = putStr \ No newline at end of file
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-22 04:30:48 +0000