From c5fcf7179a83ef65c86c6a4a390029149e518649 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Tue, 5 Oct 2021 21:49:54 +0200 Subject: Duzy commit ze smieciami --- Semestr 3/pf/lista10/l10.hs | 233 -------------------------------------------- 1 file changed, 233 deletions(-) delete mode 100644 Semestr 3/pf/lista10/l10.hs (limited to 'Semestr 3/pf/lista10/l10.hs') 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 -- cgit v1.2.3