From cce60e07901ab05b2d8d6c427e21f53d599c7ba3 Mon Sep 17 00:00:00 2001 From: Sanchayan Maity Date: Sat, 8 Aug 2020 19:01:31 +0530 Subject: [PATCH] freemonad: Update the Free monad notebook Signed-off-by: Sanchayan Maity --- freemonad.ipynb | 233 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 201 insertions(+), 32 deletions(-) diff --git a/freemonad.ipynb b/freemonad.ipynb index 78a3d99..587f411 100644 --- a/freemonad.ipynb +++ b/freemonad.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": 4, + "execution_count": 3, "metadata": {}, "outputs": [ { @@ -415,12 +415,17 @@ "\n", ":t (Fix (Output 'A' (Fix Done)))\n", "\n", - ":t (Fix (Bell (Fix (Output 'A' (Fix Done)))))" + ":t (Fix (Bell (Fix (Output 'A' (Fix Done)))))\n", + "\n", + "-- cosine x = x\n", + "-- x = 0.7...\n", + "\n", + "-- f x = x" ] }, { "cell_type": "code", - "execution_count": 13, + "execution_count": 10, "metadata": {}, "outputs": [ { @@ -432,6 +437,108 @@ "metadata": {}, "output_type": "display_data" }, + { + "data": { + "text/plain": [ + "120" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "data": { + "text/html": [ + "fact' :: forall p. (Eq p, Num p) => (p -> p) -> p -> p" + ], + "text/plain": [ + "fact' :: forall p. (Eq p, Num p) => (p -> p) -> p -> p" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, { "data": { "text/plain": [ @@ -443,14 +550,22 @@ } ], "source": [ + "{-# LANGUAGE FlexibleContexts #-}\n", + "\n", "-- https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad-Fix.html\n", "import Control.Monad.Fix\n", "\n", + "-- fix :: (a -> a) -> a\n", + "-- fix f = let {x = f x} in x\n", + "\n", "let fac n = if n <= 1 then 1 else n * fac (n-1) in fac 5\n", "\n", "fix (\\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5\n", "\n", - "-- fact' rec n = if n == 0 then 1 else n * rec (n-1)\n", + "-- fix fact' 5\n", + "fact' rec n = if n == 0 then 1 else n * rec (n-1)\n", + "\n", + ":t fact'\n", "\n", "-- f = fact' f\n", "-- = \\n -> if n == 0 then 1 else n * f (n-1)\n", @@ -470,12 +585,14 @@ " else (n-1) * (if n-2 == 0 then 1\n", " else (n-2) * fix fact' (n-3)))\n", "= ...\n", - "-}" + "-}\n", + "\n", + "fix fact' 5" ] }, { "cell_type": "code", - "execution_count": 15, + "execution_count": 5, "metadata": {}, "outputs": [ { @@ -579,6 +696,8 @@ "source": [ "data FixE f e = Fix (f (FixE f e)) | Throw e\n", "\n", + "-- data Free f r = Free (f (Free f r)) | Pure r\n", + "\n", "catch :: (Functor f) => FixE f e1 -> (e1 -> FixE f e2) -> FixE f e2\n", "catch (Fix x) f = Fix (fmap (flip catch f) x)\n", "catch (Throw e) f = f e\n", @@ -592,6 +711,7 @@ "\n", "-- output 'A'\n", "-- throw IncompleteException\n", + "-- output 'B'\n", "subroutine = Fix (Output 'A' (Throw IncompleteException)) :: FixE (Toy Char) IncompleteException\n", "\n", "-- try {subroutine}\n", @@ -604,7 +724,7 @@ }, { "cell_type": "code", - "execution_count": 23, + "execution_count": 6, "metadata": {}, "outputs": [ { @@ -691,10 +811,10 @@ ".suggestion-name {\n", "font-weight: bold;\n", "}\n", - "output :: forall b. b -> Free (Toy b) ()" + "output :: forall b (m :: * -> *). MonadFree (Toy b) m => b -> m ()" ], "text/plain": [ - "output :: forall b. b -> Free (Toy b) ()" + "output :: forall b (m :: * -> *). MonadFree (Toy b) m => b -> m ()" ] }, "metadata": {}, @@ -784,10 +904,10 @@ ".suggestion-name {\n", "font-weight: bold;\n", "}\n", - "bell :: forall b. Free (Toy b) ()" + "bell :: forall b (m :: * -> *). MonadFree (Toy b) m => m ()" ], "text/plain": [ - "bell :: forall b. Free (Toy b) ()" + "bell :: forall b (m :: * -> *). MonadFree (Toy b) m => m ()" ] }, "metadata": {}, @@ -877,10 +997,10 @@ ".suggestion-name {\n", "font-weight: bold;\n", "}\n", - "done :: forall b r. Free (Toy b) r" + "done :: forall b (m :: * -> *) a. MonadFree (Toy b) m => m a" ], "text/plain": [ - "done :: forall b r. Free (Toy b) r" + "done :: forall b (m :: * -> *) a. MonadFree (Toy b) m => m a" ] }, "metadata": {}, @@ -900,6 +1020,18 @@ "-}\n", "\n", "{-|\n", + "(>>=) :: forall a b. m a -> (a -> m b) -> m b\n", + "catch :: (Functor f) => FixE f e1 -> (e1 -> FixE f e2) -> FixE f e2\n", + "\n", + "FixE f --- m\n", + "e1 --- a\n", + "e2 --- b\n", + "\n", + "catch -- >>=\n", + "Throw -- Pure\n", + "-}\n", + "\n", + "{-|\n", "output :: a -> Free (Toy a) ()\n", "output x = Free (Output x (Pure ()))\n", "\n", @@ -913,6 +1045,10 @@ "liftF command = Free (fmap Pure command)\n", "-}\n", "\n", + "-- There is some Functor f => Free f is a monad\n", + "\n", + "-- Toy b is a Functor, Free (Toy b) is a monad\n", + "\n", "output x = liftF (Output x ())\n", "bell = liftF (Bell ())\n", "done = liftF Done\n", @@ -926,6 +1062,7 @@ "\n", "program :: Free (Toy Char) r\n", "program = do\n", + " bell\n", " subroutine\n", " bell\n", " done" @@ -933,12 +1070,13 @@ }, { "cell_type": "code", - "execution_count": 24, + "execution_count": 7, "metadata": {}, "outputs": [ { "data": { "text/plain": [ + "bell\n", "output 'A'\n", "bell\n", "done" @@ -1134,24 +1272,6 @@ "pretty (output 'A' >> (done >> output 'C'))" ] }, - { - "cell_type": "code", - "execution_count": 27, - "metadata": {}, - "outputs": [], - "source": [ - "import Control.Exception\n", - "\n", - "ringBell :: IO ()\n", - "ringBell = undefined\n", - "\n", - "interpret :: (Show b) => Free (Toy b) r -> IO ()\n", - "interpret (Free (Output b x)) = print b >> interpret x\n", - "interpret (Free (Bell x)) = ringBell >> interpret x\n", - "interpret (Free Done ) = return ()\n", - "interpret (Pure r) = throwIO (userError \"Improper termination\")" - ] - }, { "cell_type": "code", "execution_count": 43, @@ -1172,6 +1292,55 @@ "-}" ] }, + { + "cell_type": "code", + "execution_count": 9, + "metadata": {}, + "outputs": [], + "source": [ + "{-|\n", + "\n", + "data Request =\n", + " Look Direction\n", + " | ReadLine\n", + " | Fire Direction\n", + " | WriteLine String\n", + " \n", + "data Response =\n", + " Image Picture -- Response for Look\n", + " | ChatLine String -- Response for Read\n", + " | Succeeded Bool -- Response for Write\n", + " \n", + "data Interaction next =\n", + " Look Direction (Image -> next)\n", + " | Fire Direction next\n", + " | ReadLine (String -> next)\n", + " | WriteLine String (Bool -> next)\n", + " \n", + "instance Functor Interaction where\n", + " fmap f (Look dir g) = Look dir (f . g)\n", + " fmap f (Fire dir x) = Fire dir (f x)\n", + " fmap f (ReadLine g) = ReadLine (f . g)\n", + " fmap f (WriteLine s g) = WriteLine s (f . g)\n", + " \n", + "interpret :: Program r -> Game r\n", + "interpret prog = case prog of\n", + " Free (Look dir g) -> do\n", + " img <- collectImage dir\n", + " interpret (g img)\n", + " Free (Fire dir next) -> do\n", + " sendBullet dir\n", + " interpret next\n", + " Free (ReadLine g) -> do\n", + " str <- getChatLine\n", + " interpret (g str)\n", + " Free (WriteLine s g) ->\n", + " putChatLine s\n", + " interpret (g True)\n", + " Pure r -> return r\n", + "-}" + ] + }, { "cell_type": "code", "execution_count": 45,