Upgrade to Pro — share decks privately, control downloads, hide ads and more …

'Swift to Haskell: Overloading Semicolons' by Vladimir Kirillov

'Swift to Haskell: Overloading Semicolons' by Vladimir Kirillov

Originally posted here: https://speakerdeck.com/proger/swift-to-haskell-overloading-semicolons

This talk was made for CocoaHeads Kyiv #13 which took place Dec 16 2017.

CocoaHeads Ukraine

December 16, 2017
Tweet

More Decks by CocoaHeads Ukraine

Other Decks in Programming

Transcript

  1. overloading semicolons
    swift -> haskell
    Vlad Ki @darkproger

    View Slide

  2. @kievfprog

    View Slide

  3. View Slide

  4. View Slide

  5. View Slide

  6. View Slide

  7. struct Team {}
    struct Tournament {}
    func runTournament(_ tournament: Tournament) -> Team {
    let teams = tournament.joinTeams();
    let groups = tournament.emitGroups(teams);
    let groupResults = groups.map(tournament.runGroup);
    let brackets = tournament.buildBracket(groupResults);
    NSLog("%@", brackets);
    let winner = tournament.eliminate(brackets);
    return winner;
    }

    View Slide

  8. Distinct Haskell Features
    → laziness (non-strict eval, call-by-need)
    → pure, referentially-transparent functions
    → enables equational reasoning

    View Slide

  9. Laziness is Awesome

    View Slide

  10. Why FP Matters, John Hughes 1990:
    Modularity
    within eps (a:b:rest)
    | abs(a-b) <= eps = b
    | otherwise = within eps (b:rest)
    easydiff f x h
    = (f(x+h) − f x)/h
    differentiate h0 f x
    = map (easydiff f x) (repeat (/2) h0)
    within eps (differentiate h0 f x)

    View Slide

  11. Graphs
    data Node
    = A | B | C | D | E | F | G | H | I | J | K | L | M | N
    deriving (Show, Enum, Bounded, Eq)
    edge from to
    = case (from, to) of
    (A, B) -> Just 4
    (A, E) -> Just 6
    (A, D) -> Just 7
    -- ...

    View Slide

  12. reachable :: Node -> [Node]
    reachable from
    = catMaybes [fmap (const to) (edge from to) | to <- enum]

    View Slide

  13. type Trace = [Node]
    data Path = Path Int Trace deriving (Show, Eq)
    instance Ord Path where (Path a _) <= (Path b _) = a <= b

    View Slide

  14. Build the tree of all possible paths!
    bruteforce :: Int -> Trace -> Node -> Node -> Tree Path
    bruteforce cost trace to from
    = Tree (Path cost trace') (map build (reachable from))
    where
    trace' = from:trace
    build = bruteforce (cost + fromJust (edge from n)) trace' to

    View Slide

  15. Shortest path is easy, right?
    path == minimum (last (Tree.levels (bruteforce N A)))

    View Slide

  16. Branch and Bound
    data Bound a
    = Bound a
    | Unknown
    deriving (Show, Eq)
    -- | Unlike Maybe's Ord this one steers away from Unknown
    instance (Eq a, Ord a) => Ord (Bound a) where
    -- ...

    View Slide

  17. btw: cost must grow monotonically as you
    go down

    View Slide

  18. minbranch :: Ord a => Tree a -> Bound a
    minbranch = minbranch' Unknown
    minbranch' :: Ord a => Bound a -> Tree a -> Bound a
    minbranch' bound (Tree.Node root subs) =
    case subs of
    [] -> Bound root
    _ -> foldr f bound subs
    where
    f [email protected](Tree.Node r _) b
    | Bound r <= b = branch' b sub
    | otherwise = b -- **prune !!!**

    View Slide

  19. Ok, back to Dota2!

    View Slide

  20. struct Team {}
    struct Tournament {}
    func runTournament(_ tournament: Tournament) -> Team {
    let teams = tournament.joinTeams();
    let groups = tournament.emitGroups(teams);
    let groupResults = groups.map(tournament.runGroup);
    let brackets = tournament.buildBracket(groupResults);
    NSLog("%@", brackets);
    let winner = tournament.eliminate(brackets);
    return winner;
    }

    View Slide

  21. a slight syntax conversion
    data Team
    data Tournament
    runTournament (tournament :: Tournament) =
    let teams = joinTeams tournament
    groups = emitGroups tournament teams
    groupResults = map (runGroup tournament) teams
    brackets = buildBracket tournament groupResults
    _ = nsLog brackets
    winner = eliminate tournament brackets
    in (winner :: Team)

    View Slide

  22. nsLog will never be executed!
    data Team
    data Tournament
    runTournament (tournament :: Tournament) =
    let teams = joinTeams tournament
    groups = emitGroups tournament teams
    groupResults = map (runGroup tournament) teams
    brackets = buildBracket tournament groupResults
    _ = nsLog brackets
    winner = eliminate tournament brackets
    in (winner :: Team)

    View Slide

  23. let's bring back data dependencies
    data Team
    data Tournament
    runTournament (τ :: Tournament) =
    joinTeams τ
    !
    (\teams ->
    emitGroups τ teams
    !
    (\groups ->
    map (runGroup τ) teams
    !
    (\groupResults ->
    buildBracket τ groupResults (\brackets ->
    nsLog brackets
    !
    (\_ ->
    eliminate τ brackets (\winner ->
    winner))))))

    View Slide

  24. View Slide

  25. what type should have?
    perhaps
    !
    :: a -> (a -> b) -> b

    View Slide

  26. what type should have?
    sanity check:
    nsLog :: Show a => a -> Int
    nsLog x = callCFunction "NSLog" "%@" x
    test =
    let action = nsLog "hello"
    in x
    !
    (\_ -> x)
    * not referentially transparent!

    View Slide

  27. let's come up with a type for effects
    data Effects a = {- constructor for a computation
    that returns a value of type `a' -}
    !
    :: Effects a -> (a -> Effects b) -> Effects b
    !
    a f = {- perform computation `a',
    then feed its result to `f'
    which will give a computation `b' -}
    unit :: a -> Effects a
    unit a = {- make `a' pretend to be a computation -}

    View Slide

  28. data Team
    data Tournament
    runTournament :: Tournament -> Effects Team
    runTournament τ =
    joinTeams τ
    !
    (\teams ->
    emitGroups τ teams
    !
    (\groups ->
    map (runGroup τ) groups (\groupResults ->
    buildBracket τ groupResults (\brackets ->
    nsLog brackets
    !
    (\_ ->
    eliminate τ brackets (\winner ->
    unit winner))))))

    View Slide

  29. Sugar: do
    runTournament τ = do
    teams <- joinTeams τ
    groups <- emitGroups τ
    groupResults <- mapM (runGroup τ) groups
    brackets <- buildBracket τ groupResults
    nsLog brackets
    winner <- eliminate τ brackets
    unit winner

    View Slide

  30. a monad, where = >>=
    class Functor f where
    fmap :: (a -> b) -> f a -> f b
    class Functor m => Monad m where
    return :: a -> m a
    (>>=) :: m a -> (a -> m b) -> m b
    also, m has kind * -> *: HKT!

    View Slide

  31. map in a monad
    mapM :: Monad m => (a -> m b) -> [a] -> m [b]
    mapM f [] = return []
    mapM f (x:xs)
    = f x >>= \x' ->
    mapM f xs >>= \xs' ->
    return (x':xs')

    View Slide

  32. what about the rest of the functions?
    runTournament τ = do
    teams <- joinTeams τ
    groups <- emitGroups τ
    groupResults <- mapM (runGroup τ) groups
    brackets <- buildBracket τ groupResults
    nsLog brackets
    winner <- eliminate τ brackets
    unit winner

    View Slide

  33. meh
    joinTeams = Ѕ༼ ϑ ༽ꙷ
    emitGroups = Ѕ༼ ϑ ༽ꙷ
    runGroup = Ѕ༼ ϑ ༽ꙷ
    buildBracket = Ѕ༼ ϑ ༽ꙷ
    eliminate = Ѕ༼ ϑ ༽ꙷ

    View Slide

  34. types first
    data Group
    data GResult
    data Team
    data Bracket
    data ElimResult

    View Slide

  35. types first
    data TournamentOps next
    = JoinTeams ([Team] -> next)
    | EmitGroups [Team] ([Group] -> next)
    | RunGroup Group (GResult -> next)
    | BuildBracket [GResult] (Bracket -> next)
    | Eliminate Bracket (ElimResult -> next)

    View Slide

  36. Free Monads
    ∀ f:Functor you have a simplest way to
    construct a Monad
    data Free f a
    = Return a
    | Free (f (Free f a))

    View Slide

  37. a free functor
    instance Functor f => Functor (Free f) where
    fmap f x = case x of
    Return a -> Return (f a)
    Free as -> Free (fmap (fmap f) as)

    View Slide

  38. and a free monad for every free functor
    instance Functor f => Monad (Free f) where
    return = Return
    (>>=) :: Free f a -> (a -> Free f b) -> Free f b
    x >>= f = case x of
    Return a -> f a
    Free as -> Free (fmap (>>= f) as)

    View Slide

  39. lifting to Free
    liftF :: Functor f => f a -> Free f a
    liftF = Free . fmap return
    act x = liftF . flip x () -- `act' for action
    fun0 x = liftF (x id)
    fun1 x = liftF . flip x id

    View Slide

  40. what about the rest?
    joinTeams = fun0 JoinTeams
    emitGroups = fun1 EmitGroups
    runGroup = fun1 RunGroup
    buildBracket = fun1 BuildBracket
    eliminate = fun1 Eliminate

    View Slide

  41. we have a program tree
    now!

    View Slide

  42. let's interpret it
    evalDemo :: Free Tournament ElimResult -> ElimResult
    evalDemo program = case program of
    Return x ->
    x
    Free (JoinTeams f) ->
    evalDemo (f mkTeam)
    Free (EmitGroups a f) ->
    evalDemo (f mkSomeGroup)
    Free (RunGroup (Group (w:r:_)) f) ->
    evalDemo (f (GResult w r))
    Free (BuildBracket a f) ->
    evalDemo (f bracket3Demo)
    Free (Eliminate a f) ->
    evalDemo (f (Winner (Team 1)))

    View Slide

  43. https://gist.github.com/proger/2961ca8e84c2b9637f576b449d008caf
    {-# LANGUAGE NoMonomorphismRestriction,
    NoImplicitPrelude,
    ScopedTypeVariables,
    StandaloneDeriving,
    RebindableSyntax #-}

    View Slide

  44. chatbots
    data Query
    data Input
    data Dialog next = Ask Query (Input -> next)
    bot :: [Input] -> Free Dialog Input -> Int
    bot answers program = case program of
    Return x -> x
    Free (Ask q f) ->
    case answers of
    (x:xs) -> bot xs (f x)
    [] -> error "lol"

    View Slide

  45. a blast from the past
    DSLs in objc era
    regularExpressionWithPattern:
    predicateWithFormat:
    constraintsWithVisualFormat:
    make.left.equalTo(superview.mas_left)
    .with.offset(padding.left)

    View Slide

  46. why do this in a strict language?
    → OCaml's LWT: https://mirage.io/wiki/tutorial-lwt
    let start c =
    Lwt.join [
    (Time.sleep_ns (Duration.of_sec 1) >>=
    fun () -> C.log c "Heads");
    (Time.sleep_ns (Duration.of_sec 2) >>=
    fun () -> C.log c "Tails")
    ] >>= fun () ->
    C.log c "Finished"

    View Slide

  47. how about a GPU DSL?

    View Slide

  48. View Slide

  49. canny :: Float
    -> Float
    -> Acc (Image RGBA32)
    -> (Acc (Image Float), Acc (Vector Int))
    canny (constant -> low) (constant -> high)
    = stage1
    . nonMaximumSuppression low high
    . gradientMagDir low
    . gaussianY
    . gaussianX
    . toGreyscale
    where
    stage1 x = (x, selectStrong x)
    → accelerate

    View Slide

  50. free monads over common types
    https://gist.github.com/leftaroundabout/
    144da39e1084d61b10ba603e5951de81

    View Slide

  51. View Slide

  52. View Slide

  53. equational reasoning: isomophisms and
    univalence

    View Slide

  54. data Nat
    = Z | Succ Nat

    View Slide

  55. data Maybe a = Nothing
    | Just a
    data List a = Nil
    | Cons a (List a)

    View Slide

  56. data Fix f = Fix (f (Fix f))
    data L a b = Nil | Cons a b
    type List a = Fix (L a)
    Nat ∼ Fix Maybe

    View Slide

  57. data Free f a
    = Return a
    | Free (f (Free f a))
    data Const c a = Const c
    data Free (Const c) a
    = Pure a
    | Free (Const c)
    data Either c a
    = Right a
    | Left c

    View Slide

  58. Decision Trees Are Free Monads Over the
    Reader Functor
    Clay Thomas
    https://clathomasprime.github.io/hask/freeDecision

    View Slide

  59. View Slide

  60. is all of this going to be in Swift?
    → probably not
    → but wait

    View Slide

  61. Neural Networks
    Grenade (ad)
    TensorFlow
    PyTorch
    DLVM: Modern Compiler Infrastructure for Deep
    Learning Systems, dlvm.org

    View Slide

  62. Automatic Differentiation

    View Slide

  63. // Staged function representing f(x, w, b) = dot(x, w) + b
    let f: Rep<(Float2D, Float2D, Float1D) -> Float2D> =
    lambda { x, w, b in x • w + b }
    // Staged function ’g’, type-inferred from ’f’
    let g = lambda { x, w, b in
    let linear = f[x, w, b] // staged function application
    return tanh(linear)
    }
    // Gradient of ’g’ with respect to arguments ’w’ and ’b’
    let dg = gradient(of: g, withRespectTo: (1, 2), keeping: 0)
    // ’dg’ has type:
    // Rep<(Float2D, Float2D, Float1D) -> (Float2D, Float2D, Float2D)>
    // Call staged function on input data ’x’, ’w’ and ’b’
    let (dg_dw, dg_db, result) = dg[x, w, b]

    View Slide

  64. View Slide