# 2016

## 1 Kinds

A: S  
B: S -> S  
C: a -> S if polymorphic kinds are allowed, otherwise S -> S  
D: S -> S -> S  
E: S -> (S -> S) -> S  
F: ((a -> S) -> S) -> S or a = S in case polymorphic kinds are not allowed  
E B A: incorrect, the first type variable should be instantiated with S, not S -> S.  
E A: (S -> S) -> S

E A B  
F G, with `:: G c = G (c Int)`

## 2 Generic Programming

```clean
generic types a :: a -> [String]
types{|Int|} _ = ["Int"]
types{|Bool|} _ = ["Bool"]
types{|UNIT|} _ = []
types{|PAIR|} fx fy (PAIR x y) = fx x ++ fy y
types{|EITHER|} fl _ (LEFT l)  = fl l
types{|EITHER|} _ fr (RIGHT r) = fr r
types{|OBJECT of d|} fx (OBJECT x) = [d.gtd_name:fx x]
types{|CONS|} fx (CONS x) = fx x

derive types [], (,)

typeCount :: a -> Int | types{|*|} a
typeCount x = length (removeDup (types{|*|} x))
```

## 3 Deep Embedding

```clean
// a
instance Functor Res
where
	fmap f (Res x) = Res (f x)
	fmap _ (Err e) = Err e

instance Applicative Res
where
	pure x = Res x
	(<*>) (Res f) (Res x) = Res (f x)
	(<*>) (Err e) _       = Err e
	(<*>) _       (Err e) = Err e

instance Monad Res
where
	bind (Res x) f = f x
	bind (Err e) _ = Err e

instance fail Res where fail e = Err e

// b
point :: Exp -> Res P
point (Point x y) = pure {x=x, y=y}
point (Add x y)   = (+) <$> point x <*> point y
point _           = fail "Point expected"

// c
region :: Exp -> Res Reg
region (Point _ _) = fail "Region expected"
region (Circle r) = pure (CIRCLE r)
region (Add x y) = ADD <$> region x <*> region y
region (Inter x y) = INT <$> region x <*> region y
region (Invert x) = INV <$> region x
region (Move p r) = MOVE <$> point p <*> region r

// d
inside :: Point Region -> Res Bool
inside p r = ins <$> point p <*> region r
```

## 4 iTasks

```clean
insideSim = withShared (Point 1 2, Circle 3) (\shr ->
	(updateSharedInformation "Edit" [] shr -&&- viewSharedInformation "Inside" [ViewUsing (uncurry inside)] shr) >>*
	[OnAction ActionNew (always insideSim)])

Start w = startEngine insideSim w
```

## 5 Type Safe Deep Embedding

```clean
// a
:: Exp t
	= Point_  (BM t P)   Int Int
	| Circle_ (BM t Reg) Radius
	| Add                (Exp t)   (Exp t)
	| Inter_  (BM t Reg) (Exp Reg) (Exp Reg)
	| Invert_ (BM t Reg) (Exp Reg)
	| Move_   (BM t Reg) (Exp P)   (Exp Reg)

Point  :== Point_ bm
Circle :== Circle_ bm
Inter  :== Inter_ bm
Invert :== Invert_ bm
Move   :== Move_ bm

// b
eval :: (Exp a) -> a | + a
eval (Point_ bm x y) = bm.f {x=x,y=y}
eval (Circle_ bm r)  = bm.f (CIRCLE r)
eval (Add x y)       = eval x + eval y
eval (Inter_ bm x y) = bm.f (INT (eval x) (eval y))
eval (Invert_ bm x)  = bm.f (INV (eval x))
eval (Move_ bm p r)  = bm.f (MOVE (eval p) (eval r))

// c
inside :: (Exp P) (Exp Reg) -> Bool
inside p r = ins (eval p) (eval r)

Start = inside (Point 1 2) (Circle 3)
```

## 6 Shallow Embedding

```clean
// a
class expr v
where
	point :: Int Int -> v P
	circle :: Radius -> v Reg
	add :: (v a) (v a) -> v a | + a
	inter :: (v Reg) (v Reg) -> v Reg
	invert :: (v Reg) -> v Reg
	move :: (v P) (v Reg) -> v Reg

// b
:: Eval t =: Eval t

instance expr Eval
where
	point x y = Eval {x=x, y=y}
	circle r = Eval (CIRCLE r)
	add (Eval x) (Eval y) = Eval (x + y)
	inter (Eval x) (Eval y) = Eval (INT x y)
	invert (Eval x) = Eval (INV x)
	move (Eval p) (Eval r) = Eval (MOVE p r)

// c
inside :: (Eval P) (Eval Reg) -> Bool
inside (Eval p) (Eval r) = ins p r

Start = inside (point 1 2) (circle 3)
```