aboutsummaryrefslogtreecommitdiff
path: root/semestr-3/pf/lista10
diff options
context:
space:
mode:
authorFranciszek Malinka <franciszek.malinka@gmail.com>2021-10-05 21:49:54 +0200
committerFranciszek Malinka <franciszek.malinka@gmail.com>2021-10-05 21:49:54 +0200
commitc5fcf7179a83ef65c86c6a4a390029149e518649 (patch)
treed29ffc5b86a0d257453cedcf87d91a13d8bf3b0d /semestr-3/pf/lista10
parentf8a88b6a4aba1f66d04711a9330eaba49a50c463 (diff)
Duzy commit ze smieciami
Diffstat (limited to 'semestr-3/pf/lista10')
-rw-r--r--semestr-3/pf/lista10/karol.hibin0 -> 5620 bytes
-rw-r--r--semestr-3/pf/lista10/karol.hs268
-rw-r--r--semestr-3/pf/lista10/l10.hibin0 -> 5574 bytes
-rw-r--r--semestr-3/pf/lista10/l10.hs233
4 files changed, 501 insertions, 0 deletions
diff --git a/semestr-3/pf/lista10/karol.hi b/semestr-3/pf/lista10/karol.hi
new file mode 100644
index 0000000..71d78d9
--- /dev/null
+++ b/semestr-3/pf/lista10/karol.hi
Binary files 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/l10.hi b/semestr-3/pf/lista10/l10.hi
new file mode 100644
index 0000000..c89b6c1
--- /dev/null
+++ b/semestr-3/pf/lista10/l10.hi
Binary files 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