├── code2022 ├── README.md ├── .gitignore ├── Setup.hs ├── ChangeLog.md ├── test │ └── Spec.hs ├── src │ ├── V09.hs │ ├── V02.hs │ ├── Examples.hs │ ├── Lib.hs │ ├── V05.hs │ ├── V03.hs │ ├── lambda.txt │ ├── V07.hs │ ├── V11.hs │ ├── V10.hs │ ├── V12.hs │ ├── V13.hs │ ├── M14compose.hs │ └── SimplePrelude.hs ├── app │ └── Main.hs ├── package.yaml ├── LICENSE ├── code2022.cabal └── stack.yaml ├── code2024 ├── README.md ├── .gitignore ├── Setup.hs ├── ChangeLog.md ├── test │ └── Spec.hs ├── src │ ├── V02.hs │ ├── V01.hs │ ├── Examples.hs │ ├── V20241126.hs │ ├── V20241112.hs │ ├── V03.hs │ ├── V20241203.hs │ ├── V20250121.md │ ├── V20241210.hs │ ├── V20241119.hs │ ├── V20241217.hs │ ├── V20241029.hs │ ├── V20250107.md │ ├── SimplePrelude.hs │ └── V20241105.hs ├── app │ └── Main.hs ├── stack.yaml.lock ├── package.yaml ├── LICENSE ├── code2022.cabal └── stack.yaml ├── code ├── M08class.hs ├── M18extra.lhs ├── M04TypeAliases.hs ├── Examples.hs ├── Examples-after.hs ├── M06HO.hs ├── M10monad.hs ├── M05Lists.hs ├── M07io.hs ├── M16GADT.hs ├── M09testdata.hs ├── M04Cards.hs ├── Examples03.hs ├── Examples03-after.hs ├── M15monadtransformers.hs └── M14inference.hs ├── code2019 ├── Setup.hs ├── ChangeLog.md ├── Makefile ├── stack.yaml.lock ├── Examples.hs ├── M18lambda.txt ├── M05Lists.hs ├── M08class.hs ├── M11applicatives.hs ├── V02.hs ├── M10io.hs ├── M14compose.hs ├── M06Functions.hs ├── LICENSE ├── M07Laziness.hs ├── M04CardsFinal.hs ├── M13interpreter.hs ├── stack.yaml ├── code2019.cabal ├── M10ioFinal.hs ├── M16GADT.hs ├── M17lambda.hs ├── M12interpreter.hs └── M15modular.lhs ├── slides ├── 09-io.pdf ├── 14-gadt.pdf ├── 16-gadt.pdf ├── 00-intro.pdf ├── 11-parsing.pdf ├── FP01-uder.pdf ├── 07-laziness.pdf ├── 04-define-types.pdf ├── 06-higher-order.pdf ├── 08-type-classes.pdf ├── 03-haskell-types.pdf ├── M09functionaldata.pdf ├── 01-starting-haskell.pdf ├── 02-haskell-functions.pdf ├── 05-more-about-lists.pdf ├── 12-lambda-calculus.pdf ├── 14-polymorphic-types.pdf ├── 15-lambda-calculus.pdf ├── 17-polymorphic-types.pdf ├── pictures │ └── AcetoFive.JPG ├── 11-monadic-interpreter.pdf ├── 13-monad-transformers.pdf ├── 15-monad-transformers.pdf ├── 10-test-data-generators.pdf ├── 12-functors-applicatives.pdf ├── 13-evaluation-strategies.pdf ├── 16-evaluation-strategies.pdf ├── Right-fold-transformation.png ├── frontmatter.tex ├── cheatsheet.md ├── 07-laziness.tex ├── 02-haskell-functions.tex ├── common.tex ├── 05-more-about-lists.tex ├── 11-parsing.tex └── 09-io.tex ├── README.md ├── LICENSE └── .gitignore /code2022/README.md: -------------------------------------------------------------------------------- 1 | # code2022 2 | -------------------------------------------------------------------------------- /code2024/README.md: -------------------------------------------------------------------------------- 1 | # code2022 2 | -------------------------------------------------------------------------------- /code2022/.gitignore: -------------------------------------------------------------------------------- 1 | stack.yaml.lock 2 | .stack-work/ 3 | *~ -------------------------------------------------------------------------------- /code2024/.gitignore: -------------------------------------------------------------------------------- 1 | stack.yaml.lock 2 | .stack-work/ 3 | *~ -------------------------------------------------------------------------------- /code/M08class.hs: -------------------------------------------------------------------------------- 1 | -- f x = read (show x) 2 | -- g x = show (read x) 3 | -------------------------------------------------------------------------------- /code2019/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /code2022/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /code2024/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /code2022/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for code2021 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /code2024/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for code2021 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /code2022/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /code2024/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /slides/09-io.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/09-io.pdf -------------------------------------------------------------------------------- /slides/14-gadt.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/14-gadt.pdf -------------------------------------------------------------------------------- /slides/16-gadt.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/16-gadt.pdf -------------------------------------------------------------------------------- /slides/00-intro.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/00-intro.pdf -------------------------------------------------------------------------------- /slides/11-parsing.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/11-parsing.pdf -------------------------------------------------------------------------------- /slides/FP01-uder.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/FP01-uder.pdf -------------------------------------------------------------------------------- /slides/07-laziness.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/07-laziness.pdf -------------------------------------------------------------------------------- /slides/04-define-types.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/04-define-types.pdf -------------------------------------------------------------------------------- /slides/06-higher-order.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/06-higher-order.pdf -------------------------------------------------------------------------------- /slides/08-type-classes.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/08-type-classes.pdf -------------------------------------------------------------------------------- /slides/03-haskell-types.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/03-haskell-types.pdf -------------------------------------------------------------------------------- /slides/M09functionaldata.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/M09functionaldata.pdf -------------------------------------------------------------------------------- /slides/01-starting-haskell.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/01-starting-haskell.pdf -------------------------------------------------------------------------------- /slides/02-haskell-functions.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/02-haskell-functions.pdf -------------------------------------------------------------------------------- /slides/05-more-about-lists.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/05-more-about-lists.pdf -------------------------------------------------------------------------------- /slides/12-lambda-calculus.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/12-lambda-calculus.pdf -------------------------------------------------------------------------------- /slides/14-polymorphic-types.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/14-polymorphic-types.pdf -------------------------------------------------------------------------------- /slides/15-lambda-calculus.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/15-lambda-calculus.pdf -------------------------------------------------------------------------------- /slides/17-polymorphic-types.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/17-polymorphic-types.pdf -------------------------------------------------------------------------------- /slides/pictures/AcetoFive.JPG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/pictures/AcetoFive.JPG -------------------------------------------------------------------------------- /slides/11-monadic-interpreter.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/11-monadic-interpreter.pdf -------------------------------------------------------------------------------- /slides/13-monad-transformers.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/13-monad-transformers.pdf -------------------------------------------------------------------------------- /slides/15-monad-transformers.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/15-monad-transformers.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FunctionalProgramming 2 | Support repository for the functional programming lecture (Haskell) 3 | 4 | 2017, 2022 5 | 6 | -------------------------------------------------------------------------------- /slides/10-test-data-generators.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/10-test-data-generators.pdf -------------------------------------------------------------------------------- /slides/12-functors-applicatives.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/12-functors-applicatives.pdf -------------------------------------------------------------------------------- /slides/13-evaluation-strategies.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/13-evaluation-strategies.pdf -------------------------------------------------------------------------------- /slides/16-evaluation-strategies.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/16-evaluation-strategies.pdf -------------------------------------------------------------------------------- /slides/Right-fold-transformation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/proglang/FunctionalProgramming/HEAD/slides/Right-fold-transformation.png -------------------------------------------------------------------------------- /code2019/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for code2019 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /code2022/src/V09.hs: -------------------------------------------------------------------------------- 1 | module V09 where 2 | 3 | import Test.QuickCheck 4 | 5 | prop_binomi :: Integer -> Integer -> Bool 6 | prop_binomi a b = (a + b) ^ 2 == a ^ 2 + 2 * a * b + b ^ 2 7 | -------------------------------------------------------------------------------- /code2022/src/V02.hs: -------------------------------------------------------------------------------- 1 | module V02 where 2 | 3 | absolute :: Integer -> Integer 4 | absolute x | x >= 0 = x 5 | | otherwise = -x 6 | 7 | power :: (Num a) => a -> Integer -> a 8 | power x n = if n == 0 then 1 else x * power x (n - 1) 9 | -------------------------------------------------------------------------------- /code2024/src/V02.hs: -------------------------------------------------------------------------------- 1 | module V02 where 2 | 3 | absolute :: Integer -> Integer 4 | absolute x | x >= 0 = x 5 | | otherwise = -x 6 | 7 | power :: (Num a) => a -> Integer -> a 8 | power x n = if n == 0 then 1 else x * power x (n - 1) 9 | -------------------------------------------------------------------------------- /code2019/Makefile: -------------------------------------------------------------------------------- 1 | M09functionaldata.pdf: M09functionaldata.tex 2 | pdflatex M09functionaldata 3 | 4 | M09functionaldata.tex: M09functionaldata.lhs 5 | pandoc -f markdown+lhs --markdown-headings=atx -s -o M09functionaldata.tex M09functionaldata.lhs 6 | -------------------------------------------------------------------------------- /slides/frontmatter.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | 3 | \title{Functional Programming} 4 | \subtitle{Introduction} 5 | 6 | \author[Peter Thiemann]{Prof. Dr. Peter Thiemann} 7 | \institute[Univ. Freiburg]{Albert-Ludwigs-Universität Freiburg, Germany} 8 | \date{WS 2024/25} 9 | 10 | -------------------------------------------------------------------------------- /code2022/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | -- import Lib -- if needed 4 | import Graphics.Svg 5 | myline = path_ [D_ <<- mA 0 100 <> lA 30 40] 6 | svg = doctype <> with (svg11_ myline) [Width_ <<- "100", Height_ <<- "100"] 7 | main :: IO () 8 | main = renderToFile "./output.svg" svg 9 | -------------------------------------------------------------------------------- /code2024/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | -- import Lib -- if needed 4 | import Graphics.Svg 5 | myline = path_ [D_ <<- mA 0 100 <> lA 30 40] 6 | svg = doctype <> with (svg11_ myline) [Width_ <<- "100", Height_ <<- "100"] 7 | main :: IO () 8 | main = renderToFile "./output.svg" svg 9 | -------------------------------------------------------------------------------- /code2024/src/V01.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | dollarRate = 0.91691801 4 | 5 | -- | convert EUR to USD 6 | usd euros = euros * dollarRate 7 | 8 | -- | convert USD to EUR 9 | euro usds = usds / dollarRate 10 | 11 | -- a property test 12 | prop_EuroUSD x = x < 0 || euro (usd x) ~== x 13 | 14 | -- | nearly equals 15 | x ~== y = abs (x - y) < 10e-15 16 | 17 | -- price :: Num a => a 18 | price = 79 19 | -------------------------------------------------------------------------------- /code2022/src/Examples.hs: -------------------------------------------------------------------------------- 1 | module Examples where 2 | 3 | import Test.QuickCheck 4 | 5 | dollarRate = 0.98546541 6 | 7 | -- | convert euro to dollar 8 | usd euro = euro * dollarRate 9 | 10 | -- | convert dollar to euro 11 | euro usd = usd / dollarRate 12 | 13 | prop_EuroUSD x = euro (usd x) == x 14 | 15 | price = 79 16 | 17 | price' :: Double 18 | price' = 79 19 | 20 | price'' :: Num a => a 21 | price'' = 79 22 | -------------------------------------------------------------------------------- /code2024/src/Examples.hs: -------------------------------------------------------------------------------- 1 | module Examples where 2 | 3 | import Test.QuickCheck 4 | 5 | dollarRate = 0.98546541 6 | 7 | -- | convert euro to dollar 8 | usd euro = euro * dollarRate 9 | 10 | -- | convert dollar to euro 11 | euro usd = usd / dollarRate 12 | 13 | prop_EuroUSD x = euro (usd x) == x 14 | 15 | price = 79 16 | 17 | price' :: Double 18 | price' = 79 19 | 20 | price'' :: Num a => a 21 | price'' = 79 22 | -------------------------------------------------------------------------------- /code/M18extra.lhs: -------------------------------------------------------------------------------- 1 | > module M18extra where 2 | > import Data.Bifunctor 3 | 4 | > type Bin = [Bit] 5 | > data Bit = O | I deriving (Show, Enum) 6 | 7 | > unbits :: Enum a => Int -> Bin -> (a, Bin) 8 | > unbits n bs = first toEnum $ unbitsInt n bs 9 | 10 | > unbitsInt :: Int -> Bin -> (Int, Bin) 11 | > unbitsInt n (b:bs) | n > 0 = first (fromEnum b * 2^(n-1) +) $ unbitsInt (n-1) bs 12 | > unbitsInt n bs | n == 0 = (0, bs) 13 | 14 | 15 | -------------------------------------------------------------------------------- /code2024/src/V20241126.hs: -------------------------------------------------------------------------------- 1 | module V20241126 where 2 | 3 | 4 | data Term = 5 | Con Integer 6 | | Bin Term Op Term 7 | 8 | data Op = Add | Sub | Mul | Div 9 | 10 | eval :: Monad m => Term -> m Integer 11 | eval (Con n) = return n 12 | eval (Bin l o r) = do 13 | v <- eval l 14 | w <- eval r 15 | return (sys o v w) 16 | 17 | sys :: Op -> Integer -> Integer -> Integer 18 | sys Add = (+) 19 | sys Sub = (-) 20 | sys Mul = (*) 21 | sys Div = div 22 | 23 | -------------------------------------------------------------------------------- /code2022/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | 8 | foldr' :: (a -> b -> b) -> b -> [a] -> b 9 | foldr' f b [] = b 10 | foldr' f b (x : xs) = f x (foldr' f b xs) 11 | 12 | foldl' :: (b -> a -> b) -> b -> [a] -> b 13 | foldl' f b [] = b 14 | foldl' f b (x : xs) = foldl' f (f b x) xs 15 | 16 | foldl'' :: (b -> a -> b) -> b -> [a] -> b 17 | foldl'' f b xs = foldr' (\a fb -> fb . (\z -> f z a)) id xs b 18 | -------------------------------------------------------------------------------- /code/M04TypeAliases.hs: -------------------------------------------------------------------------------- 1 | type Name = String 2 | type Title = String 3 | type Year = Int 4 | type Age = Int 5 | 6 | type User = (Name, Year) 7 | -- ^ name ^ Year of birth 8 | type Film = (Title, Age) 9 | -- ^ fsk 10 | type Purchase = (Name, Title, Year) -- <---+ 11 | -- ^ user name ^ item name ^ date of purchase 12 | users :: [User] 13 | users = undefined 14 | 15 | useful_function :: (String, Int) -> String 16 | useful_function (str, i) = take i str 17 | -------------------------------------------------------------------------------- /code/Examples.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | dollarRate = 1.3671 4 | 5 | -- |convert euros to usd 6 | usd euros = euros * dollarRate 7 | 8 | -- |convert usd to eur 9 | euro usds = usds / dollarRate 10 | 11 | -- |euro and usd are inverses 12 | prop_EuroUSD x = euro (usd x) == x 13 | 14 | -- |almost equals 15 | x ~== y = abs (x - y) <= abs x * 10E-15 16 | 17 | -- |euro and usd are almost inverses 18 | prop_EuroUSD' x = euro (usd x) ~== x 19 | 20 | price = 79 21 | 22 | price' :: Double 23 | price' = 79 24 | 25 | -------------------------------------------------------------------------------- /code2019/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: ecb02ee16829df8d7219e7d7fe6c310819820bf335b0b9534bce84d3ea896684 10 | size: 499889 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/26.yaml 12 | original: lts-13.26 13 | -------------------------------------------------------------------------------- /code/Examples-after.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | dollarRate = 1.3671 4 | 5 | -- |convert euros to usd 6 | usd euros = euros * dollarRate 7 | 8 | -- |convert usd to eur 9 | euro usds = usds / dollarRate 10 | 11 | -- |euro and usd are inverses 12 | prop_EuroUSD x = euro (usd x) == x 13 | 14 | -- |almost equals 15 | x ~== y = abs (x - y) <= abs x * 10E-15 16 | 17 | -- |euro and usd are almost inverses 18 | prop_EuroUSD' x = euro (usd x) ~== x 19 | 20 | price = 79 21 | 22 | price' :: Double 23 | price' = 79 24 | 25 | -------------------------------------------------------------------------------- /code2019/Examples.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | dollarRate = 1.3671 4 | 5 | -- |convert euros to dollar 6 | usd euros = euros * dollarRate 7 | 8 | -- |convert dollars to euro 9 | euro usds = usds / dollarRate 10 | 11 | -- |bad property 12 | prop_EuroUSD x = 13 | euro (usd x) == x 14 | 15 | -- |next try 16 | prop_EuroUSD1 x = 17 | abs (euro (usd x) - x) < 10e-15 18 | 19 | -- |final try 20 | prop_EuroUSD2 x = 21 | euro (usd x) ~== x 22 | 23 | (~==) :: Double -> Double -> Bool 24 | x ~== y = abs(x - y) <= 10e-15 * abs x 25 | 26 | price :: Double 27 | price = 79 28 | 29 | -------------------------------------------------------------------------------- /code2024/src/V20241112.hs: -------------------------------------------------------------------------------- 1 | module V20241112 where 2 | 3 | copyFile :: String -> String -> IO () 4 | copyFile source target = 5 | readFile source >>= writeFile target 6 | 7 | copyFile' :: String -> String -> IO () 8 | copyFile' source target = do 9 | xs <- readFile source 10 | writeFile target xs 11 | 12 | copyFile'' source target = 13 | readFile source >>= \xs -> 14 | writeFile target xs 15 | 16 | doTwice :: IO a -> IO a 17 | doTwice io = do 18 | io 19 | io 20 | 21 | doNot :: IO a -> IO () 22 | doNot io = do 23 | return () 24 | 25 | -- definition of (>>) 26 | (>>>) :: IO a -> IO b -> IO b 27 | ma >>> mb = ma >>= \_ -> mb 28 | 29 | -------------------------------------------------------------------------------- /code/M06HO.hs: -------------------------------------------------------------------------------- 1 | import Data.Char 2 | 3 | type T1 = Int -> Int -> Int 4 | type T2 = Int -> (Int -> Int) 5 | type T3 = (Int -> Int) -> Int 6 | 7 | f1 :: T2 8 | f1 = undefined 9 | 10 | pick 1 = fst 11 | pick 2 = snd 12 | 13 | type C2 = (Int, Int) -> Int 14 | 15 | -- maps function :: C2 to function :: T1 16 | curry' :: ((a, b) -> c) -> a -> b -> c 17 | curry' f a b = f (a, b) 18 | 19 | or', and' :: [Bool] -> Bool 20 | or' xs = foldr (||) False xs 21 | 22 | and' xs = foldr (&&) True xs 23 | 24 | -- concat' [] =[] 25 | -- concat' ["Poppy", "Seed"] = "PoppySeed" 26 | concat' :: [[a]] -> [a] 27 | concat' xss = foldr (++) [] xss 28 | 29 | maximum' (x:xs) = foldr max x xs 30 | 31 | -- removeSpaces "abc def \n ghi" == "abcdefghi" 32 | removeSpaces :: String -> String 33 | removeSpaces xs = filter (not . isSpace) xs 34 | 35 | compose :: (b -> c) -> (a -> b) -> (a -> c) 36 | compose f g x = f (g x) 37 | -------------------------------------------------------------------------------- /code2024/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | pantry-tree: 9 | sha256: 677ee9598c5dedb3ef8959c26a6c65f29b3e1e3c5e83433921aef17d86a22d50 10 | size: 535 11 | hackage: svg-builder-0.1.1@sha256:22de54d326a6b6912e461e1302edb9108b02aac0b6a6368fcdc3c4a224d487fd,1440 12 | original: 13 | hackage: svg-builder-0.1.1@sha256:22de54d326a6b6912e461e1302edb9108b02aac0b6a6368fcdc3c4a224d487fd,1440 14 | snapshots: 15 | - completed: 16 | sha256: 0ced7f93245307212900d760c1322dfb527c4b902868c11ccac37f48b7d4ebb9 17 | size: 619200 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/29.yaml 19 | original: lts-19.29 20 | -------------------------------------------------------------------------------- /code/M10monad.hs: -------------------------------------------------------------------------------- 1 | module M10monad where 2 | 3 | main = do 4 | putStrLn "Hello world." 5 | "" <- return "HI there" 6 | return () 7 | {- 8 | -- 1. monad law 9 | -- return x >>= f == f x 10 | 11 | m1 x f = Just x >>= f 12 | 13 | -- 2. monad law 14 | -- m >>= return == m 15 | 16 | m2 m = (Nothing >>= return) 17 | == Nothing 18 | m3 m x = (Just x) >>= return 19 | == Just x 20 | -} 21 | {- 22 | instance Monad [] where 23 | return x = [x] 24 | m >>= f = concatMap f m 25 | -} 26 | 27 | -- (>>=) :: Monad m => m a -> (a -> m b) -> m b 28 | -- for lists 29 | -- (>>=) :: [a] -> (a -> [b]) -> [b] 30 | 31 | -- concatMap :: (a -> [b]) -> [a] -> [b] 32 | 33 | -- mf :: [a] -> (a -> [b]) -> ... 34 | 35 | mf m f = map f m 36 | 37 | concatMap' :: (a -> [b]) -> [a] -> [b] 38 | concatMap' f xs = concat $ map f xs 39 | 40 | concatMap'' f = concat . map f 41 | 42 | -- doesn't work: 43 | -- concatMap''' = concat . map 44 | -------------------------------------------------------------------------------- /code2022/src/V05.hs: -------------------------------------------------------------------------------- 1 | -- curried function type: a -> b -> c 2 | -- uncurried function type: (a, b) -> c 3 | 4 | uncurry' :: (a -> b -> c) -> (a, b) -> c 5 | uncurry' f ab = f (fst ab) (snd ab) 6 | 7 | curry' :: ((a, b) -> c) -> (a -> b -> c) 8 | curry' g a b = g (a , b) 9 | 10 | foldr' :: (a -> b -> b) -> b -> [a] -> b 11 | foldr' f z [] = z 12 | foldr' f z (x:xs) = f x (foldr' f z xs) 13 | 14 | or' :: [Bool] -> Bool 15 | or' xs = foldr' (||) False xs 16 | 17 | and' :: [Bool] -> Bool 18 | and' xs = foldr' (&&) True xs 19 | 20 | g xs = foldr' (:) [] xs 21 | 22 | append xs ys = foldr' (:) ys xs 23 | 24 | -- (.) f g x = f (g x) 25 | 26 | -- Eta reduction: 27 | -- \ x -> e x --> e 28 | -- where x not free in e 29 | 30 | -- f x y = g x y 31 | -- --> 32 | -- f = g 33 | 34 | -- term rewriting example 35 | 36 | -- f (i (e), f (e, e)) 37 | --> 38 | -- f (f (i (e), e), e) 39 | --> [ x -> e ] 40 | -- f (e, e) 41 | --> [ x -> e ] 42 | -- e 43 | 44 | 45 | -------------------------------------------------------------------------------- /code2022/src/V03.hs: -------------------------------------------------------------------------------- 1 | module V03 where 2 | 3 | doubles :: [Integer] -> [Integer] 4 | doubles [] = [] 5 | doubles (x:xs) = 2*x : doubles xs 6 | 7 | map' :: (a -> b) -> [a] -> [b] 8 | map' f [] = [] 9 | map' f (x:xs) = f x : map' f xs 10 | 11 | doubles' :: [Integer] -> [Integer] 12 | doubles' xs = map' (2 *) xs 13 | 14 | filter' :: (a -> Bool) -> [a] -> [a] 15 | filter' p [] = [] 16 | filter' p (x:xs) | p x = x : filter' p xs 17 | | otherwise = filter' p xs 18 | 19 | -- alternative 20 | -- filter' p (x:xs) = if px then ... 21 | 22 | data Suit = Spades | Hearts | Diamonds | Clubs 23 | deriving (Show) 24 | 25 | data Color = Red | Black 26 | deriving (Show) 27 | 28 | color :: Suit -> Color 29 | color Spades = Black 30 | color Hearts = Red 31 | color Diamonds = Red 32 | color Clubs = Black 33 | 34 | -------------------------------------------- 35 | 36 | data Two = One | Two 37 | 38 | -- pick :: Two -> (a, a) -> a 39 | pick One = fst 40 | pick Two = snd 41 | 42 | pick' n | n == 1 = fst 43 | | n == 2 = snd 44 | -------------------------------------------------------------------------------- /code2024/src/V03.hs: -------------------------------------------------------------------------------- 1 | module V03 where 2 | 3 | doubles :: [Integer] -> [Integer] 4 | doubles [] = [] 5 | doubles (x:xs) = 2*x : doubles xs 6 | 7 | map' :: (a -> b) -> [a] -> [b] 8 | map' f [] = [] 9 | map' f (x:xs) = f x : map' f xs 10 | 11 | doubles' :: [Integer] -> [Integer] 12 | doubles' xs = map' (2 *) xs 13 | 14 | filter' :: (a -> Bool) -> [a] -> [a] 15 | filter' p [] = [] 16 | filter' p (x:xs) | p x = x : filter' p xs 17 | | otherwise = filter' p xs 18 | 19 | -- alternative 20 | -- filter' p (x:xs) = if px then ... 21 | 22 | data Suit = Spades | Hearts | Diamonds | Clubs 23 | deriving (Show) 24 | 25 | data Color = Red | Black 26 | deriving (Show) 27 | 28 | color :: Suit -> Color 29 | color Spades = Black 30 | color Hearts = Red 31 | color Diamonds = Red 32 | color Clubs = Black 33 | 34 | -------------------------------------------- 35 | 36 | data Two = One | Two 37 | 38 | -- pick :: Two -> (a, a) -> a 39 | pick One = fst 40 | pick Two = snd 41 | 42 | pick' n | n == 1 = fst 43 | | n == 2 = snd 44 | -------------------------------------------------------------------------------- /code2022/src/lambda.txt: -------------------------------------------------------------------------------- 1 | free and bound 2 | 3 | \x.x 4 | free = 0 5 | bound = {x} 6 | 7 | \x.xy 8 | free = {y} 9 | bound = {x} 10 | 11 | (\x.x)x 12 | free = bound = {x} 13 | 14 | M = \y.x 15 | N = y 16 | M[x -> y] != \y.y (illegal!) 17 | 18 | ---- 19 | 20 | Suppose M has two distinct 21 | normal forms N1 and N2. 22 | So M -->* N1 and M -->* N2 23 | by beta reduction. 24 | So N1 == N2. 25 | Since they are normal forms, 26 | they cannot reduce. 27 | By CR, N1 =alpha= N2. 28 | 29 | ---- 30 | 31 | TRUE = \xy.x 32 | FALSE = \xy.y 33 | 34 | TRUE M N = 35 | (\xy.x) M N --> 36 | M 37 | 38 | ---- 39 | 40 | \fx.x 41 | \fx.fx 42 | \fx.f(fx) 43 | 44 | ---- 45 | 46 | LEFT = \m.\l.\r.l m 47 | RIGHT = \m.\l.\r. r m 48 | CASE = \v.v 49 | 50 | LEFT M = \l.\r.l M 51 | (LEFT M) Nl Nr --> Nl M 52 | 53 | ---- 54 | 55 | prove: M (Y M) <-> Y M 56 | 57 | Y M 58 | = 59 | (\f. (\x.f (x x)) (\x.f (x x))) M 60 | -> 61 | (\x.M (x x)) (\x.M (x x)) 62 | -> 63 | M ((\x.M (x x)) (\x.M (x x))) 64 | <- 65 | M ((\f. (\x.f (x x)) (\x.f (x x))) M) 66 | = 67 | M (Y M) 68 | -------------------------------------------------------------------------------- /code2022/src/V07.hs: -------------------------------------------------------------------------------- 1 | module V07 where 2 | 3 | ones :: [Integer] 4 | ones = 1 : ones 5 | 6 | repeat' :: a -> [a] 7 | repeat' x = x : repeat' x 8 | 9 | repeat'' :: a -> [a] 10 | repeat'' x = xs 11 | where xs = x : xs 12 | 13 | nfib :: Integer -> Integer 14 | nfib n | n == 0 = 0 15 | | n == 1 = 1 16 | | otherwise = nfib (n-1) + nfib (n-2) 17 | 18 | nfib1000 = nfib 30 19 | 20 | fib :: [Integer] 21 | fib = 0 : 1 : zipWith (+) fib (tail fib) 22 | --- fib (n+2) = fib (n+1) + fib n 23 | --- fib_0 = zipWith (+) fib_1 fib_2 24 | 25 | badfib = 1 : zipWith (+) badfib (tail badfib) 26 | 27 | primes :: [Integer] 28 | primes = sieve [2..] 29 | 30 | sieve (p : xs) = p : sieve (filter (\x -> x `mod` p /= 0) xs) 31 | 32 | data BTree = Leaf Integer | Branch BTree BTree 33 | deriving (Show) 34 | 35 | mintree :: BTree -> BTree 36 | mintree b = mb 37 | where 38 | (ib, mb) = helper ib b 39 | helper :: Integer -> BTree -> (Integer, BTree) 40 | helper m (Leaf i) = (i, Leaf m) 41 | helper m (Branch l r) = 42 | let (il, ml) = helper m l 43 | (ir, mr) = helper m r 44 | in (min il ir, Branch ml mr) 45 | -------------------------------------------------------------------------------- /code2019/M18lambda.txt: -------------------------------------------------------------------------------- 1 | in the lambda case: 2 | 3 | P(M) = [ A |- M : T ] 4 | if x not in A 5 | 6 | soundness: A |- M : T derivable 7 | 8 | wnat to prove 9 | 10 | A |- \x.M : a -> T 11 | 12 | but the LAM rule requires 13 | 14 | A, x:a |- M : T 15 | 16 | ---- need property "Weakening" 17 | 18 | if A |- M : T and x not in A 19 | then A, x:T' |- M : T 20 | 21 | ---- 22 | 23 | want to prove 24 | 25 | S A_0 U S A_1 |- M_0 M_1 : S a 26 | 27 | but have: A_0 |- M_0 : T_0 and A_1 |- M_1 : T_1 28 | 29 | ---- need property "Typing closed under substitution" 30 | 31 | if A |- M : T and S substitution 32 | then S A |- M : S T 33 | 34 | ---- 35 | 36 | hence: S A_0 |- M_0 : S T_0 37 | and S A_1 |- M_1 : S T_1 38 | 39 | weakening: 40 | 41 | S (A_0 + A_1) |- M_0 : S T_0 42 | S (A_0 + A_1) |- M_1 : S T_1 43 | 44 | from unification: S T_0 = S T_1 -> S a 45 | 46 | S (A_0 + A_1) |- M_0 : S T_1 -> S a 47 | 48 | hence apply APP 49 | 50 | S (A_0 + A_1) |- M_0 M_1 : S a 51 | 52 | 53 | --------- generic instance 54 | 55 | (*) forall a b. a -> b -> c -> b 56 | >> S = a |-> d, b |-> d with d another type variable 57 | 58 | forall d. d -> d -> c -> d 59 | 60 | no quantification over c because it was free in (*) 61 | 62 | -------------------------------------------------------------------------------- /code/M05Lists.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | data List a = Empty | Next a (List a) 4 | 5 | intoList :: [a] -> List a 6 | intoList [] = Empty 7 | intoList (x:xs) = Next x (intoList xs) 8 | 9 | -- append (++), reverse 10 | l1 = [1,2,3] 11 | l2 = [4,5] 12 | 13 | -- insert for insertion sort 14 | insert' x [] = [x] 15 | insert' y (x:xs) | y <= x = y : x : xs 16 | | otherwise = x : (insert' y xs) 17 | 18 | -- insertion sort 19 | isort [] = [] 20 | isort (x:xs) = insert' x (isort xs) 21 | 22 | -- quick sort 23 | qsort [] = [] 24 | qsort (x:xs) = qsort (filter (=x) xs)) 25 | 26 | -- split according to predicate 27 | split :: (a -> Bool) -> [a] -> ([a], [a]) 28 | split p [] = ([], []) 29 | split p (x:xs) | p x = (x:yess, nos) 30 | | otherwise = (yess, x:nos) 31 | where (yess, nos) = split p xs 32 | 33 | -- qsort using split 34 | qsort' [] = [] 35 | qsort' (x:xs) = qsort' smaller ++ x : qsort' larger 36 | where (smaller, larger) = split ( Int -> [a] -> Bool 41 | prop_take_drop n xs = take n xs ++ drop n xs == xs 42 | nonprop_take_drop n xs = drop n xs ++ take n xs == xs -------------------------------------------------------------------------------- /code2019/M05Lists.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | data List a = Empty | Next a (List a) 4 | 5 | intoList :: [a] -> List a 6 | intoList [] = Empty 7 | intoList (x:xs) = Next x (intoList xs) 8 | 9 | -- append (++), reverse 10 | l1 = [1,2,3] 11 | l2 = [4,5] 12 | 13 | -- insert for insertion sort 14 | insert' x [] = [x] 15 | insert' y (x:xs) | y <= x = y : x : xs 16 | | otherwise = x : (insert' y xs) 17 | 18 | -- insertion sort 19 | isort [] = [] 20 | isort (x:xs) = insert' x (isort xs) 21 | 22 | -- quick sort 23 | qsort [] = [] 24 | qsort (x:xs) = qsort (filter (=x) xs)) 25 | 26 | -- split according to predicate 27 | split :: (a -> Bool) -> [a] -> ([a], [a]) 28 | split p [] = ([], []) 29 | split p (x:xs) | p x = (x:yess, nos) 30 | | otherwise = (yess, x:nos) 31 | where (yess, nos) = split p xs 32 | 33 | -- qsort using split 34 | qsort' [] = [] 35 | qsort' (x:xs) = qsort' smaller ++ x : qsort' larger 36 | where (smaller, larger) = split ( Int -> [a] -> Bool 41 | prop_take_drop n xs = take n xs ++ drop n xs == xs 42 | nonprop_take_drop n xs = drop n xs ++ take n xs == xs 43 | -------------------------------------------------------------------------------- /code2019/M08class.hs: -------------------------------------------------------------------------------- 1 | data Suit = 2 | King 3 | | Ace 4 | | Queen 5 | | Jack 6 | | Numeric Integer 7 | deriving (Show, Read) 8 | 9 | instance Eq Suit where 10 | King == King = True 11 | Ace == Ace = True 12 | Queen == Queen = True 13 | Jack == Jack = True 14 | Numeric i == Numeric i2 = i == i2 15 | _ == _ = False 16 | 17 | data NumPlus a = Integer a | PlusInf | MinusInf 18 | 19 | instance Num a => Num (NumPlus a) where 20 | (Integer i) + (Integer i') = Integer (i + i') 21 | PlusInf + _ = PlusInf 22 | _ + PlusInf = PlusInf 23 | MinusInf + _ = MinusInf 24 | _ + MinusInf = MinusInf 25 | 26 | (Integer i) * (Integer i') = Integer (i * i') 27 | abs (Integer i) = Integer (abs i) 28 | signum (Integer i) = Integer (signum i) 29 | fromInteger i = Integer (fromInteger i) 30 | 31 | negate (Integer i) = Integer (negate i) 32 | negate PlusInf = MinusInf 33 | negate MinusInf = PlusInf 34 | 35 | -- f x = read (show x) 36 | -- g x = show (read x) 37 | 38 | class Stack s where 39 | push :: s a -> a -> s a 40 | pop :: s a -> s a 41 | top :: s a -> a 42 | init :: s a 43 | 44 | instance Stack [] where 45 | push = flip (:) 46 | pop = tail 47 | top = head 48 | init = [] 49 | 50 | -------------------------------------------------------------------------------- /code2024/src/V20241203.hs: -------------------------------------------------------------------------------- 1 | module V20241203 where 2 | 3 | -- instance Functor ((->) a) where 4 | -- fmap :: (c -> d) -> (a -> c) -> (a -> d) 5 | -- fmap f g = f . g 6 | 7 | type Parser t r = [t] -> [(r, [t])] 8 | 9 | -- recognizes the empty language 10 | pempty :: Parser t r 11 | pempty ts = [] 12 | 13 | -- recognizes the language with just the empty word 14 | -- (looks like return or pure!) 15 | succeed :: r -> Parser t r 16 | succeed r ts = [(r, ts)] 17 | 18 | -- `satisfy p` recognizes the language { a | p a } 19 | satisfy :: (t -> Bool) -> Parser t t 20 | satisfy p (t: ts) | p t = [(t, ts)] 21 | satisfy p _ = [] 22 | 23 | -- variation of above 24 | msatisfy :: (t -> Maybe r) -> Parser t r 25 | msatisfy m (t: ts) | Just r <- m t = [(r, ts)] 26 | msatisfy m _ = [] 27 | 28 | -- `lit t` recognizes { t } 29 | lit :: Eq t => t -> Parser t t 30 | lit t = satisfy (== t) 31 | 32 | -- alternative of parsers 33 | palt :: Parser t r -> Parser t r -> Parser t r 34 | palt p1 p2 ts = p1 ts ++ p2 ts 35 | 36 | -- sequence of parsers 37 | pseq :: Parser t (a -> b) -> Parser t a -> Parser t b 38 | pseq p1 p2 ts = [ (f a, ts2) | (f, ts1) <- p1 ts, (a, ts2) <- p2 ts1] 39 | 40 | pmap :: (s -> r) -> (Parser t s -> Parser t r) 41 | pmap f p ts = [ (f s, ts) | (s, ts) <- p ts ] 42 | -------------------------------------------------------------------------------- /code2019/M11applicatives.hs: -------------------------------------------------------------------------------- 1 | module M11applicates where 2 | 3 | 4 | sequence' :: [IO a] -> IO [a] 5 | sequence' [] = return [] 6 | sequence' (io: ios) = return (:) `ap` io `ap` sequence' ios 7 | 8 | 9 | ap :: IO (a -> b) -> IO a -> IO b 10 | ap iof iox = do 11 | f <- iof 12 | x <- iox 13 | return (f x) 14 | 15 | transpose :: [[a]] -> [[a]] 16 | transpose [] = repeat [] 17 | transpose (xs:xss) = zipWith (:) xs (transpose xss) 18 | 19 | data Exp v 20 | = Var v | Val Int | Add (Exp v) (Exp v) 21 | 22 | eval :: Exp v -> Env v -> Int 23 | eval (Var v) env = fetch v env 24 | eval (Val i) env = const i env -- == i 25 | eval (Add e1 e2) env = eval e1 env + eval e2 env 26 | 27 | type Env v = v -> Int 28 | 29 | fetch :: v -> Env v -> Int 30 | fetch v env = env v 31 | 32 | 33 | eval' :: Exp v -> Env v -> Int 34 | eval' (Var v) = fetch v 35 | eval' (Val i) = const i 36 | eval' (Add e1 e2) = const (+) `ess` eval' e1 `ess` eval' e2 37 | 38 | ess :: (Env v -> (a -> b)) 39 | -> (Env v -> a) 40 | -> (Env v -> b) 41 | ess fab fa env = (fab env) (fa env) 42 | 43 | exp1 = Add (Val 17) (Var "x") 44 | env1 = \"x" -> 4 :: Int 45 | 46 | data EnvV = EnvV 47 | data A = A 48 | data B = B 49 | 50 | ess' :: (EnvV -> (A -> B)) 51 | -> (EnvV -> A) 52 | -> (EnvV -> B) 53 | ess' = undefined 54 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 2-Clause License 2 | 3 | Copyright (c) 2017, proglang 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 17 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /code2024/src/V20250121.md: -------------------------------------------------------------------------------- 1 | ## Examples for ML type inference 2 | 3 | 4 | W ([]; λx. S x) 5 | 6 | W (x:β; S x) 7 | 8 | W (x:β; x) → (ID, β) 9 | 10 | U ← 𝓤(β ≐ Nat) 11 | U = [Nat/β] 12 | 13 | → ([Nat/β], Nat) 14 | 15 | → ([Nat/β], Nat → Nat) 16 | 17 | ------------------------------------------------------------ 18 | 19 | W ([]; λx. x) 20 | 21 | W (x:β; x) → (ID, β) 22 | 23 | → (ID, β → β) 24 | 25 | gen([]; β → β) = ∀β. β → β 26 | 27 | ------------------------------------------------------------ 28 | 29 | W (y:α; λx. y) → (ID, β → α) 30 | 31 | gen (y:α, β → α) = ∀β. β → α 32 | 33 | ------------------------------------------------------------ 34 | 35 | ### Alternative type language 36 | 37 | τ ::= α | τ → τ | Nat | ∀α. τ 38 | 39 | leads to a different system called **System F**. 40 | * all-quantifiers can be nested: argument types and return types of 41 | functions can be polymorphic 42 | * type inference is lost 43 | * (with annotionen) type checking is decidable 44 | * additional syntax: 45 | * type application e⟨τ⟩ 46 | * type lambda Λα. e 47 | 48 | ### The example term in System F: 49 | 50 | (λi: ∀α.α→α .(i ⟨Nat→Nat⟩ (λy:Nat .SUCC y )) (i ⟨Nat⟩ 42)) 51 | (Λα. λx:α .x) 52 | 53 | ### Typing rules for type application and type lambda 54 | 55 | A, α ⊢ e : τ 56 | -------------------- 57 | A ⊢ Λα. e : ∀α. τ 58 | 59 | A ⊢ e : ∀α. τ′ 60 | -------------------- 61 | A ⊢ e ⟨τ⟩ : τ′[τ/α] 62 | 63 | -------------------------------------------------------------------------------- /code2022/package.yaml: -------------------------------------------------------------------------------- 1 | name: code2022 2 | version: 0.1.0.0 3 | github: "peterthiemann/code2022" 4 | license: BSD3 5 | author: "Peter Thiemann" 6 | maintainer: "peter.thiemann@gmail.com" 7 | copyright: "2018 Peter Thiemann" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - svg-builder >= 0.1.1 25 | - QuickCheck > 2.14 26 | 27 | library: 28 | source-dirs: src 29 | 30 | executables: 31 | code2022-exe: 32 | main: Main.hs 33 | source-dirs: app 34 | ghc-options: 35 | - -threaded 36 | - -rtsopts 37 | - -with-rtsopts=-N 38 | dependencies: 39 | - code2022 40 | 41 | tests: 42 | code2022-test: 43 | main: Spec.hs 44 | source-dirs: test 45 | ghc-options: 46 | - -threaded 47 | - -rtsopts 48 | - -with-rtsopts=-N 49 | dependencies: 50 | - code2022 51 | -------------------------------------------------------------------------------- /code2024/package.yaml: -------------------------------------------------------------------------------- 1 | name: code2022 2 | version: 0.1.0.0 3 | github: "peterthiemann/code2022" 4 | license: BSD3 5 | author: "Peter Thiemann" 6 | maintainer: "peter.thiemann@gmail.com" 7 | copyright: "2018 Peter Thiemann" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - svg-builder >= 0.1.1 25 | - QuickCheck > 2.14 26 | 27 | library: 28 | source-dirs: src 29 | 30 | executables: 31 | code2022-exe: 32 | main: Main.hs 33 | source-dirs: app 34 | ghc-options: 35 | - -threaded 36 | - -rtsopts 37 | - -with-rtsopts=-N 38 | dependencies: 39 | - code2022 40 | 41 | tests: 42 | code2022-test: 43 | main: Spec.hs 44 | source-dirs: test 45 | ghc-options: 46 | - -threaded 47 | - -rtsopts 48 | - -with-rtsopts=-N 49 | dependencies: 50 | - code2022 51 | -------------------------------------------------------------------------------- /code2019/V02.hs: -------------------------------------------------------------------------------- 1 | module V02 where 2 | 3 | import Data.Complex 4 | import Data.List (genericLength) 5 | 6 | -- |compute x to the n-th power 7 | power :: Complex Double -> Integer -> Complex Double 8 | power x 0 = 1 9 | power x n | n > 0 = x * power x (n - 1) 10 | 11 | examplePair :: (Double, Bool) 12 | examplePair = (3.14, True) 13 | 14 | exampleTriple :: (Bool, Integer, String) 15 | exampleTriple = (False, 42, "hello, world") 16 | 17 | exampleFunction :: (Bool, Integer, String ) -> Bool 18 | exampleFunction (b, i, s) = b || fromInteger i > length s 19 | -- alternative: ... = b || i > genericLength s 20 | 21 | 22 | exampleTriple' :: (Bool, Int, String) 23 | exampleTriple' = (False, 42, "hello, world") 24 | 25 | exampleFunction' :: (Bool, Int, String ) -> Bool 26 | exampleFunction' (b, i, s) = b || i > length s 27 | 28 | summerize :: [String] -> String 29 | summerize [] = "None" 30 | summerize [x] = "Only " ++ x 31 | summerize [x,y] = "Two things: " ++ x ++ " and " ++ y 32 | summerize [_ ,_ ,_ ] = "Three things: ???" 33 | summerize _ = "Several things." 34 | 35 | -- |doubles every element of a list of numbers 36 | doubles :: [Integer] -> [Integer] 37 | doubles [] = [] 38 | doubles (x:xs) = (2 * x) : doubles xs 39 | 40 | -- |map a function on all elements of a list 41 | mymap :: (a -> b) -> [a] -> [b] 42 | mymap f [] = [] 43 | mymap f (x:xs) = f x : mymap f xs 44 | 45 | double x = 2 * x 46 | 47 | doubles' xs = mymap double xs 48 | 49 | -- task: use quickcheck to compare doubles and doubles' 50 | 51 | 52 | 53 | -------------------------------------------------------------------------------- /code2019/M10io.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | -- entry point of a Haskell program 4 | main :: IO () 5 | main = undefined 6 | 7 | -- predefined in Prelude: 8 | -- putChar :: Char -> IO () 9 | 10 | putString :: String -> IO () 11 | putString [] = return () 12 | -- putString (x:xs) = putChar x >>= \ _ -> putString xs 13 | putString (x:xs) = putChar x >> putString xs 14 | 15 | -- type signature is needed to avoid nasty error 16 | putString', putString'' :: String -> IO () 17 | putString' = foldr (\ c io -> (putChar c >>) io) (return ()) 18 | -- eta reduce! 19 | putString'' = foldr (\ c -> (putChar c >>)) (return ()) 20 | 21 | 22 | {- 23 | (>>) :: IO a -> IO b -> IO b 24 | io1 >> io2 = io1 >>= \ _ -> io2 25 | -} 26 | 27 | copyFile source target = 28 | readFile source >>= \xs -> (writeFile target) xs 29 | 30 | 31 | copyFile' source target = 32 | undefined 33 | 34 | doTwice io = 35 | undefined 36 | 37 | doNot io = 38 | undefined 39 | 40 | sortFile :: FilePath -> FilePath -> IO () 41 | -- sortFile inFile outFile 42 | -- reads inFile, sorts its lines, and writes the result to out 43 | -- recall 44 | -- sort :: Ord a => [a] -> [a] 45 | -- lines :: String -> [String] 46 | -- unlines :: [String] -> String 47 | sortFile inFile outFile = 48 | undefined 49 | 50 | sequence' :: [IO a] -> IO [a] 51 | sequence' = undefined 52 | 53 | 54 | printTable :: [String] -> IO () 55 | {- 56 | printTable ["New York", "Rio", "Tokio"] 57 | outputs 58 | 1: New York 59 | 2: Rio 60 | 3: Tokio 61 | -} 62 | printTable ss = undefined 63 | 64 | -------------------------------------------------------------------------------- /code2019/M14compose.hs: -------------------------------------------------------------------------------- 1 | module M14compose where 2 | 3 | newtype Comp f g a = Comp { exComp :: (f (g a)) } 4 | 5 | instance (Functor f, Functor g) => Functor (Comp f g) where 6 | -- fmap :: (a -> b) -> Comp f g a -> Comp f g b 7 | -- fga :: f (g a) 8 | fmap h (Comp fga) = Comp $ fmap (fmap h) fga 9 | 10 | 11 | cv = Comp [Just 14, Just 2, Nothing, Just 4711] 12 | 13 | instance (Applicative f, Applicative g) => Applicative (Comp f g) where 14 | -- pure :: a -> f (g a) 15 | -- for g: pure :: a -> g a 16 | -- for f: pure :: (g a) -> f (g a) 17 | pure a = Comp $ pure (pure a) 18 | Comp fff <*> Comp aaa = Comp $ 19 | -- fff :: f (g (a -> b)) 20 | -- aaa :: f (g a) 21 | -- result :: f (g b) 22 | fmap (<*>) fff -- :: f (g a -> g b) 23 | <*> aaa 24 | 25 | cfff = Comp [Just (+1), Nothing, Just (*2)] 26 | vaaa = Comp [Nothing, Just 42, Just 17] 27 | 28 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } 29 | instance Functor (MaybeT m) where 30 | fmap = undefined 31 | instance Applicative (MaybeT m) where 32 | pure = undefined 33 | (<*>) = undefined 34 | 35 | instance (Monad m) => Monad (MaybeT m) where 36 | return a = MaybeT $ return (return a) 37 | (MaybeT mmx) >>= f = MaybeT $ do 38 | mx <- mmx 39 | case mx of 40 | Nothing -> return Nothing 41 | Just x -> runMaybeT (f x) 42 | 43 | {- 44 | instance MonadTrans MaybeT where 45 | lift mx = MaybeT $ mx >>= (return . Just) 46 | -} 47 | 48 | -- StateT s Maybe a === s -> Maybe (a, s) 49 | -- MaybeT (ST s) a === s -> (Maybe a, s) 50 | -------------------------------------------------------------------------------- /slides/cheatsheet.md: -------------------------------------------------------------------------------- 1 | # Haskell Cheatsheet # 2 | 3 | - A *definition* gives a name to a value 4 | - Names are case-sensitive, must start with lowercase letter 5 | - Definitions are put in a text file ending in .hs 6 | - Comments start with `--` and extend to the end of the line 7 | - Function definitions have the form `f x1 x2 ... = e` where 8 | - `f` is the name of the function 9 | - `x1`, `x2`, ... are the names of the formal parameters 10 | - `e` is the body of the function, an expression to compute the result 11 | - Operators 12 | - arithmetic: `+` `-` `*` `/` 13 | - comparison: `==` `/=` `<` `>` etc 14 | - Automated Testing with QuickCheck 15 | - Define a property as a function `prop_...` of type `T -> Bool` 16 | - `import Testing.QuickCheck` -- in the source file 17 | - Test by executing `quickCheck prop_...` 18 | - Floating point arithmetic 19 | - Do not test floating point numbers for equality! 20 | - Approximately 15 significant decimal digits 21 | - Test equality with relative check < 10E-15 22 | - Types 23 | - Every value has a type 24 | - Numeric literals are overloaded (can be, e.g., `Integer` or `Double`) 25 | - Naming a value fixes its type (according to Haskell's rules) 26 | - Argument type of function and actual type of argument must match 27 | - Type `Double`: double precision floating point numbers 28 | - Type `Integer`: exact computation 29 | - Type signature specifies the desired type (overrides Haskell's rules) 30 | - Function definition by cases and recursion 31 | - Paraphrasing the mathematical definition 32 | -------------------------------------------------------------------------------- /code2019/M06Functions.hs: -------------------------------------------------------------------------------- 1 | module M06Functions where 2 | 3 | pick :: Int -> (component, component) -> component 4 | pick 1 = fst 5 | pick 2 = snd 6 | 7 | type T1 = Int -> Int -> Int 8 | type T2 = (Int, Int) -> Int 9 | 10 | type T1' a b c = a -> b -> c 11 | type T2' a b c = (a, b) -> c 12 | 13 | -- T1 is the same as T1' Int Int Int 14 | 15 | -- curry' :: T2' a b c -> T1' a b c 16 | 17 | curry' :: ((a, b) -> c) -> (a -> b -> c) 18 | curry' f a b = f (a,b) 19 | 20 | uncurry' :: (a -> b -> c) -> ((a, b) -> c) 21 | uncurry' f (a, b) = f a b 22 | 23 | add :: T1 24 | add x y = x+y 25 | 26 | foldr' :: (a -> b -> b) -> b -> [a] -> b 27 | foldr' op e [] = e 28 | foldr' op e (x:xs) = x `op` foldr' op e xs 29 | 30 | or' xs = foldr' (||) False xs 31 | and' xs = foldr' (&&) True xs 32 | concat' xss = foldr' (++) [] xss 33 | 34 | foldr1' :: (a -> a -> a) -> [a] -> a 35 | foldr1' op [x] = x 36 | foldr1' op (x:xs) = x `op` foldr1' op xs 37 | 38 | maximum' xs = foldr1' max xs 39 | 40 | 41 | snoc :: a -> [a] -> [a] 42 | snoc x ys = foldr' (:) [x] ys 43 | 44 | f3 xs = foldr' snoc [] xs 45 | 46 | f4 f xs = foldr' fc [] xs 47 | where fc x ys = f x : ys 48 | 49 | -- my f xs == f4 f xs 50 | 51 | my f [] = [] -- = foldr' fc [] [] 52 | my f (x:xs) = f x : my f xs 53 | -- foldr' fc [] (x:xs) = 54 | -- fc x (foldr' fc [] xs) = 55 | -- f x : foldr' fc [] xs = 56 | 57 | f3' xs = foldr' (\ x ys -> (++[x]) ys) [] xs 58 | f3'' = foldr' (\ x -> (++[x])) [] 59 | 60 | filter' p = foldr' op [] 61 | where 62 | op x | p x = (x :) 63 | | otherwise = id 64 | -------------------------------------------------------------------------------- /code2019/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Peter Thiemann 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Peter Thiemann nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /code2022/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Peter Thiemann (c) 2021 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Peter Thiemann nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /code2024/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Peter Thiemann (c) 2021 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Peter Thiemann nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /code2019/M07Laziness.hs: -------------------------------------------------------------------------------- 1 | module M07Laziness where 2 | 3 | nat :: [Integer] 4 | 5 | nat = 0 : map (+1) nat 6 | 7 | nathelper i = i : nathelper (i+1) 8 | nat'' = nathelper 0 9 | 10 | nat' = [0..] 11 | 12 | --0 cyclic representation in memory 13 | ones :: [Integer] 14 | ones = 1 : ones 15 | 16 | stupid = stupid 17 | 18 | repeat' :: a -> [a] 19 | repeat' x = x : repeat' x 20 | {- 21 | repeat' 1 == 22 | 1 : repeat' 1 == 23 | 1 : 1 : repeat' 1 24 | -} 25 | -- cyclic representation in memory 26 | repeat'' :: a -> [a] 27 | repeat'' x = xs 28 | where xs = x : xs 29 | 30 | -- fib(i+2) = fib (i+1) + fib (i) 31 | -- fib !! (i+2) == fib !! (i+1) + fib !! i 32 | 33 | -- fib (i+2) = 0 1 1 2 3 XX 34 | -- fib (i+1) = 0 1 1 2 3 35 | -- fib (i) = 0 1 1 2 3 36 | 37 | 38 | fib :: [Integer] 39 | fib = 0 : 1 : zipWith (+) (tail fib) fib 40 | 41 | primes :: [Integer] 42 | primes = helper [2..] 43 | 44 | helper (p:rest) = 45 | p : helper (filter (\n -> n `mod` p /= 0) rest) 46 | 47 | -- hamming numbers 48 | 49 | data BTree = Leaf Int | Branch BTree BTree 50 | deriving Show 51 | 52 | mintree :: BTree -> BTree 53 | mintree t = 54 | let m = minleaf t in 55 | replaceLeaves t m 56 | 57 | minleaf :: BTree -> Int 58 | minleaf (Leaf i) = i 59 | minleaf (Branch l r) = minleaf l `min` minleaf r 60 | 61 | replaceLeaves :: BTree -> Int -> BTree 62 | replaceLeaves (Leaf _) i = 63 | Leaf i 64 | replaceLeaves (Branch l r) i = 65 | Branch (replaceLeaves l i) (replaceLeaves r i) 66 | 67 | -- just one traversal 68 | mintree' :: BTree -> BTree 69 | mintree' t = mt 70 | where (mt, m) = replaceMin t m 71 | 72 | 73 | replaceMin :: BTree -> Int -> (BTree, Int) 74 | replaceMin (Leaf i) m = (Leaf m, i) 75 | replaceMin (Branch l r) m = (Branch rl rr, ml `min` mr) 76 | where (rl, ml) = replaceMin l m 77 | (rr, mr) = replaceMin r m 78 | -------------------------------------------------------------------------------- /code2022/src/V11.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QualifiedDo #-} 2 | module V11 where 3 | 4 | -- import SimplePrelude as S 5 | -- import Prelude () 6 | 7 | 8 | ap :: Monad m => m (a -> b) -> m a -> m b 9 | ap mfab ma = do 10 | f <- mfab 11 | a <- ma 12 | return (f a) 13 | 14 | -- different presentation for monads... 15 | -- instead of the bind operation 16 | -- you have a `join` operation 17 | 18 | join :: Monad m => m (m a) -> m a 19 | join mma = do 20 | ma <- mma 21 | ma 22 | 23 | ---------------------------------------------------- 24 | 25 | type Parser tok res = [tok] -> [(res, [tok])] 26 | 27 | -- pempty recognizes the empty language 28 | pempty :: Parser tok res 29 | pempty ts = [] 30 | 31 | -- succeed recognizes the empty string 32 | 33 | succeed :: r -> Parser tok r 34 | succeed r = \ts -> [(r, ts)] 35 | 36 | -- satisfy checks first token using a predicate `p` 37 | 38 | satisfy :: (t -> Bool) -> Parser t t 39 | satisfy p (t : ts) | p t = [(t, ts)] 40 | satisfy p _ = [] 41 | 42 | -- msatisfy checks and returns a substitute for tok 43 | 44 | msatisfy :: (t -> Maybe r) -> Parser t r 45 | msatisfy p (t : ts) = 46 | case p t of 47 | Just r -> [(r, ts)] 48 | Nothing -> [] 49 | msatisfy p [] = [] 50 | 51 | -- Haskell feature: pattern guards 52 | 53 | msatisfy' :: (t -> Maybe r) -> Parser t r 54 | msatisfy' p (t : ts) | Just r <- p t = [(r, ts)] 55 | msatisfy' _ _ = [] 56 | 57 | -- check literal occurrence of a topken 58 | 59 | lit :: Eq t => t -> Parser t t 60 | lit t = satisfy (== t) 61 | 62 | -- alternative 63 | 64 | palt :: Parser t r -> Parser t r -> Parser t r 65 | palt p1 p2 ts = p1 ts ++ p2 ts 66 | 67 | -- sequence 68 | 69 | pseq :: Parser t (s -> r) -> Parser t s -> Parser t r 70 | pseq pf pa ts = 71 | [ (f a, ts'') 72 | | (f, ts') <- pf ts, (a, ts'') <- pa ts' ] 73 | 74 | -- map 75 | 76 | pmap :: (s -> r) -> Parser t s -> Parser t r 77 | pmap f p ts = [ (f a, ts') | (a, ts') <- p ts ] 78 | 79 | -- 80 | 81 | instance Functor (Parser t) where 82 | 83 | -------------------------------------------------------------------------------- /code2019/M04CardsFinal.hs: -------------------------------------------------------------------------------- 1 | data Suit = Spades | Hearts | Diamonds | Clubs 2 | deriving (Show, Eq, Ord) 3 | 4 | data Color = Black | Red 5 | deriving (Show, Eq, Ord) 6 | 7 | -- Define a color function by pattern matching 8 | color :: Suit -> Color 9 | color Spades = Black 10 | color Hearts = Red 11 | color Diamonds = Red 12 | color Clubs = Black 13 | 14 | data Rank = Numeric Integer | Jack | Queen 15 | | King | Ace 16 | deriving (Show,Eq,Ord) 17 | 18 | -- rankBeats r1 r2 returns True, if r1 beats r2 19 | rankBeats :: Rank -> Rank -> Bool 20 | rankBeats r1 r2 = r1 >= r2 21 | 22 | 23 | data Card = Card { rank :: Rank, suit :: Suit } 24 | deriving (Show,Eq,Ord) 25 | 26 | cardBeats :: Card -> Card -> Bool 27 | cardBeats givenCard c = 28 | ((suit givenCard) == (suit c)) 29 | && 30 | (rankBeats (rank givenCard) (rank c)) 31 | 32 | aceOfSpades = Card Ace Spades 33 | tenOfHearts = Card (Numeric 10) Hearts 34 | queenOfHearts = undefined 35 | jackOfClub = undefined 36 | 37 | data Hand = Last Card | Next Card Hand 38 | deriving (Show) 39 | 40 | -- choose a card from the hand that beats the given card if possible 41 | -- but it does not follow suit! 42 | chooseCard :: Card -> Hand -> Card 43 | chooseCard c (Last c2) = c2 44 | chooseCard c (Next c2 h) | cardBeats c2 c = c2 45 | chooseCard c (Next c2 h) = chooseCard c h 46 | 47 | 48 | 49 | lowestCard :: Hand -> Card 50 | lowestCard (Next c h) = lowestCard' c h 51 | lowestCard (Last c) = c 52 | 53 | lowestCard' :: Card -> Hand -> Card 54 | lowestCard' cmin (Last c) = min cmin c 55 | lowestCard' cmin (Next c h) = lowestCard' (min cmin c) h 56 | 57 | hand :: Hand 58 | hand = Next tenOfHearts (Last aceOfSpades) 59 | 60 | 61 | data Foo = Foo | Bar | Baz 62 | deriving (Eq) 63 | 64 | 65 | data List a = Empty | Cons a (List a) 66 | deriving (Show) 67 | -------------------------------------------------------------------------------- /slides/07-laziness.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \documentclass{beamer} 3 | 4 | \input{common} 5 | %%% frontmatter 6 | \input{frontmatter} 7 | \subtitle{Laziness} 8 | \usepackage{tikz} 9 | 10 | 11 | \begin{document} 12 | 13 | \begin{frame} 14 | \titlepage 15 | \end{frame} 16 | %---------------------------------------------------------------------- 17 | \begin{frame} 18 | \frametitle{Laziness} 19 | \begin{itemize} 20 | \item Haskell does not evaluate function arguments unless they are 21 | demanded to calculate the function's result 22 | \item Data structures are only evaluated as much as they are needed 23 | \end{itemize} 24 | \end{frame} 25 | 26 | \begin{frame}[fragile] 27 | \frametitle{Infinite lists} 28 | \begin{verbatim} 29 | nat :: [Integer] 30 | nat = [0..] -- cheating! 31 | 32 | ones :: [Integer] 33 | ones = undefined 34 | 35 | -- |create an infinite list of argument value 36 | repeat' :: a -> [a] 37 | repeat' a = undefined 38 | \end{verbatim} 39 | \end{frame} 40 | 41 | \begin{frame}[fragile] 42 | \frametitle{Fibonacci numbers} 43 | \begin{verbatim} 44 | fib :: [Integer] 45 | fib = undefined 46 | \end{verbatim} 47 | \end{frame} 48 | \begin{frame}[fragile] 49 | \frametitle{Sieve of Eratosthenes} 50 | \begin{verbatim} 51 | primes :: [Integer] 52 | primes = undefined 53 | \end{verbatim} 54 | \end{frame} 55 | \begin{frame}[fragile] 56 | \frametitle{The minimum tree} 57 | \begin{block}<+->{A binary tree type} 58 | A variant of binary trees has information only at the nodes. 59 | \begin{verbatim} 60 | data BTree = Leaf Int | Branch BTree BTree 61 | \end{verbatim} 62 | \end{block} 63 | \begin{block}<+->{Task} 64 | \begin{itemize} 65 | \item<+-> Write a function \texttt{mintree} that replaces the value at 66 | each leaf by the minimum value of all leaves in the tree. 67 | \item<+-> \alert{Only one traversal of the tree is allowed! } 68 | \end{itemize} 69 | \end{block} 70 | \end{frame} 71 | \end{document} 72 | 73 | %%% Local Variables: 74 | %%% mode: latex 75 | %%% TeX-master: t 76 | %%% End: 77 | -------------------------------------------------------------------------------- /code2019/M13interpreter.hs: -------------------------------------------------------------------------------- 1 | module M13interpreter where 2 | 3 | type Ident = String 4 | 5 | data Term = Con Integer 6 | | Bin Term Op Term 7 | | Var Ident 8 | | Let Ident Term Term -- let x = e1 in e2 9 | deriving (Eq, Show) 10 | 11 | data Op = Add | Sub | Mul | Div 12 | deriving (Eq, Show) 13 | 14 | 15 | sys Add = (+) 16 | sys Sub = (-) 17 | sys Mul = (*) 18 | sys Div = div 19 | 20 | 21 | eval :: Monad m => 22 | Term -> (Ident -> Integer) -> m Integer 23 | eval (Con n) env = 24 | return n 25 | eval (Bin t op u) env = do 26 | vt <- eval t env 27 | vu <- eval u env 28 | return $ sys op vt vu 29 | eval (Var x) env = 30 | return $ env x 31 | eval (Let x t u) env = do 32 | vt <- eval t env 33 | eval u (update x vt env) 34 | 35 | update x vt env = 36 | \ y -> if x == y then vt else env y 37 | 38 | -- passing environemnts 39 | -- instance of the Reader monad 40 | 41 | data Reader e a = Reader { exReader :: e -> a } 42 | 43 | instance Functor (Reader e) where 44 | fmap g (Reader f) = Reader (g . f) 45 | 46 | instance Applicative (Reader e) where 47 | pure a = Reader $ \ e -> a 48 | Reader ff <*> Reader xx = 49 | Reader $ \ e -> ff e (xx e) 50 | 51 | instance Monad (Reader e) where 52 | Reader aa >>= f = 53 | Reader $ \e -> exReader (f (aa e)) e 54 | 55 | ask :: Reader e e 56 | ask = Reader id 57 | 58 | local :: (e -> e') -> Reader e' a -> Reader e a 59 | local f (Reader aa) = Reader $ \e -> aa (f e) 60 | 61 | 62 | 63 | type Env = Ident -> Integer 64 | 65 | evalR :: 66 | Term -> Reader Env Integer 67 | evalR = eval 68 | where 69 | eval (Con n) = 70 | return n 71 | eval (Bin t op u) = do 72 | vt <- eval t 73 | vu <- eval u 74 | return $ sys op vt vu 75 | eval (Var x) = do 76 | env <- ask 77 | return $ env x 78 | eval (Let x t u) = do 79 | vt <- eval t 80 | local (update x vt) (eval u) 81 | 82 | runReader :: Reader e a -> e -> a 83 | runReader (Reader aa) e = aa e 84 | 85 | 86 | -------------------------------------------------------------------------------- /code2022/code2022.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.35.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: code2022 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/peterthiemann/code2022#readme 11 | bug-reports: https://github.com/peterthiemann/code2022/issues 12 | author: Peter Thiemann 13 | maintainer: peter.thiemann@gmail.com 14 | copyright: 2018 Peter Thiemann 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/peterthiemann/code2022 25 | 26 | library 27 | exposed-modules: 28 | Examples 29 | Lib 30 | M14compose 31 | M17alacarte 32 | M19functionaldata 33 | SimplePrelude 34 | V02 35 | V03 36 | V05 37 | V07 38 | V09 39 | V10 40 | V11 41 | V12 42 | V13 43 | other-modules: 44 | Paths_code2022 45 | hs-source-dirs: 46 | src 47 | build-depends: 48 | QuickCheck >2.14 49 | , base >=4.7 && <5 50 | , svg-builder >=0.1.1 51 | default-language: Haskell2010 52 | 53 | executable code2022-exe 54 | main-is: Main.hs 55 | other-modules: 56 | Paths_code2022 57 | hs-source-dirs: 58 | app 59 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 60 | build-depends: 61 | QuickCheck >2.14 62 | , base >=4.7 && <5 63 | , code2022 64 | , svg-builder >=0.1.1 65 | default-language: Haskell2010 66 | 67 | test-suite code2022-test 68 | type: exitcode-stdio-1.0 69 | main-is: Spec.hs 70 | other-modules: 71 | Paths_code2022 72 | hs-source-dirs: 73 | test 74 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 75 | build-depends: 76 | QuickCheck >2.14 77 | , base >=4.7 && <5 78 | , code2022 79 | , svg-builder >=0.1.1 80 | default-language: Haskell2010 81 | -------------------------------------------------------------------------------- /code2022/src/V10.hs: -------------------------------------------------------------------------------- 1 | module V10 where 2 | 3 | import Test.QuickCheck 4 | 5 | -- traditional using bind 6 | 7 | copyFile :: String -> String -> IO () 8 | copyFile source target = 9 | readFile source >>= \xs -> 10 | writeFile target xs 11 | 12 | doTwice :: IO a -> IO (a, a) 13 | doTwice io = 14 | io >>= \a1 -> io >>= \a2 -> return (a1, a2) 15 | 16 | doNot :: IO a -> IO () 17 | doNot io = 18 | return () 19 | 20 | -- now: using do notation 21 | 22 | copyFileDo :: String -> String -> IO () 23 | copyFileDo source target = do 24 | xs <- readFile source 25 | writeFile target xs 26 | 27 | doTwiceDo io = do 28 | a1 <- io 29 | a2 <- io 30 | return (a1, a2) 31 | 32 | -- the "other" bind (real name: >>) 33 | 34 | (>>-) :: IO a -> IO b -> IO b 35 | ma >>- mb = ma >>= \ _ -> mb 36 | 37 | sequence' :: [IO a] -> IO [a] 38 | sequence' ios = foldr (\iox ioxs -> iox >>= \x -> ioxs >>= \xs -> return (x : xs)) (return []) ios 39 | 40 | sequence_' :: [IO a] -> IO () 41 | sequence_' ios = sequence' ios >> return () 42 | -- sequence_' = (>> return ()) . sequence' 43 | 44 | 45 | ----------------------------------------------------- 46 | 47 | data Suit = Spades | Hearts | Diamonds | Clubs 48 | deriving (Show, Eq) 49 | 50 | data Rank = Numeric Integer | Jack | Queen | King | Ace 51 | deriving (Show, Eq, Ord) 52 | 53 | data Card = Card { rank :: Rank, suit :: Suit } 54 | deriving (Show) 55 | 56 | genSuit :: Gen Suit 57 | genSuit = elements [Spades, Hearts, Diamonds, Clubs] 58 | 59 | genNumeric :: Gen Rank 60 | genNumeric = choose (2, 10) >>= (return . Numeric) 61 | 62 | genPicture :: Gen Rank 63 | genPicture = elements [Jack, Queen, King, Ace] 64 | 65 | genRank :: Gen Rank 66 | genRank = frequency [(9, genNumeric), (4, genPicture)] 67 | 68 | genCard :: Gen Card 69 | genCard = do 70 | suit <- genSuit 71 | rank <- genRank 72 | return (Card rank suit) 73 | 74 | genEven :: Gen Integer 75 | genEven = arbitrary >>= (return . (*2)) 76 | 77 | -- testing the generator 78 | 79 | validRank :: Rank -> Bool 80 | validRank (Numeric n) = 2 <= n && n <= 10 81 | validRank _ = True 82 | prop_all_validRank = forAll genRank (\r -> collect r (validRank r)) 83 | -------------------------------------------------------------------------------- /code2024/src/V20241210.hs: -------------------------------------------------------------------------------- 1 | module V20241210 where 2 | 3 | newtype Comp f g a = Comp (f (g a)) 4 | 5 | instance (Functor f, Functor g) => Functor (Comp f g) where 6 | -- fmap :: (a -> b) -> Comp f g a -> Comp f g b 7 | fmap h (Comp fga) 8 | = Comp $ fmap{-f-} (fmap{-g-} h) fga 9 | -- ^-> :: g a -> g b 10 | 11 | -- functor laws hold! 12 | 13 | instance (Applicative f, Applicative g) => 14 | Applicative (Comp f g) where 15 | pure x = Comp $ pure (pure x) 16 | Comp fga_b <*> Comp fga = Comp $ fmap (<*>) fga_b <*> fga 17 | -- fga_b :: f (g (a -> b)) 18 | -- fga :: f (g a) 19 | -- fmap (<*>) fga_b :: f (g a -> g b) 20 | -- ^-> :: g (a -> b) -> (g a -> g b) 21 | -- fmap (<*>) fga_b <*> fga :: f (g b) 22 | 23 | data ST s a = ST { runST :: s -> (s, a) } 24 | 25 | instance Functor (ST s) where 26 | fmap h sg = ST (fmap h . runST sg) 27 | 28 | instance Applicative (ST s) where 29 | pure a = ST (, a) 30 | ST fab <*> ST fa = ST $ \s -> let (s', f) = fab s in 31 | fmap f $ fa s' 32 | 33 | instance Monad (ST s) where 34 | ST fa >>= h = ST $ \s -> let (s', a) = fa s in 35 | runST (h a) s' 36 | 37 | type STM s a = Comp Maybe (ST s) a 38 | 39 | nuke :: Maybe a -> Maybe a 40 | nuke _ = Nothing 41 | 42 | reset :: ST Int a -> ST Int a 43 | reset (ST g) = ST (g . const 0) 44 | 45 | use_nuke :: STM s a -> STM s a 46 | use_nuke (Comp stm) = Comp (nuke stm) 47 | 48 | use_reset :: STM Int a -> STM Int a 49 | use_reset (Comp stm) = Comp (fmap reset stm) 50 | 51 | newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } 52 | 53 | instance Monad m => Functor (StateT s m) where 54 | fmap h (StateT g) = StateT $ \s -> do 55 | (a, s') <- g s 56 | return (h a, s') 57 | 58 | instance Monad m => Applicative (StateT s m) where 59 | pure a = StateT $ \s -> return (a, s) 60 | (<*>) = undefined 61 | 62 | instance (Monad m) => Monad (StateT s m) where 63 | m >>= f = StateT $ \s -> do 64 | (a, s') <- runStateT m s 65 | runStateT (f a) s' 66 | 67 | class MonadTrans t where 68 | lift :: (Monad m) => m a -> t m a 69 | 70 | instance MonadTrans (StateT s) where 71 | lift ma = StateT $ \s -> do { a <- ma ; return (a, s) } 72 | 73 | -------------------------------------------------------------------------------- /code2024/src/V20241119.hs: -------------------------------------------------------------------------------- 1 | module V20241119 where 2 | 3 | import Test.QuickCheck hiding (Sorted, orderedList) 4 | import qualified Data.List as L 5 | 6 | data Suit = Spades | Hearts | Diamonds | Clubs 7 | deriving (Show, Eq, Enum) 8 | 9 | instance Arbitrary Suit where 10 | arbitrary = elements [Spades .. Clubs] 11 | 12 | data Rank = Numeric Integer | Jack | Queen | King | Ace 13 | deriving (Show, Eq, Ord) 14 | 15 | instance Arbitrary Rank where 16 | arbitrary = frequency [ (4, elements [Jack, Queen, King, Ace]) 17 | , (9, choose (2,10) >>= return . Numeric) 18 | ] 19 | 20 | data Card = Card { rank :: Rank, suit :: Suit } 21 | deriving (Show) 22 | 23 | instance Arbitrary Card where 24 | arbitrary = do 25 | r <- arbitrary 26 | s <- arbitrary 27 | return $ Card r s 28 | 29 | gen_even :: Gen Integer 30 | gen_even = do 31 | i <- arbitrary 32 | return (2 * i) 33 | 34 | gen_even' :: Gen Integer 35 | gen_even' = 36 | arbitrary >>= return . (2*) 37 | 38 | gen_nonneg :: Gen Integer 39 | gen_nonneg = 40 | arbitrary >>= return . abs 41 | 42 | validRank :: Rank -> Bool 43 | validRank (Numeric n) = 2 <= n && n <= 10 44 | validRank _ = True 45 | 46 | prop_all_valid_rank_collect r = collect r (validRank r) 47 | 48 | insert :: Ord a => a -> [a] -> [a] 49 | insert x [] = [ x ] 50 | insert x (y : ys) | x <= y = x : (y : ys) 51 | | otherwise = y : insert x ys 52 | 53 | isOrdered :: Ord a => [a] -> Bool 54 | isOrdered [] = True 55 | isOrdered [ _ ] = True 56 | isOrdered (x : y : xs) = x <= y && isOrdered (y : xs) 57 | 58 | prop_insert_1 :: Integer -> [Integer] -> Bool 59 | prop_insert_1 x xs = isOrdered (insert x xs) 60 | 61 | prop_insert_2 :: Integer -> [Integer] -> Bool 62 | prop_insert_2 x xs = not (isOrdered xs) || isOrdered (insert x xs) 63 | 64 | 65 | orderedList :: (Arbitrary a, Ord a) => Gen [a] 66 | orderedList = do 67 | xs <- arbitrary 68 | return $ L.sort xs 69 | 70 | newtype Sorted a = 71 | Sorted [a] 72 | deriving (Show) 73 | 74 | instance (Ord a, Arbitrary a) => Arbitrary (Sorted a) where 75 | arbitrary = do 76 | sxs <- orderedList 77 | return $ Sorted sxs 78 | 79 | prop_insert_3 :: Integer -> Sorted Integer -> Bool 80 | prop_insert_3 x (Sorted xs) = isOrdered (insert x xs) 81 | 82 | -------------------------------------------------------------------------------- /code2024/code2022.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.35.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: code2022 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/peterthiemann/code2022#readme 11 | bug-reports: https://github.com/peterthiemann/code2022/issues 12 | author: Peter Thiemann 13 | maintainer: peter.thiemann@gmail.com 14 | copyright: 2018 Peter Thiemann 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/peterthiemann/code2022 25 | 26 | library 27 | exposed-modules: 28 | Examples 29 | Lib 30 | M14compose 31 | M17alacarte 32 | M19functionaldata 33 | SimplePrelude 34 | V01 35 | V02 36 | V03 37 | V05 38 | V07 39 | V09 40 | V10 41 | V11 42 | V12 43 | V13 44 | V20241029 45 | V20241105 46 | V20241112 47 | V20241119 48 | V20241126 49 | V20241203 50 | V20241210 51 | V20241217 52 | other-modules: 53 | Paths_code2022 54 | hs-source-dirs: 55 | src 56 | build-depends: 57 | QuickCheck >2.14 58 | , base >=4.7 && <5 59 | , svg-builder >=0.1.1 60 | default-language: Haskell2010 61 | 62 | executable code2022-exe 63 | main-is: Main.hs 64 | other-modules: 65 | Paths_code2022 66 | hs-source-dirs: 67 | app 68 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 69 | build-depends: 70 | QuickCheck >2.14 71 | , base >=4.7 && <5 72 | , code2022 73 | , svg-builder >=0.1.1 74 | default-language: Haskell2010 75 | 76 | test-suite code2022-test 77 | type: exitcode-stdio-1.0 78 | main-is: Spec.hs 79 | other-modules: 80 | Paths_code2022 81 | hs-source-dirs: 82 | test 83 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 84 | build-depends: 85 | QuickCheck >2.14 86 | , base >=4.7 && <5 87 | , code2022 88 | , svg-builder >=0.1.1 89 | default-language: Haskell2010 90 | -------------------------------------------------------------------------------- /code2024/src/V20241217.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | module V20241217 where 3 | 4 | data Term a where 5 | I :: Integer -> Term Integer 6 | D :: Double -> Term Double 7 | B :: Bool -> Term Bool 8 | Add :: (Num a) => Term a -> Term a -> Term a 9 | Eql :: (Eq a) => Term a -> Term a -> Term Bool 10 | -- deriving (Eq, Show) 11 | 12 | eval :: Term a -> a 13 | eval (I i) = i 14 | eval (B b) = b 15 | eval (D d) = d 16 | eval (Add t1 t2) = eval t1 + eval t2 17 | eval (Eql t1 t2) = eval t1 == eval t2 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | data env :- a where 76 | App :: env :- (a -> b) 77 | -> env :- a 78 | -> env :- b 79 | Lam :: (a, env) :- b 80 | -> env :- (a -> b) 81 | Var :: env :> a 82 | -> env :- a 83 | Con :: Integer 84 | -> env :- Integer 85 | Suc :: env :- Integer 86 | -> env :- Integer 87 | 88 | data env :> a where 89 | Z :: (a, env) :> a 90 | S :: env :> a -> (b, env) :> a 91 | 92 | flookup :: (env :> a) -> env -> a 93 | flookup Z (a, env) = a 94 | flookup (S n) (b, env) = flookup n env 95 | 96 | feval :: (env :- a) -> env -> a 97 | feval (App t1 t2) env = 98 | feval t1 env {- :: a -> b -} $ 99 | feval t2 env {- :: a -} 100 | feval (Lam t) env = \a -> feval t (a, env) 101 | feval (Var v) env = flookup v env 102 | feval (Con i) env = i 103 | feval (Suc t) env = feval t env + 1 104 | 105 | t1 :: env :- (a -> a) 106 | t1 = Lam (Var Z) 107 | 108 | fsuc :: env :- (Integer -> Integer) 109 | -- \x -> Suc x 110 | fsuc = Lam (Suc (Var Z)) 111 | 112 | t2 :: env :- ((a -> a) -> (a -> a)) 113 | -- t2 = \f x -> f (f x) 114 | t2 = Lam (Lam (App (Var (S Z)) (App (Var (S Z)) (Var Z)))) 115 | 116 | --- numbers as types 117 | 118 | data TZero where 119 | 120 | data TSucc a where 121 | 122 | data Vector n b where 123 | Vempty :: Vector TZero b 124 | Vcons :: b -> Vector n b -> Vector (TSucc n) b 125 | 126 | vhead :: Vector (TSucc n) b -> b 127 | vhead (Vcons x _) = x 128 | 129 | -------------------------------------------------------------------------------- /code2019/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-13.26 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # - location: 29 | # git: https://github.com/commercialhaskell/stack.git 30 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 31 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # subdirs: 33 | # - auto-update 34 | # - wai 35 | packages: 36 | - . 37 | # Dependency packages to be pulled from upstream that are not in the resolver 38 | # using the same syntax as the packages field. 39 | # (e.g., acme-missiles-0.3) 40 | # extra-deps: [] 41 | 42 | # Override default flag values for local packages and extra-deps 43 | # flags: {} 44 | 45 | # Extra package databases containing global packages 46 | # extra-package-dbs: [] 47 | 48 | # Control whether we use the GHC we find on the path 49 | # system-ghc: true 50 | # 51 | # Require a specific version of stack, using version ranges 52 | # require-stack-version: -any # Default 53 | # require-stack-version: ">=1.9" 54 | # 55 | # Override the architecture used by stack, especially useful on Windows 56 | # arch: i386 57 | # arch: x86_64 58 | # 59 | # Extra directories used by stack for building 60 | # extra-include-dirs: [/path/to/dir] 61 | # extra-lib-dirs: [/path/to/dir] 62 | # 63 | # Allow a newer minor version of GHC than the snapshot specifies 64 | # compiler-check: newer-minor 65 | -------------------------------------------------------------------------------- /code/M07io.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | -- entry point of a Haskell program 4 | main :: IO () 5 | main = undefined 6 | 7 | -- predefined in Prelude: 8 | -- putChar :: Char -> IO () 9 | 10 | putString :: String -> IO () 11 | putString [] = return () 12 | -- putString (x:xs) = putChar x >>= \ _ -> putString xs 13 | putString (x:xs) = putChar x >> putString xs 14 | 15 | -- type signature is needed to avoid nasty error 16 | putString', putString'' :: String -> IO () 17 | putString' = foldr (\ c io -> (putChar c >>) io) (return ()) 18 | -- eta reduce! 19 | putString'' = foldr (\ c -> (putChar c >>)) (return ()) 20 | 21 | 22 | {- 23 | (>>) :: IO a -> IO b -> IO b 24 | io1 >> io2 = io1 >>= \ _ -> io2 25 | -} 26 | 27 | copyFile source target = 28 | readFile source >>= \xs -> (writeFile target) xs 29 | 30 | 31 | copyFile' source target = do 32 | xs <- readFile source 33 | writeFile target xs 34 | 35 | doTwice io = do 36 | io 37 | io 38 | 39 | doNot io = do 40 | return () 41 | 42 | sortFile :: FilePath -> FilePath -> IO () 43 | -- sortFile inFile outFile 44 | -- reads inFile, sorts its lines, and writes the result to out 45 | -- recall 46 | -- sort :: Ord a => [a] -> [a] 47 | -- lines :: String -> [String] 48 | -- unlines :: [String] -> String 49 | sortFile inFile outFile = do 50 | xs <- readFile inFile 51 | writeFile outFile (unlines (sort (lines xs))) 52 | 53 | sortFile' inFile outFile = 54 | readFile inFile >>= \xs -> writeFile outFile (unlines (sort (lines xs))) 55 | 56 | sortFile'' inFile outFile = 57 | readFile inFile >>= \xs -> (writeFile outFile . unlines . sort . lines) xs 58 | 59 | sortFile''' inFile outFile = 60 | readFile inFile >>= (writeFile outFile . unlines . sort . lines) 61 | 62 | sequence' :: [IO a] -> IO [a] 63 | sequence' [] = return [] 64 | sequence' (io:ios) = do 65 | x <- io 66 | xs <- sequence' ios 67 | return (x:xs) 68 | 69 | 70 | 71 | printTable :: [String] -> IO () 72 | {- 73 | printTable ["New York", "Rio", "Tokio"] 74 | outputs 75 | 1: New York 76 | 2: Rio 77 | 3: Tokio 78 | -} 79 | printTable ss = 80 | sequence_ 81 | (map g 82 | (zip [1..length ss] ss)) 83 | where 84 | g (i, str) = putStrLn (show i ++ ": " ++ str) 85 | 86 | printTable' = 87 | sequence_ . map g . zip [1..] 88 | where 89 | g (i, str) = putStrLn (show i ++ ": " ++ str) 90 | 91 | printTable'' = 92 | sequence_ . zipWith g [1..] 93 | where 94 | g i str = putStrLn (show i ++ ": " ++ str) 95 | 96 | -------------------------------------------------------------------------------- /code2019/code2019.cabal: -------------------------------------------------------------------------------- 1 | -- Initial code2019.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | -- The name of the package. 5 | name: code2019 6 | 7 | -- The package version. See the Haskell package versioning policy (PVP) 8 | -- for standards guiding when and how versions should be incremented. 9 | -- https://wiki.haskell.org/Package_versioning_policy 10 | -- PVP summary: +-+------- breaking API changes 11 | -- | | +----- non-breaking API additions 12 | -- | | | +--- code changes with no API change 13 | version: 0.1.0.0 14 | 15 | -- A short (one-line) description of the package. 16 | synopsis: Example files for lecture 17 | 18 | -- A longer description of the package. 19 | -- description: 20 | 21 | -- The license under which the package is released. 22 | license: BSD3 23 | 24 | -- The file containing the license text. 25 | license-file: LICENSE 26 | 27 | -- The package author(s). 28 | author: Peter Thiemann 29 | 30 | -- An email address to which users can send suggestions, bug reports, and 31 | -- patches. 32 | maintainer: peter.thiemann@gmail.com 33 | 34 | -- A copyright notice. 35 | -- copyright: 36 | 37 | -- category: 38 | 39 | build-type: Simple 40 | 41 | -- Extra files to be distributed with the package, such as examples or a 42 | -- README. 43 | extra-source-files: ChangeLog.md 44 | 45 | -- Constraint on the version of Cabal needed to build this package. 46 | cabal-version: >=1.10 47 | 48 | 49 | library 50 | -- Modules exported by the library. 51 | exposed-modules: M08class, Examples, M14compose, M05Lists, M13interpreter, V02, M07Laziness, M11applicatives, M10io, M12interpreter, M09functionaldata, M06Functions, M15modular, M04CardsFinal, M11parser, M10ioFinal 52 | 53 | -- Modules included in this library but not exported. 54 | -- other-modules: 55 | 56 | -- LANGUAGE extensions used by modules in this package. 57 | other-extensions: DeriveFunctor 58 | 59 | -- Other library packages from which modules are imported. 60 | build-depends: base >=4.12 && <4.13, mtl >=2.2 && <2.3 61 | 62 | -- Directories containing source files. 63 | -- hs-source-dirs: 64 | 65 | -- Base language which the package is written in. 66 | default-language: Haskell2010 67 | 68 | -------------------------------------------------------------------------------- /code2019/M10ioFinal.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | -- entry point of a Haskell program 4 | main :: IO () 5 | main = undefined 6 | 7 | -- predefined in Prelude: 8 | -- putChar :: Char -> IO () 9 | 10 | putString :: String -> IO () 11 | putString [] = return () 12 | -- putString (x:xs) = putChar x >>= \ _ -> putString xs 13 | putString (x:xs) = putChar x >> putString xs 14 | 15 | -- type signature is needed to avoid nasty error 16 | putString', putString'' :: String -> IO () 17 | putString' = foldr (\ c io -> (putChar c >>) io) (return ()) 18 | -- eta reduce! 19 | putString'' = foldr (\ c -> (putChar c >>)) (return ()) 20 | 21 | 22 | {- 23 | (>>) :: IO a -> IO b -> IO b 24 | io1 >> io2 = io1 >>= \ _ -> io2 25 | -} 26 | 27 | copyFile source target = do 28 | content <- readFile source 29 | writeFile target content 30 | 31 | doTwice :: IO a -> IO a 32 | doTwice io = do 33 | io 34 | io 35 | 36 | doNot :: IO a -> IO Int 37 | doNot io = do 38 | let x = 3 + 2 39 | return x 40 | 41 | sortFile :: FilePath -> FilePath -> IO () 42 | -- sortFile inFile outFile 43 | -- reads inFile, sorts its lines, and writes the result to out 44 | -- recall 45 | -- sort :: Ord a => [a] -> [a] 46 | -- lines :: String -> [String] 47 | -- unlines :: [String] -> String 48 | sortFile inFile outFile = do 49 | content <- readFile inFile 50 | let content2 = unlines $ sort $ lines content 51 | writeFile outFile content2 52 | 53 | sortFile2 inFile outFile = 54 | readFile inFile >>= \content -> 55 | let content2 = unlines $ sort $ lines content in 56 | writeFile outFile content2 57 | 58 | 59 | sortFile3 inFile outFile = 60 | readFile inFile >>= 61 | (writeFile outFile . unlines . sort . lines) 62 | 63 | 64 | 65 | sequence' :: [IO a] -> IO [a] 66 | sequence' [] = return [] 67 | sequence' (h:t) = do 68 | h2 <- h 69 | t2 <- sequence' t 70 | return (h2:t2) 71 | 72 | sequence_' :: [IO a] -> IO () 73 | sequence_' [] = return () 74 | sequence_' (h:t) = do 75 | h 76 | sequence_' t 77 | 78 | 79 | realPrintTable :: [String] -> IO () 80 | {- 81 | printTable ["New York", "Rio", "Tokio"] 82 | outputs 83 | 1: New York 84 | 2: Rio 85 | 3: Tokio 86 | -} 87 | printTable _ [] = return () 88 | printTable n (h:t) = do 89 | putString (show n ++ ": ") 90 | putString h 91 | putString "\n" 92 | printTable (n+1) t 93 | 94 | printTable2 ss = 95 | let ss = map putString ss in 96 | sequence' ss 97 | 98 | realPrintTable ss = printTable 1 ss 99 | 100 | -------------------------------------------------------------------------------- /code2022/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | resolver: lts-19.29 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | # previously 21 | # resolver: 22 | # url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/13.yaml 23 | 24 | # User packages to be built. 25 | # Various formats can be used as shown in the example below. 26 | # 27 | # packages: 28 | # - some-directory 29 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 30 | # subdirs: 31 | # - auto-update 32 | # - wai 33 | packages: 34 | - . 35 | # Dependency packages to be pulled from upstream that are not in the resolver. 36 | # These entries can reference officially published versions as well as 37 | # forks / in-progress versions pinned to a git hash. For example: 38 | # 39 | extra-deps: 40 | - svg-builder-0.1.1@sha256:22de54d326a6b6912e461e1302edb9108b02aac0b6a6368fcdc3c4a224d487fd,1440 41 | # - acme-missiles-0.3 42 | # - git: https://github.com/commercialhaskell/stack.git 43 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 44 | # 45 | # extra-deps: [] 46 | 47 | # Override default flag values for local packages and extra-deps 48 | # flags: {} 49 | 50 | # Extra package databases containing global packages 51 | # extra-package-dbs: [] 52 | 53 | # Control whether we use the GHC we find on the path 54 | # system-ghc: true 55 | # 56 | # Require a specific version of stack, using version ranges 57 | # require-stack-version: -any # Default 58 | # require-stack-version: ">=2.7" 59 | # 60 | # Override the architecture used by stack, especially useful on Windows 61 | # arch: i386 62 | # arch: x86_64 63 | # 64 | # Extra directories used by stack for building 65 | # extra-include-dirs: [/path/to/dir] 66 | # extra-lib-dirs: [/path/to/dir] 67 | # 68 | # Allow a newer minor version of GHC than the snapshot specifies 69 | # compiler-check: newer-minor 70 | -------------------------------------------------------------------------------- /code2024/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | resolver: lts-19.29 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | # previously 21 | # resolver: 22 | # url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/13.yaml 23 | 24 | # User packages to be built. 25 | # Various formats can be used as shown in the example below. 26 | # 27 | # packages: 28 | # - some-directory 29 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 30 | # subdirs: 31 | # - auto-update 32 | # - wai 33 | packages: 34 | - . 35 | # Dependency packages to be pulled from upstream that are not in the resolver. 36 | # These entries can reference officially published versions as well as 37 | # forks / in-progress versions pinned to a git hash. For example: 38 | # 39 | extra-deps: 40 | - svg-builder-0.1.1@sha256:22de54d326a6b6912e461e1302edb9108b02aac0b6a6368fcdc3c4a224d487fd,1440 41 | # - acme-missiles-0.3 42 | # - git: https://github.com/commercialhaskell/stack.git 43 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 44 | # 45 | # extra-deps: [] 46 | 47 | # Override default flag values for local packages and extra-deps 48 | # flags: {} 49 | 50 | # Extra package databases containing global packages 51 | # extra-package-dbs: [] 52 | 53 | # Control whether we use the GHC we find on the path 54 | # system-ghc: true 55 | # 56 | # Require a specific version of stack, using version ranges 57 | # require-stack-version: -any # Default 58 | # require-stack-version: ">=2.7" 59 | # 60 | # Override the architecture used by stack, especially useful on Windows 61 | # arch: i386 62 | # arch: x86_64 63 | # 64 | # Extra directories used by stack for building 65 | # extra-include-dirs: [/path/to/dir] 66 | # extra-lib-dirs: [/path/to/dir] 67 | # 68 | # Allow a newer minor version of GHC than the snapshot specifies 69 | # compiler-check: newer-minor 70 | -------------------------------------------------------------------------------- /code2022/src/V12.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QualifiedDo #-} 2 | module V12 where 3 | 4 | import SimplePrelude as S 5 | import Prelude () 6 | 7 | f :: (Int, Int) -> (Int, Int) 8 | g :: (Int, Int) -> Int 9 | 10 | f' :: (Int, Int) -> Int 11 | g' :: Int -> Int 12 | 13 | f (x, y) = (2*x, 2*y) 14 | g (x, y) = x 15 | 16 | f' (x, y) = 2*x 17 | g' x = x 18 | 19 | -- g . f == g' . f' 20 | 21 | g'' x = 3 * x 22 | 23 | instance Functor [] where 24 | fmap f [] = [] 25 | fmap f (x : xs) = f x : fmap f xs 26 | 27 | -- functorial law #1 28 | -- fmap id_A == id_list_A 29 | -- to show that we invoke extensionality 30 | -- for all xs :: [a] 31 | -- show `fmap id xs == xs` 32 | -- requires inductive proof 33 | {- 34 | fmap id [] == [] (by def of fmap) 35 | fmap id (x : xs) 36 | == id x : fmap id xs (by IH) 37 | == x : xs 38 | == id (x : xs) 39 | -} 40 | 41 | instance Functor Maybe where 42 | -- fmap :: (a -> b) -> (Maybe a -> Maybe b) 43 | fmap f Nothing = Nothing 44 | fmap f (Just x) = Just (f x) 45 | 46 | {- 47 | fmap id Nothing == Nothing 48 | fmap id (Just x) == Just (id x) == Just x 49 | 50 | -} 51 | 52 | data BTree a = Leaf | Node (BTree a) a (BTree a) 53 | 54 | instance Functor BTree where 55 | -- fmap :: (a -> b) -> (BTree a -> BTree b) 56 | fmap f Leaf = Leaf 57 | fmap f (Node l x r) = 58 | Node (fmap f l) (f x) (fmap f r) 59 | 60 | -- some predefined functor instances 61 | 62 | instance Functor ((,) a) where 63 | -- we consider the object map, for any type c 64 | -- f : a |-> (c, a) 65 | -- the arrow part 66 | -- fmap :: (a -> b) -> ((c, a) -> (c, b)) 67 | fmap f (c, a) = (c, f a) 68 | 69 | data Pair a b = Pair a b 70 | -- can define functor a |-> Pair c a (in Haskell) 71 | -- there is also a functor a |-> Pair a c 72 | 73 | data Diag a = Diag a a 74 | instance Functor Diag where 75 | fmap f (Diag x y) = Diag (f x) (f y) 76 | 77 | instance Functor ((->) r) where 78 | -- strongly related to the reader monad 79 | -- object part 80 | -- f : a -> (r -> a) 81 | -- arrow part 82 | -- fmap :: (a -> b) -> ((r -> a) -> (r -> b)) 83 | fmap f ra = f . ra 84 | 85 | {- just for you information: 86 | what about the object mapping 87 | f : a -> (a -> r) 88 | proposal for corresponding arrow mapping 89 | fmap :: (a -> b) -> ((a -> r) -> (b -> r)) 90 | fmap f ar = ??? 91 | doesn't work this way! 92 | instead, we need an fmap' of a different type 93 | fmap' :: (a -> b) -> ((b -> r) -> (a -> r)) 94 | fmap' f br = br . f 95 | 96 | different kind of functor, a so-called 97 | *contravariant functor* where 98 | fmap' :: (a -> b) -> (f b -> f a) 99 | -} 100 | -------------------------------------------------------------------------------- /code2024/src/V20241029.hs: -------------------------------------------------------------------------------- 1 | module V20241029 where 2 | 3 | data BTree a = 4 | Leaf | Branch { left :: BTree a, item :: a, right :: BTree a } 5 | deriving (Show) 6 | 7 | height :: BTree a -> Int 8 | height Leaf = 0 9 | height (Branch l _ r) = 1 + max (height l) (height r) 10 | 11 | height' :: BTree a -> Int 12 | height' Leaf = 0 13 | height' (Branch {left = l, right = r}) = 1 + max (height' l) (height' r) 14 | 15 | sumTree :: Num a => BTree a -> a 16 | sumTree Leaf = 0 17 | sumTree (Branch l i r) = i + sumTree l + sumTree r 18 | 19 | ---- 20 | 21 | -- assume BTree a where Ord a is a binary search tree 22 | 23 | node :: a -> BTree a 24 | node x = Branch Leaf x Leaf 25 | 26 | insert :: Ord a => BTree a -> a -> BTree a 27 | insert Leaf x = node x 28 | insert t@(Branch l i r) x = 29 | case compare x i of 30 | LT -> Branch (insert l x) i r 31 | EQ -> t 32 | GT -> Branch l i (insert r x) 33 | 34 | search :: Ord a => BTree a -> a -> Bool 35 | search Leaf x = False 36 | search (Branch l i r) x = 37 | case compare x i of 38 | LT -> search l x 39 | EQ -> True 40 | GT -> search r x 41 | 42 | --- 43 | 44 | data ATree k v = 45 | ALeaf 46 | | ABranch { aleft :: ATree k v, key :: k, value :: v, aright :: ATree k v } 47 | deriving (Show) 48 | 49 | 50 | 51 | anode :: k -> v -> ATree k v 52 | anode k v = ABranch ALeaf k v ALeaf 53 | 54 | ainsert :: Ord k => ATree k v -> k -> v -> ATree k v 55 | ainsert ALeaf k v = anode k v 56 | ainsert t@(ABranch l i w r) k v = 57 | case compare k i of 58 | LT -> ABranch (ainsert l k v) i w r 59 | EQ -> ABranch l i v r 60 | GT -> ABranch l i w (ainsert r k v) 61 | 62 | asearch :: Ord k => ATree k v -> k -> Maybe v 63 | asearch ALeaf k = Nothing 64 | asearch (ABranch l i w r) k = 65 | case compare k i of 66 | LT -> asearch l k 67 | EQ -> Just w 68 | GT -> asearch r k 69 | 70 | ---- 71 | 72 | ex1 :: (a -> b) -> Int 73 | ex1 f = 42 74 | 75 | ex2 :: (Int -> Int) -> Int 76 | ex2 f = f (f 42) 77 | 78 | ---- 79 | 80 | -- pick :: Int -> ((a, a) -> a) 81 | pick 1 = fst 82 | pick 2 = snd 83 | 84 | bpick False = fst 85 | bpick True = snd 86 | 87 | 88 | ---- 89 | -- foldr examples 90 | 91 | foldr' :: (a -> b -> b) -> b -> [a] -> b 92 | foldr' f z [] = z 93 | foldr' f z (x:xs) = x `f` foldr' f z xs 94 | 95 | 96 | -- concat ( xs1 : xs2 : ... : xsn : []) == xs1 ++ xs2 ++ ... ++ xsn ++ [] 97 | -- concat :: [[a]] -> [a] 98 | 99 | concat' :: [[a]] -> [a] 100 | concat' xs = foldr' (++) [] xs 101 | 102 | -- equivalent "eta-reduced" function defintion 103 | concat'' = foldr' (++) [] 104 | 105 | -- maximum ( x1 : x2 : ... : xn : []) == max x1 (max x2 (... (max xn minBound))) 106 | 107 | maximum' :: (Bounded a, Ord a) => [a] -> a 108 | maximum' = foldr' max minBound 109 | 110 | exm :: Int 111 | exm = maximum' [-10, 10, 42] 112 | 113 | 114 | 115 | 116 | 117 | -------------------------------------------------------------------------------- /code2024/src/V20250107.md: -------------------------------------------------------------------------------- 1 | ## t1 = λx.x 2 | bound(t1) = { x } 3 | free(t1) = ∅ 4 | 5 | ## t2 = x (λx. y) 6 | 7 | bound(t2) = { x } 8 | free(t2) = { y, x } 9 | 10 | bound(λx .y) = bound(y) ∪ { x } = { x } 11 | 12 | ## substitution 13 | 14 | (λx. y)[ x ↦ y ] 15 | ** λx is not affected because 16 | (λy. y) is a different function 17 | 18 | (λx. x)[ x ↦ y ] 19 | ** the body is not affected because 20 | (λx. y) is a different function 21 | 22 | (λy. y x)[ x ↦ y ] 23 | ** cannot substitute directly because 24 | (λy. y y) is a different function 25 | 26 | --> (λy′. y′ x)[ x ↦ y ] 27 | == (λy′. y′ y) 28 | 29 | ## Diamond Lemma: 30 | If 31 | M →β* M₁ 32 | M →β* M₂ 33 | then 34 | ∃ N such that M₁ →β* N and M₂ →β* N 35 | 36 | M 37 | / \ 38 | M₁ M₂ 39 | \ / 40 | N 41 | 42 | ## Lemma 43 | A lambda term M has at most one normal form. 44 | Suppose M has two normal forms N₁ and N₂ 45 | 46 | By def: M →β* N₁ and N₁ contains no β redexes 47 | M →β* N₂ and N₂ contains no β redexes 48 | By (CR or diamond lemma) ∃ N such that 49 | N₁ →β* N and N₂ →β* N 50 | So N₁ =α N₂ 51 | 52 | ## encoding of booleans 53 | 54 | IF (λxy.x) M N 55 | == (λb.b) (λxy.x) M N 56 | →β (λxy.x) M N 57 | →β (λy. M) N 58 | →β M 59 | 60 | ## Church numerals 61 | 62 | [1] = λf.λx.f x 63 | [2] = λf.λx. f (f x) 64 | 65 | ## Successor 66 | 67 | SUC [n] →β* [n+1] 68 | SUC = λn. λf. λx. f (n f x) 69 | or λn. λf. λx. n f (f x) 70 | 71 | ## Addition 72 | 73 | ADD [m] [n] →β* [m+n] 74 | ADD = λm. λn. λf. λx. m f (n f x) 75 | 76 | ## test for zero 77 | 78 | IF0 = λi. i (λ_. FALSE) TRUE 79 | 80 | ## pairs 81 | 82 | FST (PAIR M N) 83 | == (λp. p (λxy. x)) (λv. v M N) 84 | →β (λv. v M N) (λxy. x) 85 | →β (λxy. x) M N 86 | →β→β M 87 | 88 | ## sums 89 | 90 | LEFT = λm. λl. λr. l m 91 | RIGHT = λm. λl. λr. r m 92 | CASE = λv.v 93 | 94 | CASE (LEFT M) L R 95 | →β* (λl. λr. l M) L R 96 | →β→β L M 97 | 98 | 99 | ## the fixed point theorem 100 | 101 | Y = λ f. (λx.f (x x)) (λx.f (x x)) 102 | 103 | Y M 104 | →β (λx.M (x x)) (λx.M (x x)) 105 | →β M ((λx.M (x x)) (λx.M (x x))) 106 | ←β M (Y M) 107 | 108 | ⇒ Y M is a fixed point of M 109 | 110 | ## multiplication using fixed point 111 | ## Scott encoding 112 | ## (x′ + 1) * y = y + (x′ * y) 113 | 114 | ## without fixed point, using recursion 115 | mul = λ x y. CASE_Nat x |Zero| (λ x′. |add| y (mul x′ y)) 116 | 117 | ## with fixed point 118 | fₘ = λmul. λ x y. CASE_Nat x |Zero| (λ x′. |add| y (mul x′ y)) 119 | |mul| = Y fₘ 120 | 121 | ### unification / unifier 122 | 123 | 𝓔 = { Bool ≐ Int } 124 | ⇒ no unifier exists 125 | 126 | 𝓔 = { Bool ≐ α } 127 | ⇒ S = α ↦ Bool is most general unifier 128 | 129 | 𝓔 = { Int → α ≐ β → Bool } 130 | ⇒ S = α ↦ Bool, β ↦ Int 131 | 132 | 133 | 𝓔 = { Int → α ≐ Int → β } 134 | ⇒ S = α ↦ β is most general unifier 135 | ⇒ S′ = α ↦ T, β ↦ T is also a unifier for any T 136 | -------------------------------------------------------------------------------- /code/M16GADT.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | module M16GADT where 3 | 4 | -- ^ A regular interpreter with multiple types. 5 | 6 | data Term0 = 7 | I0 Integer 8 | | B0 Bool 9 | | Add0 Term0 Term0 10 | | Eq0 Term0 Term0 11 | deriving (Eq, Show) 12 | 13 | data Value = Int Integer | Bool Bool 14 | deriving (Eq, Show) 15 | 16 | eval0 :: Term0 -> Value 17 | eval0 (I0 n) = Int n 18 | eval0 (B0 b) = Bool b 19 | eval0 (Add0 t t') = case (eval0 t, eval0 t') of 20 | (Int i, Int i2) -> Int (i + i2) 21 | eval0 (Eq0 t t') = case (eval0 t, eval0 t') of 22 | (Int i, Int i2) -> Bool (i == i2) 23 | (Bool i, Bool i2) -> Bool (i == i2) 24 | 25 | termGood0 = Eq0 (I0 3) (Add0 (I0 2) (I0 1)) 26 | termBad0 = Eq0 (I0 3) (B0 True) 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -- ^ "Tag-less" interpreter with GADTs 40 | 41 | data Term a where 42 | I :: Integer -> Term Integer 43 | B :: Bool -> Term Bool 44 | Add :: Term Integer -> Term Integer -> Term Integer 45 | Eq :: (Eq a) => Term a -> Term a -> Term Bool 46 | 47 | eval :: Term a -> a -- This type annotation is mandatory 48 | eval (I i) = i 49 | eval (B b) = b 50 | eval (Add t t') = eval t + eval t' 51 | eval (Eq t t') = eval t == eval t' 52 | 53 | termGood = Eq (I 3) (Add (I 2) (I 1)) 54 | -- termBad = Eq (I 3) (B True) 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | -- ^ Existential types 73 | 74 | data Package where 75 | Package :: (a -> Int) -> a -> Package 76 | 77 | package1 = Package (+1) 41 78 | package2 = Package length [1,2,3] 79 | 80 | unpack :: Package -> Int 81 | unpack (Package f a) = f a 82 | 83 | -- -- This doesn't work 84 | -- getFun :: Package -> (a -> Int) -- Who is `a` ? 85 | -- getFun (Package f _) = f 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -- ^ GADT intepreter with functions 98 | 99 | data FExp e a where 100 | App :: FExp e (a -> b) -> FExp e a -> FExp e b 101 | Lam :: FExp (a, e) b -> FExp e (a -> b) 102 | Var :: Nat e a -> FExp e a 103 | 104 | data Nat e a where 105 | Zero :: Nat (a, b) a 106 | Succ :: Nat e a -> Nat (b, e) a 107 | 108 | 109 | ex1 = Lam (Var Zero) -- \lambda x.x -- the I combinator 110 | ex2 = Lam (Lam (Var (Succ Zero))) -- \x\y.x -- the K combinator 111 | ex3 = Lam (Lam (App (Var (Succ Zero)) (Var Zero))) -- \f\x. f x 112 | -- the S combinator \x\y\z -> (x y) (y z) 113 | ex4 = Lam (Lam (Lam (App (App (Var (Succ (Succ Zero))) (Var Zero)) 114 | (App (Var (Succ Zero)) (Var Zero))))) 115 | 116 | 117 | type Program a = FExp () a 118 | 119 | lookupNat :: Nat e a -> e -> a 120 | lookupNat Zero (a, b) = a 121 | lookupNat (Succ p) (_, b) = lookupNat p b 122 | 123 | feval :: e -> FExp e a -> a 124 | feval e (App f x) = (feval e f) (feval e x) 125 | feval e (Lam b) = \x -> feval (x, e) b 126 | feval e (Var p) = lookupNat p e 127 | 128 | -------------------------------------------------------------------------------- /code/M09testdata.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | import Test.QuickCheck 3 | 4 | -- |A property to test the binomial formula 5 | prop_binomi :: Integer -> Integer -> Bool 6 | prop_binomi a b = (a + b) ^ 2 == a ^ 2 + 2 * a * b + b ^ 2 7 | 8 | {- 9 | elements :: [a] -> Gen a 10 | oneof :: [Gen a] -> Gen a 11 | frequency :: [(Int,Gen a)] -> Gen a 12 | listOf :: Gen a -> Gen [a] 13 | vectorOf :: Int -> Gen a -> Gen [a] 14 | choose :: Random a => (a,a) -> Gen a 15 | -} 16 | 17 | 18 | str1 = elements "ABCDEF" 19 | str2 = elements "PQ" 20 | 21 | str12 = oneof [str1, str2] 22 | 23 | fstr12 = frequency [(6,str1), (2,str2)] 24 | 25 | data Suit = Spades | Hearts | Diamonds | Clubs 26 | deriving (Show, Eq) 27 | 28 | gSuit :: Gen Suit 29 | gSuit = elements [Spades, Hearts, Diamonds, Clubs] 30 | 31 | instance Arbitrary Suit where 32 | arbitrary = gSuit 33 | 34 | data Rank = Numeric Integer | Jack | Queen 35 | | King | Ace 36 | deriving (Show, Eq, Ord) 37 | 38 | gImage :: Gen Rank 39 | gImage = elements [Jack, Queen, King, Ace] 40 | 41 | gRank :: Gen Rank 42 | gRank = frequency [(4, gImage), (9, gNumerics)] 43 | 44 | data Card = Card { rank :: Rank, suit :: Suit } 45 | deriving (Eq, Show) 46 | 47 | gCard :: Gen Card 48 | gCard = do 49 | s <- gSuit 50 | r <- gRank 51 | return $ Card r s 52 | 53 | 54 | 55 | gEven :: Gen Integer 56 | gEven = arbitrary >>= (return . (*2)) 57 | 58 | gNonneg :: Gen Integer 59 | gNonneg = arbitrary >>= (return . abs) 60 | 61 | data Hand = One Card | More Card Hand 62 | deriving (Eq, Show) 63 | 64 | gHand :: Gen Hand 65 | gHand = oneof 66 | [gCard >>= (return . One) 67 | ,gCard >>= \c -> gHand >>= \h -> return $ More c h] 68 | 69 | 70 | --- 71 | gNumerics' :: Gen Integer 72 | gNumerics' = choose (2, 10) 73 | 74 | gNumerics :: Gen Rank 75 | gNumerics = gNumerics' >>= \n -> return (Numeric n) 76 | 77 | gNumerics1 = gNumerics' >>= \n -> (return . Numeric) n 78 | gNumerics2 = gNumerics' >>= (return . Numeric) 79 | 80 | gNumerics0 = gNumerics' >>= \n -> return $ Numeric n 81 | 82 | -- f $ x = f x 83 | 84 | ---- 85 | 86 | validRank :: Rank -> Bool 87 | validRank (Numeric n) = 2 <= n && n <= 10 88 | validRank _ = True 89 | prop_all_validRank = forAll gRank validRank 90 | 91 | 92 | instance Arbitrary Rank where 93 | arbitrary = gRank 94 | 95 | prop_all_valid_rank_collect r = collect r (validRank r) 96 | 97 | instance Arbitrary Hand where 98 | arbitrary = gHand 99 | 100 | size (One _) = 1 101 | size (More _ h) = 1+size h 102 | 103 | prop_all_hand_collect :: Hand -> Property 104 | prop_all_hand_collect h = collect (size h) True 105 | 106 | 107 | 108 | -- |Check if a list is ordered 109 | isOrdered :: Ord a => [a] -> Bool 110 | isOrdered [] = True 111 | isOrdered [_] = True 112 | isOrdered (x1:x2:xs) = x1 <= x2 && isOrdered (x2:xs) 113 | 114 | prop_insert_1 :: Integer -> [Integer] -> Bool 115 | prop_insert_1 x xs = isOrdered (insert x xs) 116 | 117 | prop_insert_2 :: Integer -> [Integer] -> Property 118 | prop_insert_2 x xs = isOrdered xs ==> isOrdered (insert x xs) 119 | 120 | prop_insert_3 x = 121 | forAll orderedList (\xs->isOrdered (insert x xs)) 122 | 123 | -------------------------------------------------------------------------------- /code2022/src/V13.hs: -------------------------------------------------------------------------------- 1 | module V13 where 2 | 3 | import Data.Char 4 | 5 | newtype Parser tok res = Parser ([tok] -> [(res, [tok])]) 6 | exParser (Parser p) = p 7 | 8 | -- pempty recognizes the empty language 9 | pempty :: Parser tok res 10 | pempty = Parser $ \ts -> [] 11 | 12 | -- succeed recognizes the empty string 13 | 14 | succeed :: r -> Parser tok r 15 | succeed r = Parser $ \ts -> [(r, ts)] 16 | 17 | -- satisfy checks first token using a predicate `p` 18 | 19 | satisfy :: (t -> Bool) -> Parser t t 20 | satisfy p = Parser helper 21 | where 22 | helper (t : ts) | p t = [(t, ts)] 23 | helper _ = [] 24 | 25 | -- msatisfy checks and returns a substitute for tok 26 | 27 | msatisfy :: (t -> Maybe r) -> Parser t r 28 | msatisfy p = Parser helper 29 | where 30 | helper (t : ts) = 31 | case p t of 32 | Just r -> [(r, ts)] 33 | Nothing -> [] 34 | helper [] = [] 35 | 36 | 37 | -- check literal occurrence of a topken 38 | 39 | lit :: Eq t => t -> Parser t t 40 | lit t = satisfy (== t) 41 | 42 | -- alternative 43 | 44 | palt :: Parser t r -> Parser t r -> Parser t r 45 | palt p1 p2 = Parser $ \ts -> exParser p1 ts ++ exParser p2 ts 46 | 47 | -- sequence 48 | 49 | pseq :: Parser t (s -> r) -> Parser t s -> Parser t r 50 | pseq pf pa = 51 | Parser $ \ts -> 52 | [ (f a, ts'') 53 | | (f, ts') <- exParser pf ts 54 | , (a, ts'') <- exParser pa ts' ] 55 | 56 | -- map 57 | 58 | pmap :: (s -> r) -> Parser t s -> Parser t r 59 | pmap f p = Parser $ \ts -> [ (f a, ts') | (a, ts') <- exParser p ts ] 60 | 61 | -- 62 | 63 | instance Functor (Parser t) where 64 | fmap = pmap 65 | 66 | instance Applicative (Parser t) where 67 | -- pure :: a -> Parser t a 68 | pure = succeed 69 | -- (<*>) :: Parser t (s -> r) -> Parser t s -> Parser t r 70 | (<*>) = pseq 71 | 72 | instance Monad (Parser t) where 73 | -- Parser t a -> (a -> Parser t b) -> Parser t b 74 | pa >>= fb = Parser $ \ts -> 75 | [ (b, ts'') 76 | | (a, ts') <- exParser pa ts 77 | , (b, ts'') <- exParser (fb a) ts' 78 | ] 79 | 80 | -- need a parser for repetitions 81 | 82 | many :: Parser t r -> Parser t [r] 83 | many p = 84 | do r <- p 85 | rs <- many p 86 | return (r : rs) 87 | `palt` 88 | succeed [] 89 | 90 | -- ast of arithmetic expressions 91 | 92 | data Term = Con Integer | Bin Term Op Term 93 | deriving (Eq, Show) 94 | data Op = Add | Sub | Mul | Div 95 | deriving (Eq, Show) 96 | 97 | -- a parser for positive integers 98 | 99 | digitValue :: Char -> Int 100 | digitValue x = ord x - 48 101 | 102 | pdigit :: Parser Char Int 103 | pdigit = fmap digitValue $ satisfy isDigit 104 | 105 | pdigits :: Parser Char String 106 | pdigits = do 107 | x <- satisfy isDigit 108 | xs <- many (satisfy isDigit) 109 | return (x : xs) 110 | 111 | pnum :: Parser Char Integer 112 | pnum = pmap read pdigits 113 | 114 | pterm :: Parser Char Term 115 | pterm = pmap Con pnum 116 | 117 | pterm' = (pure Con <*> pnum) 118 | `palt` 119 | (pure Bin <*> pterm' <*> pop <*> pterm') 120 | 121 | mop :: Char -> Maybe Op 122 | mop '+' = Just Add 123 | mop '-' = Just Sub 124 | mop '*' = Just Mul 125 | mop '/' = Just Div 126 | mop _ = Nothing 127 | 128 | pop :: Parser Char Op 129 | pop = msatisfy mop 130 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Core latex/pdflatex auxiliary files: 2 | *.aux 3 | *.lof 4 | *.log 5 | *.lot 6 | *.fls 7 | *.out 8 | *.toc 9 | *.fmt 10 | *.fot 11 | *.cb 12 | *.cb2 13 | 14 | *~ 15 | 16 | ## Intermediate documents: 17 | *.dvi 18 | *-converted-to.* 19 | # these rules might exclude image files for figures etc. 20 | # *.ps 21 | # *.eps 22 | # *.pdf 23 | 24 | ## Generated if empty string is given at "Please type another file name for output:" 25 | .pdf 26 | 27 | ## Bibliography auxiliary files (bibtex/biblatex/biber): 28 | *.bbl 29 | *.bcf 30 | *.blg 31 | *-blx.aux 32 | *-blx.bib 33 | *.run.xml 34 | 35 | ## Build tool auxiliary files: 36 | *.fdb_latexmk 37 | *.synctex 38 | *.synctex(busy) 39 | *.synctex.gz 40 | *.synctex.gz(busy) 41 | *.pdfsync 42 | 43 | ## Auxiliary and intermediate files from other packages: 44 | # algorithms 45 | *.alg 46 | *.loa 47 | 48 | # achemso 49 | acs-*.bib 50 | 51 | # amsthm 52 | *.thm 53 | 54 | # beamer 55 | *.nav 56 | *.pre 57 | *.snm 58 | *.vrb 59 | *.rel 60 | 61 | # changes 62 | *.soc 63 | 64 | # cprotect 65 | *.cpt 66 | 67 | # elsarticle (documentclass of Elsevier journals) 68 | *.spl 69 | 70 | # endnotes 71 | *.ent 72 | 73 | # fixme 74 | *.lox 75 | 76 | # feynmf/feynmp 77 | *.mf 78 | *.mp 79 | *.t[1-9] 80 | *.t[1-9][0-9] 81 | *.tfm 82 | 83 | #(r)(e)ledmac/(r)(e)ledpar 84 | *.end 85 | *.?end 86 | *.[1-9] 87 | *.[1-9][0-9] 88 | *.[1-9][0-9][0-9] 89 | *.[1-9]R 90 | *.[1-9][0-9]R 91 | *.[1-9][0-9][0-9]R 92 | *.eledsec[1-9] 93 | *.eledsec[1-9]R 94 | *.eledsec[1-9][0-9] 95 | *.eledsec[1-9][0-9]R 96 | *.eledsec[1-9][0-9][0-9] 97 | *.eledsec[1-9][0-9][0-9]R 98 | 99 | # glossaries 100 | *.acn 101 | *.acr 102 | *.glg 103 | *.glo 104 | *.gls 105 | *.glsdefs 106 | 107 | # gnuplottex 108 | *-gnuplottex-* 109 | 110 | # gregoriotex 111 | *.gaux 112 | *.gtex 113 | 114 | # hyperref 115 | *.brf 116 | 117 | # knitr 118 | *-concordance.tex 119 | # TODO Comment the next line if you want to keep your tikz graphics files 120 | *.tikz 121 | *-tikzDictionary 122 | 123 | # listings 124 | *.lol 125 | 126 | # makeidx 127 | *.idx 128 | *.ilg 129 | *.ind 130 | *.ist 131 | 132 | # minitoc 133 | *.maf 134 | *.mlf 135 | *.mlt 136 | *.mtc[0-9]* 137 | *.slf[0-9]* 138 | *.slt[0-9]* 139 | *.stc[0-9]* 140 | 141 | # minted 142 | _minted* 143 | *.pyg 144 | 145 | # morewrites 146 | *.mw 147 | 148 | # nomencl 149 | *.nlo 150 | 151 | # pax 152 | *.pax 153 | 154 | # pdfpcnotes 155 | *.pdfpc 156 | 157 | # sagetex 158 | *.sagetex.sage 159 | *.sagetex.py 160 | *.sagetex.scmd 161 | 162 | # scrwfile 163 | *.wrt 164 | 165 | # sympy 166 | *.sout 167 | *.sympy 168 | sympy-plots-for-*.tex/ 169 | 170 | # pdfcomment 171 | *.upa 172 | *.upb 173 | 174 | # pythontex 175 | *.pytxcode 176 | pythontex-files-*/ 177 | 178 | # thmtools 179 | *.loe 180 | 181 | # TikZ & PGF 182 | *.dpth 183 | *.md5 184 | *.auxlock 185 | 186 | # todonotes 187 | *.tdo 188 | 189 | # easy-todo 190 | *.lod 191 | 192 | # xindy 193 | *.xdy 194 | 195 | # xypic precompiled matrices 196 | *.xyc 197 | 198 | # endfloat 199 | *.ttt 200 | *.fff 201 | 202 | # Latexian 203 | TSWLatexianTemp* 204 | 205 | ## Editors: 206 | # WinEdt 207 | *.bak 208 | *.sav 209 | 210 | # Texpad 211 | .texpadtmp 212 | 213 | # Kile 214 | *.backup 215 | 216 | # KBibTeX 217 | *~[0-9]* 218 | 219 | # auto folder when using emacs and auctex 220 | /auto/* 221 | */auto/* 222 | 223 | # expex forward references with \gathertags 224 | *-tags.tex 225 | 226 | .DS_Store 227 | 228 | . 229 | .stack-work -------------------------------------------------------------------------------- /slides/02-haskell-functions.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \documentclass{beamer} 3 | 4 | \input{common} 5 | %%% frontmatter 6 | \input{frontmatter} 7 | \subtitle{Functions} 8 | \usepackage{tikz} 9 | 10 | 11 | \begin{document} 12 | 13 | \begin{frame} 14 | \titlepage 15 | \end{frame} 16 | %---------------------------------------------------------------------- 17 | \begin{frame}[fragile] 18 | \frametitle{Function definition by cases} 19 | \begin{block}<+->{Example: Absolute value} 20 | Find the absolute value of a number 21 | \begin{itemize} 22 | \item if \lstinline{x} is positive, result is \lstinline{x} 23 | \item if \lstinline{x} is negative, result is \lstinline{-x} 24 | \end{itemize} 25 | \end{block} 26 | \begin{block}<+->{Definition} 27 | \begin{lstlisting} 28 | -- returns the absolute value of x 29 | absolute :: Integer -> Integer 30 | absolute x | x >= 0 = x 31 | absolute x | x < 0 = - x 32 | \end{lstlisting} 33 | \end{block} 34 | \end{frame} 35 | 36 | \begin{frame}[fragile,fragile] 37 | \frametitle{Alternative styles of definition} 38 | 39 | \begin{block}{One equation} 40 | \begin{lstlisting} 41 | absolute' x | x >= 0 = x 42 | | x < 0 = -x 43 | \end{lstlisting} 44 | \end{block} 45 | 46 | \begin{block}{Using if-then-else in an expression} 47 | \begin{lstlisting} 48 | absolute'' x = if x >= 0 then x else -x 49 | \end{lstlisting} 50 | \end{block} 51 | \end{frame} 52 | 53 | \begin{frame}[fragile] 54 | \frametitle{Recursion} 55 | Standard approach to define functions in functional languages 56 | (\textbf{no loops!}) 57 | 58 | \begin{block}{Example: power} 59 | Compute \lstinline|x^n| without using the built-in operator 60 | \begin{lstlisting} 61 | -- compute x to n-th power 62 | power x 0 = 1 63 | power x n | n > 0 = x * power x (n - 1) 64 | \end{lstlisting} 65 | \end{block} 66 | \end{frame} 67 | 68 | \begin{frame} 69 | \frametitle{Example: Counting intersections} 70 | \begin{block}<+->{Task} 71 | \begin{itemize} 72 | \item Consider $n$ non-parallel lines in the plane 73 | \item How often do these lines intersect (at most)? Call this 74 | number $I (n)$. 75 | \end{itemize} 76 | \end{block} 77 | \begin{block}<+->{Base case: $n=0$ (as simple as possible!)} 78 | \begin{itemize} 79 | \item<+-> Zero lines produce zero intersections: $I(0) = 0$ 80 | \end{itemize} 81 | \end{block} 82 | \begin{block}<+->{Inductive case: $n>0$} 83 | \begin{itemize} 84 | \item<+-> One line can intersect with the remaining 85 | lines at most $n-1$ times. 86 | \item<+-> Remove this line. The remaining lines can intersect at 87 | most $I (n-1)$ times 88 | \item<+-> Combine the above to $I (n) = I (n-1) + n-1$ 89 | \end{itemize} 90 | \end{block} 91 | \end{frame} 92 | \begin{frame}[fragile] 93 | \frametitle{Definition} 94 | \begin{block}{Counting intersections} 95 | \begin{lstlisting} 96 | -- max number of intersections of n lines 97 | nisect :: Integer -> Integer 98 | nisect 0 = 0 99 | nisect n | n > 0 = nisect (n - 1) + n - 1 100 | \end{lstlisting} 101 | \end{block} 102 | \end{frame} 103 | %---------------------------------------------------------------------- 104 | 105 | \begin{frame} 106 | \frametitle{Questions?} 107 | \begin{center} 108 | \tikz{\node[scale=15] at (0,0){?};} 109 | \end{center} 110 | \end{frame} 111 | 112 | 113 | \end{document} 114 | 115 | %%% Local Variables: 116 | %%% mode: latex 117 | %%% TeX-master: t 118 | %%% End: 119 | -------------------------------------------------------------------------------- /code/M04Cards.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | data Suit = Spades | Hearts | Diamonds | Clubs 4 | deriving (Show, Eq) 5 | 6 | data Color = Black | Red 7 | deriving (Show) 8 | 9 | -- Define a color function by pattern matching 10 | color :: Suit -> Color 11 | color Spades = Black 12 | color Clubs = Black 13 | color Diamonds = Red 14 | color Hearts = Red 15 | 16 | data Rank = Numeric Integer | Jack | Queen 17 | | King | Ace 18 | deriving (Show, Eq, Ord) 19 | 20 | -- rankBeats r1 r2 returns True, if r1 beats r2 21 | rankBeats :: Rank -> Rank -> Bool 22 | rankBeats _ Ace = False 23 | rankBeats Ace _ = True 24 | rankBeats _ King = False 25 | rankBeats King _ = True 26 | rankBeats _ Queen = False 27 | rankBeats Queen _ = True 28 | rankBeats _ Jack = False 29 | rankBeats Jack _ = True 30 | rankBeats (Numeric n1) (Numeric n2) = n1 > n2 31 | -- ^^ pattern match on constructor 32 | -- yields its argument 33 | 34 | rankBeats' r1 r2 = r1 > r2 35 | 36 | prop_rankBeats :: Rank -> Rank -> Bool 37 | prop_rankBeats r1 r2 = rankBeats r1 r2 == rankBeats' r1 r2 38 | 39 | rankEquals :: Rank -> Rank -> Bool 40 | rankEquals Ace Ace = True 41 | rankEquals King King = True 42 | rankEquals Queen Queen = True 43 | rankEquals Jack Jack = True 44 | rankEquals (Numeric m) (Numeric n) = m == n 45 | rankEquals _ _ = False 46 | 47 | {- this is a block comment {- that can be nested -} 48 | -} 49 | 50 | -- |playing cards 51 | {- 52 | data Card = Card Rank Suit 53 | deriving (Show) 54 | rank :: Card -> Rank 55 | rank (Card r s) = r 56 | suit :: Card -> Suit 57 | suit (Card r s) = s 58 | -} 59 | 60 | 61 | data Card = Card { rank :: Rank, suit :: Suit } 62 | deriving (Show) 63 | 64 | cardBeats :: Card -> Card -> Bool 65 | cardBeats givenCard c = suit givenCard == suit c 66 | && rankBeats (rank givenCard) 67 | (rank c) 68 | aceOfSpades = Card Ace Spades 69 | tenOfHearts = Card (Numeric 10) Hearts 70 | queenOfHearts = Card Queen Hearts 71 | jackOfClub = Card Jack Clubs 72 | 73 | data Hand = Last Card | Next Card Hand 74 | deriving (Show) 75 | 76 | -- choose a card from the hand that beats the given card if possible 77 | -- but it does not follow suit! 78 | chooseCard :: Card -> Hand -> Card 79 | chooseCard c (Last card) = card 80 | chooseCard c (Next card hand) = 81 | if cardBeats card c 82 | then card 83 | else chooseCard c hand 84 | 85 | exampleHand = Next jackOfClub (Next queenOfHearts (Next tenOfHearts (Last aceOfSpades))) 86 | tenOfClubs = Card (Numeric 10) Clubs 87 | 88 | -- the Maybe type 89 | data Maybe' a = Nothing' | Just' a 90 | 91 | -- like chooseCard, but follow suit 92 | chooseCard' :: Card -> Hand -> Card 93 | chooseCard' c h = 94 | chooseCardFollowing c h Nothing 95 | 96 | -- | take given card, current hand, and maybe a card of same suit as given card 97 | chooseCardFollowing :: Card -> Hand -> Maybe Card -> Card 98 | chooseCardFollowing c (Last card) Nothing = card 99 | chooseCardFollowing c (Last card) (Just cardSameSuit) = 100 | if cardBeats card c 101 | then card 102 | else cardSameSuit 103 | chooseCardFollowing c (Next card hand) m = 104 | if cardBeats card c 105 | then card 106 | else if suit c == suit card 107 | then chooseCardFollowing c hand (Just card) 108 | else chooseCardFollowing c hand m 109 | 110 | {- alternative way of writing this: 111 | else chooseCardFollowing c hand 112 | (if suit c == suit card then Just card else m) 113 | -} 114 | -------------------------------------------------------------------------------- /code2022/src/M14compose.hs: -------------------------------------------------------------------------------- 1 | module M14compose where 2 | 3 | newtype Comp f g a = Comp { exComp :: (f (g a)) } 4 | 5 | instance (Functor f, Functor g) => Functor (Comp f g) where 6 | -- fmap :: (a -> b) -> Comp f g a -> Comp f g b 7 | -- fga :: f (g a) 8 | fmap h (Comp fga) = Comp $ fmap (fmap h) fga 9 | 10 | -- fmap (h1 . h2) fga 11 | -- == fmap_f (fmap_g (h1 . h2)) fga 12 | -- == fmap_f (fmap_g h1 . fmap_g h2)) fga 13 | -- == (fmap_f (fmap_g h1) . fmap_f (fmap_g h2)) fga 14 | -- == (fmap h1 . fmap h2) fga 15 | 16 | cv = Comp [Just 14, Just 2, Nothing, Just 4711] 17 | 18 | -- (>>=) :: m a -> (a -> m b) -> m b 19 | 20 | instance (Applicative f, Applicative g) => Applicative (Comp f g) where 21 | -- pure :: a -> f (g a) 22 | -- for g: pure :: a -> g a 23 | -- for f: pure :: (g a) -> f (g a) 24 | pure a = Comp $ pure (pure a) 25 | Comp fff <*> Comp aaa = Comp $ 26 | -- fff :: f (g (a -> b)) 27 | -- aaa :: f (g a) 28 | -- result :: f (g b) 29 | fmap (<*>) fff -- :: f (g a -> g b) 30 | <*> aaa 31 | 32 | cfff = Comp [Just (+1), Nothing, Just (*2)] 33 | vaaa = Comp [Nothing, Just 42, Just 17] 34 | 35 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } 36 | instance Functor (MaybeT m) where 37 | fmap = undefined 38 | instance Applicative (MaybeT m) where 39 | pure = undefined 40 | (<*>) = undefined 41 | 42 | instance (Monad m) => Monad (MaybeT m) where 43 | return a = MaybeT $ return (return a) 44 | (MaybeT mmx) >>= f = MaybeT $ do 45 | mx <- mmx 46 | case mx of 47 | Nothing -> return Nothing 48 | Just x -> runMaybeT (f x) 49 | fail str = MaybeT $ return Nothing 50 | 51 | {- 52 | instance MonadTrans MaybeT where 53 | lift mx = MaybeT $ mx >>= (return . Just) 54 | -} 55 | 56 | newtype ReaderT m r a = ReaderT { runReaderT :: r -> m a } 57 | instance Functor (ReaderT m r) where 58 | fmap = undefined 59 | instance Applicative (ReaderT m r) where 60 | pure = undefined 61 | (<*>) = undefined 62 | instance (Monad m) => Monad (ReaderT m r) where 63 | return a = ReaderT $ const (return a) 64 | (ReaderT rma) >>= f = 65 | ReaderT $ \ r -> do 66 | a <- rma r 67 | runReaderT (f a) r 68 | fail str = ReaderT $ const (fail str) 69 | 70 | ask :: Monad m => ReaderT m r r 71 | ask = ReaderT $ \r -> return r 72 | 73 | -- StateT s Maybe a === s -> Maybe (a, s) 74 | -- MaybeT (ST s) a === s -> (Maybe a, s) 75 | 76 | data Term = Var String | Con Integer | Bin Term Op Term 77 | deriving (Eq, Show) 78 | 79 | data Op = Add | Sub | Mul | Div 80 | deriving (Eq, Show) 81 | 82 | newtype Identity a = Identity{ runIdentity :: a } 83 | 84 | instance Functor Identity where 85 | fmap h (Identity a) = Identity (h a) 86 | instance Applicative Identity where 87 | pure a = Identity a 88 | Identity f <*> Identity a = Identity (f a) 89 | instance Monad Identity where 90 | return = Identity 91 | Identity a >>= f = f a 92 | 93 | type M = ReaderT (MaybeT Identity) [(String, Integer)] 94 | 95 | applyOp :: Op -> Integer -> Integer -> M Integer 96 | applyOp Add x y = return (x + y) 97 | applyOp Div x y | y == 0 = fail "division by zero" 98 | | otherwise = return ( x `div` y ) 99 | 100 | eval :: Term -> M Integer 101 | eval (Var x) = do 102 | env <- ask 103 | case lookup x env of 104 | Just i -> return i 105 | Nothing -> fail "unknown variable" 106 | eval (Con i) = return i 107 | eval (Bin l o r) = do 108 | vl <- eval l 109 | vr <- eval r 110 | applyOp o vl vr 111 | 112 | runM t env = runIdentity (runMaybeT (runReaderT (eval t) env)) 113 | -------------------------------------------------------------------------------- /code2022/src/SimplePrelude.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2022 University of Freiburg 2 | -- Janek Spaderna 3 | -- 4 | -- Add these two import statements at the top of your file 5 | -- 6 | -- import SimplePrelude as S 7 | -- import Prelude () 8 | -- 9 | -- To write `do` blocks which use the operators from SimplePrelude instead of 10 | -- Prelude enable the QualifiedDo extension and write your `do` blocks as 11 | -- `SimplePrelude.do` (or import it `as XYZ` and use `XYZ.do`): 12 | -- 13 | -- {-# LANGUAGE QualifiedDo #-} 14 | -- 15 | -- liftM f ma = SimplePrelude.do 16 | -- a <- ma 17 | -- return (f a) 18 | -- 19 | -- 20 | {-# LANGUAGE ImportQualifiedPost #-} 21 | 22 | module SimplePrelude 23 | ( -- * Re-exports 24 | module Prelude, 25 | 26 | -- * @Functor@ 27 | Functor (..), 28 | (<$>), 29 | 30 | -- * @Applicative@ 31 | Applicative (..), 32 | liftA2, 33 | (<*), 34 | (*>), 35 | 36 | -- * @Monad@ 37 | Monad (..), 38 | (>>), 39 | (=<<), 40 | 41 | -- * @MonadFail@ 42 | MonadFail (..), 43 | ) 44 | where 45 | 46 | import Test.QuickCheck 47 | import Prelude hiding 48 | ( Applicative (..), 49 | Functor (..), 50 | Monad (..), 51 | MonadFail (..), 52 | (<$>), 53 | (=<<), 54 | ) 55 | import Prelude qualified as P 56 | 57 | ------------------------------------------------------------------------------- 58 | -- Typeclass hierarchy 59 | 60 | class Functor f where 61 | fmap :: (a -> b) -> f a -> f b 62 | 63 | class Applicative f where 64 | pure :: a -> f a 65 | (<*>) :: f (a -> b) -> f a -> f b 66 | 67 | class Monad m where 68 | return :: a -> m a 69 | (>>=) :: m a -> (a -> m b) -> m b 70 | 71 | class Monad m => MonadFail m where 72 | fail :: String -> m a 73 | 74 | ------------------------------------------------------------------------------- 75 | -- Functor based Prelude functions 76 | 77 | infixl 4 <$> 78 | 79 | (<$>) :: Functor f => (a -> b) -> f a -> f b 80 | (<$>) = fmap 81 | 82 | ------------------------------------------------------------------------------- 83 | -- Applicative based Prelude functions 84 | 85 | infixl 4 <*>, <*, *> 86 | 87 | liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c 88 | liftA2 ab2c fa fb = pure ab2c <*> fa <*> fb 89 | 90 | (<*) :: Applicative f => f a -> f b -> f a 91 | (<*) = liftA2 const 92 | 93 | (*>) :: Applicative f => f a -> f b -> f b 94 | (*>) = liftA2 (const id) 95 | 96 | ------------------------------------------------------------------------------- 97 | -- Monad based Prelude functions 98 | 99 | infixl 1 >>=, >> 100 | 101 | infixr 1 =<< 102 | 103 | (>>) :: Monad m => m a -> m b -> m b 104 | ma >> mb = ma >>= \_ -> mb 105 | 106 | (=<<) :: Monad m => (a -> m b) -> m a -> m b 107 | (=<<) = flip (>>=) 108 | 109 | ------------------------------------------------------------------------------- 110 | -- IO instances 111 | 112 | instance Functor P.IO where 113 | fmap = P.fmap 114 | 115 | instance Applicative P.IO where 116 | pure = P.pure 117 | (<*>) = (P.<*>) 118 | 119 | instance Monad P.IO where 120 | return = P.return 121 | (>>=) = (P.>>=) 122 | 123 | instance MonadFail P.IO where 124 | fail = P.fail 125 | 126 | ------------------------------------------------------------------------------- 127 | -- Test.QuickCheck.Gen instances 128 | 129 | instance Functor Gen where 130 | fmap = P.fmap 131 | 132 | instance Applicative Gen where 133 | pure = P.pure 134 | (<*>) = (P.<*>) 135 | 136 | instance Monad Gen where 137 | return = P.return 138 | (>>=) = (P.>>=) 139 | -------------------------------------------------------------------------------- /code2024/src/SimplePrelude.hs: -------------------------------------------------------------------------------- 1 | -- Copyright 2022 University of Freiburg 2 | -- Janek Spaderna 3 | -- 4 | -- Add these two import statements at the top of your file 5 | -- 6 | -- import SimplePrelude as S 7 | -- import Prelude () 8 | -- 9 | -- To write `do` blocks which use the operators from SimplePrelude instead of 10 | -- Prelude enable the QualifiedDo extension and write your `do` blocks as 11 | -- `SimplePrelude.do` (or import it `as XYZ` and use `XYZ.do`): 12 | -- 13 | -- {-# LANGUAGE QualifiedDo #-} 14 | -- 15 | -- liftM f ma = SimplePrelude.do 16 | -- a <- ma 17 | -- return (f a) 18 | -- 19 | -- 20 | {-# LANGUAGE ImportQualifiedPost #-} 21 | 22 | module SimplePrelude 23 | ( -- * Re-exports 24 | module Prelude, 25 | 26 | -- * @Functor@ 27 | Functor (..), 28 | (<$>), 29 | 30 | -- * @Applicative@ 31 | Applicative (..), 32 | liftA2, 33 | (<*), 34 | (*>), 35 | 36 | -- * @Monad@ 37 | Monad (..), 38 | (>>), 39 | (=<<), 40 | 41 | -- * @MonadFail@ 42 | MonadFail (..), 43 | ) 44 | where 45 | 46 | import Test.QuickCheck 47 | import Prelude hiding 48 | ( Applicative (..), 49 | Functor (..), 50 | Monad (..), 51 | MonadFail (..), 52 | (<$>), 53 | (=<<), 54 | ) 55 | import Prelude qualified as P 56 | 57 | ------------------------------------------------------------------------------- 58 | -- Typeclass hierarchy 59 | 60 | class Functor f where 61 | fmap :: (a -> b) -> f a -> f b 62 | 63 | class Applicative f where 64 | pure :: a -> f a 65 | (<*>) :: f (a -> b) -> f a -> f b 66 | 67 | class Monad m where 68 | return :: a -> m a 69 | (>>=) :: m a -> (a -> m b) -> m b 70 | 71 | class Monad m => MonadFail m where 72 | fail :: String -> m a 73 | 74 | ------------------------------------------------------------------------------- 75 | -- Functor based Prelude functions 76 | 77 | infixl 4 <$> 78 | 79 | (<$>) :: Functor f => (a -> b) -> f a -> f b 80 | (<$>) = fmap 81 | 82 | ------------------------------------------------------------------------------- 83 | -- Applicative based Prelude functions 84 | 85 | infixl 4 <*>, <*, *> 86 | 87 | liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c 88 | liftA2 ab2c fa fb = pure ab2c <*> fa <*> fb 89 | 90 | (<*) :: Applicative f => f a -> f b -> f a 91 | (<*) = liftA2 const 92 | 93 | (*>) :: Applicative f => f a -> f b -> f b 94 | (*>) = liftA2 (const id) 95 | 96 | ------------------------------------------------------------------------------- 97 | -- Monad based Prelude functions 98 | 99 | infixl 1 >>=, >> 100 | 101 | infixr 1 =<< 102 | 103 | (>>) :: Monad m => m a -> m b -> m b 104 | ma >> mb = ma >>= \_ -> mb 105 | 106 | (=<<) :: Monad m => (a -> m b) -> m a -> m b 107 | (=<<) = flip (>>=) 108 | 109 | ------------------------------------------------------------------------------- 110 | -- IO instances 111 | 112 | instance Functor P.IO where 113 | fmap = P.fmap 114 | 115 | instance Applicative P.IO where 116 | pure = P.pure 117 | (<*>) = (P.<*>) 118 | 119 | instance Monad P.IO where 120 | return = P.return 121 | (>>=) = (P.>>=) 122 | 123 | instance MonadFail P.IO where 124 | fail = P.fail 125 | 126 | ------------------------------------------------------------------------------- 127 | -- Test.QuickCheck.Gen instances 128 | 129 | instance Functor Gen where 130 | fmap = P.fmap 131 | 132 | instance Applicative Gen where 133 | pure = P.pure 134 | (<*>) = (P.<*>) 135 | 136 | instance Monad Gen where 137 | return = P.return 138 | (>>=) = (P.>>=) 139 | -------------------------------------------------------------------------------- /code2019/M16GADT.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | module M16GADT where 3 | 4 | -- ^ A regular interpreter with multiple types. 5 | 6 | data Term0 = 7 | I0 Integer 8 | | B0 Bool 9 | | Add0 Term0 Term0 10 | | Eq0 Term0 Term0 11 | deriving (Eq, Show) 12 | 13 | data Value = Int Integer | Bool Bool 14 | deriving (Eq, Show) 15 | 16 | eval0 :: Term0 -> Value 17 | eval0 (I0 n) = Int n 18 | eval0 (B0 b) = Bool b 19 | eval0 (Add0 t t') = case (eval0 t, eval0 t') of 20 | (Int i, Int i2) -> Int (i + i2) 21 | eval0 (Eq0 t t') = case (eval0 t, eval0 t') of 22 | (Int i, Int i2) -> Bool (i == i2) 23 | (Bool i, Bool i2) -> Bool (i == i2) 24 | 25 | termGood0 = Eq0 (I0 3) (Add0 (I0 2) (I0 1)) 26 | termBad0 = Eq0 (I0 3) (B0 True) 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -- ^ "Tag-less" interpreter with GADTs 40 | 41 | data Term a where 42 | I :: Integer -> Term Integer 43 | B :: Bool -> Term Bool 44 | D :: Double -> Term Double 45 | N :: (Num x) => x -> Term x 46 | Add :: (Num x) => Term x -> Term x -> Term x 47 | Eq :: (Eq x) => Term x -> Term x -> Term Bool 48 | 49 | eval :: Term a -> a -- This type annotation is mandatory 50 | eval (I i) = i 51 | eval (B b) = b 52 | eval (D d) = d 53 | eval (N n) = n 54 | eval (Add t t') = eval t + eval t' 55 | eval (Eq t t') = eval t == eval t' 56 | 57 | termGood = Eq (I 3) (Add (I 2) (I 1)) 58 | -- termBad = Eq (I 3) (B True) 59 | 60 | 61 | -- de Bruijn notation (a calculus of nameless dummies) 62 | example = \ x -> x -- \ 0 -- refers to the next enclosing lambda 63 | exampl0 = \ x -> \ y -> x -- \ \ 1 -- refers to the outermost lambda 64 | exampl1 = \ f -> \ x -> f x -- \ \ (1 0) 65 | exampl2 = \ x y z -> (x z) (y z) -- \ \ \ (2 0) (1 0) 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | ve :: (Int, (Int, (Bool, ()))) 78 | ve = undefined 79 | 80 | 81 | 82 | 83 | 84 | -- ^ GADT interpreter with functions 85 | -- "typed lambda calculus with constants" 86 | 87 | data FExp e a where 88 | Con :: a -> FExp e a 89 | App :: FExp e (a -> b) -> FExp e a -> FExp e b 90 | Lam :: FExp (a, e) b -> FExp e (a -> b) 91 | Var :: Nat e a -> FExp e a 92 | 93 | data Nat e a where 94 | Zero :: Nat (a, b) a 95 | Succ :: Nat e a -> Nat (b, e) a 96 | 97 | -- \lambda x.x -- the I combinator 98 | ex1 = Lam (Var Zero) 99 | -- \x\y.x -- the K combinator 100 | ex2 = Lam (Lam (Var (Succ Zero))) 101 | -- \f\x. f x 102 | ex3 = Lam (Lam (App (Var (Succ Zero)) (Var Zero))) 103 | -- the S combinator \x\y\z -> (x y) (y z) 104 | ex4 = Lam (Lam (Lam (App (App (Var (Succ (Succ Zero))) (Var Zero)) 105 | (App (Var (Succ Zero)) (Var Zero))))) 106 | 107 | 108 | type Program a = FExp () a 109 | 110 | lookupNat :: Nat e a -> e -> a 111 | lookupNat Zero (a, b) = a 112 | lookupNat (Succ p) (_, b) = lookupNat p b 113 | 114 | feval :: e -> FExp e a -> a 115 | feval e (Con v) = v 116 | feval e (App f x) = (feval e f) (feval e x) 117 | feval e (Lam b) = \x -> feval (x, e) b 118 | feval e (Var p) = lookupNat p e 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | -- ^ Existential types 133 | 134 | data Package where 135 | Package :: (a -> Int) -> a -> Package 136 | 137 | package1 = Package (+1) 41 138 | package2 = Package length [1,2,3] 139 | package3 = Package length "sdkfh" 140 | package4 = Package fst (12, undefined) 141 | 142 | 143 | unpack :: Package -> Int 144 | unpack (Package f a) = f a 145 | 146 | 147 | data PackageN where 148 | PackageN :: Num a => (a -> Int) -> a -> PackageN 149 | 150 | package1a = PackageN fromInteger 92384729384729384 151 | 152 | unpackN :: PackageN -> Int 153 | unpackN (PackageN f a) = let b = a * a in f b 154 | 155 | -- -- This doesn't work 156 | -- getFun :: Package -> (a -> Int) -- Who is `a` ? 157 | -- getFun (Package f _) = f 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /code/Examples03.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | -- |examples with tuples 4 | examplePair :: (Double, Bool) -- Double x Bool 5 | examplePair = (3.14, False) 6 | 7 | exampleTriple :: (Bool, Int, String) -- Bool x Int x String 8 | exampleTriple = (False, 42, "Answer") 9 | 10 | exampleFunction :: (Bool, Int, String) -> Bool 11 | exampleFunction (b, i, s) = not b && length s < i 12 | 13 | firstPair (x, y) = x 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | -- |function over lists - examples 73 | summerize :: [String] -> String 74 | summerize [] = "None" 75 | summerize ["Hasso"] = "Just for Hasso!!!" 76 | summerize [x] = "Only " ++ x 77 | summerize [x,y] = "Two things: " ++ x ++ " and " ++ y 78 | summerize [_,_,_] = "Three things: ???" 79 | summerize _ = "Several things." -- wild card pattern 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | -- |double every value in a list 133 | -- doubles [3,6,12] == [6,12,24] 134 | doubles :: [Integer] -> [Integer] 135 | doubles [] = [] 136 | doubles (x:xs) = (2*x) : doubles xs 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | -- |apply a function to all elements of a list 190 | -- map' f [x1, x2, ..., xn] = [f x1, f x2, ..., f xn] 191 | map' :: (a -> b) -> [a] -> [b] 192 | map' f [] = [] 193 | map' f (x:xs) = f x : map' f xs 194 | 195 | 196 | -- |doubles using map 197 | doubles' xs = map' double xs 198 | 199 | double :: Integer -> Integer 200 | double x = 2*x 201 | 202 | prop_double_is doubles' xs = doubles xs == doubles' xs 203 | 204 | doubles'' xs = map' (*2) xs 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | -- |keep only elements in list that fulfill a predicate 255 | filter' :: (a -> Bool) -> [a] -> [a] 256 | filter' p [] = [] 257 | filter' p (x:xs) = if p x then x : filter' p xs else filter' p xs 258 | 259 | xm3_is_1 x = mod x 3 == 1 260 | -- equivalently 261 | xm3_is_1' x = x `mod` 3 == 1 262 | 263 | (%$%$) x m = x `mod` m == 1 264 | 265 | 266 | filter'' p [] = [] 267 | filter'' p (x:xs) | p x = x : filter'' p xs 268 | | otherwise = filter'' p xs 269 | 270 | filter''' p [] = [] 271 | filter''' p (x:xs) | p x = x : fpxs 272 | | otherwise = fpxs 273 | where fpxs = filter''' p xs 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | -- | twice 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | -- |foldr' (predefined) 374 | -------------------------------------------------------------------------------- /code/Examples03-after.hs: -------------------------------------------------------------------------------- 1 | import Test.QuickCheck 2 | 3 | -- |examples with tuples 4 | examplePair :: (Double, Bool) -- Double x Bool 5 | examplePair = (3.14, False) 6 | 7 | exampleTriple :: (Bool, Int, String) -- Bool x Int x String 8 | exampleTriple = (False, 42, "Answer") 9 | 10 | exampleFunction :: (Bool, Int, String) -> Bool 11 | exampleFunction (b, i, s) = not b && length s < i 12 | 13 | firstPair (x, y) = x 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | -- |function over lists - examples 73 | summerize :: [String] -> String 74 | summerize [] = "None" 75 | summerize ["Hasso"] = "Just for Hasso!!!" 76 | summerize [x] = "Only " ++ x 77 | summerize [x,y] = "Two things: " ++ x ++ " and " ++ y 78 | summerize [_,_,_] = "Three things: ???" 79 | summerize _ = "Several things." -- wild card pattern 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | -- |double every value in a list 133 | -- doubles [3,6,12] == [6,12,24] 134 | doubles :: [Integer] -> [Integer] 135 | doubles [] = [] 136 | doubles (x:xs) = (2*x) : doubles xs 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | -- |apply a function to all elements of a list 190 | -- map' f [x1, x2, ..., xn] = [f x1, f x2, ..., f xn] 191 | map' :: (a -> b) -> [a] -> [b] 192 | map' f [] = [] 193 | map' f (x:xs) = f x : map' f xs 194 | 195 | 196 | -- |doubles using map 197 | doubles' xs = map' double xs 198 | 199 | double :: Integer -> Integer 200 | double x = 2*x 201 | 202 | prop_double_is doubles' xs = doubles xs == doubles' xs 203 | 204 | doubles'' xs = map' (*2) xs 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | -- |keep only elements in list that fulfill a predicate 255 | filter' :: (a -> Bool) -> [a] -> [a] 256 | filter' p [] = [] 257 | filter' p (x:xs) = if p x then x : filter' p xs else filter' p xs 258 | 259 | xm3_is_1 x = mod x 3 == 1 260 | -- equivalently 261 | xm3_is_1' x = x `mod` 3 == 1 262 | 263 | (%$%$) x m = x `mod` m == 1 264 | 265 | 266 | filter'' p [] = [] 267 | filter'' p (x:xs) | p x = x : filter'' p xs 268 | | otherwise = filter'' p xs 269 | 270 | filter''' p [] = [] 271 | filter''' p (x:xs) | p x = x : fpxs 272 | | otherwise = fpxs 273 | where fpxs = filter''' p xs 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | 305 | 306 | 307 | 308 | 309 | 310 | 311 | 312 | 313 | 314 | 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | -- | twice 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 331 | 332 | 333 | 334 | 335 | 336 | 337 | 338 | 339 | 340 | 341 | 342 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | -- |foldr' (predefined) 374 | -------------------------------------------------------------------------------- /slides/common.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \usetheme{Boadilla} % default 3 | \useoutertheme{infolines} 4 | \setbeamertemplate{navigation symbols}{} 5 | 6 | \usepackage{etex} 7 | \usepackage{alltt} 8 | \usepackage{pifont} 9 | \usepackage{color} 10 | \usepackage[utf8]{inputenc} 11 | %\usepackage{german} 12 | \usepackage{listings} 13 | \lstset{language=Haskell} 14 | \lstset{sensitive=true} 15 | \usepackage{hyperref} 16 | \hypersetup{colorlinks=true} 17 | \usepackage[final]{pdfpages} 18 | \usepackage{url} 19 | \usepackage{arydshln} % dashed lines 20 | \usepackage{tikz} 21 | \usepackage{mathpartir} 22 | 23 | \DeclareUnicodeCharacter{3BB}{\ensuremath{\lambda}} 24 | 25 | 26 | \newcommand\cmark{\ding{51}} 27 | \newcommand\xmark{\ding{55}} 28 | 29 | \newcommand{\nat}{\mathbf{N}} 30 | 31 | \usepackage[all]{xy} 32 | 33 | %% new arrow tip for xy 34 | \newdir{|>}{!/4.5pt/@{|}*:(1,-.2)@^{>}*:(1,+.2)@_{>}} 35 | 36 | \newcommand\cid[1]{\textup{\textbf{#1}}} % class names 37 | \newcommand\kw[1]{\textup{\textbf{#1}}} % key words 38 | \newcommand\tid[1]{\textup{\textsf{#1}}} % type names 39 | \newcommand\vid[1]{\textup{\texttt{#1}}} % value names 40 | \newcommand\Mid[1]{\textup{\texttt{#1}}} % method names 41 | 42 | \newcommand\TODO[1][]{{\color{red}{\textbf{TODO: #1}}}} 43 | 44 | \newcommand\String[1]{\texttt{\dq{}#1\dq{}}} 45 | 46 | \newcommand\ClassHead[1]{% 47 | \ensuremath{\begin{array}{|l|} 48 | \hline 49 | \cid{#1} 50 | \\\hline 51 | \end{array}}} 52 | \newcommand\AbstractClass[2]{% 53 | \ensuremath{\begin{array}{|l|} 54 | \hline 55 | \cid{\textit{#1}} 56 | \\\hline 57 | #2 58 | \hline 59 | \end{array}}} 60 | \newcommand\Class[2]{% 61 | \ensuremath{\begin{array}{|l|} 62 | \hline 63 | \cid{#1} 64 | \\\hline 65 | #2 66 | \hline 67 | \end{array}}} 68 | \newcommand\Attribute[3][black]{\textcolor{#1}{\Param{#2}{#3}}\\} 69 | \newcommand\Methods{\hline} 70 | \newcommand\MethodSig[3]{\Mid{#2} (#3): \,\tid{#1}\\} 71 | \newcommand\CtorSig[2]{\Mid{#1} (#2)\\} 72 | \newcommand\AbstractMethodSig[3]{\Mid{\textit{#2}} (#3): \,\tid{#1}\\} 73 | \newcommand\Param[2]{\vid{#2}:~\tid{#1}} 74 | 75 | \lstset{% 76 | frame=single, 77 | xleftmargin=2pt, 78 | stepnumber=1, 79 | numbers=left, 80 | numbersep=5pt, 81 | numberstyle=\ttfamily\tiny\color[gray]{0.3}, 82 | belowcaptionskip=\bigskipamount, 83 | captionpos=b, 84 | escapeinside={*'}{'*}, 85 | % language=java, 86 | tabsize=2, 87 | emphstyle={\bf}, 88 | commentstyle=\mdseries\it, 89 | stringstyle=\mdseries\rmfamily, 90 | showspaces=false, 91 | showtabs=false, 92 | keywordstyle=\bfseries, 93 | columns=fullflexible, 94 | basicstyle=\footnotesize\CodeFont, 95 | showstringspaces=false, 96 | morecomment=[l]\%, 97 | rangeprefix=////, 98 | includerangemarker=false, 99 | } 100 | 101 | \newcommand\CodeFont{\sffamily} 102 | 103 | \definecolor{lightred}{rgb}{0.8,0,0} 104 | \definecolor{darkgreen}{rgb}{0,0.5,0} 105 | \definecolor{darkblue}{rgb}{0,0,0.5} 106 | 107 | \newcommand\highlight[1]{\textcolor{blue}{\emph{#1}}} 108 | \newcommand\GenClass[2]{\cid{#1}\texttt{<}\cid{#2}\texttt{>}} 109 | 110 | \newcommand\Colored[3]{\alt<#1>{\textcolor{#2}{#3}}{#3}} 111 | 112 | \newcommand\nt[1]{\ensuremath{\langle#1\rangle}} 113 | 114 | \newcommand{\free}{\operatorname{free}} 115 | \newcommand{\bound}{\operatorname{bound}} 116 | \newcommand{\var}{\operatorname{var}} 117 | \newcommand\VSPBLS{\vspace{-\baselineskip}} 118 | 119 | \newcommand\IF{\textit{IF}} 120 | \newcommand\TRUE{\textit{TRUE}} 121 | \newcommand\FALSE{\textit{FALSE}} 122 | 123 | \newcommand\IFZ{\textit{IF0}} 124 | \newcommand\ZERO{\textit{ZERO}} 125 | \newcommand\SUCC{\textit{SUCC}} 126 | \newcommand\ADD{\textit{ADD}} 127 | \newcommand\SUB{\textit{SUB}} 128 | \newcommand\MULT{\textit{MULT}} 129 | \newcommand\DIV{\textit{DIV}} 130 | 131 | \newcommand\PAIR{\textit{PAIR}} 132 | \newcommand\FST{\textit{FST}} 133 | \newcommand\SND{\textit{SND}} 134 | 135 | \newcommand\CASE{\textit{CASE}} 136 | \newcommand\LEFT{\textit{LEFT}} 137 | \newcommand\RIGHT{\textit{RIGHT}} 138 | 139 | \newcommand\Encode[1]{\lceil#1\rceil} 140 | \newcommand\Reduce{\stackrel\ast\rightarrow_\beta} 141 | 142 | \newcommand\Nat{\textit{Nat}} 143 | \newcommand\Bool{\textit{Bool}} 144 | \newcommand\Pair{\textit{Pair}} 145 | \newcommand\Tfun[1]{#1\to} 146 | 147 | \newcommand\Tenv{A} 148 | \newcommand\Lam[1]{\lambda#1.} 149 | \newcommand\App[1]{#1\,} 150 | \newcommand\Succ{\textit{SUCC}\,} 151 | \newcommand\Let[2]{\textit{let}\,#1=#2\,\textit{in}\,} 152 | 153 | \newcommand\calE{\mathcal{E}} 154 | \newcommand\calU{\mathcal{U}} 155 | \newcommand\calP{\mathcal{P}} 156 | \newcommand\calW{\mathcal{W}} 157 | 158 | \newcommand\GEN{\textit{gen}} 159 | \newcommand\EFV[1]{\textit{fv} (#1)} 160 | \newcommand\Dom[1]{\textit{dom} (#1)} 161 | 162 | %%% Local Variables: 163 | %%% mode: latex 164 | %%% TeX-master: nil 165 | %%% End: 166 | -------------------------------------------------------------------------------- /code2019/M17lambda.hs: -------------------------------------------------------------------------------- 1 | 2 | {- 3 | -- free and bound 4 | ex0 = \ x -> \ y -> x 5 | -- free(ex0) = {} 6 | -- bound (ex0) = {x, y} 7 | ex1 = x 8 | -- free(ex1) = {x} 9 | -- bound (ex1) = {} 10 | ex2 = \ x -> x 11 | -- free(ex2) = {}, closed, combinator 12 | -- bound (ex2) = {x} 13 | ex3 = (\ x -> x) x 14 | -- free (ex3) = bound (ex3) = {x} 15 | 16 | 17 | -- substitution 18 | -- of x |-> ne 19 | 20 | se1 = x |-> ne 21 | = y |-> y 22 | = e1 e2 |-> e1 [ x|-> ne] 23 | (e2 [ x|-> ne]) 24 | 25 | (\ y -> y x) [ x |-> 42 ] = (\ y -> y 42) 26 | 27 | (\ y -> y x) [ x |-> y ] =!= (\ y -> y y) 28 | 29 | (\ y -> y x) [ x |-> y ] = (\ y' -> y' x) [ x |-> y ] = (\ y' -> y' y) 30 | 31 | 32 | -- left side of computation rule: 33 | -- redex 34 | -- right side: 35 | -- reductum, contractum 36 | 37 | (\x -> (y x)) -- no beta redex 38 | 39 | (\ x -> (y x)) M -beta-> (y M) 40 | 41 | (\ x -> (y x)) -eta-> y 42 | 43 | -} 44 | 45 | {- 46 | a lambda term M has at most one normal form 47 | 48 | Suppose 49 | M -b*-> N1 a normal form 50 | M -b*-> N2 another normal form 51 | 52 | hence N1 <-b*-> N2 53 | by CR there is some N such that\ 54 | N1 -b*-> N 55 | N2 -b*-> N 56 | 57 | but N1, N2 are normal forms, 58 | so N1 =a= N and N =a= N2 59 | so N1 =a= N2 60 | 61 | -} 62 | 63 | tt = \ x y -> x 64 | ff = \ x y -> y 65 | iff = \ b t f -> b t f 66 | 67 | {- 68 | 69 | iff tt 42 57 70 | = 71 | (((\ b t f -> b t f) tt) 42) 57 72 | -b-> 73 | ((\ t f -> tt t f) 42) 57 74 | -b-> 75 | (\ f -> tt 42 f) 57 76 | -b-> 77 | tt 42 57 78 | = 79 | ((\ x y -> x) 42) 57 80 | -b-> 81 | (\ y -> 42) 57 82 | -b-> 83 | 42 84 | 85 | -} 86 | 87 | zero = \f x -> x 88 | one = \f x -> f x 89 | two = \f x -> f (f x) 90 | three= \f x -> f (f (f x)) 91 | 92 | succ1 = \n f x -> f (n f x) 93 | succ2 = \n f x -> n f (f x) 94 | 95 | {- 96 | 97 | m f x = f^m x 98 | n f x = f^n x 99 | 100 | (\ g -> m n g) g y = 101 | (\ g -> n^m g) g y = 102 | n^m g y = 103 | g^(n^m) y 104 | 105 | two f x = f (f x) 106 | three f x = f (f (f x)) 107 | 108 | two three g x = 109 | three (three g) x = 110 | (three g (three g (three g x))) 111 | 112 | -} 113 | 114 | -- [0] = \f \x. x 115 | -- if0 [0] Z S --> Z 116 | -- if0 [n+-] Z S --> S 117 | 118 | if0 = \n -> \z -> \s -> n (\z -> s) z 119 | {- 120 | if0 zero Z S 121 | = 122 | (\n -> \z -> \s -> n (\z -> s) z) zero Z S 123 | --> 124 | (\z -> \s -> zero (\z -> s) z) Z S 125 | --> 126 | (\s -> zero (\z -> s) Z) S 127 | --> 128 | (zero (\z -> S) Z) 129 | = 130 | ((\f -> \x -> x) (\z -> S) Z) 131 | --> 132 | (\x -> x) Z 133 | --> 134 | Z 135 | -} 136 | 137 | pair = \x -> \y -> \f -> f x y 138 | 139 | triple = \x y z -> \f -> f x y z 140 | 141 | xcase = \e -> \nl -> \nr -> e nl nr 142 | 143 | left = \pl -> \nl nr -> nl pl 144 | right = \pr -> \nl nr -> nr pr 145 | 146 | -- subtraction for Church numerals 147 | -- requirement: predecessor 148 | 149 | xsucc = \n f x -> f (n f x) 150 | 151 | xpred = \n -> 152 | fst (n (\(_, r) -> (r, xsucc r)) (zero , zero)) 153 | 154 | church :: Int -> (a -> a) -> a -> a 155 | church 0 = zero 156 | church n = xsucc (church (n-1)) 157 | 158 | {- 159 | y = \f -> (\x -> f (x x)) (\x -> f (x x)) 160 | 161 | N = Y M 162 | 163 | N 164 | = 165 | (Y M) 166 | = 167 | ((\f -> (\x -> f (x x)) (\x -> f (x x))) M) 168 | --> 169 | ((\x -> M (x x)) (\x -> M (x x))) 170 | --> 171 | M ((\x -> M (x x)) (\x -> M (x x))) 172 | 173 | <-- 174 | M ((\f -> (\x -> f (x x)) (\x -> f (x x))) M) 175 | = 176 | M (Y M) 177 | = 178 | M N 179 | 180 | 181 | for Y we have: Y M = M (Y M) 182 | 183 | -} 184 | 185 | fix m = m (fix m) 186 | 187 | -- the factorial function 188 | 189 | -- write a non-recursive function 190 | -- that abstracts over the recursive call 191 | 192 | fact = 193 | \fac -> 194 | \n -> if n == 0 then 1 else n * fac (n - 1) 195 | {- 196 | fix fact 0 197 | --> 198 | fact (fix fact) 0 199 | = 200 | (\fac -> \n -> 201 | if n == 0 then 1 else n * fac (n - 1)) (fix fact) 0 202 | --> --> 203 | if 0 == 0 then 1 else n * (fix fact) (n - 1) 204 | --> 205 | 1 206 | 207 | fix fact 2 208 | --> 209 | fact (fix fact) 2 210 | = 211 | (\fac -> \n -> 212 | if n == 0 then 1 else n * fac (n - 1)) (fix fact) 2 213 | --> --> 214 | if 2 == 0 then 1 else 2 * (fix fact) (2 - 1) 215 | --> 216 | 2 * (fix fact) 1 217 | 218 | -} 219 | 220 | {- 221 | try to type check M N 222 | 223 | recursively find that M : A -> B 224 | recursively find that N : A' 225 | 226 | need to check whether A = A'? 227 | 228 | concrete example (with type variables a and b): 229 | M : (a -> b) -> (a -> b) 230 | N : (Int -> Int) 231 | 232 | is (a -> b) = (Int -> Int) ? 233 | No, but if I substitute a |-> Int and b |-> Int, then it's fine! 234 | 235 | --> Need substitute a and b in *whole* type for M: 236 | 237 | M : (Int -> Int) -> (Int -> Int) 238 | N : (Int -> Int) 239 | ----------------------------------- by rule App 240 | M N : (Int -> Int) 241 | 242 | --- another: 243 | 244 | M : (a -> b) -> (a -> b) 245 | N : (c -> Bool) 246 | 247 | is (a -> b) =.= (c -> Bool) ? 248 | 249 | no, but if I substitute a |-> c and b |-> Bool, 250 | then I can "unify" the two types: 251 | 252 | M : (c -> Bool) -> (c -> Bool) 253 | N : (c -> Bool) 254 | 255 | ---- 256 | 257 | M N : (c -> Bool) 258 | 259 | In each case, the substitution is called a unifier of the two types. 260 | 261 | -} 262 | -------------------------------------------------------------------------------- /code2024/src/V20241105.hs: -------------------------------------------------------------------------------- 1 | module V20241105 where 2 | 3 | import Data.Char 4 | 5 | data BTree a = 6 | Leaf | Branch { left :: BTree a, item :: a, right :: BTree a } 7 | deriving (Show) 8 | 9 | height :: BTree a -> Int 10 | height Leaf = 0 11 | height (Branch l _ r) = 1 + max (height l) (height r) 12 | 13 | height' :: BTree a -> Int 14 | height' Leaf = 0 15 | height' (Branch {left = l, right = r}) = 1 + max (height' l) (height' r) 16 | 17 | sumTree :: Num a => BTree a -> a 18 | sumTree Leaf = 0 19 | sumTree (Branch l i r) = i + sumTree l + sumTree r 20 | 21 | ---- 22 | 23 | foldBTree :: (b -> a -> b -> b) -> b -> BTree a -> b 24 | foldBTree f z Leaf = z 25 | foldBTree f z (Branch l i r) = f (foldBTree f z l) i (foldBTree f z r) 26 | 27 | height'' t = foldBTree f z t 28 | where 29 | f l i r = 1 + max l r 30 | z = 0 31 | 32 | sumTree'' t = foldBTree f z t 33 | where 34 | f l i r = l + i + r 35 | z = 0 36 | 37 | height''' = foldBTree (\ l i r -> 1 + max l r) 0 38 | sumTree''' = foldBTree (\ l i r -> l + i + r) 0 39 | 40 | 41 | ---- 42 | 43 | -- assume BTree a where Ord a is a binary search tree 44 | 45 | node :: a -> BTree a 46 | node x = Branch Leaf x Leaf 47 | 48 | insert :: Ord a => BTree a -> a -> BTree a 49 | insert Leaf x = node x 50 | insert t@(Branch l i r) x = 51 | case compare x i of 52 | LT -> Branch (insert l x) i r 53 | EQ -> t 54 | GT -> Branch l i (insert r x) 55 | 56 | search :: Ord a => BTree a -> a -> Bool 57 | search Leaf x = False 58 | search (Branch l i r) x = 59 | case compare x i of 60 | LT -> search l x 61 | EQ -> True 62 | GT -> search r x 63 | 64 | --- 65 | 66 | data ATree k v = 67 | ALeaf 68 | | ABranch { aleft :: ATree k v, key :: k, value :: v, aright :: ATree k v } 69 | deriving (Show) 70 | 71 | 72 | 73 | anode :: k -> v -> ATree k v 74 | anode k v = ABranch ALeaf k v ALeaf 75 | 76 | ainsert :: Ord k => ATree k v -> k -> v -> ATree k v 77 | ainsert ALeaf k v = anode k v 78 | ainsert t@(ABranch l i w r) k v = 79 | case compare k i of 80 | LT -> ABranch (ainsert l k v) i w r 81 | EQ -> ABranch l i v r 82 | GT -> ABranch l i w (ainsert r k v) 83 | 84 | asearch :: Ord k => ATree k v -> k -> Maybe v 85 | asearch ALeaf k = Nothing 86 | asearch (ABranch l i w r) k = 87 | case compare k i of 88 | LT -> asearch l k 89 | EQ -> Just w 90 | GT -> asearch r k 91 | 92 | ---- 93 | 94 | ex1 :: (a -> b) -> Int 95 | ex1 f = 42 96 | 97 | ex2 :: (Int -> Int) -> Int 98 | ex2 f = f (f 42) 99 | 100 | ---- 101 | 102 | -- pick :: Int -> ((a, a) -> a) 103 | pick 1 = fst 104 | pick 2 = snd 105 | 106 | bpick False = fst 107 | bpick True = snd 108 | 109 | 110 | ---- 111 | -- foldr examples 112 | 113 | foldr' :: (a -> b -> b) -> b -> [a] -> b 114 | foldr' f z [] = z 115 | foldr' f z (x:xs) = x `f` foldr' f z xs 116 | 117 | 118 | -- concat ( xs1 : xs2 : ... : xsn : []) == xs1 ++ xs2 ++ ... ++ xsn ++ [] 119 | -- concat :: [[a]] -> [a] 120 | 121 | concat' :: [[a]] -> [a] 122 | concat' xs = foldr' (++) [] xs 123 | 124 | -- equivalent "eta-reduced" function defintion 125 | concat'' = foldr' (++) [] 126 | 127 | -- maximum ( x1 : x2 : ... : xn : []) == max x1 (max x2 (... (max xn minBound))) 128 | 129 | maximum' :: (Bounded a, Ord a) => [a] -> a 130 | maximum' = foldr' max minBound 131 | 132 | exm :: Int 133 | exm = maximum' [-10, 10, 42] 134 | 135 | ----- 136 | isNotSpace :: Char -> Bool 137 | isNotSpace = not . isSpace 138 | -- a pointfree definition 139 | 140 | -- (f . g) x = f (g x) 141 | 142 | isNotSpace' x = (not . isSpace) x -- can eta reduce 143 | 144 | isNotSpace'' x = not (isSpace x) -- cannot eta reduce 145 | 146 | isReallySpace = not . not . isSpace 147 | isReallySpace'' x = not (not (isSpace x)) -- cannot eta reduce 148 | 149 | 150 | ------------------------------------------------------------ 151 | -- laziness 152 | 153 | nat :: [Integer] 154 | nat = [0..] 155 | 156 | nat' = 0 : map (+1) nat' 157 | 158 | ones = 1 : ones 159 | 160 | nat'' = 0 : zipWith (+) nat'' ones 161 | 162 | repeat' x = x : repeat' x 163 | 164 | repeat'' x = loop 165 | where loop = x : loop 166 | 167 | -- infix function application 168 | -- (f $ x) = f x 169 | 170 | -- f . g $ h . k $ x 171 | -- (f . g) ((h . k) x) 172 | 173 | fib = 0: 1: zipWith (+) fib (tail fib) 174 | 175 | fib' n = fibl !! n 176 | where 177 | fibl = 0: 1: zipWith (+) fibl (tail fibl) 178 | 179 | 180 | fib'' () = fibl 181 | where 182 | fibl = 0: 1: zipWith (+) fibl (tail fibl) 183 | 184 | primes = sieve [2..] 185 | sieve (p: xs) = p: (sieve $ filter (\x -> x `mod` p /= 0) xs) 186 | sieve' (p: xs) = p: (sieve' $ filter ((/= 0). (`mod` p)) xs) 187 | sieve'' (p: xs) = p: sieve'' [ x | x <- xs, x `mod` p /= 0] 188 | 189 | ---------------------------------------- 190 | -- the minimum tree problem 191 | ---------------------------------------- 192 | 193 | data BinTree = BLeaf Int | Node BinTree BinTree 194 | deriving (Show) 195 | 196 | 197 | mintree :: BinTree -> BinTree 198 | mintree b = t 199 | where 200 | (t, m) = mtree b m 201 | 202 | mtree :: BinTree -> Int -> (BinTree, Int) 203 | mtree (BLeaf v) m = (BLeaf m, v) 204 | mtree (Node l r) m = 205 | let (tl, ml) = mtree l m 206 | (tr, mr) = mtree r m 207 | in (Node tl tr, min ml mr) 208 | 209 | 210 | ---------------------------------------- 211 | 212 | data Color = Red | Black 213 | deriving (Eq, Show, Enum) 214 | 215 | colors = [Red .. Black] 216 | 217 | data Suit = Spades | Hearts | Diamond | Clubs 218 | deriving (Eq, Show, Enum) 219 | 220 | -- error: ambiguity 221 | -- ov x = show (read x) 222 | 223 | vo x = read(show x) 224 | 225 | 226 | -------------------------------------------------------------------------------- /code/M15monadtransformers.hs: -------------------------------------------------------------------------------- 1 | module M15monadtransformers where 2 | import qualified Data.Map.Strict as M 3 | 4 | -- | A Manual combination of Maybe and State 5 | 6 | data MaybeState s a = MS { runMS :: s -> Maybe (a, s) } 7 | 8 | instance Functor (MaybeState s) where 9 | fmap f ms = MS (\s -> mapFst f <$> runMS ms s) 10 | where mapFst f (x, y) = (f x, y) 11 | 12 | 13 | instance Applicative (MaybeState s) where 14 | pure a = MS (\s -> Just (a, s)) 15 | f <*> ms = MS (\s -> do 16 | (f, s') <- runMS f s 17 | (a, s'') <- runMS ms s' 18 | Just (f a, s'')) 19 | 20 | instance Monad (MaybeState s) where 21 | return a = MS (\s -> Just (a, s)) 22 | ms >>= f = MS (\s -> case runMS ms s of 23 | Nothing -> Nothing 24 | Just (a,s') -> runMS (f a) s') 25 | 26 | -- | Monad Transformer definition 27 | 28 | class MonadTrans t where 29 | lift :: Monad m => m a -> t m a 30 | 31 | -- | The MaybeT monad transformer 32 | 33 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } 34 | 35 | instance Functor m => Functor (MaybeT m) where 36 | fmap f = MaybeT . fmap (fmap f) . runMaybeT 37 | 38 | instance Monad m => Applicative (MaybeT m) where 39 | pure = MaybeT . return . Just 40 | mf <*> mx = MaybeT $ do 41 | mb_f <- runMaybeT mf 42 | case mb_f of 43 | Nothing -> return Nothing 44 | Just f -> do 45 | mb_x <- runMaybeT mx 46 | case mb_x of 47 | Nothing -> return Nothing 48 | Just x -> return (Just (f x)) 49 | 50 | 51 | instance Monad m => Monad (MaybeT m) where 52 | return = MaybeT . return . Just 53 | (MaybeT mmx) >>= f = MaybeT $ do 54 | mx <- mmx 55 | case mx of 56 | Nothing -> return Nothing 57 | Just x -> runMaybeT (f x) 58 | 59 | instance MonadTrans MaybeT where 60 | lift ma = MaybeT $ ma >>= return . Just 61 | 62 | mfail :: Monad m => MaybeT m a 63 | mfail = MaybeT $ return Nothing 64 | 65 | -- We can recover Maybe by applying MaybeT to Id 66 | 67 | data Id x = Id x 68 | instance Functor Id where 69 | fmap f (Id x) = Id $ f x 70 | instance Applicative Id where 71 | pure = Id 72 | (Id f) <*> (Id x) = Id $ f x 73 | instance Monad Id where 74 | return = Id 75 | Id x >>= f = f x 76 | 77 | runId (Id x) = x 78 | 79 | type MaybeLike = MaybeT Id 80 | 81 | someint :: MaybeLike Integer 82 | someint = return 3 83 | 84 | test0 :: (Monad m) => Integer -> MaybeT m Integer 85 | test0 x = do 86 | if x /= 0 then return x 87 | else mfail 88 | 89 | -- | StateT 90 | 91 | newtype StateT s m a = 92 | StateT { runStateT :: s -> m (a,s) } 93 | 94 | get :: Monad m => StateT s m s 95 | get = StateT (\s -> return (s, s)) 96 | 97 | set :: Monad m => s -> StateT s m s 98 | set x = StateT (\s -> return (x, x)) 99 | 100 | 101 | instance Functor m => Functor (StateT s m) where 102 | fmap f m = StateT $ \s -> fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s 103 | 104 | instance Monad m => Applicative (StateT s m) where 105 | pure a = StateT $ \s -> return (a, s) 106 | StateT mf <*> StateT mx = StateT $ \ s -> do 107 | (f, s') <- mf s 108 | (x, s'') <- mx s' 109 | return (f x, s'') 110 | 111 | instance Monad m => Monad (StateT s m) where 112 | return a = StateT $ \s -> return (a, s) 113 | m >>= f = StateT $ \s -> do 114 | (a, s') <- runStateT m s 115 | runStateT (f a) s' 116 | 117 | instance MonadTrans (StateT s) where 118 | lift ma = StateT $ \s -> do { a <- ma ; return (a, s) } 119 | 120 | 121 | -- Maybe+State 122 | type MS2 s a = StateT s Maybe a 123 | 124 | test2 :: MS2 Integer Integer 125 | test2 = do 126 | s <- get 127 | if s > 0 then lift $ Just $ s * s else lift Nothing 128 | 129 | -- State+Maybe ? 130 | type MS3 s a = MaybeT (StateT s Id) a 131 | 132 | test3 :: MS3 Integer Integer 133 | test3 = do 134 | s <- lift $ get 135 | if s > 0 then return $ s * s else mfail 136 | 137 | runMS3 :: MS3 s a -> s -> (Maybe a, s) 138 | runMS3 mma s = 139 | let ma = runMaybeT mma in 140 | let a = runStateT ma s in 141 | runId a 142 | 143 | 144 | -- | ReaderT 145 | newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } 146 | 147 | -- Retrieves the monad environment. 148 | ask :: (Monad m) => ReaderT r m r 149 | ask = ReaderT return 150 | 151 | -- Runs computation in modified environment. 152 | local :: Monad m => (r -> r) -> ReaderT r m a -> ReaderT r m a 153 | local f (ReaderT rma) = ReaderT (rma . f) 154 | 155 | test4 :: ReaderT [String] Id String 156 | test4 = do 157 | l <- ask 158 | return $ head l 159 | 160 | computeWith :: String -> ReaderT [String] Id a -> ReaderT [String] Id a 161 | computeWith s m = do 162 | local ((:)s) m 163 | 164 | test5 = do 165 | v <- computeWith "foo" test4 166 | v2 <- test4 167 | return (v, v2) 168 | 169 | 170 | instance Functor m => Functor (ReaderT r m) where 171 | fmap f m = ReaderT $ fmap f . runReaderT m 172 | 173 | instance Applicative m => Applicative (ReaderT r m) where 174 | pure = ReaderT . const . pure 175 | f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r 176 | 177 | instance Monad m => Monad (ReaderT r m) where 178 | return = lift . return 179 | m >>= k = ReaderT $ \r -> do 180 | a <- runReaderT m r 181 | runReaderT (k a) r 182 | 183 | instance MonadTrans (ReaderT r) where 184 | lift m = ReaderT (\_ -> m) 185 | 186 | 187 | -- | Monadic interpreter 188 | 189 | type Ident = String 190 | data Term = Con Integer 191 | | Div Term Term 192 | | Var Ident | Let Ident Term Term 193 | | Read | Write Term 194 | deriving (Eq, Show) 195 | 196 | type Env = M.Map Ident Integer 197 | type InterpM = StateT Integer (ReaderT Env (MaybeT Id)) 198 | 199 | run :: InterpM a -> Maybe (a, Integer) 200 | run m = runId $ runMaybeT $ runReaderT (runStateT m 0) M.empty 201 | 202 | eval :: Term -> InterpM Integer 203 | eval (Con i) = return i 204 | eval (Div t t') = do 205 | v <- eval t 206 | v' <- eval t' 207 | if v' == 0 then lift $ lift $ mfail else return (v `div` v') 208 | eval (Var id) = do 209 | env <- lift ask 210 | lift $ lift $ MaybeT $ return $ M.lookup id env 211 | eval (Let id t tbody) = do 212 | v <- eval t 213 | liftState (local (M.insert id v)) $ eval tbody 214 | 215 | eval Read = get 216 | eval (Write t) = 217 | eval t >>= \v -> 218 | set v >>= \_ -> 219 | return v 220 | 221 | liftState f m = 222 | StateT $ \s -> f $ runStateT m s 223 | 224 | 225 | -------------------------------------------------------------------------------- /slides/05-more-about-lists.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \documentclass{beamer} 3 | 4 | \input{common} 5 | %%% frontmatter 6 | \input{frontmatter} 7 | \subtitle{More about lists} 8 | \usepackage{tikz} 9 | 10 | 11 | \begin{document} 12 | 13 | \begin{frame} 14 | \titlepage 15 | \end{frame} 16 | %---------------------------------------------------------------------- 17 | \begin{frame}[fragile] 18 | \frametitle{Lists recap} 19 | \begin{block}{Zero or more values} 20 | \begin{verbatim} 21 | [] [1] [True, False] ["a", "bunch", "of", "flowers"] 22 | \end{verbatim} 23 | \end{block} 24 | \begin{block}{All have the same type} 25 | \begin{verbatim} 26 | [True, False] -- good 27 | [1, "two", False] -- bad, type error 28 | \end{verbatim} 29 | \end{block} 30 | \begin{block}{Order matters} 31 | \begin{verbatim} 32 | [1,2,3] /= [3,2,1] 33 | \end{verbatim} 34 | \end{block} 35 | \end{frame} 36 | %---------------------------------------------------------------------- 37 | \begin{frame}[fragile] 38 | \frametitle{List syntax} 39 | \begin{verbatim} 40 | (1 : (2 : (3 : []))) 41 | == 42 | 1 : 2 : 3 : [] 43 | == 44 | [1,2,3] 45 | \end{verbatim} 46 | Strings are lists of characters 47 | \begin{verbatim} 48 | "Hearts" == ['H','e','a','r','t','s'] 49 | \end{verbatim} 50 | \end{frame} 51 | %---------------------------------------------------------------------- 52 | \begin{frame}[fragile] 53 | \frametitle{Defining a list datatype} 54 | \begin{block}<+->{The values of type [a] are \dots} 55 | \begin{itemize} 56 | \item either \texttt{[]}, the empty list 57 | \item or \texttt{x:xs} where \texttt{x} has type \texttt{a} and 58 | \texttt{xs} has type \texttt{[a]} \\ 59 | ``\texttt{:}'' is pronounced ``cons'' 60 | \end{itemize} 61 | \end{block} 62 | \begin{verbatim} 63 | data List a = ... 64 | \end{verbatim} 65 | \begin{block}<+->{Corresponding definition} 66 | \begin{verbatim} 67 | data List a = Nil | Cons a (List a) 68 | \end{verbatim} 69 | \begin{itemize} 70 | \item New: \texttt{List} is a parametric datatype with type 71 | parameter \texttt{a} 72 | \item Many functions on lists are also parametric (i.e., \textbf{polymorphic}) 73 | \end{itemize} 74 | \end{block} 75 | \end{frame} 76 | %---------------------------------------------------------------------- 77 | \begin{frame}[fragile] 78 | \frametitle{Polymorphic functions on lists} 79 | \begin{verbatim} 80 | length :: [a] -> Int 81 | (++) :: [a] -> [a] -> [a] 82 | concat :: [[a]] -> [a] 83 | take :: Int -> [a] -> [a] 84 | zip :: [a] -> [b] -> [(a,b)] 85 | 86 | map :: (a -> b) -> [a] -> [b] 87 | filter :: (a -> Bool) -> [a] -> [a] 88 | \end{verbatim} 89 | \end{frame} 90 | %---------------------------------------------------------------------- 91 | \begin{frame}[fragile] 92 | \frametitle{Prelude functions on lists} 93 | \begin{block}<+->{Functions on specific lists} 94 | \begin{verbatim} 95 | and, or :: [Bool] -> Bool 96 | words, lines :: String -> [String] 97 | unwords, unlines :: [String] -> String 98 | \end{verbatim} 99 | \end{block} 100 | \begin{block}<+->{Overloaded functions on lists} 101 | \begin{verbatim} 102 | sum, product :: Num a => [a] -> a 103 | elem :: Eq a => a -> [a] -> Bool 104 | sort :: Ord a => [a] -> [a] 105 | \end{verbatim} 106 | \end{block} 107 | \end{frame} 108 | %---------------------------------------------------------------------- 109 | %---------------------------------------------------------------------- 110 | \begin{frame}[fragile] 111 | \frametitle{Some examples \dots} 112 | \begin{itemize} 113 | \item append, reverse 114 | \item sum, product 115 | \item take, drop, splitAt 116 | \item zip, unzip 117 | \item insert, isort, qsort 118 | \item QuickCheck: collect, classify 119 | \end{itemize} 120 | \end{frame} 121 | %---------------------------------------------------------------------- 122 | \begin{frame}[fragile] 123 | \frametitle{Quicksort!} 124 | \begin{verbatim} 125 | qsort :: Ord a => [a] -> [a] 126 | qsort [] = [] 127 | qsort (x:xs) = qsort smaller ++ [x] ++ qsort bigger 128 | where 129 | smaller = filter (<= x) xs 130 | bigger = filter (> x) xs 131 | \end{verbatim} 132 | \end{frame} 133 | %---------------------------------------------------------------------- 134 | \begin{frame}[fragile] 135 | \frametitle{An unfortunate QuickCheck --- ghci interaction} 136 | \begin{block}<+->{Two properties} 137 | \begin{verbatim} 138 | prop_take_drop n xs = take n xs ++ drop n xs == xs 139 | nonprop_take_drop n xs = drop n xs ++ take n xs == xs 140 | \end{verbatim} 141 | \end{block} 142 | \begin{block}<+->{Testing \dots} 143 | \begin{verbatim} 144 | *Main> quickCheck prop_take_drop 145 | +++ OK, passed 100 tests. 146 | *Main> quickCheck nonprop_take_drop 147 | +++ OK, passed 100 tests. 148 | \end{verbatim} 149 | \end{block} 150 | \begin{block}<+->{Oops! what went wrong?} 151 | \begin{verbatim} 152 | prop_take_drop :: Eq a => Int -> [a] -> Bool 153 | nonprop_take_drop :: Eq a => Int -> [a] -> Bool 154 | \end{verbatim} 155 | \vspace{-\baselineskip} 156 | \begin{itemize} 157 | \item The properties have polymorphic types, but\dots 158 | \item QuickCheck does not work with polymorphic types! 159 | \end{itemize} 160 | \end{block} 161 | \end{frame} 162 | %---------------------------------------------------------------------- 163 | \begin{frame}[fragile] 164 | \frametitle{Ghci ``helps''} 165 | \begin{itemize} 166 | \item Instead of indicating the problem, ghci chooses a more specific \textbf{default type} 167 | \item In this case, it plugs the unit type for \texttt{a} 168 | \item QuickCheck tests 169 | \begin{verbatim} 170 | prop_take_drop :: Eq a => Int -> [()] -> Bool 171 | nonprop_take_drop :: Eq a => Int -> [()] -> Bool 172 | \end{verbatim} 173 | \item Order does not matter when all elements are the same\dots 174 | \end{itemize} 175 | \end{frame} 176 | %---------------------------------------------------------------------- 177 | \begin{frame}[fragile] 178 | \frametitle{Force ghci to be unhelpful} 179 | \begin{itemize} 180 | \item Use type signatures 181 | \item Disable defaulting 182 | \begin{verbatim} 183 | *Main> :set -XNoExtendedDefaultRules 184 | \end{verbatim} 185 | \item Restrict types used in defaulting 186 | \begin{verbatim} 187 | *Main> default (Integer, Double) 188 | \end{verbatim} 189 | \end{itemize} 190 | \end{frame} 191 | %---------------------------------------------------------------------- 192 | 193 | \begin{frame} 194 | \frametitle{Break Time --- Questions?} 195 | \begin{center} 196 | \tikz{\node[scale=15] at (0,0){?};} 197 | \end{center} 198 | \end{frame} 199 | 200 | 201 | \end{document} 202 | 203 | %%% Local Variables: 204 | %%% mode: latex 205 | %%% TeX-master: t 206 | %%% End: 207 | -------------------------------------------------------------------------------- /slides/11-parsing.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \documentclass{beamer} 3 | 4 | \input{common} 5 | %%% frontmatter 6 | \input{frontmatter} 7 | \subtitle 8 | {Parsing} 9 | 10 | \begin{document} 11 | 12 | \begin{frame} 13 | \titlepage 14 | \end{frame} 15 | 16 | %\begin{frame} 17 | % \frametitle{Outline} 18 | % \tableofcontents 19 | % You might wish to add the option [pausesections] 20 | %\end{frame} 21 | 22 | 23 | \begin{frame}[fragile] 24 | \frametitle{Recall the expression language} 25 | \begin{block}<+->{Definition} 26 | \begin{lstlisting} 27 | data Term = Con Integer 28 | | Bin Term Op Term 29 | deriving (Eq, Show) 30 | 31 | data Op = Add | Sub | Mul | Div 32 | deriving (Eq, Show) 33 | \end{lstlisting} 34 | \end{block} 35 | \begin{alertblock}<+->{Parsing expressions} 36 | \begin{itemize} 37 | \item Read a string like \texttt{"3+42/6"} 38 | \item Recognize it as a valid term 39 | \item Return \texttt{Bin (Con 3) Add (Bin (Con 42) Div (Con 6))} 40 | \end{itemize} 41 | \end{alertblock} 42 | \end{frame} 43 | 44 | \begin{frame}[fragile] 45 | \frametitle{Parsing} 46 | \begin{block}{The type of a simple parser} 47 | \begin{lstlisting} 48 | type Parser token result = [token] -> [(result, [token])] 49 | \end{lstlisting} 50 | \end{block} 51 | \end{frame} 52 | 53 | \begin{frame}[fragile] 54 | \frametitle{Combinator parsing} 55 | \begin{block}{Primitive parsers} 56 | \begin{lstlisting} 57 | pempty :: Parser t r 58 | succeed :: r -> Parser t r 59 | satisfy :: (t -> Bool) -> Parser t t 60 | msatisfy :: (t -> Maybe a) -> Parser t a 61 | lit :: Eq t => t -> Parser t t 62 | \end{lstlisting} 63 | \end{block} 64 | \end{frame} 65 | 66 | \begin{frame}[fragile] 67 | \frametitle{Combinator parsing II} 68 | \begin{block}{Combination of parsers} 69 | \begin{lstlisting} 70 | palt :: Parser t r -> Parser t r -> Parser t r 71 | pseq :: Parser t (s -> r) -> Parser t s -> Parser t r 72 | pmap :: (s -> r) -> Parser t s -> Parser t r 73 | \end{lstlisting} 74 | \end{block} 75 | \end{frame} 76 | 77 | 78 | \begin{frame}[fragile] 79 | \frametitle{A taste of compiler construction} 80 | \begin{block}{A lexer} 81 | A lexer partitions the incoming list of 82 | characters into a list of tokens. A token is either a single symbol, 83 | an identifier, or a number. Whitespace characters are removed. 84 | \end{block} 85 | \end{frame} 86 | 87 | 88 | \begin{frame}[fragile] 89 | \frametitle{Underlying concepts} 90 | \begin{alertblock}{Parsers have a rich structure} 91 | \begin{itemize} 92 | \item many concepts from category theory can be mapped to programming concepts 93 | \item parsing illustrates many of these concepts 94 | \end{itemize} 95 | \end{alertblock} 96 | \end{frame} 97 | 98 | 99 | \begin{frame}[fragile] 100 | \frametitle{Functors} 101 | \begin{alertblock}{The functor class} 102 | \begin{lstlisting} 103 | class Functor f where 104 | fmap :: (a -> b) -> (f a -> f b) 105 | \end{lstlisting} 106 | \end{alertblock} 107 | 108 | \begin{exampleblock}{Instances} 109 | List, Maybe, IO, \dots 110 | \end{exampleblock} 111 | \begin{alertblock}{Functorial laws} 112 | \begin{lstlisting} 113 | fmap id_a == id_f_a 114 | fmap (f . g) == fmap f . fmap g 115 | \end{lstlisting} 116 | \end{alertblock} 117 | \end{frame} 118 | 119 | \begin{frame}[fragile] 120 | \frametitle{Parsing is \dots} 121 | \begin{block}{A functor} 122 | Check the functorial laws! 123 | \end{block} 124 | \begin{block}{A monad} 125 | Check the monad laws! 126 | \end{block} 127 | \begin{alertblock}{Consequence} 128 | Can use \texttt{do} notation for parsing! 129 | \end{alertblock} 130 | \end{frame} 131 | 132 | 133 | \begin{frame}[fragile] 134 | \frametitle{Applicative} 135 | \begin{alertblock}{Example 1: sequencing computation} 136 | \begin{lstlisting} 137 | sequence :: [IO a] -> IO [a] 138 | sequence [] = return [] 139 | sequence (io:ios) = do x <- io 140 | xs <- sequence ios 141 | return (x:xs) 142 | \end{lstlisting} 143 | \end{alertblock} 144 | \begin{alertblock}{Alternative way} 145 | \begin{lstlisting} 146 | sequence [] = return [] 147 | sequence (io:ios) = return (:) `ap` io `ap` sequence ios 148 | 149 | return :: Monad m => a -> m a 150 | ap :: Monad m => m (a -> b) -> m a -> m b 151 | \end{lstlisting} 152 | \end{alertblock} 153 | \end{frame} 154 | 155 | 156 | 157 | \begin{frame}[fragile] 158 | \frametitle{Applicative} 159 | \begin{exampleblock}{Example 2: transposition} 160 | \begin{lstlisting} 161 | transpose :: [[a]] -> [[a]] 162 | transpose [] = repeat [] 163 | transpose (xs:xss) = zipWith (:) xs (transpose xss) 164 | \end{lstlisting} 165 | \end{exampleblock} 166 | \begin{alertblock}{Rewrite} 167 | \begin{lstlisting} 168 | transpose [] = repeat [] 169 | transpose (xs:xss) = repeat (:) `zapp` xs `zapp` transpose xss 170 | 171 | zapp :: [a -> b] -> [a] -> [b] 172 | zapp fs xs = zipWith ($) fs xs 173 | \end{lstlisting} 174 | \end{alertblock} 175 | \end{frame} 176 | 177 | \begin{frame}[fragile] 178 | \frametitle{Applicative Interpreter} 179 | \begin{block}{Standard interpretation} 180 | \begin{lstlisting} 181 | data Exp v 182 | = Var v 183 | | Val Int 184 | | Add (Exp v) (Exp v) 185 | 186 | eval :: Exp v -> Env v -> Int 187 | eval (Var v) env = fetch v env 188 | eval (Val i) env = i 189 | eval (Add e1 e2) env = eval e1 env + eval e2 env 190 | 191 | type Env v = v -> Int 192 | fetch :: v -> Env v -> Int 193 | fetch v env = env v 194 | \end{lstlisting} 195 | \end{block} 196 | \end{frame} 197 | 198 | 199 | \begin{frame}[fragile] 200 | \frametitle{Applicative Interpreter} 201 | \begin{alertblock}{Alternative implementation} 202 | \begin{lstlisting} 203 | eval' :: Exp v -> Env v -> Int 204 | eval' (Var v) = fetch v 205 | eval' (Val i) = const i 206 | eval' (Add e1 e2) = const (+) `ess` (eval' e1) `ess` (eval' e2) 207 | 208 | ess a b c = (a c) (b c) 209 | \end{lstlisting} 210 | \end{alertblock} 211 | \end{frame} 212 | 213 | \begin{frame}[fragile] 214 | \frametitle{Applicative} 215 | \begin{exampleblock}{Extract the common structure} 216 | \begin{lstlisting} 217 | class Functor f => Applicative f where 218 | pure :: a -> f a 219 | (<*>) :: f (a -> b) -> f a -> f b 220 | \end{lstlisting} 221 | \end{exampleblock} 222 | \end{frame} 223 | 224 | \begin{frame}[fragile] 225 | \frametitle{Applicative} 226 | \begin{block}{Laws} 227 | \begin{itemize} 228 | \item Identity 229 | \begin{lstlisting} 230 | pure id <*> v == v 231 | \end{lstlisting} 232 | \item Composition 233 | \begin{lstlisting} 234 | pure (.) <*> u <*> v <*> w = u <*> (v <*> w) 235 | \end{lstlisting} 236 | \item Homomorphism 237 | \begin{lstlisting} 238 | pure f <*> pure x = pure (f x) 239 | \end{lstlisting} 240 | \item Interchange 241 | \begin{lstlisting} 242 | u <*> pure y = pure ($ y) <*> u 243 | \end{lstlisting} 244 | \end{itemize} 245 | \end{block} 246 | \end{frame} 247 | 248 | \begin{frame}[fragile] 249 | \frametitle{Parsers are Applicative!} 250 | \begin{alertblock}{} 251 | \begin{lstlisting} 252 | instance Applicative (Parser' token) where 253 | pure = return 254 | (<*>) = ap 255 | 256 | instance Alternative (Parser' token) where 257 | empty = mzero 258 | (<|>) = mplus 259 | \end{lstlisting} 260 | \end{alertblock} 261 | \end{frame} 262 | 263 | 264 | 265 | 266 | \begin{frame} 267 | \frametitle{Wrapup} 268 | \begin{itemize}[<+->] 269 | \item what if there are multiple applicatives? 270 | \item they just compose (unlike monads) 271 | \item applicative do notation 272 | \item applicatives cannot express dependency 273 | \item enable more clever parsers 274 | \end{itemize} 275 | 276 | \end{frame} 277 | 278 | 279 | \end{document} 280 | 281 | 282 | -------------------------------------------------------------------------------- /code2019/M12interpreter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | module M12interpreter where 3 | 4 | data Term = Con Integer 5 | | Bin Term Op Term 6 | deriving (Eq, Show) 7 | 8 | data Op = Add | Sub | Mul | Div 9 | deriving (Eq, Show) 10 | 11 | eval :: Term -> Integer 12 | eval (Con n) = n 13 | eval (Bin t op u) = sys op (eval t) (eval u) 14 | 15 | sys Add = (+) 16 | sys Sub = (-) 17 | sys Mul = (*) 18 | sys Div = div 19 | 20 | 21 | 22 | 23 | 24 | 25 | -- some example terms 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | evalErr :: Term -> Exception Integer 34 | evalErr = eval where 35 | eval (Con n) = Return n 36 | eval (Bin t op u) = case eval t of 37 | Raise s -> Raise s 38 | Return v -> case eval u of 39 | Raise s -> Raise s 40 | Return w -> 41 | if (op == Div && w == 0) 42 | then 43 | Raise "div by zero" 44 | else 45 | Return (sys op v w) 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | newtype Trace a = Trace (a, String) 58 | deriving (Show) 59 | 60 | evalTrace :: Term -> Trace Integer 61 | evalTrace = eval where 62 | eval e@(Con n) = Trace (n, trace e n) 63 | eval e@(Bin t op u) = 64 | let Trace (v, x) = eval t in 65 | let Trace (w, y) = eval u in 66 | let r = sys op v w in 67 | Trace (r, x ++ y ++ trace e r) 68 | 69 | trace t n = "eval (" ++ show t ++ ") = " 70 | ++ show n ++ "\n" 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | newtype Count a = Count { exCount :: Int -> (a, Int) } 88 | 89 | evalCount :: Term -> Count Integer 90 | evalCount = eval where 91 | eval (Con n) = Count $ \i -> (n, i) 92 | eval (Bin t op u) = Count $ \i -> let (v, j) = exCount (eval t) i in 93 | let (w, k) = exCount (eval u) j in 94 | (sys op v w, k + 1) 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | ex1 = Con 42 105 | ex2 = Bin (Con 17) Add (Con 4) 106 | ex3 = Bin ex2 Div (Con 0) 107 | ex4 = Bin ex2 Mul ex2 108 | 109 | 110 | 111 | 112 | evalMonad :: Monad m => Term -> m Integer 113 | evalMonad = eval where 114 | eval (Con n) = return n 115 | eval (Bin t op u) = eval t >>= \v -> 116 | eval u >>= \w -> 117 | return (sys op v w) 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | -- identity monad 133 | newtype Id a = Id a 134 | 135 | instance Functor Id where 136 | -- fmap :: (a -> b) -> Id a -> Id b 137 | fmap g (Id a) = Id (g a) 138 | 139 | 140 | 141 | instance Applicative Id where 142 | pure x = Id x 143 | -- Id (a -> b) -> Id a -> Id b 144 | Id f <*> Id x = Id (f x) 145 | 146 | 147 | 148 | instance Monad Id where 149 | return x = Id x 150 | -- Id a -> (a -> Id b) -> Id b 151 | Id x >>= f = f x 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | -- modeling exceptions 162 | data Exception a = Raise String 163 | | Return a 164 | deriving (Show) 165 | 166 | -- exception monad 167 | instance Functor Exception where 168 | fmap g (Raise s) = Raise s 169 | fmap g (Return a) = Return (g a) 170 | 171 | instance Applicative Exception where 172 | pure x = Return x 173 | -- (<*>) :: Exception (a -> b) -> Exception a -> Exception b 174 | Return g <*> Return a = Return (g a) 175 | Raise s <*> _ = Raise s 176 | _ <*> Raise s = Raise s 177 | 178 | {- equivalent definition using the fact Functor Exception -} 179 | {- unreachable -} 180 | Return g <*> exx = fmap g exx 181 | Raise s <*> _ = Raise s 182 | 183 | instance Monad Exception where 184 | -- (>>=) :: Exception a -> (a -> Exception b) -> Exception b 185 | Return a >>= f = f a 186 | Raise s >>= f = Raise s 187 | fail s = Raise s 188 | 189 | raise :: String -> Exception a 190 | raise s = Raise s 191 | 192 | -- ma >> mb = ma >>= const mb 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | evalMExc :: Term -> Exception Integer 211 | evalMExc = eval where 212 | eval (Con n) = return n 213 | eval (Bin t op u) = eval t >>= \v -> 214 | eval u >>= \w -> 215 | if (op == Div && w == 0) 216 | then fail "div by zero" 217 | else return (sys op v w) 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | -- tracing monad 231 | instance Functor Trace where 232 | fmap g (Trace (a, out)) = Trace (g a, out) 233 | 234 | instance Applicative Trace where 235 | pure a = Trace (a, "") 236 | -- g :: a -> b, a :: a 237 | Trace (g, out) <*> Trace (a, out') = Trace (g a, out ++ out') 238 | 239 | instance Monad Trace where 240 | Trace (a, out) >>= g = let Trace (b, out') = g a 241 | in Trace (b, out ++ out') 242 | 243 | output :: String -> Trace () 244 | output s = Trace ((), s) 245 | 246 | 247 | 248 | 249 | 250 | -- monadic interpreter with tracing 251 | evalMTrace :: Term -> Trace Integer 252 | evalMTrace = eval where 253 | eval e@(Con n) = output (trace e n) >> 254 | return n 255 | eval e@(Bin t op u) = eval t >>= \v -> 256 | eval u >>= \w -> 257 | let r = sys op v w in 258 | output (trace e r) >> 259 | return r 260 | 261 | 262 | 263 | 264 | 265 | 266 | -- counting monad 267 | instance Functor Count where 268 | -- fmap :: (a -> b) -> Count a -> Count b 269 | fmap g (Count f) = Count $ \ i -> let (a, i') = f i in (g a, i') 270 | 271 | instance Applicative Count where 272 | pure x = Count $ \ i -> (x, i) 273 | Count cf <*> Count cx = Count $ \ i -> let (f, j) = cf i in 274 | let (x, k) = cx j in 275 | (f x, k) 276 | 277 | instance Monad Count where 278 | -- f :: a -> Count b 279 | Count cx >>= f = Count $ \ i -> let (x, j) = cx i in 280 | exCount (f x) j 281 | 282 | 283 | incr :: Count () 284 | incr = Count $ \ i -> ((), i+1) 285 | 286 | 287 | runCount :: Count a -> Int -> (a, Int) 288 | runCount (Count f) x = f x 289 | 290 | 291 | -- monadic interpreter with counting 292 | 293 | evalMCount :: Term -> Count Integer 294 | evalMCount = eval where 295 | eval (Con n) = return n 296 | eval (Bin t op u) = eval t >>= \v -> 297 | eval u >>= \w -> 298 | incr >> 299 | return (sys op v w) 300 | 301 | 302 | -- * excursion on kinding of type constructors 303 | 304 | -- kind of Count 305 | -- Count :: * -> * 306 | -- Id :: * -> * 307 | -- [] :: * -> * 308 | 309 | data ST s a = ST { exST :: s -> (a, s) } 310 | 311 | -- kind of ST 312 | -- ST :: * -> * -> * 313 | 314 | -- ST Int :: * -> * 315 | -- ST Int () :: * 316 | 317 | -- (,) :: * -> * -> * 318 | -- (,) Int :: * -> * 319 | 320 | -- (,,) :: * -> * -> * -> * 321 | 322 | -- * a different interface to monads 323 | 324 | -- Haskell : functions of type a -> b 325 | -- Monad : functions of type (a -> m b) 326 | 327 | -- if all functions have type of shape (a -> m b) 328 | -- examples: 2nd argument of (>>=) 329 | -- return :: (a -> m a) 330 | 331 | -- (.) :: (b -> c) -> (a -> b) -> (a -> c) 332 | 333 | mcomp :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) 334 | mcomp f g = \ a -> g a >>= \ b -> f b 335 | -- = \ a -> g a >>= f 336 | 337 | {- 338 | return `mcomp` g == \ a -> g a >>= return == \ a -> g a == g 339 | 340 | f `mcomp` return == \ a -> return a >>= f == \ a -> f a == f 341 | 342 | (f `mcomp` g) `mcomp` h == f `mcomp` (g `mcomp` h) 343 | -} 344 | 345 | -- * the list monad 346 | 347 | {- 348 | instance Monad [] where 349 | return x = [x] 350 | -- (>>=) :: [a] -> (a -> [b]) -> [b] 351 | la >>= f = concatMap f la 352 | -} 353 | -------------------------------------------------------------------------------- /code/M14inference.hs: -------------------------------------------------------------------------------- 1 | module M14inference where 2 | 3 | import Control.Monad 4 | import Data.List (union, (\\)) 5 | 6 | type TyVar = String 7 | type TyCon = String 8 | 9 | data Type 10 | = TyVar TyVar 11 | | TyApp TyCon [Type] 12 | deriving (Show) 13 | 14 | -- example types 15 | tyNat = TyApp "Nat" [] 16 | tyFun τ1 τ2 = TyApp "->" [τ1, τ2] 17 | tyList τ = TyApp "[]" [τ] 18 | 19 | tyAlpha = TyVar "a" 20 | tyBeta = TyVar "b" 21 | 22 | -- substitutions represented as lists of pairs 23 | type Subst = [(TyVar, Type)] 24 | 25 | -- domain of substitution 26 | domSubst :: Subst -> [TyVar] 27 | domSubst = map fst 28 | 29 | -- identity substitution 30 | idSubst :: Subst 31 | idSubst = [] 32 | 33 | -- apply a substitution to a type 34 | applySubst :: Subst -> Type -> Type 35 | applySubst subst (TyVar x) 36 | | Just ty <- lookup x subst = ty 37 | | otherwise = TyVar x 38 | applySubst subst (TyApp tc tys) = TyApp tc $ map (applySubst subst) tys 39 | 40 | -- compose substitutions 41 | composeSubst :: Subst -> Subst -> Subst 42 | composeSubst s1 s0 = 43 | map g s0 ++ filter p s1 44 | where 45 | g (tv, ty) = (tv, applySubst s1 ty) 46 | p (tv, ty) = not $ tv `elem` domS0 47 | domS0 = domSubst s0 48 | 49 | -- apply a substitution to a type scheme 50 | applySubstScheme :: Subst -> Scheme -> Scheme 51 | applySubstScheme subst (Forall tvs τ) = 52 | Forall tvs (applySubst subst' τ) 53 | -- requires that dom subst \cap tvs = \emptyset 54 | where 55 | subst' = filter p subst 56 | p (α, τ) = not (α `elem` tvs) 57 | 58 | -- apply a substitution to a type assumption 59 | applySubstAss :: Subst -> Ass -> Ass 60 | applySubstAss subst = 61 | map $ \ (x, σ) -> (x, applySubstScheme subst σ) 62 | 63 | -- unification 64 | unify :: Monad m => Type -> Type -> m Subst 65 | unify (TyVar x) (TyVar y) 66 | | x == y = return idSubst 67 | | x < y = return [(x, TyVar y)] 68 | | otherwise = return [(y, TyVar x)] 69 | unify (TyVar x) ty 70 | | x `elem` freetv ty = 71 | fail $ (x ++ " occurs in " ++ show ty) 72 | | otherwise = 73 | return [(x, ty)] 74 | unify ty (TyVar y) = return [(y, ty)] 75 | unify ty1@(TyApp tc1 tys1) ty2@(TyApp tc2 tys2) 76 | | tc1 /= tc2 || length tys1 /= length tys2 = 77 | fail $ "failing to unify " ++ show ty1 ++ " with " ++ show ty2 78 | | otherwise = 79 | unifyList idSubst tys1 tys2 80 | 81 | unifyList :: Monad m => Subst -> [Type] -> [Type] -> m Subst 82 | unifyList subst [] [] = 83 | return subst 84 | unifyList subst (ty1:tys1) (ty2:tys2) = 85 | do subst1 <- unify (applySubst subst ty1) (applySubst subst ty2) 86 | unifyList (composeSubst subst1 subst) tys1 tys2 87 | unifyList _ _ _ = 88 | fail "tycon arity mismatch (should not happen)" 89 | 90 | -- monad for reporting error messages 91 | -- Haskell forces us to define instances of Functor and Applicative 92 | data UError a 93 | = ULeft String -- error message 94 | | URight a -- returned result 95 | 96 | instance Monad UError where 97 | return a = URight a 98 | m >>= f = case m of 99 | ULeft s -> ULeft s 100 | URight a -> f a 101 | fail s = ULeft s 102 | 103 | instance Functor UError where 104 | fmap f ua = case ua of 105 | ULeft s -> ULeft s 106 | URight a -> URight (f a) 107 | 108 | instance Applicative UError where 109 | pure a = URight a 110 | uf <*> ub = case uf of 111 | ULeft s -> ULeft s 112 | URight f -> 113 | case ub of 114 | ULeft s -> ULeft s 115 | URight b -> URight (f b) 116 | 117 | -- examples for unification 118 | uex1, uex2, uex3, uex4, uex5, uex6, uex7, uex8 :: Monad m => m Subst 119 | uex1 = unify tyAlpha tyAlpha 120 | uex2 = unify tyAlpha tyBeta 121 | uex3 = unify tyAlpha tyNat 122 | uex4 = unify tyNat tyBeta 123 | uex5 = unify tyNat (tyFun tyBeta tyBeta) -- error 124 | uex6 = unify tyBeta (tyFun tyBeta tyBeta) -- error 125 | uex7 = unify (tyFun tyAlpha (tyFun tyBeta tyAlpha)) (tyFun (TyVar "γ") (TyVar "δ")) 126 | uex8 = unify (tyFun tyAlpha tyBeta) 127 | (tyFun (tyFun tyNat tyNat) tyAlpha) 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | -- Monad for HM type inference 137 | -- combination of two monads: 138 | -- * fresh variable generation: state monad 139 | -- * error messages: Either monad 140 | 141 | type HMError = String 142 | data HMState = HMState { count :: Int } 143 | 144 | data HM a 145 | = HM { exHM :: HMState -> Either HMError (a, HMState) } 146 | 147 | instance Functor HM where 148 | fmap f hma = 149 | HM (\s -> case exHM hma s of 150 | Left msg -> Left msg 151 | Right (a, s') -> Right (f a, s') 152 | ) 153 | 154 | instance Applicative HM where 155 | pure x = 156 | HM (\s -> Right (x, s)) 157 | ax <*> ay = 158 | HM (\s -> case exHM ax s of 159 | Left msg -> Left msg 160 | Right (x, s') -> 161 | case exHM ay s' of 162 | Left msg -> Left msg 163 | Right (y, s'') -> 164 | Right (x y, s'') 165 | ) 166 | 167 | instance Monad HM where 168 | return x = 169 | HM (\s -> Right (x, s)) 170 | m >>= f = 171 | HM (\s -> case exHM m s of 172 | Left msg -> Left msg 173 | Right (x, s') -> exHM (f x) s' 174 | ) 175 | fail msg = 176 | HM (\s -> Left msg) 177 | 178 | -- run the HM monad 179 | runHM :: HM a -> Either String a 180 | runHM hma = 181 | case exHM hma HMState { count = 0 } of 182 | Left m -> Left m 183 | Right (x, s) -> Right x 184 | 185 | -- lookup a value in an association list 186 | mlookup :: (Monad m, Eq a) => a -> [(a, b)] -> m b 187 | mlookup x xys = 188 | case lookup x xys of 189 | Nothing -> fail "mlookup failed" 190 | Just y -> return y 191 | 192 | -- generate a fresh type variable 193 | fresh :: HM TyVar 194 | fresh = 195 | HM (\s -> 196 | let s' = s { count = count s + 1 } 197 | tv = 'a' : show (count s') 198 | in Right (tv, s')) 199 | 200 | -- generate a list of fresh type variables 201 | freshList :: [x] -> HM [TyVar] 202 | freshList = mapM (const fresh) 203 | 204 | -- mini-ml syntax 205 | type ExVar = String 206 | 207 | data Exp 208 | = ExVar ExVar 209 | | ExLam ExVar Exp 210 | | ExApp Exp Exp 211 | | ExLet ExVar Exp Exp 212 | | ExNum Integer 213 | | ExSuc Exp 214 | 215 | -- type schemes 216 | data Scheme = Forall [TyVar] Type 217 | 218 | -- type assumptions 219 | type Ass = [(ExVar, Scheme)] 220 | 221 | -- free variables in a type 222 | freetv :: Type -> [TyVar] 223 | freetv (TyVar tv) = [tv] 224 | freetv (TyApp tc tys) = foldr union [] $ map freetv tys 225 | 226 | -- fv in a type assumption 227 | freetvAss :: Ass -> [TyVar] 228 | freetvAss = foldr union [] . map (freetvScheme . snd) 229 | 230 | -- fv in a type scheme 231 | freetvScheme :: Scheme -> [TyVar] 232 | freetvScheme (Forall gtvs ty) = freetv ty \\ gtvs 233 | 234 | -- the gen function 235 | gen :: Ass -> Type -> Scheme 236 | gen ass ty = 237 | let fvt = freetv ty 238 | fva = freetvAss ass 239 | in Forall (fvt \\ fva) ty 240 | 241 | 242 | 243 | -- algorithm W 244 | infer :: Ass -> Exp -> HM (Subst, Type) 245 | infer ass (ExVar x) = 246 | do Forall αs tx <- mlookup x ass 247 | βs <- freshList αs 248 | let genSubst = zip αs $ map TyVar βs 249 | return (idSubst, applySubst genSubst tx) 250 | infer ass (ExLam x e) = 251 | do β <- fresh 252 | (subst, τ) <- infer ((x, Forall [] (TyVar β)) : ass) e 253 | return (subst, TyApp "->" [applySubst subst (TyVar β), τ]) 254 | infer ass (ExApp e0 e1) = 255 | do (subst0, τ0) <- infer ass e0 256 | (subst1, τ1) <- infer (applySubstAss subst0 ass) e1 257 | β <- fresh 258 | usubst <- unify (applySubst subst1 τ0) (TyApp "->" [τ1, TyVar β]) 259 | return ( composeSubst usubst (composeSubst subst1 subst0) 260 | , applySubst usubst (TyVar β)) 261 | infer ass (ExLet x e0 e1) = 262 | do (subst0, τ0) <- infer ass e0 263 | let σ = gen (applySubstAss subst0 ass) τ0 264 | (subst1, τ1) <- infer ((x, σ) : ass) e1 265 | return (composeSubst subst1 subst0, τ1) 266 | infer ass (ExNum n) = 267 | return (idSubst, TyApp "Nat" []) 268 | infer ass (ExSuc e) = 269 | do (subst, τ) <- infer ass e 270 | usubst <- unify τ (TyApp "Nat" []) 271 | return (composeSubst usubst subst, TyApp "Nat" []) 272 | 273 | -- examples 274 | iex1 = ExLam "x" (ExVar "x") 275 | iex2 = ExLam "x" (ExLam "y" (ExVar "x")) 276 | iex3 = ExLet "i" iex1 (ExApp (ExVar "i") (ExNum 42)) 277 | iex4 = ExLet "i" iex1 (ExApp (ExVar "i") (ExVar "i")) 278 | 279 | ass1 = [("map", Forall ["a", "b"] (tyFun (tyFun tyAlpha tyBeta) (tyFun (TyApp "[]" [tyAlpha]) (TyApp "[]" [tyBeta])))) 280 | ,("p", Forall [] (tyFun (tyNat) (TyApp "Bool" [])))] 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | -- try to define HM on top of UError 289 | 290 | data HM' a 291 | = HM' { exHM' :: HMState -> UError (a, HMState) } 292 | 293 | instance Functor HM' where 294 | fmap f hma = 295 | HM' (\s -> fmap (f # id) $ exHM' hma s) 296 | 297 | (#) :: (a1 -> b1) -> (a2 -> b2) -> (a1, a2) -> (b1, b2) 298 | (f1 # f2) (a1, a2) = (f1 a1, f2 a2) 299 | 300 | instance Applicative HM' where 301 | pure x = 302 | HM' (\s -> pure (x, s)) 303 | ax <*> ay = 304 | undefined 305 | 306 | instance Monad HM' where 307 | return x = 308 | HM' (\s -> return (x, s)) 309 | m >>= f = 310 | HM' (\s -> exHM' m s >>= \(x, s') -> exHM' (f x) s') 311 | 312 | -------------------------------------------------------------------------------- /code2019/M15modular.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE FlexibleContexts #-} 2 | 3 | > module M15modular where 4 | > import Control.Monad.Except 5 | > import Control.Monad.Reader 6 | > import Control.Monad.State.Strict 7 | 8 | Modular interpreters 9 | ==================== 10 | 11 | We learned about several uses of monads (applicatives, functors) 12 | * to express various kinds of computational effect (state, reader, writer, ...) 13 | * to write extensible interpreters 14 | * to express composition of effects with monad transformers 15 | 16 | Put this accumulated knowledge into practice by building an actual interpreter 17 | step by step. In particular, we will see how to 18 | * interpret an expression language (again) 19 | * add exceptions 20 | * add variable binding 21 | * NEW: implement function values and function application 22 | * NEW: implement lazy values 23 | 24 | We achieve all that just by adding new code, never going back to change existing code. 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | Syntax 38 | 39 | 0.0 The base language 40 | 41 | > data Exp 42 | > = Integer Integer 43 | > | Bool Bool 44 | > | String String 45 | > | Binop Binop Exp Exp 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 1.0 Exception handling 61 | 62 | > | Try Exp Exp 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 2.0 Variables 78 | 79 | > | Let Ident Exp Exp 80 | > | Var Ident 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 3.0 Functions 93 | 94 | > | Lam Ident Exp 95 | > | App Exp Exp 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 4.0 Laziness 108 | 109 | > | Delay Exp 110 | > | Force Exp 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 0.1 Values 123 | 124 | Now that we have several types of values, we have to encode them in a data type. 125 | 126 | > data Value 127 | > = VInteger Integer 128 | > | VBool Bool 129 | > | VString String 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 3.1 Function values 153 | 154 | Now we could try to represent functions by functions... 155 | 156 | | VFun (Value -> Value) 157 | 158 | but that would not work, because we'd cut off the monad at the point where the function is called. The function should rather be monadic as in 159 | 160 | | VFun (Value -> m Value) 161 | 162 | but then our Value type would have to be parameterized over the monad m. 163 | 164 | Fortunately, there is a simpler first-order representation of functions as a data structure: 165 | The closure 166 | 167 | > | VClosure Env Ident Exp 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 4.1 Lazy values 183 | 184 | Lazy values are also represented by closures, but they don't have an argument. 185 | They are evaluated later, but still with their current environment. 186 | 187 | > | VThunk Int Env Exp 188 | 189 | 190 | 191 | > showValue :: Value -> IO () 192 | > showValue (VInteger i) = putStrLn ("Integer " ++ show i) 193 | > showValue (VBool b) = putStrLn ("Bool " ++ show b) 194 | > showValue (VString s) = putStrLn ("String " ++ show s) 195 | > showValue (VClosure _ _ _) = putStrLn ("Closure") 196 | > showValue (VThunk i _ _) = putStrLn ("Thunk #"++show i) 197 | 198 | 199 | 200 | 201 | 202 | 203 | 0.2 Interpretation of the binary operators. 204 | 205 | > data Binop = Add | Sub | Mul | Div | Eql | Cnc 206 | 207 | > -- binop :: (Monad m) => Binop -> Value -> Value -> m Value 208 | > binop Add (VInteger x1) (VInteger x2) = 209 | > return $ VInteger (x1 + x2) 210 | 211 | > binop Eql (VInteger x1) (VInteger x2) = 212 | > return $ VBool (x1 == x2) 213 | > 214 | > binop Eql (VString s1) (VString s2) = 215 | > return $ VBool (s1 == s2) 216 | 217 | > binop Cnc (VString s1) (VString s2) = 218 | > return $ VString (s1 ++ s2) 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 1.1 An exceptional operation 237 | 238 | Let's start with the exception 239 | " 240 | throwError :: e -> m a 241 | Is used within a monadic computation to begin exception processing. 242 | " 243 | 244 | > binop Div (VInteger x1) (VInteger x2) = 245 | > if x2 == 0 then throwError "division by zero" else return $ VInteger (x1 `div` x2) 246 | 247 | 248 | 249 | 250 | 251 | 252 | 2.1 Variable bindings 253 | 254 | > type Ident = String 255 | 256 | > type Env = Ident -> Maybe Value 257 | 258 | > -- update :: Ident -> Value -> Env -> Env 259 | > update :: (Eq i) => i -> v -> (i -> Maybe v) -> (i -> Maybe v) 260 | > update x v e = \y -> if x == y then Just v else e x 261 | 262 | 263 | 264 | 265 | 266 | 267 | 0.3 A first round of interpretation 268 | 269 | > -- eval :: (Monad m) => Exp -> m Value 270 | > eval (Integer i) = return $ VInteger i 271 | > eval (Bool b) = return $ VBool b 272 | > eval (String s) = return $ VString s 273 | > eval (Binop b e1 e2) = do 274 | > x1 <- eval e1 275 | > x2 <- eval e2 276 | > binop b x1 x2 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 1.2 Let's deal with the exception 299 | 300 | " 301 | catchError :: m a -> (e -> m a) -> m a 302 | 303 | A handler function to handle previous errors and return to normal execution. 304 | A common idiom is: 305 | 306 | do { action1; action2; action3 } `catchError` handler 307 | 308 | where the action functions can call throwError. 309 | Note that handler and the do-block must have the same return type. 310 | " 311 | 312 | In our language, Try should work similar to try in Python, say. 313 | 314 | > eval (Try e1 e2) = 315 | > eval e1 `catchError` \ s -> eval e2 316 | 317 | We don't have a means to pass the string to the evaluator, yet. 318 | 319 | 320 | 321 | 322 | 323 | 324 | 325 | 326 | 327 | 328 | 329 | 330 | 2.2 Variable bindings with a Reader monad 331 | 332 | " 333 | ask :: m r 334 | 335 | Retrieves the monad environment. 336 | " 337 | 338 | > eval (Var x) = do 339 | > env <- ask 340 | > maybe (throwError "unbound variable") return $ env x 341 | 342 | " 343 | local :: (r -> r) -- |The function to modify the environment. 344 | -> m a -- |Reader to run in the modified environment. 345 | -> m a -- |Executes a computation in a modified environment. 346 | " 347 | 348 | > eval (Let x e1 e2) = do 349 | > v1 <- eval e1 350 | > local (update x v1) (eval e2) 351 | 352 | Note that e1 is always evaluated! 353 | 354 | 355 | 356 | 357 | 358 | 359 | 360 | 361 | 3.2 Function values 362 | 363 | > eval (Lam x e) = do 364 | > env <- ask 365 | > return $ VClosure env x e 366 | 367 | That is, the function value remembers (in its env component) the environment (i.e. the values of the variables) where it was created. This environment has to be reinstalled when the function is applied to an argument. 368 | 369 | > eval (App e1 e2) = do 370 | > v1 <- eval e1 371 | > v2 <- eval e2 372 | > case v1 of 373 | > VClosure env x e -> 374 | > local (const (update x v2 env)) (eval e) 375 | > _ -> 376 | > throwError "function expected" 377 | 378 | This manipulation of the environment implements static binding / static scope. 379 | 380 | This application always evaluates the argument v2. 381 | So these functions are not lazy, but strict. 382 | 383 | 384 | 385 | 386 | 387 | 388 | 389 | 390 | 391 | 392 | 393 | 4.2 Creating and using lazy values 394 | 395 | > eval (Delay e) = do 396 | > env <- ask 397 | > a <- alloc () 398 | > return $ VThunk a env e 399 | > 400 | > eval (Force e) = do 401 | > v <- eval e 402 | > case v of 403 | > VThunk a env e' -> do 404 | > st <- get 405 | > case memory st a of 406 | > Nothing -> do 407 | > vforced <- local (const env) (eval e') 408 | > let memory' = update a vforced (memory st) 409 | > put (st {memory = memory'}) 410 | > return vforced 411 | > Just v -> do 412 | > return v 413 | > _ -> 414 | > throwError "force expected a thunk" 415 | 416 | Not quite "lazy" as in Haskell, as they are evaluated at every use (which is "call by name") whereas Haskell's implementation of laziness guarantees at most one evaluation. 417 | Providing such a guarantee requires a state monad that remembers whether a thunk has been evaluated already. 418 | 419 | 420 | 421 | ================================================================================ 422 | 423 | > run e = evalState (runReaderT (runExceptT (eval e)) (const Nothing)) initialStore 424 | > 425 | > data Store = Store { 426 | > count :: Int, -- allocation counter 427 | > memory :: Int -> Maybe Value -- memory i = value of thunk at address i 428 | > } 429 | > 430 | > initialStore :: Store 431 | > initialStore = Store { count = 0, memory = const Nothing } 432 | > 433 | > alloc () = do 434 | > st <- get 435 | > let c = count st 436 | > put (st {count = c+1}) 437 | > return c 438 | 439 | 440 | 441 | 442 | 443 | 444 | 445 | 446 | 447 | > ex1 = Binop Div (Integer 42) (Integer 0) 448 | > ex2 = Try ex1 (Integer 0) 449 | > ex3 = Try (Binop Add ex1 (Integer 1)) (Integer 0) 450 | > ex4 = Binop Add ex3 ex1 451 | > ex5 = Let "x" ex1 (Integer 4711) 452 | > ex6 = Let "x" (Delay ex1) (Integer 4711) 453 | > ex7 = Let "x" (Delay ex1) (Force (Var "x")) 454 | > ex8 = Let "x" (Delay ex1) (Try (Force (Var "x")) (Integer 1435)) 455 | > ex9 = Let "x" (Delay ex1) (Try (Force (Var "x")) (Force (Var "x"))) 456 | > 457 | 458 | 459 | -------------------------------------------------------------------------------- /slides/09-io.tex: -------------------------------------------------------------------------------- 1 | %% -*- coding: utf-8 -*- 2 | \documentclass{beamer} 3 | 4 | \input{common} 5 | %%% frontmatter 6 | \input{frontmatter} 7 | \subtitle{IO} 8 | \usepackage{tikz} 9 | 10 | 11 | \begin{document} 12 | 13 | \begin{frame} 14 | \titlepage 15 | \end{frame} 16 | %---------------------------------------------------------------------- 17 | \begin{frame}[fragile] 18 | \frametitle{Referential transparency and substitutivity} 19 | \begin{block}<+->{Remember the first class?} 20 | \begin{itemize} 21 | \item Every variable and expression has just one value\\ 22 | \textbf{referential transparency} 23 | \item Every variable can be replaced by its definition\\ 24 | \textbf{substitutivity} 25 | \end{itemize} 26 | \end{block} 27 | \begin{block}<+->{Enables reasoning} 28 | \begin{lstlisting} 29 | -- sequence of function calls does not matter 30 | f () + g () == g () + f () 31 | -- number of function calls does not matter 32 | f () + f ( ) == 2 * f () 33 | \end{lstlisting} 34 | \end{block} 35 | \end{frame} 36 | %---------------------------------------------------------------------- 37 | \begin{frame}[fragile] 38 | \frametitle{How does IO fit in?} 39 | \begin{alertblock}<+->{Bad example} 40 | Suppose we had 41 | \begin{lstlisting} 42 | input :: () -> Integer 43 | \end{lstlisting} 44 | \begin{itemize} 45 | \item<+-> Consider 46 | \begin{lstlisting} 47 | let x = input () in 48 | x + x 49 | \end{lstlisting} 50 | \item<+-> Expect to read one input and use it twice 51 | \item<+-> By substitutivity, this expression must behave like 52 | \begin{lstlisting} 53 | input () + input () 54 | \end{lstlisting} 55 | which reads two inputs! 56 | \item<+-> VERY WRONG!!! 57 | \end{itemize} 58 | \end{alertblock} 59 | \end{frame} 60 | %---------------------------------------------------------------------- 61 | \begin{frame}[fragile] 62 | \frametitle{The dilemma} 63 | \begin{alertblock}<+->{Haskell is a pure language, but IO is a side effect} 64 | \end{alertblock} 65 | \begin{block}<+->{A contradiction?} 66 | \end{block} 67 | \begin{block}<+->{No!} 68 | \begin{itemize} 69 | \item Instead of performing IO operations directly, there is an 70 | abstract type of \textbf{IO instructions}, which get executed 71 | lazily by the operating system 72 | \item Some instructions (e.g., read from a file) return values, so the abstract IO type is parameterized over their type 73 | \item Keep in mind: instructions are just values like any other 74 | \end{itemize} 75 | \end{block} 76 | \end{frame} 77 | %---------------------------------------------------------------------- 78 | \begin{frame}[fragile] 79 | \frametitle{Haskell IO} 80 | 81 | \begin{block}<+->{The main function} 82 | Top-level result of a program is an IO ``instruction''. 83 | \begin{lstlisting} 84 | main :: IO () 85 | main = undefined 86 | \end{lstlisting} 87 | \begin{itemize} 88 | \item an instruction describes the \textbf{effect} of the program 89 | \item effect $=$ IO action, imperative state change, \dots 90 | \end{itemize} 91 | \end{block} 92 | % \begin{block}<+->{An instruction that returns a result} 93 | % \begin{lstlisting} 94 | % -- defined in the Prelude 95 | % readFile :: FileName -> IO String 96 | % \end{lstlisting} 97 | % \end{block} 98 | \end{frame} 99 | %---------------------------------------------------------------------- 100 | \begin{frame}[fragile] 101 | \frametitle{Kinds of instructions} 102 | \begin{block}<+->{Primitive instructions} 103 | \begin{lstlisting} 104 | -- defined in the Prelude 105 | putChar :: Char -> IO () 106 | getChar :: IO Char 107 | writeFile :: FileName -> String -> IO () 108 | readFile :: FileName -> IO String 109 | \end{lstlisting} 110 | and many more 111 | \end{block} 112 | \begin{block}<+->{No op instruction} 113 | \begin{lstlisting} 114 | return :: a -> IO a 115 | \end{lstlisting} 116 | The IO instruction \texttt{return 42} performs no IO, but yields the value 42. 117 | \end{block} 118 | \end{frame} 119 | %---------------------------------------------------------------------- 120 | \begin{frame}[fragile] 121 | \frametitle{Combining two instructions} 122 | \begin{block}<+->{The bind operator \texttt{>>=}} 123 | Intuition: next instruction may depend on the output of the previous one 124 | \begin{lstlisting} 125 | (>>=) :: IO a -> (a -> IO b) -> IO b 126 | \end{lstlisting} 127 | The instruction \texttt{m >>= f} 128 | \begin{itemize} 129 | \item executes \texttt{m :: IO a} first 130 | \item gets its result \texttt{x :: a} 131 | \item applies \texttt{f :: a -> IO b} to the result 132 | \item to obtain an instruction \texttt{f x :: IO b} that returns a \texttt{b} 133 | \item and executes this instruction to return a \texttt{b} 134 | \end{itemize} 135 | \end{block} 136 | \begin{block}<+->{Example} 137 | \begin{lstlisting} 138 | readFiles f1 f2 = 139 | readFile f1 >>= \xs1 -> readFile f2 140 | \end{lstlisting} 141 | \end{block} 142 | \end{frame} 143 | %---------------------------------------------------------------------- 144 | \begin{frame}[fragile] 145 | \frametitle{More convenient: \texttt{do} notation} 146 | \begin{lstlisting} 147 | copyFile source target = 148 | undefined 149 | 150 | doTwice io = 151 | undefined 152 | 153 | doNot io = 154 | undefined 155 | \end{lstlisting} 156 | \end{frame} 157 | %---------------------------------------------------------------------- 158 | \begin{frame} 159 | \frametitle{Translating \texttt{do} notation into \texttt{>>=} operations} 160 | \begin{itemize} 161 | \item \texttt{do \emph{lastinstruction}} 162 | \\ $\longrightarrow$ 163 | \\ \texttt{\emph{lastinstruction}} 164 | \\[2ex] 165 | \item \texttt{do \{ \emph{x} <- \emph{action1}; \emph{instructions} \}} 166 | \\ $\longrightarrow$ 167 | \\ \texttt{\emph{action1} >>= \textbackslash \emph{x} -> \texttt{do \{ \emph{instructions} \}}} 168 | \\[2ex] 169 | \item \texttt{do \{ \emph{action1}; \emph{instructions} \}} 170 | \\ $\longrightarrow$ 171 | \\ \texttt{\emph{action1} >> \texttt{do \{ \emph{instructions} \}}} 172 | \\[2ex] 173 | \item \texttt{do \{ let \emph{binding}; \emph{instructions} \}} 174 | \\ $\longrightarrow$ 175 | \\ \texttt{let \emph{binding} in do \{ \emph{instructions} \}} 176 | \end{itemize} 177 | \end{frame} 178 | %---------------------------------------------------------------------- 179 | \begin{frame}[fragile] 180 | \frametitle{Instructions vs functions} 181 | \begin{block}<+->{Functions} 182 | produce the same result each time they are called 183 | \end{block} 184 | \begin{block}<+->{Instructions} 185 | \begin{itemize} 186 | \item are interpreted each time they are executed, 187 | \item the result depends on the context 188 | \item may be different each time 189 | \end{itemize} 190 | \end{block} 191 | \end{frame} 192 | %---------------------------------------------------------------------- 193 | \begin{frame} 194 | \frametitle{Underlying concept: \textbf{Monad}} 195 | 196 | \begin{block}<+->{What's a monad? (first approximation)} 197 | \begin{itemize} 198 | \item abstract datatype for instructions that produce values 199 | \item built-in combination \texttt{>>=} 200 | \item abstracts over different interpretations (computations) 201 | \end{itemize} 202 | \end{block} 203 | \begin{alertblock}<+->{IO is a special case of a monad} 204 | \begin{itemize} 205 | \item one very useful application for monad 206 | \item built into Haskell 207 | \item but there's more to the concept 208 | \item many more instances to come! 209 | \end{itemize} 210 | \end{alertblock} 211 | \end{frame} 212 | %---------------------------------------------------------------------- 213 | \begin{frame}[fragile] 214 | \frametitle{Hands-on task} 215 | Define a function 216 | \begin{lstlisting} 217 | sortFile :: FilePath -> FilePath -> IO () 218 | 219 | -- sortFile inFile outFile 220 | -- reads inFile, sorts its lines, and writes the result to outFile 221 | 222 | -- recall 223 | -- sort :: Ord a => [a] -> [a] 224 | -- lines :: String -> [String] 225 | -- unlines :: [String] -> String 226 | \end{lstlisting} 227 | \end{frame} 228 | %---------------------------------------------------------------------- 229 | \begin{frame}[fragile] 230 | \frametitle{Utilities} 231 | \begin{lstlisting} 232 | sequence :: [IO a] -> IO [a] 233 | sequence_ :: [IO a] -> IO () 234 | \end{lstlisting} 235 | \end{frame} 236 | %---------------------------------------------------------------------- 237 | \begin{frame}[fragile] 238 | \frametitle{Another hands-on task} 239 | Define a function 240 | \begin{lstlisting} 241 | printTable :: [String] -> IO () 242 | 243 | {- 244 | printTable ["New York", "Rio", "Tokio"] 245 | outputs 246 | 1: New York 247 | 2: Rio 248 | 3: Tokio 249 | -} 250 | \end{lstlisting} 251 | \end{frame} 252 | %---------------------------------------------------------------------- 253 | %---------------------------------------------------------------------- 254 | \begin{frame} 255 | \frametitle{Wrapup} 256 | \begin{alertblock}{First encounter with monads} 257 | \begin{itemize} 258 | \item A monad is an abstract data type of instructions returning results. 259 | \item The next instruction can depend on previous results. 260 | \item Instructions are just values. 261 | \item Haskell's IO operations are instructions of the \texttt{IO} monad. 262 | \end{itemize} 263 | \end{alertblock} 264 | \end{frame} 265 | 266 | % \begin{frame} 267 | % \frametitle{Break Time --- Questions?} 268 | % \begin{center} 269 | % \tikz{\node[scale=15] at (0,0){?};} 270 | % \end{center} 271 | % \end{frame} 272 | 273 | 274 | \end{document} 275 | 276 | %%% Local Variables: 277 | %%% mode: latex 278 | %%% TeX-master: t 279 | %%% End: 280 | --------------------------------------------------------------------------------