From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Thu, 25 Feb 2021 14:42:55 +0100 Subject: Stare semestry, niepoukladane --- Semestr 3/pf/lista10/bf | 1 + Semestr 3/pf/lista10/karol | Bin 0 -> 2932448 bytes Semestr 3/pf/lista10/karol.hi | Bin 0 -> 5620 bytes Semestr 3/pf/lista10/karol.hs | 268 ++++++++++++++++++++++++++++++++++++++++++ Semestr 3/pf/lista10/karol.o | Bin 0 -> 61256 bytes Semestr 3/pf/lista10/l10 | Bin 0 -> 2918184 bytes Semestr 3/pf/lista10/l10.hi | Bin 0 -> 5574 bytes Semestr 3/pf/lista10/l10.hs | 233 ++++++++++++++++++++++++++++++++++++ Semestr 3/pf/lista10/l10.o | Bin 0 -> 52288 bytes Semestr 3/pf/lista10/out | Bin 0 -> 1 bytes 10 files changed, 502 insertions(+) create mode 100644 Semestr 3/pf/lista10/bf create mode 100644 Semestr 3/pf/lista10/karol create mode 100644 Semestr 3/pf/lista10/karol.hi create mode 100644 Semestr 3/pf/lista10/karol.hs create mode 100644 Semestr 3/pf/lista10/karol.o create mode 100644 Semestr 3/pf/lista10/l10 create mode 100644 Semestr 3/pf/lista10/l10.hi create mode 100644 Semestr 3/pf/lista10/l10.hs create mode 100644 Semestr 3/pf/lista10/l10.o create 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 new file mode 100644 index 0000000..265e751 --- /dev/null +++ b/Semestr 3/pf/lista10/bf @@ -0,0 +1 @@ +++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>. diff --git a/Semestr 3/pf/lista10/karol b/Semestr 3/pf/lista10/karol new file mode 100644 index 0000000..da1ab05 Binary files /dev/null and b/Semestr 3/pf/lista10/karol differ diff --git a/Semestr 3/pf/lista10/karol.hi b/Semestr 3/pf/lista10/karol.hi new file mode 100644 index 0000000..71d78d9 Binary files /dev/null and b/Semestr 3/pf/lista10/karol.hi differ diff --git a/Semestr 3/pf/lista10/karol.hs b/Semestr 3/pf/lista10/karol.hs new file mode 100644 index 0000000..2920318 --- /dev/null +++ b/Semestr 3/pf/lista10/karol.hs @@ -0,0 +1,268 @@ +{-# 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 new file mode 100644 index 0000000..a167058 Binary files /dev/null and b/Semestr 3/pf/lista10/karol.o differ diff --git a/Semestr 3/pf/lista10/l10 b/Semestr 3/pf/lista10/l10 new file mode 100644 index 0000000..46d8200 Binary files /dev/null and b/Semestr 3/pf/lista10/l10 differ diff --git a/Semestr 3/pf/lista10/l10.hi b/Semestr 3/pf/lista10/l10.hi new file mode 100644 index 0000000..c89b6c1 Binary files /dev/null and b/Semestr 3/pf/lista10/l10.hi differ diff --git a/Semestr 3/pf/lista10/l10.hs b/Semestr 3/pf/lista10/l10.hs new file mode 100644 index 0000000..647fa30 --- /dev/null +++ b/Semestr 3/pf/lista10/l10.hs @@ -0,0 +1,233 @@ +{-# 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 new file mode 100644 index 0000000..762a110 Binary files /dev/null and b/Semestr 3/pf/lista10/l10.o differ diff --git a/Semestr 3/pf/lista10/out b/Semestr 3/pf/lista10/out new file mode 100644 index 0000000..f76dd23 Binary files /dev/null and b/Semestr 3/pf/lista10/out differ -- cgit v1.2.3