summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--exams/2015.md254
1 files changed, 254 insertions, 0 deletions
diff --git a/exams/2015.md b/exams/2015.md
new file mode 100644
index 0000000..040a09f
--- /dev/null
+++ b/exams/2015.md
@@ -0,0 +1,254 @@
+# 2015
+
+## 1 Kinds
+
+Maybe: S -> S
+A: S
+B: S
+C: S -> S
+D: k -> (k -> S) -> S
+E: ((S -> S) -> S) -> S
+D Maybe A: *incorrect*
+D A Maybe: S
+D Maybe: ((S -> S) -> S) -> S (if polymorphic kinds are allowed; otherwise incorrect)
+D A: (S -> S) -> S
+
+:: T m = T (m Int)
+
+## 2 Generic Programming
+
+```clean
+// a
+generic gToNothing a :: a -> a
+gToNothing{|Maybe|} _ _ = Nothing
+gToNothing{|UNIT|} _ = UNIT
+gToNothing{|EITHER|} fl fr (LEFT x) = LEFT (fl x)
+gToNothing{|EITHER|} fl fr (RIGHT x) = RIGHT (fr x)
+gToNothing{|PAIR|} fx fy (PAIR x y) = PAIR (fx x) (fy y)
+gToNothing{|OBJECT|} fx (OBJECT x) = OBJECT (fx x)
+gToNothing{|CONS|} fx (CONS x) = CONS (fx x)
+
+// b
+gToNothing{|Int|} i = i
+gToNothing{|Bool|} b = b
+derive gToNothing (,), []
+
+Start = gToNothing{|*|} (Just 1, [Nothing, Just True])
+
+// c
+:: Rose a = RoseLeaf | RoseTwig a [Rose a]
+
+prop_gToNothing_once_is_enough :: (Rose (Maybe Int)) -> Property
+prop_gToNothing_once_is_enough r = n r === twice n r
+where n = gToNothing{|*|}
+
+// d
+:: NothingCount a = NC Int
+
+generic gMaxNothingCount a :: NothingCount a
+gMaxNothingCount{|Int|} = NC 0
+gMaxNothingCount{|Maybe|} (NC x) = NC (max 1 x)
+gMaxNothingCount{|UNIT|} = NC 0
+gMaxNothingCount{|EITHER|} (NC x) (NC y) = NC (max x y)
+gMaxNothingCount{|PAIR|} (NC x) (NC y) = NC (x + y)
+gMaxNothingCount{|OBJECT|} (NC c) = NC c
+gMaxNothingCount{|CONS|} (NC c) = NC c
+```
+
+## 3 Deep Embedding
+
+```clean
+// a
+:: MoException e r = Exception e | Result r
+
+instance Functor (MoException e)
+where
+ fmap f (Exception e) = Exception e
+ fmap f (Result r) = Result (f r)
+
+instance Applicative (MoException e)
+where
+ pure x = Result x
+ (<*>) (Exception e) _ = Exception e
+ (<*>) _ (Exception e) = Exception e
+ (<*>) (Result f) (Result r) = Result (f r)
+
+instance Monad (MoException e)
+where
+ bind (Exception e) _ = Exception e
+ bind (Result r) f = f r
+
+unlockedInUpPos :: MoException CraneException a
+unlockedInUpPos = Exception UnlockedInUpPos
+
+movedInDownPos :: MoException CraneException a
+movedInDownPos = Exception MovedInDownPos
+
+// b
+:: VPosition = Up | Down
+:: HPosition = Ship | Quay
+
+:: Position =
+ { v :: VPosition
+ , h :: HPosition
+ }
+
+:: State =
+ { quay :: [String]
+ , ship :: [String]
+ , crane :: Maybe String
+ , pos :: Position
+ }
+
+// c
+// The advantage of using monads is two-fold:
+// - We can hide all error handling using combinators
+// - We get a lot for free using combinators (forever, ...)
+
+eval :: CAction State -> MoException CraneException State
+eval MoveLeft {pos={h=Quay,v=Down}} = movedInDownPos
+eval MoveLeft s = pure {s & pos.h=Ship}
+eval MoveRight {pos={h=Ship,v=Down}} = movedInDownPos
+eval MoveRight s = pure {s & pos.h=Quay}
+eval MoveUp s = pure {s & pos.v=Up}
+eval MoveDown s = pure {s & pos.v=Down}
+eval Lock s
+| s.crane =: (Just _) = pure s
+| s.pos.v =: Up = pure s
+| s.pos.h =: Ship = pure case s.ship of
+ [] -> s
+ [c:cs] -> {s & crane=Just c, ship=cs}
+| s.pos.h =: Quay = pure case s.quay of
+ [] -> s
+ [c:cs] -> {s & crane=Just c, quay=cs}
+eval Unlock {pos={v=Up},crane=Just _} = unlockedInUpPos
+eval Unlock s=:{crane=Just c} = pure case s.pos.h of
+ Ship -> {s & crane=Nothing, ship=[c:s.ship]}
+ Quay -> {s & crane=Nothing, quay=[c:s.quay]}
+eval Unlock s = pure s
+eval (a :. b) s = eval a s >>= eval b
+eval w=:(WhileContainerBelow a) s
+| isContainerBelow s = eval (a :. w) s
+| otherwise = pure s
+where
+ isContainerBelow :: State -> Bool
+ isContainerBelow {pos={h=Quay},quay=[_:_]} = True
+ isContainerBelow {pos={h=Ship},ship=[_:_]} = True
+ isContainerBelow _ = False
+```
+
+## 4 Task-Oriented Programming
+
+```clean
+// a
+enterAndSimulate :: Task State
+enterAndSimulate = enterInformation "Initial state" [] >>= apply
+where
+ apply :: State -> Task State
+ apply st = (enterInformation "Action" [] -|| viewInformation "State" [] st) >>*
+ [ OnAction ActionContinue (hasValue (\a -> eval` a st))
+ , OnAction ActionQuit (always st)
+ ]
+
+ eval` :: CAction State -> Task State
+ eval` a st = case eval a st of
+ Result st -> return st
+ Exception e -> throw e
+
+// b
+simulate :: CAction State -> Task ((CAction, State), MoException CraneException State)
+simulate a st = withShared (a,st) \shr ->
+ updateSharedInformation "Setup" [] shr -&&-
+ viewSharedInformation "Result" [ViewWith (uncurry eval)] shr
+```
+
+## 5 Shallow Embedding
+
+```clean
+// a
+moveLeft :: State -> MoException CraneException State
+moveLeft {pos={h=Quay,v=Down}} = movedInDownPos
+moveLeft s = pure {s & pos.h=Ship}
+
+moveRight :: State -> MoException CraneException State
+moveRight {pos={h=Ship,v=Down}} = movedInDownPos
+moveRight s = pure {s & pos.h=Quay}
+
+moveUp :: State -> MoException CraneException State
+moveUp s = pure {s & pos.v=Up}
+
+moveDown :: State -> MoException CraneException State
+moveDown s = pure {s & pos.v=Down}
+
+lock :: State -> MoException CraneException State
+lock s
+| s.crane =: (Just _) = pure s
+| s.pos.v =: Up = pure s
+| s.pos.h =: Ship = pure case s.ship of
+ [] -> s
+ [c:cs] -> {s & crane=Just c, ship=cs}
+| s.pos.h =: Quay = pure case s.quay of
+ [] -> s
+ [c:cs] -> {s & crane=Just c, quay=cs}
+
+unlock :: State -> MoException CraneException State
+unlock {pos={v=Up},crane=Just _} = unlockedInUpPos
+unlock s=:{crane=Just c} = pure case s.pos.h of
+ Ship -> {s & crane=Nothing, ship=[c:s.ship]}
+ Quay -> {s & crane=Nothing, quay=[c:s.quay]}
+unlock s = pure s
+
+(:.) infixl 1 ::
+ (State -> MoException CraneException State)
+ (State -> MoException CraneException State)
+ State -> MoException CraneException State
+(:.) a b s = a s >>= b
+
+whileContainerBelow :: (State -> MoException CraneException State)
+ State -> MoException CraneException State
+whileContainerBelow a s
+| isContainerBelow s = a s >>= whileContainerBelow a
+| otherwise = pure s
+where
+ isContainerBelow :: State -> Bool
+ isContainerBelow {pos={h=Quay},quay=[_:_]} = True
+ isContainerBelow {pos={h=Ship},ship=[_:_]} = True
+ isContainerBelow _ = False
+
+// b
+:: Up = Up_
+:: Down = Down_
+
+:: State updown = // ... (updown is always Up or Down)
+
+moveLeft :: (State Up) -> MoException CraneException (State Up)
+moveRight :: (State Up) -> MoException CraneException (State Up)
+
+moveUp :: (State Down) -> MoException CraneException (State Up)
+moveDown :: (State Up) -> MoException CraneException (State Down)
+
+lock :: (State Down) -> MoException CraneException (State Down)
+unlock :: (State Down) -> MoException CraneException (State Down)
+
+(:.) infixl 1 ::
+ ((State a) -> MoException CraneException (State b))
+ ((State b) -> MoException CraneException (State c))
+ (State a) -> MoException CraneException (State c)
+
+whileContainerBelow :: ((State a) -> MoException CraneException (State a))
+ (State a) -> MoException CraneException (State a)
+where
+ isContainerBelow :: (State a) -> Bool
+```
+
+c. We would have to include whether an action moves up or down in the `CAction`
+ type, i.e. `:: CAction updown = // ...`. But then `MoveUp` can only be a
+ constructor of the type `:: CAction Up`, not of `:: CAction Down`, and there
+ is no way to indicate this in the type definition.
+ With GADTs we can indicate it in the type definition, assuming that the
+ bimap argument of the constructor is always `bimapId :: Bimap a a`.
+
+d. Shallow embedding is faster and more space-efficient, because we do not
+ interpret data structures but execute code directly. In shallow embedding it
+ is also easier to add a language construct, although it is more difficult to
+ add a view.
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-16 07:56:14 +0000