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/bf | 1 - Semestr 3/pf/lista10/karol | Bin 2932448 -> 0 bytes Semestr 3/pf/lista10/karol.hi | Bin 5620 -> 0 bytes Semestr 3/pf/lista10/karol.hs | 268 ------------------------------------------ Semestr 3/pf/lista10/karol.o | Bin 61256 -> 0 bytes Semestr 3/pf/lista10/l10 | Bin 2918184 -> 0 bytes Semestr 3/pf/lista10/l10.hi | Bin 5574 -> 0 bytes Semestr 3/pf/lista10/l10.hs | 233 ------------------------------------ Semestr 3/pf/lista10/l10.o | Bin 52288 -> 0 bytes Semestr 3/pf/lista10/out | Bin 1 -> 0 bytes 10 files changed, 502 deletions(-) delete mode 100644 Semestr 3/pf/lista10/bf delete mode 100644 Semestr 3/pf/lista10/karol delete mode 100644 Semestr 3/pf/lista10/karol.hi delete mode 100644 Semestr 3/pf/lista10/karol.hs delete mode 100644 Semestr 3/pf/lista10/karol.o delete mode 100644 Semestr 3/pf/lista10/l10 delete mode 100644 Semestr 3/pf/lista10/l10.hi delete mode 100644 Semestr 3/pf/lista10/l10.hs delete mode 100644 Semestr 3/pf/lista10/l10.o delete mode 100644 Semestr 3/pf/lista10/out (limited to 'Semestr 3/pf/lista10') diff --git a/Semestr 3/pf/lista10/bf b/Semestr 3/pf/lista10/bf deleted file mode 100644 index 265e751..0000000 --- a/Semestr 3/pf/lista10/bf +++ /dev/null @@ -1 +0,0 @@ -++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>. diff --git a/Semestr 3/pf/lista10/karol b/Semestr 3/pf/lista10/karol deleted file mode 100644 index da1ab05..0000000 Binary files a/Semestr 3/pf/lista10/karol and /dev/null differ diff --git a/Semestr 3/pf/lista10/karol.hi b/Semestr 3/pf/lista10/karol.hi deleted file mode 100644 index 71d78d9..0000000 Binary files a/Semestr 3/pf/lista10/karol.hi and /dev/null differ diff --git a/Semestr 3/pf/lista10/karol.hs b/Semestr 3/pf/lista10/karol.hs deleted file mode 100644 index 2920318..0000000 --- a/Semestr 3/pf/lista10/karol.hs +++ /dev/null @@ -1,268 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE GADTs #-} - --- ex 1 - -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) -sprintf d = d id "" - -int :: (String -> a) -> String -> Integer -> a -int f str n = f $ str ++ show n - -str :: (String -> a) -> String -> String -> a -str f str str2 = f $ str ++ str2 - -lit :: String -> (String -> a) -> String -> a -lit str c str2 = c $ str2 ++ str - -(^^) = (.) - -fstring = sprintf (str . lit " ma " . int . lit " kot" . str . lit ".") -string = fstring "Adrzej" 2 "y" - --- ex 2 - --- type Format a b = (String -> a) -> String -> b - --- data Format a b where --- Lit :: String -> Format (String -> a) (String -> a) --- Int :: Format (String -> a) (Int -> a) --- Str :: Format a (String -> a) --- (:^:) :: Format a c -> Format c b -> Format a b - -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 - --- 2.ja to tak zamienie 1. powiedz co z tym zrobic 3. i dostaniesz coś innego -ksprintf :: Format a b -> (String -> a) -> String -> b -ksprintf (Lit str) c = \s -> c (s ++ str) -ksprintf Int c = \s n -> c ( s ++ show n) -ksprintf Str c = \s t -> c (s ++ t) -ksprintf (a :^: b) c = ksprintf a $ ksprintf b c - -kprintf :: Format a b -> (IO () -> a) -> IO () -> b -kprintf (Lit str) c = \s -> c (s >> putStr str) -kprintf Int c = \s n -> c ( s >> putStr (show n)) -kprintf Str c = \s t -> c ( s >> putStr t) -kprintf (a :^: b) c = kprintf a $ kprintf b c - --- printf :: Format a b -> IO () -printf fmt = kprintf fmt (>> putStrLn "") (return ()) - -sprimtf d = ksprintf d id "" - -fmt = Str :^: Lit " ma " :^: Int :^: Lit " kot" :^: Str :^: Lit "..." - -fstrimg = sprimtf $ Str :^: Lit " ma " :^: Int :^: Lit " kot" :^: Str :^: Lit "..." - --- ex 3 - -echoLower :: IO () -echoLower = do - hSetBuffering stdin NoBuffering - getContents >>= putStr . map toLower - --- ex 4 - -data StreamTrans i o a - = Return a - | ReadS (Maybe i -> StreamTrans i o a) - | WriteS o (StreamTrans i o a) - -toLowerStr :: StreamTrans Char Char () -toLowerStr = ReadS f - where f (Just i) = WriteS (toLower i) toLowerStr - f Nothing = 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 - --- main = do --- hSetBuffering stdin NoBuffering --- runIOStreamTrans toLowerStr - --- ex 5 - -safeHead [] = Nothing -safeHead (x : xs) = Just x - -safeTail [] = [] -safeTail (x : xs) = xs - -listTrans :: StreamTrans i o a -> [i] -> ([o], a) -listTrans (Return a) xs = ([] , a) -listTrans (ReadS f) xs = listTrans (f $ safeHead xs) (safeTail xs) -listTrans (WriteS o str) xs = let (ys, a) = listTrans str xs - in (o : ys, a) - - --- ex 6 - --- wersja która działą sensowanie dla transformatorów które na zmianę wczytują i wypisują -runCycle :: StreamTrans a a b -> b -runCycle (Return b) = b -runCycle (ReadS f) = runCycle $ f Nothing -- meh -runCycle (WriteS o (ReadS f)) = runCycle (f $ Just o) -runCycle (WriteS o str) = runCycle str - -runCycleIO :: Show a => StreamTrans a a b -> IO b -runCycleIO (Return b) = return b -runCycleIO (ReadS f) = runCycleIO $ f Nothing -- meh -runCycleIO (WriteS o (ReadS f)) = print o >> threadDelay 500000 >> runCycleIO (f $ Just o) -runCycleIO (WriteS o str) = runCycleIO str - --- str1 n j = if j > 0 then --- WriteS n (ReadS (\case Nothing -> Return n --- Just i -> WriteS (n + i) (str1 (n+i) (j-1)))) --- else Return n - - -str1 n = WriteS n (ReadS (\case Nothing -> Return "akuku" - Just i -> WriteS (n + i) (str1 (n+i)))) - --- str2 n = WriteS (n+1) (str1 n) - --- -- wersja która akumuluje cały output, jeśli ma coś do przekazania do inputa to przekazuje --- runCycle1 :: StreamTrans a a b -> b --- runCycle1 = undefined --- where --- -- runCycleK :: ([a], (StreamTrans a a b)) -> ([a], (StreamTrans a a b)) --- -- runCycleK (ys, (ReadS f)) = (safeTail ys , f $ safeHead ys) --- -- runCycleK (ReadS f) = undefined --- -- runCycleK (WriteS o str) = undefined - --- ex 7 - -(|>|) :: StreamTrans i m a -> StreamTrans m o b -> StreamTrans i o b -_ |>| Return b = Return b -ReadS f |>| st = ReadS $ \i -> f i |>| st -st1 |>| WriteS o st2 = WriteS o (st1 |>| st2) -WriteS o st |>| ReadS f = st |>| f (Just o) -st |>| ReadS f = st |>| f Nothing - - --- ex 8 - -catchOutput :: StreamTrans i o a -> StreamTrans i b (a, [o]) -catchOutput = catchOutput' [] - where - catchOutput' os (Return a) = Return (a, reverse os) - catchOutput' os (ReadS f) = ReadS $ catchOutput' os . f - catchOutput' os (WriteS o str) = catchOutput' (o:os) str - - --- main = do --- hSetBuffering stdin NoBuffering --- let (outs1, ((), outs2)) = listTrans (catchOutput toLowerStr) ['a', 'b', 'G', 'F'] --- -- outs1 are catchOutput outputs - ambigous empty outputs --- print outs2 - --- ex 9 - -data BF - = MoveR -- > - | MoveL -- < - | Inc -- + - | Dec -- - - | Output -- . - | Input -- , - | While [BF] -- [ ] - deriving Show - -readWhile :: (i -> Bool) -> StreamTrans i i () -readWhile p = ReadS $ \case - Nothing -> Return () - Just i -> - if p i then - WriteS i $ readWhile p - else - Return () - -brainfuckParser :: StreamTrans Char BF () -brainfuckParser = ReadS $ \case - Nothing -> Return () - Just c | c == '>' -> WriteS MoveR brainfuckParser - Just c | c == '<' -> WriteS MoveL brainfuckParser - Just c | c == '+' -> WriteS Inc brainfuckParser - Just c | c == '-' -> WriteS Dec brainfuckParser - Just c | c == '.' -> WriteS Output brainfuckParser - Just c | c == ',' -> WriteS Input brainfuckParser - Just c | c == '[' -> do (bl, bfs) <- catchOutput (readWhile (/= ']') |>| brainfuckParser) - WriteS (While bfs) brainfuckParser - -- fajnie jakby parser zwracał zamiast () False, jeśli input się skończy zanim przeczytamy ']' - Just c -> brainfuckParser - --- ex 10 -coerceEnum :: (Enum a, Enum b) => a -> b -coerceEnum = toEnum . fromEnum - -type Tape = ([Integer], [Integer]) -evalBF :: Tape -> BF -> StreamTrans Char Char Tape -evalBF (l, r) MoveR = Return (head r : l, tail r) -evalBF (l, r) MoveL = Return (tail l, head l : r) -evalBF (l, r) Inc = Return (l, 1 + head r : tail r) -evalBF (l, r) Dec = Return (l, head r - 1 : tail r) -evalBF tp@(l, r) Output = WriteS (coerceEnum $ head r) (Return tp) -evalBF (l, r) Input = ReadS $ \case Just i -> Return (l , coerceEnum i : tail r) - -- and what with nothing? -evalBF tp@(l, r) bf@(While bfs) = - if head r == 0 then - Return tp - else do - newtp <- evalBFBlcok tp bfs - evalBF newtp bf - -evalBFBlcok :: Tape -> [BF] -> StreamTrans Char Char Tape -evalBFBlcok = foldM evalBF - -runBF :: [BF] -> StreamTrans Char Char () -runBF = foldM_ evalBF (repeat 0, repeat 0) - --- runRealTime :: Tape -> StreamTrans i BF a -> StreamTrans BF (StreamTrans Char Char Tape) -> - --- ex 11 - -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 - -- 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 \ No newline at end of file diff --git a/Semestr 3/pf/lista10/karol.o b/Semestr 3/pf/lista10/karol.o deleted file mode 100644 index a167058..0000000 Binary files a/Semestr 3/pf/lista10/karol.o and /dev/null differ diff --git a/Semestr 3/pf/lista10/l10 b/Semestr 3/pf/lista10/l10 deleted file mode 100644 index 46d8200..0000000 Binary files a/Semestr 3/pf/lista10/l10 and /dev/null differ diff --git a/Semestr 3/pf/lista10/l10.hi b/Semestr 3/pf/lista10/l10.hi deleted file mode 100644 index c89b6c1..0000000 Binary files a/Semestr 3/pf/lista10/l10.hi and /dev/null differ 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 diff --git a/Semestr 3/pf/lista10/l10.o b/Semestr 3/pf/lista10/l10.o deleted file mode 100644 index 762a110..0000000 Binary files a/Semestr 3/pf/lista10/l10.o and /dev/null differ diff --git a/Semestr 3/pf/lista10/out b/Semestr 3/pf/lista10/out deleted file mode 100644 index f76dd23..0000000 Binary files a/Semestr 3/pf/lista10/out and /dev/null differ -- cgit v1.2.3