diff --git a/lecture-01/Haskell/Examples.hs b/lecture-01/Haskell/Examples.hs new file mode 100644 index 0000000000000000000000000000000000000000..f33272ff8f20827d6f18c00813eb443d246679b9 --- /dev/null +++ b/lecture-01/Haskell/Examples.hs @@ -0,0 +1,66 @@ +module Examples where + +import Data.Char (isUpper, toLower) +import StateMonad + +import qualified SimpleRefs as SR +import Refs +import WriterMonad + + + +-- examples for writer monad + +ex1 :: Writer String Int +ex1 = do let a= 3+4 + tell $ "Calculated a " ++ show a ++ "\n" + let b= 8* 3 + tell $ "Calculated b " ++ show b ++ "\n" + return $ a+ b + +ex1a :: Logger Int +ex1a = do let a= 3+4 + logger $ "Calculated a: " ++ show a + let b= 8* 3 + logger $ "Calculated b: " ++ show b + return $ a+ b + + +-- examples for state Monad +-- Example using a very simple state +type WithCounter alpha = State Int alpha + +-- This function is like toLower, but also counts the number of upper-case +-- characters converted to lower. +cntToLower :: String-> (String, Int) +cntToLower s = run (cntToL s) 0 + +-- Main function : we can now use monad syntax! +cntToL :: String-> WithCounter String +cntToL [] = return "" +cntToL (x:xs) + | isUpper x = do ys<- cntToL xs + set (+1) + return (toLower x: ys) + | otherwise = do { ys<- cntToL xs; return (x: ys) } + + +-- Examples for references + +ex2 :: SR.Stateful Int String +ex2 = do r<- SR.newRef 43 + s<- SR.newRef 17 + SR.writeRef r 99 + SR.writeRef s 17 + v<- SR.readRef r + w<- SR.readRef s + return $ "r= "++ show v++ ", s= "++ show w + +ex3 :: Stateful String +ex3 = do r<- newRef "" + s<- newRef (0 :: Int) + writeRef r "Foo" + writeRef s 43 + vr <- readRef r + vs <- readRef s + return $ vr ++ show vs diff --git a/lecture-01/Haskell/ListMonad.hs b/lecture-01/Haskell/ListMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..72b2c1d34c48cd918cddcfdc60608b63d81e6683 --- /dev/null +++ b/lecture-01/Haskell/ListMonad.hs @@ -0,0 +1,26 @@ +module ListMonad where + +-- List Monad Instance + +import Prelude hiding ((++)) + +data List a = Nil | a :! (List a) + deriving (Read, Show) + +(++) :: List a-> List a-> List a +Nil ++ bs = bs +(a:! as) ++ bs = a :! (as ++ bs) + +instance Functor List where + fmap f Nil = Nil + fmap f (a:!as) = f a :! fmap f as + +instance Applicative List where + pure a = a :! Nil + f :! fs <*> a :! as = f a :! (fs <*> as) + _ <*> _ = Nil + +instance Monad List where + a :! as >>= g = g a ++ (as >>= g) + Nil >>= g = Nil + return a = a :! Nil diff --git a/lecture-01/Haskell/MaybeMonad.hs b/lecture-01/Haskell/MaybeMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..ab2e2a1dc5bcec4dbc6c0e58100fc56909fa8201 --- /dev/null +++ b/lecture-01/Haskell/MaybeMonad.hs @@ -0,0 +1,37 @@ +module MaybeMonad where + +-- Maybe and Either Monad Instances + +import Prelude hiding (Maybe, Just, Nothing, Either, Left, Right) + +data Maybe alpha = Just alpha | Nothing + +instance Functor Maybe where + fmap f (Just a) = Just (f a) + fmap f Nothing = Nothing + +instance Applicative Maybe where + pure a = Just a + Just f <*> Just b = Just (f b) + _ <*> _ = Nothing + +instance Monad Maybe where + Just a >>= g = g a + Nothing >>= g = Nothing + return = Just + +data Either alpha beta = Left alpha | Right beta + +instance Functor (Either alpha) where + fmap f (Right b) = Right (f b) + fmap f (Left a) = Left a + +instance Applicative (Either alpha) where + pure = Right + Right f <*> Right b = Right (f b) + _ <*> Left b = Left b + +instance Monad (Either alpha) where + Right b >>= g = g b + Left a >>= _ = Left a + return = Right diff --git a/lecture-01/Haskell/Perms.hs b/lecture-01/Haskell/Perms.hs new file mode 100644 index 0000000000000000000000000000000000000000..0a527a4f7520b9a31e5f4c861938e43c76c041ee --- /dev/null +++ b/lecture-01/Haskell/Perms.hs @@ -0,0 +1,24 @@ +module Perms where + +-- Ohne Monaden-Notation +ins' :: alpha-> [alpha]-> [[alpha]] +ins' x [] = [[x]] +ins' x (y:ys) = [x:y:ys] ++ map (y :) (ins' x ys) + +perms' :: [alpha]-> [[alpha]] +perms' [] = [[]] +perms' (x:xs) = [is | ps <- perms' xs, is <- ins' x ps ] + +-- In Monaden-Notation: +ins :: alpha-> [alpha]-> [[alpha]] +ins x [] = return [x] +ins x (y:ys) = [x:y:ys] ++ do + is <- ins x ys + return $ y:is + +perms :: [alpha]-> [[alpha]] +perms [] = return [] +perms (x:xs) = do + ps <- perms xs + is <- ins x ps + return is diff --git a/lecture-01/Haskell/ReaderMonad.hs b/lecture-01/Haskell/ReaderMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..2ce8496ce9419124fc121d6f59f9faa6b35cbc1c --- /dev/null +++ b/lecture-01/Haskell/ReaderMonad.hs @@ -0,0 +1,21 @@ +module ReaderMonad where + +data Reader sigma alpha = R {run :: sigma-> alpha} + +instance Functor (Reader sigma) where + fmap f (R g) = R (f. g) + +instance Applicative (Reader sigma) where + pure a = R (const a) + R g <*> R f = R $ \s-> g s (f s) + +instance Monad (Reader sigma) where + return a = R (const a) + R f >>= g = R $ \s-> run (g (f s)) s + + +--Elementary operations: reading the state +get :: (sigma-> alpha)-> Reader sigma alpha +get f = R $ \s-> f s +-- equivalent to get = R + diff --git a/lecture-01/Haskell/Refs.hs b/lecture-01/Haskell/Refs.hs new file mode 100644 index 0000000000000000000000000000000000000000..0e41d150fe17e753d0403149038db5f15fbe6423 --- /dev/null +++ b/lecture-01/Haskell/Refs.hs @@ -0,0 +1,49 @@ +module Refs( + Ref + , Stateful + , readRef + , writeRef + , newRef + , runSt + ) where + +-- Typed references + +import qualified Data.Map as Map +import Data.Map(Map) +import Text.Printf +import Data.Dynamic + +import StateMonad + +newtype Ref alpha = Ref Int + +-- The memory maps references to alpha values, and keeps track of the next +-- fresh reference. +data Mem = Mem { fresh :: Int, mem :: Map Int Dynamic } + +-- A stateful computation is a state monad with a memory as a state +type Stateful beta = State Mem beta + -- This is slightly unsafe because the type synonym is not opaque + +-- Elementary operations + +readRef :: Typeable alpha=> Ref alpha-> Stateful alpha +readRef (Ref i) = get $ \m-> + case Map.lookup i (mem m) of + Just a -> case fromDynamic a of + Just v -> v + Nothing -> error $ printf "readRef: Refence %06x ill-typed" i + Nothing -> error $ printf "readRef: Reference %06x not defined" i +writeRef :: Typeable alpha=> Ref alpha-> alpha-> Stateful () +writeRef (Ref i) a = set $ \m-> m{mem = Map.insert i (toDyn a) (mem m)} + +newRef :: Typeable alpha=> alpha-> Stateful (Ref alpha) +newRef a = do i <- get fresh + set $ \m-> m {mem= Map.insert i (toDyn a) (mem m), fresh= i+1} + return $ Ref i + +-- Run alpha stateful computation with an empty state +runSt :: Stateful beta -> beta +runSt s = fst $ StateMonad.run s $ Mem { fresh= 0, mem= Map.empty } + diff --git a/lecture-01/Haskell/SimpleRefs.hs b/lecture-01/Haskell/SimpleRefs.hs new file mode 100644 index 0000000000000000000000000000000000000000..04b94ebc5d852e08914c3e896f2afd98e571166f --- /dev/null +++ b/lecture-01/Haskell/SimpleRefs.hs @@ -0,0 +1,45 @@ +module SimpleRefs( + Ref + , Stateful + , readRef + , writeRef + , newRef + , runSt + ) where + +import qualified Data.Map as Map +import Data.Map(Map) +import Text.Printf + +import StateMonad + +newtype Ref = Ref Int + +-- The memory maps references to a values, and keeps track of the next +-- fresh reference. +data Mem alpha = Mem { fresh :: Int, mem :: Map Int alpha } + +-- A stateful computation is a state monad with a memory as a state +type Stateful alpha beta = State (Mem alpha) beta + +-- Elementary operations + +readRef :: Ref-> Stateful alpha alpha +readRef (Ref i) = get $ \m-> + case Map.lookup i (mem m) of + Just a -> a + Nothing -> error $ printf "readRef: Reference %08x not defined." i + +writeRef :: Ref-> alpha-> Stateful alpha () +writeRef (Ref i) a = set $ \m-> m{mem = Map.insert i a (mem m)} + +newRef :: alpha-> Stateful alpha Ref +newRef a = do i <- get fresh + set $ \m-> m { mem= Map.insert i a (mem m), fresh= i+1 } + return $ Ref i + +-- Run a stateful computation with a new state + +runSt :: Stateful alpha beta -> beta +runSt s = fst $ StateMonad.run s $ Mem { fresh= 0, mem= Map.empty } + diff --git a/lecture-01/Haskell/SimpleState.hs b/lecture-01/Haskell/SimpleState.hs new file mode 100644 index 0000000000000000000000000000000000000000..1b134d3650eff28729b6cfa8273ff16aa5bec990 --- /dev/null +++ b/lecture-01/Haskell/SimpleState.hs @@ -0,0 +1,55 @@ +module SimpleState where + +import Prelude hiding (curry, uncurry, map) +import Data.Char (isUpper, toLower) + +curry :: ((alpha, beta) -> gamma)-> alpha-> beta-> gamma +uncurry :: (alpha-> beta-> gamma)-> (alpha, beta) -> gamma + +curry f a b = f (a, b) +uncurry f (a, b)= f a b + +-- A very simple ``state transformer'' + +-- Type representing a state transforming function +type State sigma alpha = sigma-> (alpha, sigma) + +-- Composition of two state transformers +comp :: State sigma alpha-> (alpha-> State sigma beta)-> State sigma beta +comp f g = uncurry g . f + +-- Lifting: the trivial state transformer +lift :: alpha-> State sigma alpha +lift = curry id + +-- Transforming functions +map :: (alpha-> beta)-> State sigma alpha-> State sigma beta +map f g = (\(a, s)-> (f a, s)) . g + +-- Basic operations + +-- Reading the state +get :: (sigma-> alpha)-> State sigma alpha +get f s = (f s, s) + +-- Setting the state +set :: (sigma-> sigma)-> State sigma () +set g s = ((), g s) + +-- Example using a very simple state +type WithCounter alpha = State Int alpha + + +-- This function is like toLower, but also counts the number of upper-case +-- characters converted to lower. +cntToLower :: String-> (String, Int) +cntToLower s = cntToL s 0 + +-- Main function +cntToL :: String-> WithCounter String +cntToL [] = lift "" +cntToL (x:xs) + | isUpper x = cntToL xs `comp` + \ys-> set (+1) `comp` + \()-> lift (toLower x: ys) + | otherwise = cntToL xs `comp` \ys-> lift (x: ys) diff --git a/lecture-01/Haskell/StateMonad.hs b/lecture-01/Haskell/StateMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..ddf11c3147625cf2664cbdac06efb5ff0d1f0817 --- /dev/null +++ b/lecture-01/Haskell/StateMonad.hs @@ -0,0 +1,40 @@ +module StateMonad( + State + , get + , set + , run + ) where + +-- The simple state transformer as a monad + +-- Type representing a state transforming function +-- We need to wrap this in a datatype to be able to make it into an instance +data State sigma alpha = St { run :: sigma-> (alpha, sigma) } + +-- Transforming functions: Functor instance +instance Functor (State sigma) where + fmap f g = St $ \s-> (\(a, s1)-> (f a, s1)) (run g s) + +-- Applicate instance +instance Applicative (State sigma) where + pure a = St $ \s-> (a, s) + p <*> q = St $ \s-> let (f, s') = run p s + (a, s'') = run q s' + in (f a, s'') + +-- Composition and lifting: Monad instance +instance Monad (State sigma) where + f >>= g = St $ \s -> let (a, s')= run f s + in run (g a) s' + return a = St $ \s-> (a, s) + + +-- Basic operations + +-- Reading the state +get :: (sigma-> alpha)-> State sigma alpha +get f = St $ \s-> (f s, s) + +-- Setting the state +set :: (sigma-> sigma)-> State sigma () +set g = St $ \s-> ((), g s) diff --git a/lecture-01/Haskell/WriterMonad.hs b/lecture-01/Haskell/WriterMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..b1bb4bd6da80a2f19ca8a3c85ecb25a6e8c45be3 --- /dev/null +++ b/lecture-01/Haskell/WriterMonad.hs @@ -0,0 +1,34 @@ +module WriterMonad where + +import Data.Monoid + +data Writer sigma alpha = W sigma alpha + +instance Functor (Writer sigma) where + fmap f (W s a) = W s $ f a + +instance Monoid sigma=> Applicative (Writer sigma) where + pure a = W mempty a + W s1 f <*> W s2 a = W (s1 `mappend` s2) $ f a + +instance Monoid sigma=> Monad (Writer sigma) where + return a = W mempty a + (W s1 a) >>= g = let W s2 b = g a + in W (s1 `mappend` s2) b + +tell :: sigma-> Writer sigma () +tell s = W s () + +runW :: Writer sigma a-> (sigma, a) +runW (W s a) = (s, a) + +-- A logging monad + +type Logger = Writer [String] + +logger :: String-> Logger () +logger s = tell [s] + +runLog :: Logger a-> IO a +runLog c = let (l, a) = runW c + in do putStrLn $ unlines l; return a diff --git a/lecture-01/Scala/Expr.scala b/lecture-01/Scala/Expr.scala new file mode 100644 index 0000000000000000000000000000000000000000..737d73451edcf735bff8b8739b794f9437080663 --- /dev/null +++ b/lecture-01/Scala/Expr.scala @@ -0,0 +1,41 @@ +import scala.util.Try + +enum Operator: + case Plus + case Times + case Minus + case DivideBy + + override def toString: String = this match + case Plus => "+" + case Times => "*" + case Minus => "-" + case DivideBy => "/" + +enum Expr: + case Binary(operator: Operator, left: Expr, right: Expr) + case Const(value: Int) + case Variable(identifier: String) + + override def toString: String = this match + case Binary(op,l,r) => s"$l $op $r" + case Const(v) => v.toString + case Variable(i) => i + +object Expr: + def eval(expr: Expr, env: Map[String,Int]): Option[Int] = + expr match + case Const(v) => Some(v) + case Binary(op,l,r) => + val f: (Int,Int) => Int = op match + case Operator.Plus => _ + _ + case Operator.Minus => _ - _ + case Operator.Times => _ * _ + case Operator.DivideBy => _ / _ + for + l <- eval(l,env) + r <- eval(r,env) + res <- Try(f(l,r)).recover{ case e if !e.isInstanceOf[ArithmeticException] => throw e }.toOption + yield res + case Variable(i) => + env.get(i) diff --git a/lecture-01/Scala/Ordered.scala b/lecture-01/Scala/Ordered.scala new file mode 100644 index 0000000000000000000000000000000000000000..0999f13549eca9614c7a23c14863e995c8291c07 --- /dev/null +++ b/lecture-01/Scala/Ordered.scala @@ -0,0 +1,14 @@ +enum Order: + case LessThan + case Equal + case GreaterThan + +trait Ordered[T]: + def compare(a: T, b: T): Order + +def compare[T](a: T, b: T)(implicit order: Ordered[T]): Order = + order.compare(a,b) + +implicit class OrderOperators[T](a: T)(implicit order: Ordered[T]): + def >(b: T): Boolean = compare(a,b) == Order.GreaterThan + def <(b: T): Boolean = compare(a,b) == Order.LessThan \ No newline at end of file diff --git a/lecture-01/Scala/Rational.scala b/lecture-01/Scala/Rational.scala new file mode 100644 index 0000000000000000000000000000000000000000..cc1c21d795b8deb1bfdf0c1efa55a6b64461aef7 --- /dev/null +++ b/lecture-01/Scala/Rational.scala @@ -0,0 +1,9 @@ +case class Rational(num: Int, denom: Int) + +object Rational: + implicit object OrderedRational extends Ordered[Rational]: + def compare(a: Rational, b: Rational): Order = + a.num * b.denom - b.num * a.denom match + case x if x > 0 => Order.GreaterThan + case x if x < 0 => Order.LessThan + case _ => Order.Equal \ No newline at end of file diff --git a/lecture-02/Example.hs b/lecture-02/Example.hs new file mode 100644 index 0000000000000000000000000000000000000000..dda23cfad2cdaa669c8235e9d1a0e63e680d0888 --- /dev/null +++ b/lecture-02/Example.hs @@ -0,0 +1,18 @@ +module Example where + +import Control.Monad.Identity +import StateMonadT +import ExnMonadT + +type State = Int +type Error = String + +type ResMonad a = StateT (ExnT Identity Error) State a + +exm1 :: ResMonad Int +exm1 = do a<- get id + if (a == 0) then lift $ err "NULL!" + else set $ \_ -> a+1 + return a + + diff --git a/lecture-02/ExnMonadT.hs b/lecture-02/ExnMonadT.hs new file mode 100644 index 0000000000000000000000000000000000000000..ded5d0909eca12dc4d3e7022cc5c67876cc3f7ce --- /dev/null +++ b/lecture-02/ExnMonadT.hs @@ -0,0 +1,28 @@ +module ExnMonadT where + +-- Maybe and Either Monad Instances + +{- This is predefined: +data Either alpha beta = Left alpha | Right beta +-} + +data ExnT m e a = ExnT { runEx :: m (Either e a) } + +instance Functor m=> Functor (ExnT m e) where + fmap f (ExnT a) = ExnT (fmap (fmap f) a) + +instance Monad m=> Applicative (ExnT m e) where + pure = ExnT . pure . Right + ExnT fm <*> ExnT ma = ExnT $ do ef<- fm; ea<- ma; return $ ef <*> ea + +instance Monad m=> Monad (ExnT m e) where + return = ExnT . return . Right + ExnT ma >>= g = ExnT $ do e <- ma + case e of Right a -> runEx (g a) + Left err -> return (Left err) + + +-- Operations: + +err :: Monad m=> e-> ExnT m e a +err = ExnT. return. Left diff --git a/lecture-02/Expr/EvalFull.hs b/lecture-02/Expr/EvalFull.hs new file mode 100644 index 0000000000000000000000000000000000000000..8ee5a3ca50eca5fe1275f3014e7ef005ec71aa24 --- /dev/null +++ b/lecture-02/Expr/EvalFull.hs @@ -0,0 +1,32 @@ +module EvalFull where + +import Prelude hiding (fail) + +import Expr2 +import ResMonad +import qualified Data.Map as M + +type State = M.Map String Double + +eval :: Expr -> Res State Double +eval (Var i) = get (M.! i) +eval (Num n) = return n +eval (Plus a b) = do x<- eval a; y<- eval b; return $ x+ y +eval (Minus a b) = do x<- eval a; y<- eval b; return $ x- y +eval (Times a b) = do x<- eval a; y<- eval b; return $ x* y +eval (Div a b) = do x<- eval a; y<- eval b + if y == 0 then fail else return $ x / y +eval (Pick a b) = do x<- eval a; y<- eval b; join x y + +{- +-- Examples: +s = M.fromList[("a", 3), ("b", 7)] +run (eval (Plus (Var "a") (Var "b"))) s + +run (eval (Plus (Num 3) (Div (Var "b") (Minus (Num 3) (Var "a"))))) s + +run (eval (Plus (Num 3) (Div (Var "a") (Var "b")))) s + +run (eval (Div (Pick (Var "a") (Num 5)) (Pick (Var "b") (Num 0)))) s + +-} diff --git a/lecture-02/Expr/EvalND.hs b/lecture-02/Expr/EvalND.hs new file mode 100644 index 0000000000000000000000000000000000000000..91213afe2a66ff8a03e5726b57459cf7953bb728 --- /dev/null +++ b/lecture-02/Expr/EvalND.hs @@ -0,0 +1,20 @@ +module EvalND where + +import Expr2 + +eval :: Expr -> [Double] +eval (Var i) = return 0 +eval (Num n) = return n +eval (Plus a b) = do x<- eval a; y<- eval b; return $ x+ y +eval (Minus a b) = do x<- eval a; y<- eval b; return $ x- y +eval (Times a b) = do x<- eval a; y<- eval b; return $ x* y +eval (Div a b) = do x<- eval a; y<- eval b; return $ x/ y +eval (Pick a b) = do x<- eval a; y<- eval b; [x, y] + +{- +-- Examples: + +eval (Plus (Num 3) (Pick (Num 4) (Num 5))) +eval (Times (Pick (Num 4) (Num 5)) (Pick (Num 1) (Num 0))) + +-} diff --git a/lecture-02/Expr/EvalPartial.hs b/lecture-02/Expr/EvalPartial.hs new file mode 100644 index 0000000000000000000000000000000000000000..efc47242125cdd2aa7c74c744b2a32db0bb3a5fc --- /dev/null +++ b/lecture-02/Expr/EvalPartial.hs @@ -0,0 +1,19 @@ +module EvalPartial where + +import Expr + +eval :: Expr -> Maybe Double +eval (Var _) = return 0 +eval (Num n) = return n +eval (Plus a b) = do x<- eval a; y<- eval b; return $ x+ y +eval (Minus a b) = do x<- eval a; y<- eval b; return $ x- y +eval (Times a b) = do x<- eval a; y<- eval b; return $ x* y +eval (Div a b) = do + x<- eval a; y<- eval b; if y == 0 then Nothing else Just $ x/ y + +{- +-- Examples: +eval (Plus (Num 3) (Div (Times (Num 4) (Num 5)) (Minus (Num 3) (Num 3)))) +eval (Plus (Num 3) (Div (Times (Num 4) (Num 5)) (Minus (Num 4) (Num 3)))) + +-} diff --git a/lecture-02/Expr/EvalPlain.hs b/lecture-02/Expr/EvalPlain.hs new file mode 100644 index 0000000000000000000000000000000000000000..5796dbd41bc51e26503566b8e2359f3c6d8eade4 --- /dev/null +++ b/lecture-02/Expr/EvalPlain.hs @@ -0,0 +1,12 @@ +module EvalPlain where + +import Expr + +eval :: Expr -> Double +eval (Var _) = 0 +eval (Num n) = n +eval (Plus a b) = eval a+ eval b +eval (Minus a b) = eval a- eval b +eval (Times a b) = eval a* eval b +eval (Div a b) = eval a/ eval b + diff --git a/lecture-02/Expr/EvalStateful.hs b/lecture-02/Expr/EvalStateful.hs new file mode 100644 index 0000000000000000000000000000000000000000..d542d03752654ab7c6e192908110666de452ac55 --- /dev/null +++ b/lecture-02/Expr/EvalStateful.hs @@ -0,0 +1,23 @@ +module EvalStateful where + +import Expr +import ReaderMonad +import qualified Data.Map as M + +type State = M.Map String Double + +eval :: Expr -> Reader State Double +eval (Var i) = get (M.! i) +eval (Num n) = return n +eval (Plus a b) = do x<- eval a; y<- eval b; return $ x+ y +eval (Minus a b) = do x<- eval a; y<- eval b; return $ x- y +eval (Times a b) = do x<- eval a; y<- eval b; return $ x* y +eval (Div a b) = do x<- eval a; y<- eval b; return $ x/ y + +{- +-- Example: + +s = M.fromList[("a", 3), ("b", 7)] +run (eval (Plus (Var "a") (Var "b"))) s + +-} diff --git a/lecture-02/Expr/Expr.hs b/lecture-02/Expr/Expr.hs new file mode 100644 index 0000000000000000000000000000000000000000..d54c6c54807a1662d58af1cd53d08a3e50d89b07 --- /dev/null +++ b/lecture-02/Expr/Expr.hs @@ -0,0 +1,13 @@ +module Expr where + +data Expr = Var String + | Num Double + | Plus Expr Expr + | Minus Expr Expr + | Times Expr Expr + | Div Expr Expr + deriving (Eq, Show) + +evalM :: Monad m=> (String-> m a) -> (a-> a-> m a)-> Expr-> m a +evalM f p (Var i) = f i +evalM f p (Plus a b) = do x<- evalM f p a; y <- evalM f p b; p x y diff --git a/lecture-02/Expr/Expr2.hs b/lecture-02/Expr/Expr2.hs new file mode 100644 index 0000000000000000000000000000000000000000..523d358a30410368d2781f9c16af537699e7e024 --- /dev/null +++ b/lecture-02/Expr/Expr2.hs @@ -0,0 +1,11 @@ +module Expr2 where + +data Expr = Var String + | Num Double + | Plus Expr Expr + | Minus Expr Expr + | Times Expr Expr + | Div Expr Expr + | Pick Expr Expr + deriving (Eq, Show) + diff --git a/lecture-02/Expr/ListMonad.hs b/lecture-02/Expr/ListMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..72b2c1d34c48cd918cddcfdc60608b63d81e6683 --- /dev/null +++ b/lecture-02/Expr/ListMonad.hs @@ -0,0 +1,26 @@ +module ListMonad where + +-- List Monad Instance + +import Prelude hiding ((++)) + +data List a = Nil | a :! (List a) + deriving (Read, Show) + +(++) :: List a-> List a-> List a +Nil ++ bs = bs +(a:! as) ++ bs = a :! (as ++ bs) + +instance Functor List where + fmap f Nil = Nil + fmap f (a:!as) = f a :! fmap f as + +instance Applicative List where + pure a = a :! Nil + f :! fs <*> a :! as = f a :! (fs <*> as) + _ <*> _ = Nil + +instance Monad List where + a :! as >>= g = g a ++ (as >>= g) + Nil >>= g = Nil + return a = a :! Nil diff --git a/lecture-02/Expr/MaybeMonad.hs b/lecture-02/Expr/MaybeMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..ab2e2a1dc5bcec4dbc6c0e58100fc56909fa8201 --- /dev/null +++ b/lecture-02/Expr/MaybeMonad.hs @@ -0,0 +1,37 @@ +module MaybeMonad where + +-- Maybe and Either Monad Instances + +import Prelude hiding (Maybe, Just, Nothing, Either, Left, Right) + +data Maybe alpha = Just alpha | Nothing + +instance Functor Maybe where + fmap f (Just a) = Just (f a) + fmap f Nothing = Nothing + +instance Applicative Maybe where + pure a = Just a + Just f <*> Just b = Just (f b) + _ <*> _ = Nothing + +instance Monad Maybe where + Just a >>= g = g a + Nothing >>= g = Nothing + return = Just + +data Either alpha beta = Left alpha | Right beta + +instance Functor (Either alpha) where + fmap f (Right b) = Right (f b) + fmap f (Left a) = Left a + +instance Applicative (Either alpha) where + pure = Right + Right f <*> Right b = Right (f b) + _ <*> Left b = Left b + +instance Monad (Either alpha) where + Right b >>= g = g b + Left a >>= _ = Left a + return = Right diff --git a/lecture-02/Expr/ReaderMonad.hs b/lecture-02/Expr/ReaderMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..2ce8496ce9419124fc121d6f59f9faa6b35cbc1c --- /dev/null +++ b/lecture-02/Expr/ReaderMonad.hs @@ -0,0 +1,21 @@ +module ReaderMonad where + +data Reader sigma alpha = R {run :: sigma-> alpha} + +instance Functor (Reader sigma) where + fmap f (R g) = R (f. g) + +instance Applicative (Reader sigma) where + pure a = R (const a) + R g <*> R f = R $ \s-> g s (f s) + +instance Monad (Reader sigma) where + return a = R (const a) + R f >>= g = R $ \s-> run (g (f s)) s + + +--Elementary operations: reading the state +get :: (sigma-> alpha)-> Reader sigma alpha +get f = R $ \s-> f s +-- equivalent to get = R + diff --git a/lecture-02/Expr/ResMonad.hs b/lecture-02/Expr/ResMonad.hs new file mode 100644 index 0000000000000000000000000000000000000000..a589bea75bd463e6bbd68f15f7f92e1b59cc9aef --- /dev/null +++ b/lecture-02/Expr/ResMonad.hs @@ -0,0 +1,37 @@ +module ResMonad( + Res + , run + , get + , fail + , join + ) where + +import Prelude hiding (fail) + +-- The result monad: a combination of reader monad, list monad and maybe monad. +data Res sigma alpha = Res { run :: sigma-> [Maybe alpha] } + +instance Functor (Res sigma) where + fmap f (Res g) = Res $ fmap (fmap f). g + +instance Applicative (Res sigma) where + pure a = Res (const [Just a]) + Res f <*> Res a = Res $ \s-> do h<-f s; i<- a s; return $ h <*> i + +instance Monad (Res sigma) where + return a = Res (const [Just a]) + Res f >>= g = Res $ \s-> do ma<- f s + case ma of + Just a-> run (g a) s + Nothing-> return Nothing + +-- Elementary operations: + +get :: (sigma-> alpha)-> Res sigma alpha +get f = Res $ \s-> [Just $ f s] + +fail :: Res sigma alpha +fail = Res $ const [Nothing] + +join :: alpha-> alpha-> Res sigma alpha +join a b = Res $ \s-> [Just a, Just b] diff --git a/lecture-02/IMP/Absy.hs b/lecture-02/IMP/Absy.hs new file mode 100644 index 0000000000000000000000000000000000000000..20fb4cb0575d2bf4221d73424a7190b31cc59d49 --- /dev/null +++ b/lecture-02/IMP/Absy.hs @@ -0,0 +1,30 @@ +module Absy where + +-- Abstract syntax for a small imperative language + +data Cmd = (:=) Var Expr + | Block [Cmd] + | Print String Expr + | Read Var + | While BExpr Cmd + | If BExpr Cmd Cmd + | Break + | Throw String + | Catch Cmd (String-> Cmd) + +type Var = String + +data Expr = Num Int + | Var Var + | Plus Expr Expr + | Minus Expr Expr + | Times Expr Expr + | Div Expr Expr + | Mod Expr Expr + +data BExpr = Eq Expr Expr + | Less Expr Expr + | Not BExpr + | And BExpr BExpr + | Or BExpr BExpr + | BTrue diff --git a/lecture-02/IMP/Examples.hs b/lecture-02/IMP/Examples.hs new file mode 100644 index 0000000000000000000000000000000000000000..84761f17dfc831cf7d88d4fdf4d6c336c2ee1f19 --- /dev/null +++ b/lecture-02/IMP/Examples.hs @@ -0,0 +1,29 @@ +module Examples where + +import Absy +import IMP + +-- The factorial +p1 = Block [ Read "x" + , "n" := Num 1 + , Print "Input: " (Var "x") + , While (Less (Num 0) (Var "x")) $ + Block [ "n" := Times (Var "n") (Var "x") + , "x" := Minus (Var "x") (Num 1) + ] + , Print "The result is " (Var "n") + ] + +-- Collatz conjecture +p2 = Block [ Read "x" + , "c" := Num 0 + , While BTrue $ + Block [ Print "Tracing: x= " (Var "x") + , If (Eq (Num 0) (Mod (Var "x") (Num 2))) + ("x" := Div (Var "x") (Num 2)) + ("x" := Plus (Times (Var "x") (Num 3)) (Num 1)) + , If (Eq (Var "x") (Num 1)) Break (Block []) + , "c" := Plus (Var "c") (Num 1) + ] + , Print "Number of steps: " (Var "c") + ] diff --git a/lecture-02/IMP/IMP.hs b/lecture-02/IMP/IMP.hs new file mode 100644 index 0000000000000000000000000000000000000000..18fdbf6e35ead1acd4f0f32ebe1298e93ab69b62 --- /dev/null +++ b/lecture-02/IMP/IMP.hs @@ -0,0 +1,115 @@ +module IMP where + +-- A small imperative language + +import Text.Read(readMaybe) +import Data.Maybe(mapMaybe) + +import qualified Data.Map as Map +import Control.Monad.Identity +import Control.Monad.Except +import Control.Monad.State.Strict +import Control.Monad.Writer.Strict + +import Absy + +data St = St { mem :: Map.Map Var Int + , stdin :: [Int] + } + +initialState :: [Int]-> St +initialState i = St Map.empty i + +-- Exceptions +data Exn = BreakExn + | User String + | Error String + deriving Show + +type Imp a = StateT St (WriterT [String] (ExceptT Exn Identity)) a + +readVar :: Var-> Imp Int +readVar var = do + s<- get + case Map.lookup var (mem s) of + Just i -> return i + Nothing -> throwError (Error $ "Invalid variable access "++ var) + +writeVar :: Var-> Int-> Imp () +writeVar v w = modify $ \s-> s{mem = Map.insert v w (mem s)} + +output :: String-> Int-> Imp () +output msg i = tell [msg ++ show i] + +input :: Imp Int +input = do + s<- get + case stdin s of + i:is -> do put $ s{stdin = is} + return i + [] -> throwError (Error $ "Premature EOF") + +catch :: Imp ()-> (String-> Imp ())-> Imp () +catch i handler = + i `catchError` \e-> case e of User str-> handler str; _ -> throwError e + + +-- Evaluate an expression. + +liftBinOp :: (Int-> Int-> a)-> Expr-> Expr-> Imp a +liftBinOp f e1 e2 = do i1<- evalA e1; i2<- evalA e2; return $ f i1 i2 + +evalA :: Expr-> Imp Int +evalA (Num i) = return i +evalA (Var l) = readVar l +evalA (Plus e1 e2) = liftBinOp (+) e1 e2 +evalA (Minus e1 e2) = liftBinOp (-) e1 e2 +evalA (Times e1 e2) = liftBinOp (*) e1 e2 +evalA (Mod e1 e2) = do v1 <- evalA e1 + v2 <- evalA e2 + when (v2 == 0) $ throwError (Error $ "Division by zero") + return $ v1 `mod` v2 +evalA (Div e1 e2) = do v1 <- evalA e1 + v2 <- evalA e2 + when (v2 == 0) $ throwError (Error $ "Division by zero") + return $ v1 `div` v2 + +evalB :: BExpr -> Imp Bool +evalB BTrue = return True +evalB (Eq e1 e2) = liftBinOp (==) e1 e2 +evalB (Less e1 e2) = liftBinOp (<) e1 e2 +evalB (Not b) = do r<- evalB b; return (not r) +evalB (And b1 b2) = do r1<- evalB b1; r2<- evalB b2; return (r1 && r2) +evalB (Or b1 b2) = do r1<- evalB b1; r2<- evalB b2; return (r1 || r2) + +eval :: Cmd-> Imp () +eval (l := e) = do v<- evalA e; writeVar l v +eval (Block cs) = forM_ cs eval +eval (Print str e) = do i<- evalA e; output str i +eval (Read l) = do i<- input; writeVar l i +eval w@(While c i) = + do { b <- evalB c; if b then eval i >> eval w else return () } + `catchError` \e-> case e of BreakExn -> return (); _ -> throwError e +eval (If c p q) = + do b <- evalB c; + if b then eval p else eval q +eval Break = throwError BreakExn +eval (Throw exn) = throwError $ User exn +eval (Catch i handler) = eval i `catch` \s-> eval $ handler s + +readLines :: IO [String] +readLines = do + s <- getLine + m <- if (null s) then return [] else readLines + return $ s: m + +run :: Cmd-> IO () +run i = do + putStrLn "Please provide input (one number per line, end with empty line):" + l <- readLines + let ints= mapMaybe readMaybe l + let ws = runStateT (eval i) (initialState ints) + let out = execWriterT ws + case runExcept out of + Left ex -> putStrLn $ "*** ERROR: " ++ show ex + Right o -> putStr (unlines o) diff --git a/lecture-02/Scala/State.scala b/lecture-02/Scala/State.scala new file mode 100644 index 0000000000000000000000000000000000000000..8804485598e6b2d115a9359d8b0ffb25ca6af43c --- /dev/null +++ b/lecture-02/Scala/State.scala @@ -0,0 +1,37 @@ +case class State[S,A](run: S => (A,S)): + def flatMap[B](f: A => State[S,B]): State[S,B] = State { s => + val (a,s2) = run(s) + f(a).run(s2) + } + + def map[B](f: A => B): State[S,B] = + flatMap(a => State(s => (f(a),s))) + + def eval(s: S): A = run(s)._1 + def exec(s: S): S = run(s)._2 + +object State: + def get[S]: State[S,S] = new State(s => (s,s)) + def put[S](s_ : S): State[S,Unit] = new State(s => ((),s_)) + def modify[S](f: S => S): State[S,Unit] = get.flatMap(x => put(f(x))) + +object Example: + def push[A](x: A): State[List[A],Unit] = State.modify(x :: _) + + def pop[A]: State[List[A],A] = for + xs <- State.get + _ <- State.put(xs.tail) + yield xs.head + + def example: State[List[Int],Int] = for + _ <- push(10) + _ <- push(20) + a <- pop + b <- pop + _ <- push (a+b) + _ <- push(30) + a <- pop + b <- pop + _ <- push (a*b) + result <- pop + yield result \ No newline at end of file diff --git a/lecture-02/Scala/StateT.scala b/lecture-02/Scala/StateT.scala new file mode 100644 index 0000000000000000000000000000000000000000..72d7b26a2c1301f820b2eceab627315f1de0ba7f --- /dev/null +++ b/lecture-02/Scala/StateT.scala @@ -0,0 +1,56 @@ +import scala.language.higherKinds + +trait Monad[M[*]]: + def pure[A](a: A): M[A] + def bind[A,B](m: M[A], f: A => M[B]): M[B] + +object Monad: + implicit class MonadOps[M[*], A](m: M[A])(implicit instance: Monad[M]): + def flatMap[B](f: A => M[B]): M[B] = instance.bind(m, f) + def map[B](f: A => B): M[B] = flatMap(f andThen instance.pure) + +enum Failable[A]: + case Success(value: A) + case Failure(e: Throwable) + + def success[A](value: A): Failable[A] = Success(value) + def fail[A](e: Throwable): Failable[A] = Failure[A](e) + + implicit object MonadInstance extends Monad[Failable]: + def pure[A](a: A): Failable[A] = Success(a) + def bind[A, B](m: Failable[A], f: A => Failable[B]): Failable[B] = + m match + case Success(a) => f(a) + case Failure(e) => Failure(e) + + import Monad._ + + def example = for + a <- success(4) + b <- fail[Int](new Exception("whaaat?")) + c <- success(7) + yield c + +case class StateT[M[*],S,A](run: S => M[(A,S)]) + +object StateT: + implicit def monadInstance[M[*],S](implicit m: Monad[M]) = + new Monad[({type λ[Y] = StateT[M,S,Y]})#λ]: + override def pure[A](a: A): StateT[M, S, A] = + StateT(s => m.pure((a,s))) + + override def bind[A, B](f: StateT[M, S, A], g: A => StateT[M, S, B]): StateT[M, S, B] = + StateT[M,S,B](s => + m.bind[(A,S),(B,S)](f.run(s), { case (a,s2) => g(a).run(s2) })) + + def get[M[*],S](implicit m: Monad[M]): StateT[M,S,S] = new StateT(s => m.pure(s,s)) + def put[M[*],S](s_ : S)(implicit m: Monad[M]): StateT[M,S,Unit] = new StateT(s => m.pure((),s_)) + + implicit def lift[M[*],S,A](v: M[A])(implicit m: Monad[M]): StateT[M,S,A] = + StateT(s => m.bind(v,(a: A) => m.pure((a,s)))) + + import Monad._ + + def example = for + a <- get[Failable,Int] + yield a \ No newline at end of file diff --git a/lecture-02/Scala/build.sbt b/lecture-02/Scala/build.sbt new file mode 100644 index 0000000000000000000000000000000000000000..1c2fb5130c85aecc168d6cdfeaef003d62f90451 --- /dev/null +++ b/lecture-02/Scala/build.sbt @@ -0,0 +1,9 @@ +name := "02" + +version := "0.1" + +scalaVersion := "3.1.1" + +scalaSource in Compile := baseDirectory.value + +unmanagedSources / excludeFilter := "StateT.scala" diff --git a/lecture-02/Scala/project/build.properties b/lecture-02/Scala/project/build.properties new file mode 100644 index 0000000000000000000000000000000000000000..c8fcab543a9cfc5c5c21bb0b6cc80414275625ef --- /dev/null +++ b/lecture-02/Scala/project/build.properties @@ -0,0 +1 @@ +sbt.version=1.6.2 diff --git a/lecture-02/StateMonadT.hs b/lecture-02/StateMonadT.hs new file mode 100644 index 0000000000000000000000000000000000000000..6d096367e19aaf7c0c8dde9855826e6fae907e47 --- /dev/null +++ b/lecture-02/StateMonadT.hs @@ -0,0 +1,37 @@ +module StateMonadT where + +-- Type representing a state transforming function +data StateT m s a = St { runSt :: s-> m (a, s) } + +-- Functor instance +instance Functor m=> Functor (StateT m s) where + fmap f st1 = St $ \s-> fmap (\(a1, s1)-> (f a1, s1)) (runSt st1 s) + +-- Applicate instance +instance Monad m=> Applicative (StateT m s) where + pure a = St $ \s-> return (a, s) + p <*> q = St $ \s-> do (f, s') <- runSt p s + (a, s'') <- runSt q s' + return (f a, s'') + + +-- Composition: Monad instance +instance Monad m=> Monad (StateT m s) where + f >>= g = St $ \s -> do (a, s') <- runSt f s + runSt (g a) s' + return a = St $ \s-> return (a, s) + +-- Lifting +lift :: Monad m=> m a-> StateT m s a +lift ma = St $ \s-> do a<- ma; return (a, s) + +-- Basic operations + +-- Reading the state +get :: Monad m=> (s-> a)-> StateT m s a +get f = St $ \s-> return (f s, s) + +-- Setting the state +set :: Monad m=> (s-> s)-> StateT m s () +set g = St $ \s-> return ((), g s) + diff --git a/lecture-02/project/build.properties b/lecture-02/project/build.properties new file mode 100644 index 0000000000000000000000000000000000000000..c8fcab543a9cfc5c5c21bb0b6cc80414275625ef --- /dev/null +++ b/lecture-02/project/build.properties @@ -0,0 +1 @@ +sbt.version=1.6.2 diff --git a/lecture-03/Haskell/ConcExn.hs b/lecture-03/Haskell/ConcExn.hs new file mode 100644 index 0000000000000000000000000000000000000000..a390430ec92590b75bee2bfb8c5afe646d313a99 --- /dev/null +++ b/lecture-03/Haskell/ConcExn.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +import Control.Exception +import Control.Concurrent + +-- Catch an error call inside an IO action. +catcherr :: IO ()-> IO () +catcherr io = catch io handler where + -- Need explicit signature for handler here + handler :: ErrorCall -> IO () + handler e = putStrLn "An error call has been caught (and ignored)." + + +ex1 :: IO () +ex1 = do + m <- newEmptyMVar + forkIO (do {s<- takeMVar m; putStrLn s}) + threadDelay (100000) + catcherr $ putMVar m (error "FOO!") + +ex2 :: IO () +ex2 = do + m <- newEmptyMVar + forkIO (catcherr (do {s<- takeMVar m; putStrLn s})) + threadDelay (100000) + putMVar m (error "FOO!") + +ex3 :: IO () +ex3 = catcherr $ do + m <- newEmptyMVar + forkIO (do {s<- takeMVar m; putStrLn s}) + threadDelay (100000) + putMVar m (error "FOO!") + diff --git a/lecture-03/Haskell/Robots3.hs b/lecture-03/Haskell/Robots3.hs new file mode 100644 index 0000000000000000000000000000000000000000..894d92c77b5d28b3b88404d1982231e15be81666 --- /dev/null +++ b/lecture-03/Haskell/Robots3.hs @@ -0,0 +1,22 @@ +module Robots3 where + +import Control.Concurrent +import System.Random + +data Robot = Robot {id :: Int, pos :: Int, battery :: Int} + +instance Show Robot where + show (Robot i p b) = "Robot #"++ show i++ " at "++ show p++ " [battery: "++ show b++ "]" + +-- Move given robot by n units in separate thread, +-- return a future which gets filled once movement is complete +move :: Robot-> Int-> IO (MVar Robot) +move r n = do + f <- newEmptyMVar; forkIO (mv f r n); return f where + mv f r n + | n <= 0 || battery r <= 0 = putMVar f r + | otherwise = do + m<- randomRIO(0,10); threadDelay(m*100000) + putStrLn $ "Bleep, bleep: "++ show r + mv f r{pos= pos r+ 1, battery= battery r- 1} (n-1) + diff --git a/lecture-03/Haskell/RobotsEx1.hs b/lecture-03/Haskell/RobotsEx1.hs new file mode 100644 index 0000000000000000000000000000000000000000..5cf89ffa5960d8c4b3c31019d910a2e19847c29b --- /dev/null +++ b/lecture-03/Haskell/RobotsEx1.hs @@ -0,0 +1,11 @@ +module RobotsEx1 where + +import Control.Concurrent +import System.Random +import Robots3 + +ex :: IO () +ex = do + let swarm = [Robot i 0 5 | i<- [1..6]] + fs <- mapM (\r-> do { n <- randomRIO (0, 10); move r n }) swarm + putStrLn "Started moving robots..." diff --git a/lecture-03/Haskell/RobotsEx2.hs b/lecture-03/Haskell/RobotsEx2.hs new file mode 100644 index 0000000000000000000000000000000000000000..b489db9eab3e57bd9cf7343139c93ffb0fd20e06 --- /dev/null +++ b/lecture-03/Haskell/RobotsEx2.hs @@ -0,0 +1,13 @@ +module RobotsEx2 where + +import Control.Concurrent +import System.Random +import Robots3 + +ex :: IO () +ex = do + let swarm = [Robot i 0 5 | i<- [1..6]] + fs <- mapM (\r-> do { n <- randomRIO (0, 10); move r n }) swarm + putStrLn "Started moving robots..." + mapM_ (\f-> takeMVar f >>= putStrLn. show) fs + putStrLn "Finished moving robots" diff --git a/lecture-03/Haskell/RobotsEx3.hs b/lecture-03/Haskell/RobotsEx3.hs new file mode 100644 index 0000000000000000000000000000000000000000..3cd92a0446a3d1cabfe6e750ed89068b41916c2c --- /dev/null +++ b/lecture-03/Haskell/RobotsEx3.hs @@ -0,0 +1,25 @@ +module RobotsEx3 where + +import Control.Concurrent +import Control.Monad(when) +import System.Random +import Robots3 + +ex :: IO () +ex = do + let swarm = [Robot i 0 10 | i<- [1 .. numRobots]] + fs <- mapM (\r-> do { n <- randomRIO (0, 10); move r n }) swarm + putStrLn "Started moving robots..." + cnt <- newMVar numRobots + finished <- newEmptyMVar + mapM_ (\v-> forkIO (watchRobot v cnt finished)) fs + takeMVar finished + putStrLn "Finished moving robots..." + where + numRobots = 6 + watchRobot v cnt f = do + r<- takeMVar v + c<- modifyMVar cnt $ \c-> return (c-1, c-1) + putStrLn $ "Finished: "++ show r++ "(" ++ show c ++ " robots left.)" + when (c == 0) $ putMVar f () + diff --git a/lecture-03/Haskell/Sem.hs b/lecture-03/Haskell/Sem.hs new file mode 100644 index 0000000000000000000000000000000000000000..db967e1fc6e6b64819619c4015dcc6f1aba1ab7b --- /dev/null +++ b/lecture-03/Haskell/Sem.hs @@ -0,0 +1,32 @@ +module Sem where + +import Control.Concurrent hiding(QSem) + +data Sem = Sem (MVar (Bool, [MVar ()])) + +-- Create Semaphore +new :: IO Sem +new = do m <- newMVar (True, []) + return (Sem m) + +-- "P" +wait :: Sem -> IO () +wait (Sem sem) = do + (avail, blocked) <- takeMVar sem + if avail then + putMVar sem (False, []) + else do + block <- newEmptyMVar + putMVar sem (False, blocked++ [block]) + takeMVar block + +-- "V" +signal :: Sem -> IO () +signal (Sem sem) = do + (_, blocked) <- takeMVar sem + case blocked of + [] -> putMVar sem (True, []) + block:blocked' -> do + putMVar sem (False, blocked') + putMVar block () + diff --git a/lecture-03/Haskell/Simple1 b/lecture-03/Haskell/Simple1 new file mode 100755 index 0000000000000000000000000000000000000000..7092fd72d713bf25010285c677568acd619d80b5 Binary files /dev/null and b/lecture-03/Haskell/Simple1 differ diff --git a/lecture-03/Haskell/Simple1.hi b/lecture-03/Haskell/Simple1.hi new file mode 100644 index 0000000000000000000000000000000000000000..7af3be5e1dfe0a1d632c61d7cd60c83bd603eced Binary files /dev/null and b/lecture-03/Haskell/Simple1.hi differ diff --git a/lecture-03/Haskell/Simple1.hs b/lecture-03/Haskell/Simple1.hs new file mode 100644 index 0000000000000000000000000000000000000000..b2881b4a8d709cb8ae8bb48532290e26d2ed640f --- /dev/null +++ b/lecture-03/Haskell/Simple1.hs @@ -0,0 +1,9 @@ +module Main where + +import Control.Concurrent + +write :: Char-> IO () +write c = do putChar c; write c + +main :: IO () +main = do forkIO (write 'X'); write 'O' diff --git a/lecture-03/Haskell/Simple1.o b/lecture-03/Haskell/Simple1.o new file mode 100644 index 0000000000000000000000000000000000000000..5e419e3ca5042c00bdd5fd2072269614ff108064 Binary files /dev/null and b/lecture-03/Haskell/Simple1.o differ diff --git a/lecture-03/Haskell/Synchronized.hs b/lecture-03/Haskell/Synchronized.hs new file mode 100644 index 0000000000000000000000000000000000000000..7037a797c07f176e6cc9e37ba036a618bc2353b2 --- /dev/null +++ b/lecture-03/Haskell/Synchronized.hs @@ -0,0 +1,21 @@ +import qualified Sem +import Control.Concurrent + +sync :: Sem.Sem-> IO ()-> IO () +sync s f = do Sem.wait s; f; Sem.signal s + +b1 :: IO () +b1 = do putStrLn "foo"; threadDelay(1000); putStrLn "baz" + +-- Synchronized +s1 :: IO () +s1 = do q<- Sem.new; forkIO (sync q b1); sync q b1 + +-- Unsynchronized +us1 :: IO () +us1 = do q<- Sem.new; forkIO b1; b1 + +{- This also works: +q<- Sem.newQSem 1 +forkIO (sync q b1) >> (sync q b1) +-} diff --git a/lecture-03/Scala/Future.scala b/lecture-03/Scala/Future.scala new file mode 100644 index 0000000000000000000000000000000000000000..ba582e6359ebc4fa014982bc314abbcc1f0148f3 --- /dev/null +++ b/lecture-03/Scala/Future.scala @@ -0,0 +1,47 @@ +trait Future[+T] { self => + def onComplete(callback: Try[T] => Unit): Unit + + def map[U](f: T => U) = new Future[U] { + def onComplete(callback: Try[U] => Unit) = + self onComplete (t => callback(t.map(f))) + } + + def flatMap[U](f: T => Future[U]) = new Future[U] { + def onComplete(callback: Try[U] => Unit) = + self onComplete { _.map(f) match { + case Success(fu) => fu.onComplete(callback) + case Failure(e) => callback(Failure(e)) + } } + } + + def filter(p: T => Boolean) = + map { t => if (!p(t)) throw new NoSuchElementException; t } +} + +object Future { + def apply[T](f: => T) = { + val handlers = collection.mutable.Buffer.empty[Try[T] => Unit] + var result: Option[Try[T]] = None + + val runnable = new Runnable { + def run = { + val r = Try(f) + handlers.synchronized { + result = Some(r) + handlers.foreach(_(r)) + } + } + } + + (new Thread(runnable)).start() + + new Future[T] { + def onComplete(f: Try[T] => Unit) = handlers.synchronized { + result match { + case None => handlers += f + case Some(r) => f(r) + } + } + } + } +} diff --git a/lecture-03/Scala/README.md b/lecture-03/Scala/README.md new file mode 100644 index 0000000000000000000000000000000000000000..9c7c1f2f3fb2d2f01bc1a922b8f4ea5d3ae87234 --- /dev/null +++ b/lecture-03/Scala/README.md @@ -0,0 +1,8 @@ + +# How to run these examples interactively: + +* Compile with scalac ... +* Start interactive scala shell (scala): +> import robots1._ +> .... + diff --git a/lecture-03/Scala/Robots1.scala b/lecture-03/Scala/Robots1.scala new file mode 100644 index 0000000000000000000000000000000000000000..faafe5dff37af38d1b0d6d8b1286e6be88a5cd30 --- /dev/null +++ b/lecture-03/Scala/Robots1.scala @@ -0,0 +1,18 @@ +import scala.util.{Try,Success,Failure} +import scala.concurrent.{Future,Promise} +import scala.concurrent.ExecutionContext.Implicits.global +import scala.util.Random + +class LowBatteryException() extends Exception("Low Battery") + +case class Robot(id: Int, pos: Int, battery: Int): + private def mv(n: Int): Robot = + if n <= 0 then this + else if (battery > 0) then + Thread.sleep(100*Random.nextInt(10)); + Robot(id, pos+1, battery- 1).mv(n-1) + else throw new LowBatteryException + + def move(n: Int): Future[Robot] = Future { mv(n) } + + override def toString = s"Robot #$id at $pos [battery: $battery]" \ No newline at end of file diff --git a/lecture-03/Scala/Robots2.scala b/lecture-03/Scala/Robots2.scala new file mode 100644 index 0000000000000000000000000000000000000000..f87022fc9d8b7dc8276fcc4127155f477fafe333 --- /dev/null +++ b/lecture-03/Scala/Robots2.scala @@ -0,0 +1,17 @@ +import scala.concurrent.{Future, Promise} +import scala.concurrent.ExecutionContext.Implicits.global + +object Examples: + def ex1 = + val robotSwarm = List.range(1,6).map{i=> Robot(i,0,10)} + val moved = robotSwarm.map(_.move(10)) + moved.map(_.onComplete(println)) + println("Started moving...") + + def ex2 = + val r= Robot(99, 0, 20) + for + r1 <- r.move(3) + r2 <- r1.move(5) + r3 <- r2.move(2) + yield r3 \ No newline at end of file diff --git a/lecture-03/Scala/Try.scala b/lecture-03/Scala/Try.scala new file mode 100644 index 0000000000000000000000000000000000000000..1c46313b8641c3b06674fe5c94e8168df71292d0 --- /dev/null +++ b/lecture-03/Scala/Try.scala @@ -0,0 +1,25 @@ +/* Odersky's Try monad */ +import scala.util.control.NonFatal + +sealed abstract class Try[+T] { + scala.util.Try + def flatMap[U](f: T => Try[U]): Try[U] = this match { + case Success(x) => try f(x) catch { case NonFatal(ex) => Failure(ex) } + case fail: Failure => fail + } + def map[U](f: T => U): Try[U] = this match { + case Success(x) => Try(f(x)) + case fail: Failure => fail + } + def unit[U]= Try + } + +case class Success[T](x: T) extends Try[T] +case class Failure(ex: Throwable) extends Try[Nothing] + +object Try { + def apply[T](expr: => T): Try[T] = + try Success(expr) + catch { case NonFatal(ex) => Failure(ex) } + } + diff --git a/lecture-03/Scala/build.sbt b/lecture-03/Scala/build.sbt new file mode 100644 index 0000000000000000000000000000000000000000..afec67347b3c91ff512704581a4aafbf97c9d570 --- /dev/null +++ b/lecture-03/Scala/build.sbt @@ -0,0 +1,3 @@ +name := "lecture-03" +scalaVersion := "3.1.1" +Compile / scalaSource := baseDirectory.value \ No newline at end of file diff --git a/lecture-03/Scala/project/build.properties b/lecture-03/Scala/project/build.properties new file mode 100644 index 0000000000000000000000000000000000000000..c8fcab543a9cfc5c5c21bb0b6cc80414275625ef --- /dev/null +++ b/lecture-03/Scala/project/build.properties @@ -0,0 +1 @@ +sbt.version=1.6.2 diff --git a/lecture-04/Scala/Counter.scala b/lecture-04/Scala/Counter.scala new file mode 100644 index 0000000000000000000000000000000000000000..9d12f82daf0f713ad16ee5502e9ae749fbe8cc3e --- /dev/null +++ b/lecture-04/Scala/Counter.scala @@ -0,0 +1,27 @@ +import akka.actor.typed.scaladsl.Behaviors +import akka.actor.typed.{Behavior, ActorRef, ActorSystem} +import akka.actor.testkit.typed.scaladsl.ActorTestKit + + +enum Message: + case Count + case Get(n: ActorRef[Int]) + +def counter(count: Int): Behavior[Message] = Behaviors.receiveMessage { + case Message.Count => + counter(count + 1) + case Message.Get(sender) => + sender ! count + Behaviors.same +} + +@main def main() = + val testkit = ActorTestKit("hello") + val c = testkit.spawn(counter(0)) + c ! Message.Count + c ! Message.Count + c ! Message.Count + val p = testkit.createTestProbe[Int]() + c ! Message.Get(p.ref) + println(p.receiveMessage()) + testkit.shutdownTestKit() \ No newline at end of file diff --git a/lecture-04/Scala/build.sbt b/lecture-04/Scala/build.sbt new file mode 100644 index 0000000000000000000000000000000000000000..c97f8b4780509f777f0c775c3fd7d5a4b4790f50 --- /dev/null +++ b/lecture-04/Scala/build.sbt @@ -0,0 +1,11 @@ +name := "lecture-03" +scalaVersion := "3.1.1" +val AkkaVersion = "2.6.19" +val Slf4jVersion = "1.7.36" +libraryDependencies ++= Seq( + "com.typesafe.akka" %% "akka-actor-typed" % AkkaVersion, + "com.typesafe.akka" %% "akka-actor-testkit-typed" % AkkaVersion, + "org.slf4j" % "slf4j-api" % Slf4jVersion, + "org.slf4j" % "slf4j-simple" % Slf4jVersion +) +Compile / scalaSource := baseDirectory.value \ No newline at end of file diff --git a/lecture-04/Scala/project/build.properties b/lecture-04/Scala/project/build.properties new file mode 100644 index 0000000000000000000000000000000000000000..c8fcab543a9cfc5c5c21bb0b6cc80414275625ef --- /dev/null +++ b/lecture-04/Scala/project/build.properties @@ -0,0 +1 @@ +sbt.version=1.6.2 diff --git a/lecture-05/Bank.hs b/lecture-05/Bank.hs new file mode 100644 index 0000000000000000000000000000000000000000..473eba964104698f86f5d1e48ee8062e6c190c74 --- /dev/null +++ b/lecture-05/Bank.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE LambdaCase #-} +module Bank where + +import Control.Concurrent + +data Message a = Stop | Message { + messageSender :: (ActorRef a), + payload :: a +} + +newtype ActorRef a = ActorRef { + inbox :: MVar (Message a) +} + +data ActorContext a = ActorContext { + self :: ActorRef a, + sender :: ActorRef a +} + +newtype Behavior a = Behavior { + receive :: ActorContext a -> a -> IO (Behavior a) +} + +respond :: ActorContext a -> a -> IO () +respond context msg = + send (sender context) (self context) msg + +send :: ActorRef a -> ActorRef a -> a -> IO () +send (ActorRef recipient) sender message = + putMVar recipient (Message sender message) + +ask :: ActorRef a -> a -> IO a +ask recipient message = do + inbox <- newEmptyMVar + let self = ActorRef inbox + send recipient self message + (Message sender answer) <- takeMVar inbox + return answer + +stop :: ActorRef a -> IO () +stop (ActorRef recipient) = putMVar recipient Stop + +become :: (ActorContext a -> a -> IO (Behavior a)) -> IO (Behavior a) +become = return . Behavior + +actor :: Behavior a -> IO (ActorRef a) +actor behavior = do + inbox <- newEmptyMVar + let self = ActorRef inbox + let loop (Behavior behavior) = do + msg <- takeMVar inbox + case msg of + Stop -> return () + (Message sender msg) -> do + let context = ActorContext self sender + newState <- behavior context msg + loop newState + forkIO $ loop behavior + return self + +data BankMessage = + CreateAccount | NewBankAccount (ActorRef BankMessage) | + Deposit Integer | Withdraw Integer | + RequestBalance | Balance Integer | + Transfer (ActorRef BankMessage) (ActorRef BankMessage) Integer | + Done | Failed String + +data Bank = Bank { + accounts :: [ActorRef BankMessage] +} + +bank :: IO (ActorRef BankMessage) +bank = actor (Behavior receive) where + receive context = \case + CreateAccount -> do + newAccount <- account 0 + respond context $ NewBankAccount newAccount + become receive + Transfer from to amount -> do + tf <- wireTransfer + send tf (sender context) (Transfer from to amount) + become receive + +account :: Integer -> IO (ActorRef BankMessage) +account balance = actor (Behavior $ receive balance) where + receive balance context = \case + Deposit amount -> do + respond context $ Done + become $ receive (balance + amount) + Withdraw amount -> + if amount <= balance then do respond context $ Done + become $ receive (balance - amount) + else do respond context $ Failed "No sufficient balance" + become $ receive balance + RequestBalance -> do + respond context $ Balance balance + become $ receive balance + +wireTransfer :: IO (ActorRef BankMessage) +wireTransfer = actor (Behavior initialState) where + initialState context = \case + t@(Transfer from to amount) -> do + send from (self context) $ Withdraw amount + become $ waitForWithdraw (sender context) t + waitForWithdraw client t@(Transfer from to amount) context = \case + Done -> do + send to (self context) $ Deposit amount + become $ waitForDeposit client t + Failed reason -> do + send client (self context) $ Failed ("Withdrawal failed: " ++ reason) + stop (self context) + become undefined + waitForDeposit client (Transfer from to amount) context = \case + Done -> do + send client (self context) $ Done + stop (self context) + become undefined + Failed reason -> do + send client (self context) $ Failed ("") + stop (self context) + become undefined + +test :: IO () +test = do + theBank <- bank + NewBankAccount account1 <- ask theBank CreateAccount + NewBankAccount account2 <- ask theBank CreateAccount + ask account1 $ Deposit 10000 + result <- ask theBank $ Transfer account1 account2 5000 + case result of + Done -> putStrLn "Transfer successfull" + Failed reason -> putStrLn reason + Balance balance1 <- ask account1 RequestBalance + Balance balance2 <- ask account2 RequestBalance + putStrLn $ "Konto 1: " ++ (show balance1) ++ ", Konto 2: " ++ (show balance2) \ No newline at end of file diff --git a/lecture-05/BinTree.hs b/lecture-05/BinTree.hs new file mode 100644 index 0000000000000000000000000000000000000000..87e84947eb8341e515a1c836c94df6a4e34c6c49 --- /dev/null +++ b/lecture-05/BinTree.hs @@ -0,0 +1,54 @@ +data Tree a = Leaf a | Node (Tree a) (Tree a) + +data Ctxt a = Empty + | Le (Ctxt a) (Tree a) + | Ri (Tree a) (Ctxt a) + +newtype Loc a = Loc (Tree a, Ctxt a) + +top :: Tree a-> Loc a +top t = (Loc (t, Empty)) + +go_left :: Loc a-> Loc a +go_left (Loc(t, ctx)) = case ctx of + Empty -> error "go_left at empty" + Le c r -> error "go_left of left" + Ri l c -> Loc(l, Le c t) + +go_right :: Loc a-> Loc a +go_right (Loc(t, ctx)) = case ctx of + Empty -> error "go_right at empty" + Le c r -> Loc(r, Ri t c) + Ri _ _ -> error "go_right of right" + +go_up :: Loc a-> Loc a +go_up (Loc(t, ctx)) = case ctx of + Empty -> error "go_up of empty" + Le c r -> Loc(Node t r, c) + Ri l c -> Loc(Node l t, c) + +go_down_left :: Loc a-> Loc a +go_down_left (Loc(t, c)) = case t of + Leaf _ -> error "go_down at leaf" + Node l r -> Loc(l, Le c r) + +go_down_right :: Loc a-> Loc a +go_down_right (Loc(t, c)) = case t of + Leaf _ -> error "go_down at leaf" + Node l r -> Loc(r, Ri l c) + +ins_left :: Tree a-> Loc a-> Loc a +ins_left t1 (Loc(t, ctx)) = Loc(t, Ri t1 ctx) + +ins_right :: Tree a-> Loc a-> Loc a +ins_right t1 (Loc(t, ctx)) = Loc(t, Le ctx t1) + +delete :: Loc a-> Loc a +delete (Loc(_, c)) = case c of + Empty -> error "delete of empty" + Le c r -> Loc(r, c) + Ri l c -> Loc(l, c) + +update :: Tree a-> Loc a-> Loc a +update t (Loc(_, c)) = Loc(t, c) + diff --git a/lecture-05/BinTree.scala b/lecture-05/BinTree.scala new file mode 100644 index 0000000000000000000000000000000000000000..695ef4704040d8349dee387d8e06ab72dcac2600 --- /dev/null +++ b/lecture-05/BinTree.scala @@ -0,0 +1,55 @@ +// Binary trees with functional updates. + +enum Tree[+A]: + case Leaf(value: A) + case Node(left: Tree[A], + right: Tree[A]) + +enum Context[+A]: + case object Empty + case Left(up: Context[A], + right: Tree[A]) + case Right(left: Tree[A], + up: Context[A]) + + case Loc(tree: Tree[A], context: Context[A]) + + + def goLeft: Loc[A] = context match + case Empty => sys.error("goLeft at empty") + case Left(_,_) => sys.error("goLeft of left") + case Right(l,c) => Loc(l,Left(c,tree)) + + + def goRight: Loc[A] = context match + case Empty => sys.error("goRight at empty") + case Left(c,r) => Loc(r,Right(tree,c)) + case Right(_,_) => sys.error("goRight of right") + + + def goUp: Loc[A] = context match + case Empty => sys.error("goUp of empty") + case Left(c,r) => Loc(Node(tree,r),c) + case Right(l,c) => Loc(Node(l,tree),c) + + + def goDownLeft: Loc[A] = tree match + case Leaf(_) => sys.error("goDown at leaf") + case Node(l,r) => Loc(l,Left(context,r)) + + + def goDownRight: Loc[A] = tree match + case Leaf(_) => sys.error("goDown at leaf") + case Node(l,r) => Loc(r,Right(l,context)) + + + def insertLeft(t: Tree[A]): Loc[A] = + Loc(tree,Right(t,context)) + + def insertRight(t: Tree[A]): Loc[A] = + Loc(tree,Left(context,t)) + + def delete: Loc[A] = context match + case Empty => sys.error("delete of empty") + case Left(c,r) => Loc(r,c) + case Right(l,c) => Loc(l,c) diff --git a/lecture-05/EditorBetter.hs b/lecture-05/EditorBetter.hs new file mode 100644 index 0000000000000000000000000000000000000000..e5ef21a7f17b6c2bb3305df5a8a7b8762f3a1b5b --- /dev/null +++ b/lecture-05/EditorBetter.hs @@ -0,0 +1,42 @@ +module EditorBetter where + +import Data.Maybe(fromMaybe) + +-- A very simple text editor, but more efficient +data Editor = Ed { before :: [Char] -- In reverse order + , cursor :: Maybe Char + , after :: [Char] } + +empty :: Editor +empty = Ed [] Nothing [] + +go_left :: Editor-> Editor +go_left e@(Ed [] _ _) = e +go_left (Ed (a:as) (Just c) bs) = Ed as (Just a) (c: bs) + +go_right :: Editor-> Editor +go_right e@(Ed _ _ []) = e +go_right (Ed as (Just c) (b:bs)) = Ed (c:as) (Just b) bs + +-- Insert a char to the right of the cursor, move cursor +insert :: Char-> Editor-> Editor +insert t (Ed as Nothing bs) = Ed as (Just t) bs +insert t (Ed as (Just c) bs) = Ed (c:as) (Just t) bs + +-- Delete character under the cursor +delete :: Editor-> Editor +delete (Ed as _ (b:bs)) = Ed as (Just b) bs +delete (Ed (a:as) _ []) = Ed as (Just a) [] +delete (Ed [] _ []) = Ed [] Nothing [] + +-- Remove character to the left of cursor +remove :: Editor-> Editor +remove = delete . go_left + +-- Insert a string: successively insert characters +insert_str :: String-> Editor-> Editor +insert_str = flip $ foldl (flip insert) + +instance Show Editor where + show (Ed as c bs) = + reverse as ++ fromMaybe '?' c:bs ++"\n" ++ replicate (length as) ' ' ++ "^" diff --git a/lecture-05/EditorSimple.hs b/lecture-05/EditorSimple.hs new file mode 100644 index 0000000000000000000000000000000000000000..8b8193ba39c3b590ab1b2d6a0654d90663101f23 --- /dev/null +++ b/lecture-05/EditorSimple.hs @@ -0,0 +1,35 @@ +module SimpleEditor where + +-- A very simple text editor + +type Pos = Int +data Editor = Ed { text :: String + , cursor :: Pos } + +empty :: Editor +empty = Ed {text= "", cursor= 0} + +go_left :: Editor -> Editor +go_left Ed{text= t, cursor= c} + | c == 0 = error "At start of line" + | otherwise = Ed{text= t, cursor= c- 1} + +go_right :: Editor-> Editor +go_right Ed{text= t, cursor= c} + | c == length t = error "At end of text" + | otherwise = Ed{text= t, cursor= c+ 1} + +-- Insert a char to the right of the cursor, move cursor behind +insert :: Editor-> Char-> Editor +insert Ed{text= t, cursor= c} text = + let (as, bs) = splitAt c t + in Ed{text= as ++ (text: bs), cursor= c+1} + +-- Delete the character under the cursor +delete :: Editor-> Editor +delete Ed{text= t, cursor= c} = + let (as, bs) = splitAt c t + bs' = drop 1 bs + c' = if c == length t && c > 0 then c-1 else c + in Ed{text= as ++ bs', cursor= c} + diff --git a/lecture-05/EditorSimple.scala b/lecture-05/EditorSimple.scala new file mode 100644 index 0000000000000000000000000000000000000000..8ff1c379f8ddc40194bf7b1ee4e8d7257d7e47f7 --- /dev/null +++ b/lecture-05/EditorSimple.scala @@ -0,0 +1,30 @@ + +type Text = List[String] + +case class Pos(line: Int, col: Int) + +case class Editor(text: Text, cursor: Pos): + + def left: Editor = + if cursor.col == 0 then sys.error("At start of line") + else Editor(text, cursor.copy(col = cursor.col - 1)) + + def right: Editor = + if cursor.col == text(cursor.line).length then sys.error("At end of line") + else Editor (text, cursor.copy(col= cursor.col+ 1)) + + + private def updCurLine(newLine: String): List[String] = + text.take(cursor.line) ++ (newLine :: text.drop(cursor.line+ 1)) + + def insert(s: String): Editor = + val (befor,after) = text(cursor.line).splitAt(cursor.col) + Editor(updCurLine(befor+ s+ after),cursor.copy(col= cursor.col+1)) + + + def delete: Editor = + val (before, after)= text(cursor.line).splitAt(cursor.col) + val newCol = if (cursor.col == text(cursor.line).length) && cursor.col > 0 then + cursor.col- 1 else cursor.col + Editor(updCurLine(before+ after.drop(1)), cursor.copy(col= newCol)) + diff --git a/lecture-05/RoseTree.hs b/lecture-05/RoseTree.hs new file mode 100644 index 0000000000000000000000000000000000000000..abfe28cbdc68df784c5b2c1bab58e1a8e4e438f4 --- /dev/null +++ b/lecture-05/RoseTree.hs @@ -0,0 +1,85 @@ +module RoseTree where + +-- Rose trees with functional updates ("zipper") + +-- Rose trees: +data Tree a = Node a [Tree a] + deriving (Eq, Show) + +-- A context points into a tree: +-- * either empty +-- * or a list of left subtrees, a label, another context, and a list of right subtrees +data Ctxt a = Empty + | Cons [Tree a] a (Ctxt a) [Tree a] + +-- A tree together with a context +newtype Loc a = Loc (Tree a, Ctxt a) + +go_left :: Loc a-> Loc a +go_left (Loc(t, c)) = case c of + Cons (l:le) a up ri -> Loc(l, Cons le a up (t:ri)) + _ -> error "go_left: at first" + +go_right :: Loc a-> Loc a +go_right (Loc(t, c)) = case c of + Cons le a up (r:ri) -> Loc(r, Cons (t:le) a up ri) + _ -> error "go_right: at last" + +go_up :: Loc a-> Loc a +go_up (Loc (t, c)) = case c of + Empty -> error "go_up: at the top" + Cons le a up ri -> + Loc (Node a (reverse le ++ t:ri), up) + +go_down :: Loc a-> Loc a +go_down (Loc (t, c)) = case t of + Node _ [] -> error "go_down: at leaf" + Node a (t:ts) -> Loc (t, Cons [] a c ts) + +insert_left :: Tree a-> Loc a-> Loc a +insert_left t1 (Loc (t, c)) = case c of + Empty -> error "insert_left: insert at empty" + Cons le a up ri -> Loc(t, Cons (t1:le) a up ri) + +insert_right :: Tree a-> Loc a-> Loc a +insert_right t1 (Loc (t, c)) = case c of + Empty -> error "insert_right: insert at empty" + Cons le a up ri -> Loc(t, Cons le a up (t1:ri)) + +update :: Tree a-> Loc a-> Loc a +update t (Loc (_, c)) = Loc (t, c) + +delete :: Loc a-> Loc a +delete (Loc(_, c)) = case c of + Empty -> error "delete: delete at top" + Cons le a up (r:ri) -> Loc(r, Cons le a up ri) + Cons (l:le) a up [] -> Loc(l, Cons le a up []) + Cons [] a up [] -> Loc (Node a [], up) + +-- Start with given tree +top :: Tree a-> Loc a +top t = Loc (t, Empty) + +-- Navigation by path (cf. the simple rose trees) +path :: Loc a-> [Int]-> Loc a +path l [] = l +path l (i:ps) + | i == 0 = path (go_down l) ps + | i > 0 = path (go_left l) (i-1: ps) + + +-- Example tree +t = Node "-" [ Node "*" [ Node "a" [], Node "b" [] ] + , Node "*" [ Node "c" [], Node "d" [] ] + ] + +-- For debugging: +instance Show a=> Show(Loc a) where + show (Loc (t, Empty)) = show t + show (Loc (t, Cons ls a c ts)) = + replicate (length ls) '<' ++ "\n[" ++ show a ++ "]\n" ++ show t++ "\n"++ replicate (length ts) '>' + + +full :: Loc a-> Tree a +full (Loc (t, Empty)) = t +full (Loc (t, Cons ls a c ts)) = full (Loc (Node a $ reverse ls ++ (t:ts), c)) diff --git a/lecture-05/RoseTree.scala b/lecture-05/RoseTree.scala new file mode 100644 index 0000000000000000000000000000000000000000..6d84b92c156fd67b92290049f5eed361e4596522 --- /dev/null +++ b/lecture-05/RoseTree.scala @@ -0,0 +1,75 @@ +// Rose trees with functional updates: + +sealed trait Tree[A] +case class Leaf[A](a: A) extends Tree[A] +case class Node[A](children: Tree[A]*) extends Tree[A] + +sealed trait Context[+A] +case object Empty extends Context[Nothing] +case class Cons[A]( + left: List[Tree[A]], + up: Context[A], + right: List[Tree[A]]) extends Context[A] + +case class Loc[A]( + tree: Tree[A], + context: Context[A]) { + +def this(t: Tree[A])= this(t, Empty) + +def goLeft: Loc[A] = context match { + case Cons(l::le, up, ri) => + Loc(l, Cons(le, up, tree::ri)) + case _ => sys.error("goLeft of first") + } + +def goRight: Loc[A] = context match { + case Cons(le, up, r::ri) => + Loc(r, Cons(tree::le, up, ri)) + case _ => sys.error("goRight of last") + } + +def goUp: Loc[A] = context match { + case Empty => sys.error("goUp of empty") + case Cons(le, up, ri) => + Loc(Node((le.reverse ++ (tree::ri)):_*), up) + } + +def goDown: Loc[A] = tree match { + case Leaf(_) => sys.error("goDown at leaf") + case Node() => sys.error("goDown at empty") + case Node(t, ts@ _*) => + Loc(t, Cons(List(), context, ts.toList)) + } + +def insertLeft(t: Tree[A]): Loc[A] = context match { + case Empty => sys.error("insertLeft at empty") + case Cons(le, up, ri) => Loc(tree, Cons(t::le, up, ri)) + } + +def insertRight(t: Tree[A]): Loc[A] = context match { + case Empty => sys.error("insertRight at empty") + case Cons(le, up, ri) => Loc(tree, Cons(le, up, t::ri)) + } + +def insertDown(t: Tree[A]): Loc[A] = tree match { + case Leaf(_) => sys.error("insertDown at leaf") + case Node(ts @_*) => Loc(t, Cons(Nil, context, ts.toList)) + } + +def update(t: Tree[A]): Loc[A] = Loc(t, context) + +def delete: Loc[A] = context match { + case Empty => Loc(Node(),Empty) + case Cons(le, up, r::ri) => Loc(r, Cons(le, up, ri)) + case Cons(l::le, up, Nil) => Loc(l, Cons(le, up, Nil)) + case Cons(Nil, up, Nil) => Loc(Node(), up) + } + +def path(ps: List[Int]): Loc[A] = ps match { + case Nil => this + case i::ps if i == 0 => goDown.path(ps) + case i::ps if i > 0 => goLeft.path((i-1)::ps) + } + +} diff --git a/lecture-05/RoseTreeSimple.hs b/lecture-05/RoseTreeSimple.hs new file mode 100644 index 0000000000000000000000000000000000000000..f49fdc0a3ccb831eecd1f89f60e357e30cef45e4 --- /dev/null +++ b/lecture-05/RoseTreeSimple.hs @@ -0,0 +1,31 @@ +module RoseTreSimple where + +-- Simple rose trees +data Tree a = Node a [Tree a] + deriving (Eq, Show) + +-- Update, reference by name (substitution) +upd1 :: Eq a=> a-> Tree a-> Tree a-> Tree a +upd1 a nu (Node b ts) + | a == b = nu + | otherwise = Node b (map (upd1 a nu) ts) + +-- Update, reference by path +type Path = [Int] +upd2 :: Path-> Tree a-> Tree a-> Tree a +upd2 [] nu _ = nu +upd2 (p:ps) nu (Node a ts) + | p >= length ts = error $ "Malformed path (index "++ show p++ "too large)" + | otherwise = let (t1, t2)= splitAt p ts + in Node a $ t1++ upd2 ps nu (head t2) : tail t2 + +-- Examples +t = Node "-" [ Node "*" [Node "a" [], Node "b" []] + , Node "*" [Node "c" [], Node "d" []] + ] + +s= Node "+" [Node "x" [], Node "y" []] + +t1= upd1 "b" s t +t2= upd2 [1,2] s t + diff --git a/lecture-05/SimpleRoseTree.scala b/lecture-05/SimpleRoseTree.scala new file mode 100644 index 0000000000000000000000000000000000000000..f8a2395d0d6be08d3aebf4116eef1cd014c2a872 --- /dev/null +++ b/lecture-05/SimpleRoseTree.scala @@ -0,0 +1,7 @@ +enum Tree[A]: + case Leaf[A](a: A) + case Node[A](children: Tree[A]*) + +val t = Node(Leaf("-"), + Node(Leaf("*"), Leaf("a"), Leaf ("b")), + Node(Leaf("*"), Leaf("c"), Leaf ("d"))) diff --git a/lecture-05/ZipLists.hs b/lecture-05/ZipLists.hs new file mode 100644 index 0000000000000000000000000000000000000000..8cedd9eba9037bf17c897348f860a3c7b3c7e5af --- /dev/null +++ b/lecture-05/ZipLists.hs @@ -0,0 +1,29 @@ +-- Lists with functional update + +data List a = Nil | Cons a (List a) + deriving Show + +-- This context type is actually List a! +data Ctxt a = Empty | Snoc (Ctxt a) a + +-- So instead of this: +newtype Loc1 a = Loc1 (List a, Ctxt a) +-- we can have: +newtype Loc a = Loc (List a, List a) + +top :: List a-> Loc a +top xs = Loc (xs, Nil) + +-- Allowing us to write: +fastrev1 :: List a-> List a +fastrev1 xs = rev (top xs) where + rev :: Loc a-> List a + rev (Loc(Nil, as)) = as + rev (Loc(Cons x xs, as)) = rev (Loc (xs, Cons x as)) + +-- Note this is the same as the usual: +fastrev2 :: [a]-> [a] +fastrev2 xs = rev xs [] where + rev :: [a]-> [a]-> [a] + rev [] as = as + rev (x:xs) as = rev xs (x:as) diff --git a/lecture-05/ZipLists.scala b/lecture-05/ZipLists.scala new file mode 100644 index 0000000000000000000000000000000000000000..b6c011a418805d399cabde0525c7248676eee565 --- /dev/null +++ b/lecture-05/ZipLists.scala @@ -0,0 +1,16 @@ + +enum List[+A]: + case Nil + case Cons[A](head: A, tail: List[A]) + + +enum Context[+A]: + case Empty + case Snoc[A](init: Context[A], last: A) + + +object List: + def rev[A](l: List[A], init: List[A] = Nil): List[A] = l match + case Nil => init + case Cons(x, xs) => rev(xs, Cons(x, init)) + diff --git a/lecture-06/Haskell/CurryN.hs b/lecture-06/Haskell/CurryN.hs new file mode 100644 index 0000000000000000000000000000000000000000..0ba241f8faa263c05c14448efe80790475fdc082 --- /dev/null +++ b/lecture-06/Haskell/CurryN.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} +module CurryN where + +import Control.Monad +import Language.Haskell.TH + +curryN :: Int -> Q Exp +curryN n = do + f <- newName "f" + xs <- replicateM n (newName "x") + let args = map VarP (f:xs) + ntup = TupE (map VarE xs) + return $ LamE args (AppE (VarE f) ntup) + +genCurries :: Int -> Q [Dec] +genCurries n = forM [1..n] mkCurryDec + where mkCurryDec ith = do + cury <- curryN ith + let name = mkName $ "curry" ++ show ith + return $ FunD name [Clause [] (NormalB cury) []] \ No newline at end of file diff --git a/lecture-06/Haskell/JSON.hs b/lecture-06/Haskell/JSON.hs new file mode 100644 index 0000000000000000000000000000000000000000..0ad2055819e55fb2513644fee783997e1b7943ee --- /dev/null +++ b/lecture-06/Haskell/JSON.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DefaultSignatures, DeriveGeneric, TypeOperators, FlexibleContexts, FlexibleInstances #-} + +import GHC.Generics +import Data.List (intersperse) + +data JSON = + JSNull | + JSObject [(String,JSON)] | + JSArray [JSON] | + JSValue String + +instance Show JSON where + show (JSNull) = "null" + show (JSValue s) = s + show (JSObject s) = '{' : commaSeparatedfields ++ "}" where + commaSeparatedfields = concat $ intersperse ", " fields + fields = map (\(k,v) -> '"' : k ++ "\": " ++ (show v)) s + show (JSArray vs) = '[' : commaSeparatedItems ++ "]" where + commaSeparatedItems = concat $ intersperse ", " items + items = map show vs + +class ToJSON a where + toJSON :: a -> JSON + default toJSON :: (Generic a, ToJSON' (Rep a)) => a -> JSON + toJSON a = toJSON' (from a) + +instance ToJSON a => ToJSON [a] where + toJSON = JSArray . map toJSON + +instance {-# OVERLAPS #-} ToJSON [Char] where + toJSON s = JSValue ('"' : s ++ "\"") + +instance ToJSON Int where + toJSON i = JSValue (show i) + +class ToJSON' f where + toJSON' :: f p -> JSON + +-- Empty Type +instance ToJSON' V1 where + toJSON' x = undefined + +-- Unit Type +instance ToJSON' U1 where + toJSON' U1 = JSNull + +-- Sum Type +instance (ToJSON' f, ToJSON' g) => ToJSON' (f :+: g) where + toJSON' x = pullTag (json x) + where json (L1 x) = toJSON' x + json (R1 x) = toJSON' x + pullTag (JSObject [(name, JSObject fields)]) = + JSObject (("tag",toJSON name):fields) + +-- Product Type +instance (ToJSON' f, ToJSON' g) => ToJSON' (f :*: g) where + toJSON' (a :*: b) = case (toJSON' a, toJSON' b) of + (JSObject [head], JSObject fields) -> JSObject (head:fields) + +-- Type Ref +instance (ToJSON c) => ToJSON' (K1 i c) where + toJSON' (K1 x) = toJSON x + +-- Datatype Metadata (multiple constructors) +instance (ToJSON' f, ToJSON' g, Datatype d) => ToJSON' (M1 D d (f :+: g)) where + toJSON' (M1 x) = toJSON' x + +-- Datatype Metadata (single constructor) +instance (ToJSON' f, Datatype d) => ToJSON' (M1 D d f) where + toJSON' (M1 x) = dropTag $ toJSON' x + where dropTag (JSObject [(_,x)]) = x + +-- Constructor Metadata +instance (ToJSON' f, Constructor c) => ToJSON' (M1 C c f) where + toJSON' y@(M1 x) = JSObject [(conName y, toJSON' x)] + +-- Selector Metadata +instance (ToJSON' f, Selector c) => ToJSON' (M1 S c f) where + toJSON' y@(M1 x) = JSObject [(selName y, toJSON' x)] + +data Person = Person { + name :: [String], + age :: Int +} deriving Generic + +instance ToJSON Person diff --git a/lecture-06/Scala/Compiletime.scala b/lecture-06/Scala/Compiletime.scala new file mode 100644 index 0000000000000000000000000000000000000000..bb254af8b4edc2782f786d433ad0c2421308264d --- /dev/null +++ b/lecture-06/Scala/Compiletime.scala @@ -0,0 +1,7 @@ +import scala.compiletime.constValue +import scala.compiletime.ops.int.* + +type A = 3 +type B = 4 +type C = A + B +def sevenToFourteen(c: C) = constValue[C * 2] \ No newline at end of file diff --git a/lecture-06/Scala/HList.scala b/lecture-06/Scala/HList.scala new file mode 100644 index 0000000000000000000000000000000000000000..ed831ffbb956cdf25b0406f2d34785301c409714 --- /dev/null +++ b/lecture-06/Scala/HList.scala @@ -0,0 +1,25 @@ +import compiletime._ + +type Concat[L <: Tuple, +R <: Tuple] <: Tuple = L match + case EmptyTuple => R + case h *: t => h *: Concat[t, R] + +def concat[L <: Tuple, R <: Tuple](l: L, r: R): Concat[L,R] = + runtime.Tuples.concat(l,r).asInstanceOf[Concat[L,R]] + +val example: (Int,String,Boolean,Double) = + concat((1,"Hallo"),(false,4.2)) + +type F[X <: Int | String | Boolean | Double] = X match + case Int => Boolean + case String => Int + case Boolean => String + case Double => Double + +inline def f[X <: Int | String | Boolean | Double](x: X): F[X] = x match + case i: Int => i > 0 + case s: String => s.length + case b: Boolean => b.toString + case d: Double => -d + +//val example2: (Boolean,Int,String,Double) = example.map \ No newline at end of file diff --git a/lecture-06/Scala/Json1.scala b/lecture-06/Scala/Json1.scala new file mode 100644 index 0000000000000000000000000000000000000000..2c5877208802b44574d33c5d5e20bd397d37562e --- /dev/null +++ b/lecture-06/Scala/Json1.scala @@ -0,0 +1,38 @@ +package json1 + +//class ToJson t where +// write :: t -> String +sealed trait ToJson[T]: + def write(in: T): String + +object ToJson: + def write[T](t: T)(using toJson: ToJson[T]): String = toJson.write(t) + + // instance ToJson String where + // write s = '"' : s ++ ['"'] + given ToJson[String] with + def write(in: String) = '"' + in + '"' // Will break with escapes + + given ToJson[Int] with + def write(in: Int) = in.toString + + given [T](using toJson: ToJson[T]): ToJson[Seq[T]] with + def write(in: Seq[T]) = in.map(toJson.write).mkString("[",",","]") + + +////////////////// +// example code // +////////////////// + +case class Person(names: Seq[String], age: Int) + +given ToJson[Person] with + def write(in: Person) = + s"""|{ + | "type": "Person", + | "names": ${ToJson.write(in.names)}, + | "age": ${ToJson.write{in.age}} + |}""".stripMargin + + +val example = ToJson.write(Person(Seq("Homer","Simpson"),43)) \ No newline at end of file diff --git a/lecture-06/Scala/Json2.scala b/lecture-06/Scala/Json2.scala new file mode 100644 index 0000000000000000000000000000000000000000..cbf66d059f4b53df2c946a3b26a9bc97e2dbaa12 --- /dev/null +++ b/lecture-06/Scala/Json2.scala @@ -0,0 +1,68 @@ +package json2 + +import scala.deriving.Mirror +import scala.compiletime.* +sealed trait ToJson[T]: + def write(in: T): String + +object ToJson: + def write[T](in: T)(using toJson: ToJson[T]): String = toJson.write(in) + + // instance ToJson String where + // write s = '"' : s ++ ['"'] + given ToJson[String] with + def write(in: String) = '"' + in + '"' // Will break with escapes + + given ToJson[Int] with + def write(in: Int) = in.toString + + given [T](using toJson: ToJson[T]): ToJson[Seq[T]] with + def write(in: Seq[T]) = in.map(toJson.write).mkString("[",",","]") + + def sumToJson[T](s: Mirror.SumOf[T], toJsons: => List[ToJson[_]]): ToJson[T] = + new ToJson[T]: + def write(in: T) = + val index = s.ordinal(in) + toJsons(index).asInstanceOf[ToJson[Any]].write(in) + + + def productToJson[T](name: String, toJsons: => List[ToJson[_]]): ToJson[T] = + new ToJson[T]: + def write(in: T) = + val product = in.asInstanceOf[Product] + val values = product.productIterator + val discriminator = Iterator.single(ToJson.write("type") -> ToJson.write(name)) + val fields = + for + (value,index) <- values.zipWithIndex + name = ToJson.write(product.productElementName(index)) + jsonValue = toJsons(index).asInstanceOf[ToJson[Any]].write(value) + yield name -> jsonValue + (discriminator ++ fields).map(_ + ":" + _).mkString("{",",","}") + + inline def summonAll[T <: Tuple]: List[ToJson[_]] = + inline erasedValue[T] match + case _: EmptyTuple => Nil + case _: (t *: ts) => summonInline[ToJson[t]] :: summonAll[ts] + + inline given derived[T](using m: Mirror.Of[T]): ToJson[T] = + lazy val toJsons = summonAll[m.MirroredElemTypes] + lazy val name = valueOf[m.MirroredLabel] + inline m match + case s: Mirror.SumOf[T] => sumToJson(s,toJsons) + case _: Mirror.ProductOf[T] => productToJson(name,toJsons) + + +////////////////// +// example code // +////////////////// + +case class Person(name: Seq[String], age: Int) derives ToJson +enum Foo derives ToJson: + case Bar, Baz +case class Cat(name: String, lives: Int, foo: Foo) derives ToJson + +val example = ToJson.write(Person(Seq("Homer","Simpson"),43)) +val example2 = ToJson.write( + Cat("Maunzi", 9, Foo.Baz) +) \ No newline at end of file diff --git a/lecture-06/Scala/Typeclass.scala b/lecture-06/Scala/Typeclass.scala new file mode 100644 index 0000000000000000000000000000000000000000..cda0f352bd66980fec16e9ee721e8f94487c6821 --- /dev/null +++ b/lecture-06/Scala/Typeclass.scala @@ -0,0 +1,49 @@ +import scala.deriving.* +import scala.compiletime.{erasedValue, summonInline} + +inline def summonAll[T <: Tuple]: List[Eq[_]] = + inline erasedValue[T] match + case _: EmptyTuple => Nil + case _: (t *: ts) => summonInline[Eq[t]] :: summonAll[ts] + +trait Eq[T]: + def eqv(x: T, y: T): Boolean + +object Eq: + given Eq[Int] with + def eqv(x: Int, y: Int) = x == y + + def check(elem: Eq[_])(x: Any, y: Any): Boolean = + elem.asInstanceOf[Eq[Any]].eqv(x, y) + + def iterator[T](p: T) = p.asInstanceOf[Product].productIterator + + def eqSum[T](s: Mirror.SumOf[T], elems: => List[Eq[_]]): Eq[T] = + new Eq[T]: + def eqv(x: T, y: T): Boolean = + val ordx = s.ordinal(x) + (s.ordinal(y) == ordx) && check(elems(ordx))(x, y) + + def eqProduct[T](p: Mirror.ProductOf[T], elems: => List[Eq[_]]): Eq[T] = + new Eq[T]: + def eqv(x: T, y: T): Boolean = + iterator(x).zip(iterator(y)).zip(elems.iterator).forall { + case ((x, y), elem) => check(elem)(x, y) + } + + inline given derived[T](using m: Mirror.Of[T]): Eq[T] = + lazy val elemInstances = summonAll[m.MirroredElemTypes] + inline m match + case s: Mirror.SumOf[T] => eqSum(s, elemInstances) + case p: Mirror.ProductOf[T] => eqProduct(p, elemInstances) + +enum Opt[+T] derives Eq: + case Sm(t: T) + case Nn + +def test(): Unit = + import Opt.* + val eqoi = summon[Eq[Opt[Int]]] + assert(eqoi.eqv(Sm(23), Sm(23))) + assert(!eqoi.eqv(Sm(23), Sm(13))) + assert(!eqoi.eqv(Sm(23), Nn)) \ No newline at end of file diff --git a/lecture-06/Scala/build.sbt b/lecture-06/Scala/build.sbt new file mode 100644 index 0000000000000000000000000000000000000000..25928cda935a253cc3538e405d326becb67f1fa6 --- /dev/null +++ b/lecture-06/Scala/build.sbt @@ -0,0 +1,2 @@ +scalaVersion := "3.1.2" +name := "lecture-06" \ No newline at end of file diff --git a/lecture-06/Scala/project/build.properties b/lecture-06/Scala/project/build.properties new file mode 100644 index 0000000000000000000000000000000000000000..c8fcab543a9cfc5c5c21bb0b6cc80414275625ef --- /dev/null +++ b/lecture-06/Scala/project/build.properties @@ -0,0 +1 @@ +sbt.version=1.6.2 diff --git a/lecture-06/macro.c b/lecture-06/macro.c new file mode 100644 index 0000000000000000000000000000000000000000..faa904e9b7b06e3811e93364a4bc0f92ce215d7f --- /dev/null +++ b/lecture-06/macro.c @@ -0,0 +1,15 @@ +#include <stdio.h> + +#define square(n) ((n)*(n)) +#define UpTo(i, n) for((i) = 0; (i) < (n); (i)++) + +int main(int argc, char *argv[]) +{ + int i; + int B(A); + +UpTo(i,10) { + printf("i squared is: %d\n", square(i)); +} + +}