add examples from lectures

lecture-03/Haskell/Sem.hs

+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 ()
+

lecture-03/Haskell/Simple1.hs

+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'

lecture-03/Haskell/Synchronized.hs

+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)
+-}

lecture-03/Scala/Future.scala

+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)
+        }
+      }
+    }
+  }
+}

lecture-03/Scala/README.md

+
+# How to run these examples interactively:
+
+* Compile with scalac ...
+* Start interactive scala shell (scala):
+> import robots1._
+> ....
+

lecture-03/Scala/Robots1.scala

+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

lecture-03/Scala/Robots2.scala

+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

lecture-03/Scala/Try.scala

+/* 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) }
+  }
+

lecture-03/Scala/build.sbt

+name := "lecture-03"
+scalaVersion := "3.1.1"
+Compile / scalaSource := baseDirectory.value
\ No newline at end of file

lecture-03/Scala/project/build.properties

+sbt.version=1.6.2

lecture-04/Scala/Counter.scala

+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

lecture-04/Scala/build.sbt

+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

lecture-04/Scala/project/build.properties

+sbt.version=1.6.2

lecture-05/Bank.hs

+{-# 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

lecture-05/BinTree.hs

+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)
+

lecture-05/BinTree.scala

+// 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)

lecture-05/EditorBetter.hs

+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) ' ' ++ "^"