Planet Haskell

January 19, 2019

Haskell at Work

Purely Functional GTK+, Part 2: TodoMVC

Purely Functional GTK+, Part 2: TodoMVC

In the last episode we built a "Hello, World" application using gi-gtk-declarative. It's now time to convert it into a to-do list application, in the style of TodoMVC.

To convert the “Hello, World!” application to a to-do list application, we begin by adjusting our data types. The Todo data type represents a single item, with a Text field for its name. We also need to import the Text type from Data.Text.

data Todo = Todo
  { name :: Text
  }

Our state will no longer be (), but a data types holding Vector of Todo items. This means we also need to import Vector from Data.Vector.

data State = State
  { todos :: Vector Todo
  }

As the run function returns the last state value of the state reducer loop, we need to discard that return value in main. We wrap the run action in void, imported from Control.Monad.

Let’s rewrite our view function. We change the title to “TodoGTK+” and replace the label with a todoList, which we’ll define in a where binding. We use container to declare a Gtk.Box, with vertical orientation, containing all the to-do items. Using fmap and a typed hole, we see that we need a function Todo -> BoxChild Event.

view' :: State -> AppView Gtk.Window Event
view' s = bin
  Gtk.Window
  [#title := "TodoGTK+", on #deleteEvent (const (True, Closed))]
  todoList
  where
    todoList = container Gtk.Box
                         [#orientation := Gtk.OrientationVertical]
                         (fmap _ (todos s))

The todoItem will render a Todo value as a Gtk.Label displaying the name.

view' :: State -> AppView Gtk.Window Event
view' s = bin
  Gtk.Window
  [#title := "TodoGTK+", on #deleteEvent (const (True, Closed))]
  todoList
  where
    todoList = container Gtk.Box
                         [#orientation := Gtk.OrientationVertical]
                         (fmap todoItem (todos s))
    todoItem todo = widget Gtk.Label [#label := name todo]

Now, GHC tells us there’s a “non-type variable argument in the constraint”. The type of todoList requires us to add the FlexibleContexts language extension.

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

The remaining type error is in the definition of main, where the initial state cannot be a () value. We construct a State value with an empty vector.

main :: IO ()
main = void $ run App
  { view         = view'
  , update       = update'
  , inputs       = []
  , initialState = State {todos = mempty}
  }

Adding New To-Do Items

While our application type-checks and runs, there are no to-do items to display, and there’s no way of adding new ones. We need to implement a form, where the user inserts text and hits the Enter key to add a new to-do item. To represent these events, we’ll add two new constructors to our Event type.

data Event
  = TodoTextChanged Text
  | TodoSubmitted
  | Closed

TodoTextChanged will be emitted each time the text in the form changes, carrying the current text value. The TodoSubmitted event will be emitted when the user hits Enter.

When the to-do item is submitted, we need to know the current text to use, so we add a currentText field to the state type.

data State = State
  { todos       :: Vector Todo
  , currentText :: Text
  }

We modify the initialState value to include an empty Text value.

main :: IO ()
main = void $ run App
  { view         = view'
  , update       = update'
  , inputs       = []
  , initialState = State {todos = mempty, currentText = mempty}
  }

Now, let’s add the form. We wrap our todoList in a vertical box, containing the todoList and a newTodoForm widget.

view' :: State -> AppView Gtk.Window Event
view' s = bin
  Gtk.Window
  [#title := "TodoGTK+", on #deleteEvent (const (True, Closed))]
  (container Gtk.Box
             [#orientation := Gtk.OrientationVertical]
             [todoList, newTodoForm]
  )
  where
    ...

The form consists of a Gtk.Entry widget, with the currentText of our state as its text value. The placeholder text will be shown when the entry isn’t focused. We use onM to attach an effectful event handler to the changed signal.

view' :: State -> AppView Gtk.Window Event
view' s = bin
  Gtk.Window
  [#title := "TodoGTK+", on #deleteEvent (const (True, Closed))]
  (container Gtk.Box
             [#orientation := Gtk.OrientationVertical]
             [todoList, newTodoForm]
  )
  where
    ...
    newTodoForm = widget
      Gtk.Entry
      [ #text := currentText s
      , #placeholderText := "What needs to be done?"
      , onM #changed _
      ]

The typed hole tells us we need a function Gtk.Entry -> IO Event. The reason we use onM is to have that IO action returning the event, instead of having a pure function. We need it to query the underlying GTK+ widget for it’s current text value. By using entryGetText, and mapping our event constructor over that IO action, we get a function of the correct type.

    ...
    newTodoForm = widget
      Gtk.Entry
      [ #text := currentText s
      , #placeholderText := "What needs to be done?"
      , onM #changed (fmap TodoTextChanged . Gtk.entryGetText)
      ]

It is often necessary to use onM and effectful GTK+ operations in event handlers, as the callback type signatures rarely have enough information in their arguments. But for the next event, TodoSubmitted, we don’t need any more information, and we can use on to declare a pure event handler for the activated signal.

    ...
    newTodoForm = widget
      Gtk.Entry
      [ #text := currentText s
      , #placeholderText := "What needs to be done?"
      , onM #changed (fmap TodoTextChanged . Gtk.entryGetText)
      , on #activate TodoSubmitted
      ]

Moving to the next warning, we see that the update' function is no longer total. We are missing cases for our new events. Let’s give the arguments names and pattern match on the event. The case for Closed will be the same as before.

update' :: State -> Event -> Transition State Event
update' s e = case e of
  Closed -> Exit

When the to-do text value changes, we’ll update the currentText state using a Transition. The first argument is the new state, and the second argument is an action of type IO (Maybe Event). We don’t want to emit any new event, so we use (pure Nothing).

update' :: State -> Event -> Transition State Event
update' s e = case e of
  TodoTextChanged t -> Transition s { currentText = t } (pure Nothing)
  Closed -> Exit

For the TodoSubmitted event, we define a newTodo value with the currentText as its name, and transition to a new state with the newTodo item appended to the todos vector. We also reset the currentText to be empty.

To use Vector.snoc, we need to add a qualified import.

import           Control.Monad                 (void)
import           Data.Text                     (Text)
import           Data.Vector                   (Vector)
import qualified Data.Vector                   as Vector
import qualified GI.Gtk                        as Gtk
import           GI.Gtk.Declarative
import           GI.Gtk.Declarative.App.Simple

Running the application, we can start adding to-do items.

Improving the Layout

Our application doesn’t look very good yet, so let’s improve the layout a bit. We’ll begin by left-aligning the to-do items.

todoItem i todo =
  widget
    Gtk.Label
    [#label := name todo, #halign := Gtk.AlignStart]

To push the form down to the bottom of the window, we’ll wrap the todoList in a BoxChild, and override the defaultBoxChildProperties to have the child widget expand and fill all the available space of the box.

todoList =
  BoxChild defaultBoxChildProperties { expand = True, fill = True }
    $ container Gtk.Box
                [#orientation := Gtk.OrientationVertical]
                (fmap todoItem (todos s))

We re-run the application, and see it has a nicer layout.

Completing To-Do Items

There’s one very important missing: being able to mark a to-do item as completed. We add a Bool field called completed to the Todo data type.

data Todo = Todo
  { name      :: Text
  , completed :: Bool
  }

When creating new items, we set it to False.

update' :: State -> Event -> Transition State Event
update' s e = case e of
  ...
  TodoSubmitted ->
    let newTodo = Todo {name = currentText s, completed = False}
    in  Transition
          s { todos = todos s `Vector.snoc` newTodo, currentText = mempty }
          (pure Nothing)
  ...

Instead of simply rendering the name, we’ll use strike-through markup if the item is completed. We define completedMarkup, and using guards we’ll either render the new markup or render the plain name. To make it strike-through, we wrap the text value in <s> tags.

widget
  Gtk.Label
    [ #label := completedMarkup todo
    , #halign := Gtk.AlignStart
    ]
  where
    completedMarkup todo
      | completed todo = "<s>" <> name todo <> "</s>"
      | otherwise      = name todo

For this to work, we need to enable markup for the label be setting #useMarkup to True.

widget
  Gtk.Label
    [ #label := completedMarkup todo
    , #useMarkup := True
    , #halign := Gtk.AlignStart
    ]
  where
    completedMarkup todo
      | completed todo = "<s>" <> name todo <> "</s>"
      | otherwise      = name todo

In order for the user to be able to toggle the completed status, we wrap the label in a Gtk.CheckButton bin. The #active property will be set to the current completed status of the Todo value. When the check button is toggled, we want to emit a new event called TodoToggled.

todoItem todo =
  bin Gtk.CheckButton
      [#active := completed todo, on #toggled (TodoToggled i)]
    $ widget
        Gtk.Label
        [ #label := completedMarkup todo
        , #useMarkup := True
        , #halign := Gtk.AlignStart
        ]

Let’s add the new constructor to the Event data type. It will carry the index of the to-do item.

data Event
  = TodoTextChanged Text
  | TodoSubmitted
  | TodoToggled Int
  | Closed

To get the corresponding index of each Todo value, we’ll iterate using Vector.imap instead of using fmap.

    todoList =
      BoxChild defaultBoxChildProperties { expand = True, fill = True }
        $ container Gtk.Box
                    [#orientation := Gtk.OrientationVertical]
                    (Vector.imap todoItem (todos s))
    todoItem i todo =
      ...

The pattern match on events in the update' function is now missing a case for the new event constructor. Again, we’ll do a transition where we update the todos somehow.

update' :: State -> Event -> Transition State Event
update' s e = case e of
  ...
  TodoToggled i -> Transition s { todos = _ (todos s) } (pure Nothing)
  ...

We need a function Vector Todo -> Vector Todo that modifies the value at the index i. There’s no handy function like that available in the vector package, so we’ll create our own. Let’s call it mapAt.

update' :: State -> Event -> Transition State Event
update' s e = case e of
  ...
  TodoToggled i -> Transition s { todos = mapAt i _ (todos s) } (pure Nothing)
  ...

It will take as arguments the index, a mapping function, and a Vector a, and return a Vector a.

mapAt :: Int -> (a -> a) -> Vector a -> Vector a

We implement it using Vector.modify, and actions on the mutable representation of the vector. We overwrite the value at i with the result of mapping f over the existing value at i.

mapAt :: Int -> (a -> a) -> Vector a -> Vector a
mapAt i f = Vector.modify (\v -> MVector.write v i . f =<< MVector.read v i)

To use mutable vector operations through the MVector name, we add the qualified import.

import qualified Data.Vector.Mutable           as MVector

Finally, we implement the function to map, called toggleComplete.

toggleCompleted :: Todo -> Todo
toggleCompleted todo = todo { completed = not (completed todo) }

update' :: State -> Event -> Transition State Event
update' s e = case e of
  ...
  TodoToggled i -> Transition s { todos = mapAt i toggleComplete (todos s) } (pure Nothing)
  ...

Now, we run our application, add some to-do items, and mark or unmark them as completed. We’re done!

Learning More

Building our to-do list application, we have learned the basics of gi-gtk-declarative and the “App.Simple” architecture. There’s more to learn, though, and I recommend checking out the project documentation. There are also a bunch of examples in the Git repository.

Please note that this project is very young, and that APIs are not necessarily stable yet. I think, however, that it’s a much nicer way to build GTK+ applications using Haskell than the underlying APIs provided by the auto-generated bindings.

Now, have fun building your own functional GTK+ applications!

by Oskar Wickström at January 19, 2019 12:00 AM

April 16, 2019

Oskar Wickström

Property-Based Testing in a Screencast Editor, Case Study 2: Video Scene Classification

In the last case study on property-based testing (PBT) in Komposition we looked at timeline flattening. This post covers the video classifier, how it was tested before, and the bugs I found when I wrote property tests for it.

If you haven’t read the introduction or the first case study yet, I recommend checking them out!

Classifying Scenes in Imported Video

Komposition can automatically classify scenes when importing video files. This is a central productivity feature in the application, effectively cutting recorded screencast material automatically, letting the user focus on arranging the scenes of their screencast. Scenes are segments that are considered moving, as opposed to still segments:

  • A still segment is a sequence of at least \(S\) seconds of near-equal frames
  • A moving segment is a sequence of non-equal frames, or a sequence of near-equal frames with a duration less than \(S\)

\(S\) is a preconfigured minimum still segment duration in Komposition. In the future it might be configurable from the user interface, but for now it’s hard-coded.

Equality of two frames \(f_1\) and \(f_2\) is defined as a function \(E(f_1, f_2)\), described informally as:

  • comparing corresponding pixel color values of \(f_1\) and \(f_2\), with a small epsilon for tolerance of color variation, and
  • deciding two frames equal when at least 99% of corresponding pixel pairs are considered equal.

In addition to the rules stated above, there are two edge cases:

  1. The first segment is always a considered a moving segment (even if it’s just a single frame)
  2. The last segment may be a still segment with a duration less than \(S\)

The second edge case is not what I would call a desirable feature, but rather a shortcoming due to the classifier not doing any type of backtracking. This could be changed in the future.

Manually Testing the Classifier

The first version of the video classifier had no property tests. Instead, I wrote what I thought was a decent classifier algorithm, mostly messing around with various pixel buffer representations and parallel processing to achieve acceptable performance.

The only type of testing I had available, except for general use of the application, was a color-tinting utility. This was a separate program using the same classifier algorithm. It took as input a video file, and produced as output a video file where each frame was tinted green or red, for moving and still frames, respectively.

Video classification shown with color tinting

In the recording above you see the color-tinted output video based on a recent version of the classifier. It classifies moving and still segments rather accurately. Before I wrote property tests and fixed the bugs that I found, it did not look so pretty, flipping back and forth at seemingly random places.

At first, debugging the classifier with the color-tinting tool way seemed like a creative and powerful technique. But the feedback loop was horrible, having to record video, process it using the slow color-tinting program, and inspecting it by eye. In hindsight, I can conclude that PBT is far more effective for testing the classifier.

Video Classification Properties

Figuring out how to write property tests for video classification wasn’t obvious to me. It’s not uncommon in example-based testing that tests end up mirroring the structure, and even the full implementation complexity, of the system under test. The same can happen in property-based testing.

With some complex systems it’s very hard to describe the correctness as a relation between any valid input and the system’s observed output. The video classifier is one such case. How do I decide if an output classification is correct for a specific input, without reimplementing the classification itself in my tests?

The other way around is easy, though! If I have a classification, I can convert that into video frames. Thus, the solution to the testing problem is to not generate the input, but instead generate the expected output. Hillel Wayne calls this technique “oracle generators” in his recent article.1

The classifier property tests generate high-level representations of the expected classification output, which are lists of values describing the type and duration of segments.

A generated sequence of expected classified segments
A generated sequence of expected classified segments

Next, the list of output segments is converted into a sequence of actual frames. Frames are two-dimensional arrays of RGB pixel values. The conversion is simple:

  • Moving segments are converted to a sequence of alternating frames, flipping between all gray and all white pixels
  • Still frames are converted to a sequence of frames containing all black pixels

The example sequence in the diagram above, when converted to pixel frames with a frame rate of 10 FPS, can be visualized like in the following diagram, where each thin rectangle represents a frame:

Pixel frames derived from a sequence of expected classified output segments
Pixel frames derived from a sequence of expected classified output segments

By generating high-level output and converting it to pixel frames, I have input to feed the classifier with, and I know what output it should produce. Writing effective property tests then comes down to writing generators that produce valid output, according to the specification of the classifier. In this post I’ll show two such property tests.

Testing Still Segment Minimum Length

As stated in the beginning of this post, classified still segments must have a duration greater than or equal to \(S\), where \(S\) is the minimum still segment duration used as a parameter for the classifier. The first property test we’ll look at asserts that this invariant holds for all classification output.

hprop_classifies_still_segments_of_min_length = property $ do

  -- 1. Generate a minimum still segment length/duration
  minStillSegmentFrames <- forAll $ Gen.int (Range.linear 2 (2 * frameRate))
  let minStillSegmentTime = frameCountDuration minStillSegmentFrames

  -- 2. Generate output segments
  segments <- forAll $
    genSegments (Range.linear 1 10)
                (Range.linear 1
                              (minStillSegmentFrames * 2))
                (Range.linear minStillSegmentFrames
                              (minStillSegmentFrames * 2))
                resolution

  -- 3. Convert test segments to actual pixel frames
  let pixelFrames = testSegmentsToPixelFrames segments

  -- 4. Run the classifier on the pixel frames
  let counted = classifyMovement minStillSegmentTime (Pipes.each pixelFrames)
                & Pipes.toList
                & countSegments

  -- 5. Sanity check
  countTestSegmentFrames segments === totalClassifiedFrames counted

  -- 6. Ignore last segment and verify all other segments
  case initMay counted of
    Just rest ->
      traverse_ (assertStillLengthAtLeast minStillSegmentTime) rest
    Nothing -> success
  where
    resolution = 10 :. 10

This chunk of test code is pretty busy, and it’s using a few helper functions that I’m not going to bore you with. At a high level, this test:

  1. Generates a minimum still segment duration, based on a minimum frame count (let’s call it \(n\)) in the range \([2, 20]\). The classifier currently requires that \(n \geq 2\), hence the lower bound. The upper bound of 20 frames is an arbitrary number that I’ve chosen.
  2. Generates valid output segments using the custom generator genSegments, where
    • moving segments have a frame count in \([1, 2n]\), and
    • still segments have a frame count in \([n, 2n]\).
  3. Converts the generated output segments to actual pixel frames. This is done using a helper function that returns a list of alternating gray and white frames, or all black frames, as described earlier.
  4. Count the number of consecutive frames within each segment, producing a list like [Moving 18, Still 5, Moving 12, Still 30].
  5. Performs a sanity check that the number of frames in the generated expected output is equal to the number of frames in the classified output. The classifier must not lose or duplicate frames.
  6. Drops the last classified segment, which according to the specification can have a frame count less than \(n\), and asserts that all other still segments have a frame count greater than or equal to \(n\).

Let’s run some tests.

> :{
| hprop_classifies_still_segments_of_min_length
|   & Hedgehog.withTests 10000
|   & Hedgehog.check
| :}
  ✓ <interactive> passed 10000 tests.

Cool, it looks like it’s working.

Sidetrack: Why generate the output?

Now, you might wonder why I generate output segments first, and then convert to pixel frames. Why not generate random pixel frames to begin with? The property test above only checks that the still segments are long enough!

The benefit of generating valid output becomes clearer in the next property test, where I use it as the expected output of the classifier. Converting the output to a sequence of pixel frames is easy, and I don’t have to state any complex relation between the input and output in my property. When using oracle generators, the assertions can often be plain equality checks on generated and actual output.

But there’s benefit in using the same oracle generator for the “minimum still segment length” property, even if it’s more subtle. By generating valid output and converting to pixel frames, I can generate inputs that cover the edge cases of the system under test. Using property test statistics and coverage checks, I could inspect coverage, and even fail test runs where the generators don’t hit enough of the cases I’m interested in.2

Had I generated random sequences of pixel frames, then perhaps the majority of the generated examples would only produce moving segments. I could tweak the generator to get closer to either moving or still frames, within some distribution, but wouldn’t that just be a variation of generating valid scenes? It would be worse, in fact. I wouldn’t then be reusing existing generators, and I wouldn’t have a high-level representation that I could easily convert from and compare with in assertions.

Testing Moving Segment Time Spans

The second property states that the classified moving segments must start and end at the same timestamps as the moving segments in the generated output. Compared to the previous property, the relation between generated output and actual classified output is stronger.

hprop_classifies_same_scenes_as_input = property $ do
  -- 1. Generate a minimum still still segment duration
  minStillSegmentFrames <- forAll $ Gen.int (Range.linear 2 (2 * frameRate))
  let minStillSegmentTime = frameCountDuration minStillSegmentFrames

  -- 2. Generate test segments
  segments <- forAll $ genSegments (Range.linear 1 10)
                                   (Range.linear 1
                                                 (minStillSegmentFrames * 2))
                                   (Range.linear minStillSegmentFrames
                                                 (minStillSegmentFrames * 2))
                                   resolution

  -- 3. Convert test segments to actual pixel frames
  let pixelFrames = testSegmentsToPixelFrames segments

  -- 4. Convert expected output segments to a list of expected time spans
  --    and the full duration
  let durations = map segmentWithDuration segments
      expectedSegments = movingSceneTimeSpans durations
      fullDuration = foldMap unwrapSegment durations

  -- 5. Classify movement of frames
  let classifiedFrames =
        Pipes.each pixelFrames
        & classifyMovement minStillSegmentTime
        & Pipes.toList

  -- 6. Classify moving scene time spans
  let classified =
        (Pipes.each classifiedFrames
         & classifyMovingScenes fullDuration)
        >-> Pipes.drain
        & Pipes.runEffect
        & runIdentity

  -- 7. Check classified time span equivalence
  expectedSegments === classified

  where
    resolution = 10 :. 10

Steps 1–3 are the same as in the previous property test. From there, this test:

  1. Converts the generated output segments into a list of time spans. Each time span marks the start and end of an expected moving segment. Furthermore, it needs the full duration of the input in step 6, so that’s computed here.
  2. Classify the movement of each frame, i.e. if it’s part of a moving or still segment.
  3. Run the second classifier function called classifyMovingScenes, based on the full duration and the frames with classified movement data, resulting in a list of time spans.
  4. Compare the expected and actual classified list of time spans.

While this test looks somewhat complicated with its setup and various conversions, the core idea is simple. But is it effective?

Bugs! Bugs everywhere!

Preparing for a talk on property-based testing, I added the “moving segment time spans” property a week or so before the event. At this time, I had used Komposition to edit multiple screencasts. Surely, all significant bugs were caught already. Adding property tests should only confirm the level of quality the application already had. Right?

Nope. First, I discovered that my existing tests were fundamentally incorrect to begin with. They were not reflecting the specification I had in mind, the one I described in the beginning of this post.

Furthermore, I found that the generators had errors. At first, I used Hedgehog to generate the pixels used for the classifier input. Moving frames were based on a majority of randomly colored pixels and a small percentage of equally colored pixels. Still frames were based on a random single color.

The problem I had not anticipated was that the colors used in moving frames were not guaranteed to be distinct from the color used in still frames. In small-sized examples I got black frames at the beginning and end of moving segments, and black frames for still segments, resulting in different classified output than expected. Hedgehog shrinking the failing examples’ colors towards 0, which is black, highlighted this problem even more.

I made my generators much simpler, using the alternating white/gray frames approach described earlier, and went on to running my new shiny tests. Here’s what I got:

What? Where does 0s–0.6s come from? The classified time span should’ve been 0s–1s, as the generated output has a single moving scene of 10 frames (1 second at 10 FPS). I started digging, using the annotate function in Hedgehog to inspect the generated and intermediate values in failing examples.

I couldn’t find anything incorrect in the generated data, so I shifted focus to the implementation code. The end timestamp 0.6s was consistently showing up in failing examples. Looking at the code, I found a curious hard-coded value 0.5 being bound and used locally in classifyMovement.

The function is essentially a fold over a stream of frames, where the accumulator holds vectors of previously seen and not-yet-classified frames. Stripping down and simplifying the old code to highlight one of the bugs, it looked something like this:

classifyMovement minStillSegmentTime =
  case ... of
    InStillState{..} ->
      if someDiff > minEqualTimeForStill
        then ...
        else ...
    InMovingState{..} ->
      if someOtherDiff >= minStillSegmentTime
        then ...
        else ...
  where
    minEqualTimeForStill = 0.5

Let’s look at what’s going on here. In the InStillState branch it uses the value minEqualTimeForStill, instead of always using the minStillSegmentTime argument. This is likely a residue from some refactoring where I meant to make the value a parameter instead of having it hard-coded in the definition.

Sparing you the gory implementation details, I’ll outline two more problems that I found. In addition to using the hard-coded value, it incorrectly classified frames based on that value. Frames that should’ve been classified as “moving” ended up “still”. That’s why I didn’t get 0s–1s in the output.

Why didn’t I see 0s–0.5s, given the hard-coded value 0.5? Well, there was also an off-by-one bug, in which one frame was classified incorrectly together with the accumulated moving frames.

The classifyMovement function is 30 lines of Haskell code juggling some state, and I managed to mess it up in three separate ways at the same time. With these tests in place I quickly found the bugs and fixed them. I ran thousands of tests, all passing.

Finally, I ran the application, imported a previously recorded video, and edited a short screencast. The classified moving segments where notably better than before.

Summary

A simple streaming fold can hide bugs that are hard to detect with manual testing. The consistent result of 0.6, together with the hard-coded value 0.5 and a frame rate of 10 FPS, pointed clearly towards an off-by-one bug. I consider this is a great showcase of how powerful shrinking in PBT is, consistently presenting minimal examples that point towards specific problems. It’s not just a party trick on ideal mathematical functions.

Could these errors have been caught without PBT? I think so, but what effort would it require? Manual testing and introspection did not work for me. Code review might have revealed the incorrect definition of minEqualTimeForStill, but perhaps not the off-by-one and incorrect state handling bugs. There are of course many other QA techniques, I won’t evaluate all. But given the low effort that PBT requires in this setting, the amount of problems it finds, and the accuracy it provides when troubleshooting, I think it’s a clear win.

I also want to highlight the iterative process that I find naturally emerges when applying PBT:

  1. Think about how your system is supposed to work. Write down your specification.
  2. Think about how to generate input data and how to test your system, based on your specification. Tune your generators to provide better test data. Try out alternative styles of properties. Perhaps model-based or metamorphic testing fits your system better.
  3. Run tests and analyze the minimal failing examples. Fix your implementation until all tests pass.

This can be done when modifying existing code, or when writing new code. You can apply this without having any implementation code yet, perhaps just a minimal stub, and the workflow is essentially the same as TDD.

Coming Up

The final post in this series will cover testing at a higher level of the system, with effects and multiple subsystems being integrated to form a full application. We will look at property tests that found many bugs and that made a substantial refactoring possible.

  1. Introduction
  2. Timeline Flattening
  3. Video Scene Classification
  4. Integration Testing

Until then, thanks for reading!

Credits

Thank you Ulrik Sandberg, Pontus Nagy, and Fredrik Björeman for reviewing drafts of this post.

Footnotes


  1. See the “Oracle Generators” section in Finding Property Tests.↩︎

  2. John Hughes’ talk Building on developers’ intuitions goes into depth on this. There’s also work being done to provide similar functionality for Hedgehog.↩︎

April 16, 2019 10:00 PM

June 22, 2013

Shayne Fletcher

Maybe

There are different approaches to the issue of not having a value to return. One idiom to deal with this in C++ is the use of boost::optional<T> or std::pair<bool, T>.

class boost::optional<T> //Discriminated-union wrapper for values.

Maybe is a polymorphic sum type with two constructors : Nothing or Just a.
Here's how Maybe is defined in Haskell.


{- The Maybe type encapsulates an optional value. A value of type
Maybe a either contains a value of type a (represented as Just a), or
it is empty (represented as Nothing). Using Maybe is a good way to
deal with errors or exceptional cases without resorting to drastic
measures such as error.

The Maybe type is also a monad.
It is a simple kind of error monad, where all errors are
represented by Nothing. -}

data Maybe a = Nothing | Just a

{- The maybe function takes a default value, a function, and a Maybe
value. If the Maybe value is Nothing, the function returns the default
value. Otherwise, it applies the function to the value inside the Just
and returns the result. -}

maybe :: b -> (a -> b) -> Maybe a -> b
maybe n _ Nothing = n
maybe _ f (Just x) = f x

I haven't tried to compile the following OCaml yet but I think it should be roughly OK.

type 'a option = None | Some of 'a ;;

let maybe n f a =
match a with
| None -> n
| Some x -> f x
;;

Here's another variant on the Maybe monad this time in Felix. It is applied to the problem of "safe arithmetic" i.e. the usual integer arithmetic but with guards against under/overflow and division by zero.


union success[T] =
| Success of T
| Failure of string
;

fun str[T] (x:success[T]) =>
match x with
| Success ?t => "Success " + str(t)
| Failure ?s => "Failure " + s
endmatch
;

typedef fun Fallible (t:TYPE) : TYPE => success[t] ;

instance Monad[Fallible]
{
fun bind[a, b] (x:Fallible a, f: a -> Fallible b) =>
match x with
| Success ?a => f a
| Failure[a] ?s => Failure[b] s
endmatch
;

fun ret[a](x:a):Fallible a => Success x ;
}

//Safe arithmetic.

const INT_MAX:int requires Cxx_headers::cstdlib ;
const INT_MIN:int requires Cxx_headers::cstdlib ;

fun madd (x:int) (y:int) : success[int] =>
if x > 0 and y > (INT_MAX - x) then
Failure[int] "overflow"
else
Success (y + x)
endif
;

fun msub (x:int) (y:int) : success[int] =>
if x > 0 and y < (INT_MIN + x) then
Failure[int] "underflow"
else
Success (y - x)
endif
;

fun mmul (x:int) (y:int) : success[int] =>
if x != 0 and y > (INT_MAX / x) then
Failure[int] "overflow"
else
Success (y * x)
endif
;

fun mdiv (x:int) (y:int) : success[int] =>
if (x == 0) then
Failure[int] "attempted division by zero"
else
Success (y / x)
endif
;

//--
//
//Test.

open Monad[Fallible] ;

//Evalue some simple expressions.

val zero = ret 0 ;
val zero_over_one = bind ((Success 0), (mdiv 1)) ;
val undefined = bind ((Success 1),(mdiv 0)) ;
val two = bind((ret 1), (madd 1)) ;
val two_by_one_plus_one = bind (two , (mmul 2)) ;

println$ "zero = " + str zero ;
println$ "1 / 0 = " + str undefined ;
println$ "0 / 1 = " + str zero_over_one ;
println$ "1 + 1 = " + str two ;
println$ "2 * (1 + 1) = " + str (bind (bind((ret 1), (madd 1)) , (mmul 2))) ;
println$ "INT_MAX - 1 = " + str (bind ((ret INT_MAX), (msub 1))) ;
println$ "INT_MAX + 1 = " + str (bind ((ret INT_MAX), (madd 1))) ;
println$ "INT_MIN - 1 = " + str (bind ((ret INT_MIN), (msub 1))) ;
println$ "INT_MIN + 1 = " + str (bind ((ret INT_MIN), (madd 1))) ;

println$ "--" ;

//We do it again, this time using the "traditional" rshift-assign
//syntax.

syntax monad //Override the right shift assignment operator.
{
x[ssetunion_pri] := x[ssetunion_pri] ">>=" x[>ssetunion_pri] =># "`(ast_apply ,_sr (bind (,_1 ,_3)))";
}
open syntax monad;

println$ "zero = " + str (ret 0) ;
println$ "1 / 0 = " + str (ret 1 >>= mdiv 0) ;
println$ "0 / 1 = " + str (ret 0 >>= mdiv 1) ;
println$ "1 + 1 = " + str (ret 1 >>= madd 1) ;
println$ "2 * (1 + 1) = " + str (ret 1 >>= madd 1 >>= mmul 2) ;
println$ "INT_MAX = " + str (INT_MAX) ;
println$ "INT_MAX - 1 = " + str (ret INT_MAX >>= msub 1) ;
println$ "INT_MAX + 1 = " + str (ret INT_MAX >>= madd 1) ;
println$ "INT_MIN = " + str (INT_MIN) ;
println$ "INT_MIN - 1 = " + str (ret INT_MIN >>= msub 1) ;
println$ "INT_MIN + 1 = " + str (ret INT_MIN >>= madd 1) ;
println$ "2 * (INT_MAX/2) = " + str (ret INT_MAX >>= mdiv 2 >>= mmul 2 >>= madd 1) ; //The last one since we know INT_MAX is odd and that division will truncate.
println$ "2 * (INT_MAX/2 + 1) = " + str (ret INT_MAX >>= mdiv 2 >>= madd 1 >>= mmul 2) ;

//--
That last block using the <<= syntax produces (in part) the following output (the last two print statments have been truncated away -- the very last one produces an expected overflow).

by Shayne Fletcher (noreply@blogger.com) at June 22, 2013 09:07 PM

December 13, 2019

Mark Jason Dominus

California corpse-tampering law

[ Content warning: dead bodies, sex crime, just plain nasty ]

A co-worker brought this sordid item to my attention: LAPD officer charged after allegedly fondling a dead woman's breast.

[A] Los Angeles Police Department officer … was charged Thursday with one felony count of having sexual contact with human remains without authority, officials said, after he allegedly fondled a dead woman's breast.

[The officer] was alone in a room with the deceased woman while his partner went to get paper work from a patrol car…. At that point, [he] turned off the body camera and inappropriately touched the woman. … A two-minute buffer on the camera captured the incident even though [he] had turned it off.

Yuck.

Chas. Owens then asked a very good question:

Okay, no one is commenting on “sexual contact with human remains without authority
How does one go about getting authority to have sexual contact with human remains?
Is there a DMV for necrophiles?

I tried to resist this nerdsnipe, but I was unsuccessful. I learned that California does have a law on the books that makes it a felony to have unauthorized sex with human remains:

HEALTH AND SAFETY CODE - HSC
DIVISION 7. DEAD BODIES [7000 - 8030]
PART 1. GENERAL PROVISIONS [7000 - 7355]
CHAPTER 2. General Provisions [7050.5 - 7055]

7052.

(a) Every person who willfully mutilates, disinters, removes from the place of interment, or commits an act of sexual penetration on, or has sexual contact with, any remains known to be human, without authority of law, is guilty of a felony. This section does not apply to any person who, under authority of law, removes the remains for reinterment, or performs a cremation.

(b)(2) “Sexual contact” means any willful touching by a person of an intimate part of a dead human body for the purpose of sexual arousal, gratification, or abuse.

(California HSC, section 7052)

I think this addresses Chas.’s question. Certainly there are other statutes that authorize certain persons to disinter or mutilate corpses for various reasons. (Inquests, for example.) A defendant wishing to take advantage of this exception would have to affirmatively claim that he was authorized to grope the corpse’s breast, and by whom. I suppose he could argue that the state had the burden of proof to show that he had not been authorized to fondle the corpse, but I doubt that many jurors would find this persuasive.

Previously on this blog: Legal status of corpses in 1911 England.

by Mark Dominus (mjd@plover.com) at December 13, 2019 06:20 PM

December 12, 2019

Gabriel Gonzalez

Prefer to use fail for IO exceptions

fail

This post briefly explains why I commonly suggest that people replace error with fail when raising IOExceptions.

The main difference between error and fail can be summarized by the following equations:

In other words, any attempt to evaluate an expression that is an error will raise the error. Evaluating an expression that is a fail does not raise the error or trigger any side effects.

Why does this matter? One of the nice properties of Haskell is that Haskell separates effect order from evaluation order. For example, evaluating a print statement is not the same thing as running it:

This insensitivity to evaluation order makes Haskell code easier to maintain. Specifically, this insensitivity frees us from concerning ourselves with evaluation order in the same way garbage collection frees us from concerning ourselves with memory management.

Once we begin using evaluation-sensitive primitives such as error we necessarily need to program with greater caution than before. Now any time we manipulate a subroutine of type IO a we need to take care not to prematurely force the thunk storing that subroutine.

How likely are we to prematurely evaluate a subroutine? Truthfully, not very likely, but fortunately taking the extra precaution to use fail is not only theoretically safer, it is also one character shorter than using error.

Limitations

Note that this advice applies solely to the case of raising IOExceptions within an IO subroutine. fail is not necessarily safer than error in other cases, because fail is a method of the MonadFail typeclass and the typeclass does not guarantee in general that fail is safe.

fail happens to do the correct thing for IO:

… but for other MonadFail instances fail could be a synonym for error and offer no additional protective value.

If you want to future-proof your code and ensure that you never use the wrong MonadFail instance, you can do one of two things:

  • Enable the TypeApplications language extension and write fail @IO string
  • Use Control.Exception.throwIO (userError string) instead of fail

However, even if you choose not to future-proof your code fail is still no worse than error in this regard.

by Gabriel Gonzalez (noreply@blogger.com) at December 12, 2019 04:59 PM

Mark Jason Dominus

Benefits

Many ‘bene-’ words do have ‘male-’ opposites. For example, the opposite of a benefactor is a malefactor, the opposite of a benediction is a malediction, and the opposite of benevolence is malevolence. But strangely there is no ‘malefit’ that is opposite to ‘benefit’.

Or so I wrote, and then I thought I had better look it up.

The Big Dictionary has six examples, one as recent as 1989 and one as early as 1755:

I took it into my head to try for a benefit, and to that end printed some bills… but… instead of five and twenty pounds, I had barely four…. The morning after my malefit, I was obliged to strip my friend of the ownly decent gown she had, and pledged it to pay the players.

(Charlotte Charke, A narrative of the life of Mrs. Charlotte Charke (youngest daughter of Colley Cibber, Esq.), 1755.)

(I think the “benefit” here is short for “benefit performance”, an abbreviation we still use today.)

Mrs. Charke seems to be engaging in intentional wordplay. All but one of the other citations similarly suggest intentional wordplay; for example:

Malefactors used to commit malefactions. Why could they not still be said to do so, rather than disbenefits, or, perhaps, stretching a point, commit malefits?

(P. Howard, Word in Your Ear, 1983.)

The one exception is from no less a person than J.R.R. Tolkien:

Some very potent fiction is specially composed to be inspected by others and to deceive, to pass as record; but it is made for the malefit of Men.

(Around 1973, Quoted in C. Tolkien, History of Middle-earth: Sauron Defeated, 1992.)

Incidentally, J.R.R. is quoted 362 times in the Big Dictionary.

by Mark Dominus (mjd@plover.com) at December 12, 2019 04:24 PM

Brent Yorgey

Computing Eulerian paths is harder than you think

Everyone who has studied any graph theory at all knows the celebrated story of the Seven Bridges of Königsberg, and how Euler gave birth to modern graph theory while solving the problem.

Euler’s proof is clever, incisive, not hard to understand, and a great introduction to the kind of abstract reasoning we can do about graphs. There’s little wonder that it is often used as one of the first nontrivial graph theory results students are introduced to, e.g. in a discrete mathematics course. (Indeed, I will be teaching discrete mathematics in the spring and certainly plan to talk about Eulerian paths!)

Euler’s 1735 solution was not constructive, and in fact he really only established one direction of the “if and only if”:

If a graph has an Eulerian path, then it has exactly zero or two vertices with odd degree.

This can be used to rule out the existence of Eulerian paths in graphs without the right vertex degrees, which was Euler’s specific motivation. However, one suspects that Euler knew it was an if and only if, and didn’t write about the other direction (if a graph has exactly zero or two vertices with odd degree, then it has an Eulerian path) because he thought it was trivial.1

The first person to publish a full proof of both directions, including an actual algorithm for finding an Eulerian path, seems to be Carl Hierholzer, whose friend published a posthumous paper in Hierholzer’s name after his untimely death in 1871, a few weeks before his 31st birthday.2 (Notice that this was almost 150 years after Euler’s original paper!) If the vertex degrees cooperate, finding an Eulerian path is almost embarrassingly easy according to Hierholzer’s algorithm: starting at one of the odd-degree vertices (or anywhere you like if there are none), just start walking through the graph—any which way you please, it doesn’t matter!—visiting each edge at most once, until you get stuck. Then pick another part of the graph you haven’t visited, walk through it randomly, and splice that path into your original path. Repeat until you’ve explored the whole graph. And generalizing all of this to directed graphs isn’t much more complicated.

So, in summary, this is a well-studied problem, solved hundreds of years ago, that we present to students as a first example of a nontrivial yet still simple-to-understand graph proof and algorithm. So it should be pretty easy to code, right?

So what’s the problem?

Recently I came across the eulerianpath problem on Open Kattis, and I realized that although I have understood this algorithm on a theoretical level for almost two decades (I almost certainly learned it as a young undergraduate), I have never actually implemented it! So I set out to solve it.

Right away the difficulty rating of 5.7 tells us that something strange is going on. “Easy” problems—the kind of problems you can give to an undergraduate at the point in their education when they might first be presented with the problem of finding Eulerian paths—typically have a difficulty rating below 3. As I dove into trying to implement it, I quickly realized two things. First of all, given an arbitrary graph, there’s a lot of somewhat finicky work that has to be done to check whether the graph even has an Eulerian path, before running the algorithm proper:

  1. Calculate the degree of all graph vertices (e.g. by iterating through all the edges and incrementing appropriate counters for the endpoints of each edge).
  2. Check if the degrees satisfy Euler’s criteria for the existence of a solution, by iterating through all vertices and making sure their degrees are all even, but also counting the number of vertices with an odd degree to make sure it is either zero or two. At the same time, if we see an odd-degree vertex, remember it so we can be sure to start the path there.
  3. If all vertices have even degree, pick an arbitrary node as the start vertex.
  4. Ensure the graph is connected (e.g. by doing a depth-first search)—Euler kind of took this for granted, but this technically has to be part of a correct statement of the theorem. If we have a disconnected graph, each component could have an Eulerian path or cycle without the entire graph having one.

And if the graph is directed—as it is in the eulerianpath problem on Kattis—then the above steps get even more finicky. In step 1, we have to count the in- and outdegree of each vertex separately; in step 2, we have to check that the in- and outdegrees of all vertices are equal, except for possibly two vertices where one of them has exactly one more outgoing than incoming edge (which must be the start vertex), and vice versa for the other vertex; in step 4, we have to make sure to start the DFS from the chosen start vertex, because the graph need not be strongly connected, it’s enough for the entire graph to be reachable from the start vertex.

The second thing I realized is that Hierholzer’s algorithm proper—walk around until getting stuck, then repeatedly explore unexplored parts of the graph and splice them into the path being built—is still rather vague, and it’s nontrivial to figure out how to do it, and what data structures to use, so that everything runs in time linear in the number of edges. For example, we don’t want to iterate over the whole graph—or even just the whole path built so far—to find the next unexplored part of the graph every time we get stuck. We also need to be able to do the path splicing in constant time; so, for example, we can’t just store the path in a list or array, since then splicing in a new path segment would require copying the entire path after that point to make space. I finally found a clever solution that pushes the nodes being explored on a stack; when we get stuck, we start popping nodes, placing them into an array which will hold the final path (starting from the end), and keep popping until we find a node with an unexplored outgoing edge, then switch back into exploration mode, pushing things on the stack until we get stuck again, and so on. But this is also nontrivial to code correctly since there are many lurking off-by-one errors and so on. And I haven’t even talked about how we keep track of which edges have been explored and quickly find the next unexplored edge from a vertex.

I think it’s worth writing another blog post or two with more details of how the implementation works, both in an imperative language and in a pure functional language, and I may very well do just that. But in any case, what is it about this problem that results in such a large gap between the ease of understanding its solution theoretically, and the difficulty of actually implementing it?


  1. Actually, the way I have stated the other direction of the if and only if is technically false!—can you spot the reason why?↩

  2. Though apparently someone named Listing published the basic idea of the proof, with some details omitted, some decades earlier. I’ve gotten all this from Herbert Fleischner, Eulerian Graphs and Related Topics, Annals of Discrete Mathematics 45, Elsevier 1990. Fleischner reproduces Euler’s original paper as well as Hierholzer’s, together with English translations.↩

by Brent at December 12, 2019 01:19 PM

December 10, 2019

Joey Hess

announcing the filepath-bytestring haskell library

filepath-bytestring is a drop-in replacement for the standard haskell filepath library, that operates on RawFilePath rather than FilePath.

The benefit, of course, is speed. "foo" </> "bar" is around 25% faster with the new library. dropTrailingPathSeparator is 120% faster. But the real speed benefits probably come when a program is able to input filepaths as ByteStrings, manipulate them, and operate on the files, all without using String.

It's extensively tested, not only does it run all the same doctests that the filepath library does, but each function is quickchecked to behave the same as the equivilant function from filepath.

While I implemented almost everything, I did leave off some functions that operate on PATH, which seem unlikely to be useful, and the complicated normalise and stuff that uses it.

This work was sponsored by Jake Vosloo on Patron.

December 10, 2019 08:31 PM

Philip Wadler

Programming Languages for Trustworthy Systems

Image result for lfcs informatics edinburgh

The University of Edinburgh seeks to appoint a Lecturer/Senior Lecturer/Reader in Programming Languages for Trustworthy Systems.  An ideal candidate will be able to contribute and complement the expertise of the Programming Languages & Foundations Group which is part of the Laboratory for Foundations of Computer Science (LFCS).

The successful candidate will have a PhD, an established research agenda and the enthusiasm and ability to undertake original research, to lead a research group, and to engage with teaching and academic supervision, with expertise in at least one of the following:
  • Practical systems verification: e.g. for operating systems, databases, compilers, distributed systems
  • Language-based verification: static analysis, verified systems / smart contract programming, types, SAT/SMT solving
  • Engineering trustworthy software: automated/property-based testing, bug finding, dynamic instrumentation, runtime verification
We are seeking current and future leaders in the field.

Applications from individuals from underrepresented groups in Computer Science are encouraged.

Appointment will be full-time and open-ended.

The post is situated in the Laboratory for Foundations of Computer Science, the Institute in which the School's expertise in functional programming, logic and semantics, and theoretical computer science is concentrated.  Collaboration relating to PL across the School is encouraged and supported by the School's Programming Languages Research Programme, to which the successful applicant will be encouraged to contribute. Applicants whose PL-related research aligns well with particular strengths of the School, such as machine learning, AI, robotics, compilers, systems, and security, are encouraged to apply and highlight these areas of alignment.  

All applications must contain the following supporting documents:
• Teaching statement outlining teaching philosophy, interests and plans
• Research statement outlining the candidate’s research vision and future plans
• Full CV (resume) and publication list

The University job posting and submission site, including detailed application instructions, is at this link:


Applications close at 5pm GMT on January 31, 2020. This deadline is firm, so applicants are exhorted to begin their applications in advance.

Shortlisting for this post is due early February with interview dates for this post expected to fall in early April 2020. Feedback will only be provided to interviewed candidates. References will be sought for all shortlisted candidates. Please indicate on your application form if you are happy for your referees to be contacted.

Informal enquiries may be addressed to Prof Philip Wadler (wadler@inf.ed.ac.uk).

Lecturer Grade: UE08 (£41,526 - £49,553) 
Senior Lecturer or Reader Grade: UE09 (£52,559 - £59,135)

The School is advertising a number of positions, including this one, as described here:


About the Laboratory for Foundations of Computer Science

As one of the largest Institutes in the School of Informatics, and one of the largest theory research groups in the world, the Laboratory for Foundations of Computer Science combines expertise in all aspects of theoretical computer science, including algorithms and complexity, cryptography, database theory, logic and semantics, and quantum computing. The Programming Languages and Foundations group includes over 25 students, researchers and academic staff, working on functional programming, types, verification, semantics, software engineering, language-based security and new programming models. Past contributions to programming languages research originating at LFCS include Standard ML, the Edinburgh Logical Framework, models of concurrency such as the pi-calculus, and foundational semantic models of effects in programming languages, based on monads and more recently algebraic effects and handlers.

About the School of Informatics and University of Edinburgh

The School of Informatics at the University of Edinburgh is one of the largest in Europe, with more than 120 academic staff and a total of over 500 post-doctoral researchers, research students and support staff. Informatics at Edinburgh rated highest on Research Power in the most recent Research Excellence Framework. The School has strong links with industry, with dedicated business incubator space and well-established enterprise and business development programmes. The School of Informatics has recently established the Bayes Centre for Data Technology, which provide a locus for fruitful multi-disciplinary work, including a range of companies collocated in it. The School holds a Silver Athena SWAN award in recognition of our commitment to advance the representation of women in science, mathematics, engineering and technology. We are also Stonewall Scotland Diversity Champions actively promoting LGBT equality.

by Philip Wadler (noreply@blogger.com) at December 10, 2019 06:33 PM

December 09, 2019

Russell O'Connor

Stochastic Elections Canada 2019 Results

It is time to announce the results from Stochastic Elections Canada for the 43rd General Election.

Every vote counts with the stochastic election process, so we had to wait until all election results were validated before we could announce our results. However, stochastic election results are not very sensitive to small changes to the number of votes counted. The distributions for each candidate are typically only slightly adjusted.

Now we can announce our MP selection.

2019 Stochastic Election Simulation Results
Party Seats Seat Percentage Vote Percentage
Liberal 116 34.3% 33.1%
Conservative 102 30.2% 34.4%
NDP-New Democratic Party 61 18.0% 15.9%
Bloc Québécois 25 7.40% 7.69%
Green Party 23 6.80% 6.50%
People’s Party 6 1.78% 1.64%
Christian Heritage Party 1 0.296% 0.105%
Parti Rhinocéros 1 0.296% 0.0535%
Independent 3 0.888%

Results by province and by riding are available (electoral districts on page 2).

The results were generated from Elections Canada data. One hundred and eighty-one elected candidates differ from the actual 2019 election outcome.

The People’s Party holds the balance of power in this parliament. Assuming a Liberal party member becomes speaker of the house, that means the Liberals together with the Bloc Québécois and Green Party have 163 votes and the Conservative and NDP together have 163 votes. The People’s Party’s 6 votes that is enough to decide which side reaches 169.

The rise in the Green Party’s popular vote allowed them to gain more seats this election. The Green Party has close to the same number of seats as the Bloc Québécois which reflects the fact that they have close to the same popular vote, even though the Green Party’s votes are more dilluted throughout Canada. This illustrates how sortition is a form of proportional electoral system.

Many proportional election systems require candidates to run under a party, or at least it is advantageous to be a run under a party. One notable advantage of sortition is that independent or unaffiliated candidates are not disadvantaged. While we did not select Jody Wilson-Raybould for her riding, Jane Philpott was elected to Markham—Stouffville. Also Archie MacKinnon was elected to Sydney—Victoria. And, with sortition, even the 396 residents of Miramichi—Grand Lake get a turn to have their choice of Mathew Grant Lawson to represent them in parliament.

This is only one example of the results of a stochastic election. Because of the stochastic nature of the election process, actual results may differ.

In Canada’s election process, it is sometimes advantageous to not vote for one’s preferred candidate. The stochastic election system is the only system in which it always best to vote for your preferred candidate. Therefore, if the 2019 election were actually using a stochastic election system, people would be allowed to vote for their true preferences. The outcome could be somewhat different than what this simulation illustrates.

Related info

December 09, 2019 08:31 PM

Monday Morning Haskell

Data Types in Rust: Borrowing from Both Worlds

combine_data.png

Last time, we looked at the concept of ownership in Rust. This idea underpins how we manage memory in our Rust programs. It explains why we don't need garbage collection. and it helps a lot with ensuring our program runs efficiently.

This week, we'll study the basics of defining data types. As we've seen so far, Rust combines ideas from both object oriented languages and functional languages. We'll continue to see this trend with how we define data. There will be some ideas we know and love from Haskell. But we'll also see some ideas that come from C++.

For the quickest way to get up to speed with Rust, check out our Rust Video Tutorial! It will walk you through all the basics of Rust, including installation and making a project.

Defining Structs

Haskell has one primary way to declare a new data type: the data keyword. We can also rename types in certain ways with type and newtype, but data is the core of it all. Rust is a little different in that it uses a few different terms to refer to new data types. These all correspond to particular Haskell structures. The first of these terms is struct.

The name struct is a throwback to C and C++. But to start out we can actually think of it as a distinguished product type in Haskell. That is, a type with one constructor and many named fields. Suppose we have a User type with name, email, and age. Here's how we could make this type a struct in Rust:

struct User {
  name: String,
  email: String,
  age: u32,
}

This is very much like the following Haskell definition:

data User = User
  { name :: String
  , email :: string
  , age :: Int
  }

When we initialize a user, we should use braces and name the fields. We access individual fields using the . operator.

let user1 = User {
  name: String::from("James"),
  email: String::from("james@test.com"),
  age: 25,
};

println!("{}", user1.name);

If we declare a struct instance to be mutable, we can also change the value of its fields if we want!

let mut user1 = User {
  name: String::from("James"),
  email: String::from("james@test.com"),
  age: 25,
};

user1.age = 26;

When you're starting out, you shouldn't use references in your structs. Make them own all their data. It's possible to put references in a struct, but it makes things more complicated.

Tuple Structs

Rust also has the notion of a "tuple struct". These are like structs except they do not name their fields. The Haskell version would be an "undistinguished product type". This is a type with a single constructor, many fields, but no names. Consider these:

// Rust
struct User(String, String, u32);

-- Haskell
data User = User String String Int

We can destructure and pattern match on tuple structs. We can also use numbers as indices with the . operator, in place of user field names.

struct User(String, String, u32);

let user1 = User("james", "james@test.com", 25);

// Prints "james@test.com"
println!("{}", user1.1);

Rust also has the idea of a "unit struct". This is a type that has no data attached to it. These seem a little weird, but they can be useful, as in Haskell:

// Rust
struct MyUnitType;

-- Haskell
data MyUnitType = MyUnitType

Enums

The last main way we can create a data type is with an "enum". In Haskell, we typically use this term to refer to a type that has many constructors with no arguments. But in Rust, an enum is the general term for a type with many constructors, no matter how much data each has. Thus it captures the full range of what we can do with data in Haskell. Consider this example:

// Rust
struct Point(f32, f32);

enum Shape {
  Triangle(Point, Point, Point),
  Rectangle(Point, Point, Point, Point),
  Circle(Point, f32),
}

-- Haskell
data Point = Point Float Float

data Shape =
  Triangle Point Point Point |
  Rectangle Point Point Point Point |
  Circle Point Float

Pattern matching isn't quite as easy as in Haskell. We don't make multiple function definitions with different patterns. Instead, Rust uses the match operator to allow us to sort through these. Each match must be exhaustive, though you can use _ as a wildcard, as in Haskell. Expressions in a match can use braces, or not.

fn get_area(shape: Shape) -> f32 {
  match shape {
    Shape::Triangle(pt1, pt2, pt3) => {
      // Calculate 1/2 base * height
    },
    Shape::Rectangle(pt1, pt2, pt3, pt4) => {
      // Calculate base * height
    },
    Shape::Circle(center, radius) => (0.5) * radius * radius * PI
  }
}

Notice we have to namespace the names of the constructors! Namespacing is one element that feels more familiar from C++. Let's look at another.

Implementation Blocks

So far we've only looked at our new types as dumb data, like in Haskell. But unlike Haskell, Rust allows us to attach implementations to structs and enums. These definitions can contain instance methods and other functions. They act like class definitions from C++ or Python. We start off an implementation section with the impl keyword.

As in Python, any "instance" method has a parameter self. In Rust, this reference can be mutable or immutable. (In C++ it's called this, but it's an implicit parameter of instance methods). We call these methods using the same syntax as C++, with the . operator.

impl Shape {
  fn area(&self) -> f32 {
    match self {
      // Implement areas
    }
  }
}

fn main() {
  let shape1 = Shape::Circle(Point(0, 0), 5);
  println!("{}", shape1.area()); 
}

We can also create "associated functions" for our structs and enums. These are functions that don't take self as a parameter. They are like static functions in C++, or any function we would write for a type in Haskell.

impl Shape {
  fn shapes_intersect(s1: &Shape, s2: &Shape) -> bool 
    
  
}

fn main() {
  let shape1 = Shape::Circle(Point(0, 0), 5);
  let shape2 = Shape::Circle(Point(10, 0), 6);
  if Shape::shapes_intersect(&shape1, &shape2) {
    println!("They intersect!");
  } else {
    println!("No intersection!");
  };
}

Notice we still need to namespace the function name when we use it!

Generic Types

As in Haskell, we can also use generic parameters for our types. Let's compare the Haskell definition of Maybe with the Rust type Option, which does the same thing.

// Rust
enum Option<T> {
  Some(T),
  None,
}

-- Haskell
 data Maybe a =
  Just a |
  Nothing

Not too much is different here, except for the syntax.

We can also use generic types for functions:

fn compare<T>(t1: &T, t2: &T) -> bool 
  

But, you won't be able to do much with generics unless you know some information about what the type does. This is where traits come in.

Traits

For the final topic of this article, we'll discuss traits. These are like typeclasses in Haskell, or interfaces in other languages. They allow us to define a set of functions. Types can provide an implementation for those functions. Then we can use those types anywhere we need a generic type with that trait.

Let's reconsider our shape example and suppose we have a different type for each of our shapes.

struct Point(f32, f32);

struct Rectangle {
  top_left: Point,
  top_right: Point,
  bottom_right: Point,
  bottom_left: Point,
}

struct Triangle {
  pt1: Point,
  pt2: Point,
  pt3: Point,
}

struct Circle {
  center: Point,
  radius: f32,
}

Now we can make a trait for calculating the area, and let each shape implement that trait! Here's how the syntax looks for defining it and then using it in a generic function. We can constrain what generics a function can use, as in Haskell:

pub trait HasArea {
  fn calculate_area(&self) -> f32;
}

impl HasArea for Circle {
  fn calculate_area(&self) -> f32 {
    self.radius * self.radius * PI
  }
}

fn double_area<T: HasArea>(element: &T) -> f32 {
  2 * element.calculate_area()
}

Also as in Haskell, we can derive certain traits with one line! The Debug trait works like Show:

#[derive(Debug)]
struct Circle 
  

What's Next

This should give us a more complete understanding of how we can define data types in Rust. We see an interesting mix of concepts. Some ideas, like instance methods, come from the object oriented world of C++ or Python. Other ideas, like matchable enumerations, come from more functional languages like Haskell.

Next time, we'll start looking at making a project with Rust. We'll consider how we create a project, how to manage its dependencies, how to run it, and how to test it.

by James Bowen at December 09, 2019 03:30 PM

Philip Wadler

Election Special: Antisemitism


In the run-up to the election, I am passing on a couple of resources in case readers find them of value.

Antisemitism has been so much in the news that everyone must believe there cannot be smoke without fire. But if you dig into the allegations, it becomes clear that a minuscule flame has been fanned for political purposes.
How Labour Became “Antisemitic”

Ever since his shock election to the Labour leadership in 2015, Jeremy Corbyn has been dogged by allegations of “antisemitism.” Both the media and hostile MPs claim he has failed to confront Jew-hate in party ranks — one Tory minister even said Corbyn would be “the first antisemitic Western leader since 1945.” Often bound up with debates on Israel and anti-imperialism, this has become one of the main lines of attack against Corbyn, both within and outside the party.
Yet for all the headlines about “mounting antisemitism” in Labour, we are rarely given any sense of its scale. Data released by the party in February 2019 showed that it had received 1,106 specific complaints of antisemitism since April 2018, of which just 673 regarded actual Labour members. The party membership stands at over half a million: the allegations, even if they were true, concern around 0.1 percent of the total.
Constant media talk of Labour’s “antisemitism crisis” has nonetheless warped all discussion of this issue. This is a key finding of Bad News for Labour, a new book on the party’s handling of antisemitism claims. The study is especially notable for its use of focus groups and polling to gauge public perceptions of the affair: when its authors commissioned Survation to ask 1,009 people how many Labour members faced antisemitism complaints, the average estimate — at 34 percent — was over three hundred times the published figures.

by Philip Wadler (noreply@blogger.com) at December 09, 2019 12:21 PM

FP Complete

Casa: Content-Addressable Storage Archive

Casa stands for "content-addressable storage archive", and also means "home" in romance languages, and it is an online service we're announcing to store packages in a content-addressable way.

It's the natural next step in our general direction towards reproducible builds and immutable infrastructure. Its first application is use in the most popular Haskell build tool, Stack. The master branch of this tool is now download its package indexes, metadata and content from this service.

Although its primary use case was for Haskell, it could easily apply to other languages, such as Rust's Cargo package manager. This post will focus on Casa in general. Next week, we'll dive into its implications for Haskell build tooling.

Content-addressable storage in a nutshell

CAS is primarily an addressing system:

  • When you store content in the storage system, you generate a key for it by hashing the content, e.g. a SHA256.
  • When you want to retrieve the content, you use this SHA256 key.

Because the SHA256 refers to only this piece of content, you can validate that what you get out is what you put in originally. The logic goes something like:

  • Put "Hello, World!" into system.
  • Key is: dffd6021bb2bd5b0af676290809ec3a53191dd81c7f70a4b28688a362182986f
  • Later, request dffd6021bb2bd5b0af676290809ec3a53191dd81c7f70a4b28688a362182986f from system.
  • Receive back content, check that sha256sum(content) = dffd6021bb2bd5b0af676290809ec3a53191dd81c7f70a4b28688a362182986f.
  • If so, great! If not, reject this content and raise an error.

This is how Casa works. Other popular systems that use this style of addressing are IPFS and, of course, Git.

Casa endpoints

There is one simple download entry point to the service.

  • GET http://casa.fpcomplete.com/<your key> -- to easily grab the content of a key with curl. This doesn't have an API version associated with it, because it will only ever accept a key and return a blob.

These two are versioned because they accept and return JSON/binary formats that may change in the future:

  • GET http://casa.fpcomplete.com/v1/metadata/<your key> -- to display metadata about a value.
  • POST http://casa.fpcomplete.com/v1/pull - we POST up to a thousand key-len pairs in binary format (32 bytes for the key, 8 bytes for the length) and the server will stream all the contents back to the client in key-content pairs.

Beyond 1000 keys, the client must make separate requests for the next 1000, etc. This is due to request length limits intentionally applied to the server for protection.

Protected upload

Upload is protected under the endpoint /v1/push. This is similar to the pull format, but sends length-content pairs instead. The server streamingly inserts these into the database.

The current workflow here is that the operator of the archive sets up a regular push system which accesses casa on a separate port which is not publicly exposed. In the Haskell case, we pull from Stackage and Hackage (two Haskell package repositories) every 15 minutes, and push content to Casa.

Furthermore, rather than uploading packages as tarballs, we instead upload individual files. With this approach, we remove a tonne of duplication on the server. Most new package uploads change only a few files, and yet an upgrading user has to download the whole package all over again.

Service characteristics

Here are some advantages of using CAS for package data:

  1. It's reproducible. You always get the package that you wanted.
  2. It's secure on the wire; a man-in-the-middle attack cannot alter a package without the SHA256 changing, which can be trivially rejected. However, we connect over a TLS-encrypted HTTP connection to preserve privacy.
  3. You don't have to trust the server. It could get hacked, and you could still trust content from it if it gives you content with the correct SHA256 digest.
  4. The client is protected from a DoS by a man-in-the-middle that might send an infinitely sized blob in return; the client already knows the length of the blob, so it can streamingly consume only this length, and check it against the SHA256.
  5. It's inherently mirror-able. Because we don't need to trust servers, anyone can be a mirror.

Recalling the fact that each unique blob is a file from a package, a cabal file, a snapshot, or a tree rendered to a binary blob, that removes a lot of redundancy. The storage requirements for Casa are trivial. There are currently around 1,000,000 unique blobs (with the largest file at 46MB). Rather than growing linearly with respect to the number of uploaded package versions, we grow linearly with respect to unique files.

Internal Company Casas

Companies often run their own package archive on their own network (or IP-limited public server) and upload their custom packages to it, to be used by everyone in the company.

Here are some reasons you might want to do that:

  • Some organizations block outside Internet access, for security and retaining IP.
  • Even if the download has integrity guarantees, organizations might not want to reveal what is being downloaded for privacy.
  • An organization may simply for speed reasons want downloads of packages to come within the same network, rather than reaching across the world which can have significant latency.

You can do the same with Casa.

The Casa repository is here which includes both the server and a binary for uploading and querying blobs.

In the future we will include in the Casa server a trivial way to support mirroring, by querying keys on-demand from other Casa servers (including the main one run by us).

Summary

Here's what we've brought to the table with Casa:

  • Reliable, reproducible referring to packages and their files.
  • De-duplication of package files; fewer things to download, on your dev machine or on CI.
  • An easy to use and rely on server.
  • A way to run an archive of your own that is trivial to run.

We believe this CAS architecture has use in other language ecosystems, not just Haskell. If you're a company interested in running your own Casa server, and/or updating your tooling, e.g. Cargo, to use this service, please contact us.

December 09, 2019 12:13 PM

Philip Wadler

Election Special: NHS


In the run-up to the election, I am passing on a couple of resources in case readers find them of value.

Must watch film - now offered free in time for General Election 2019.

The Great NHS Heist forensically examines not only how the Tories plan to sell off the NHS but how they are already well advanced in smashing it apart, selling off the fragments piece by piece.

by Philip Wadler (noreply@blogger.com) at December 09, 2019 11:51 AM

December 07, 2019

Magnus Therning

December 06, 2019

Chris Smith 2

My Takeaways: Fernando Alegre’s talk on CodeWorld in Louisiana

On Wednesday evening, Fernando Alegre spoke to the New York Haskell User Group about using CodeWorld to teach Haskell to high school students in Louisiana. Most of the students have no prior programming experience, and he’s been very successful at quite a large scale. The talk is on YouTube.

https://medium.com/media/b4bd3826241da1ee8984b2f5a55a5d01/href

You should absolutely watch Fernando’s talk yourself. But here are the big points I took away from it.

#1: The scale of LSU’s work is very impressive.

The sheer scale of what Fernando is doing is staggering here. They have expanded from one high school in Baton Rouge in 2016 to more schools than we could count on his map. They are reaching about 800 students this school year, and it’s been doubling every year. Next year, with increased funding from several grants, they plan to triple the number to close to 2500 students per year. This is the major leagues, here!

There’s one big problem here: finding and keeping that many teachers is hard. Fernando mentioned that their number of students has been doubling every year, but the number of teachers has been growing linearly. Some of the issues here are:

  • Professional development costs money. While they’ve been able to fund teachers to attend so far, that has its limits. This is not a one-day retreat, either! LSU’s teachers attend a 6 week intensive training program, along with continuous online support after the main training session.
  • Teachers lack technical background. Because so many teachers are required, LSU cannot have too many prerequisites. The teachers often lack any past computer science experience, and don’t necessarily teach math, science, or anything technical. Some are afraid of math coming in! Fernando mentioned at one point that while the students are the ultimate goal, he sees teachers as his main challenge.
  • Teacher attrition is an issue. Louisiana schools also face a shortage of math and science teachers, and those who complete LSU’s training program for computational thinking often still find themselves back in math and science classrooms, instead. Several teachers have also left teaching to use their new skills themselves in the software industry.

There is also a lot of support work needed for a project of this size. Fernando mentioned they are looking to hire an entry-level software engineer, preferably working in Haskell, to help with the infrastructure needs of the project.

#2: The stakes are high.

Fernando talked for a while about their EIR research grant (search for Louisiana State University here for details), which is connected to the What Works Clearinghouse. What Works Clearinghouse is a database maintained by the U.S. Department of Education about which educational techniques do or don’t have research-supported impacts on student achievement.

A lot of approaches to teaching K-12 computer science have been studied in the past, and the results have not often impressed. Logo, Scratch, and others all have most research showing small to no gains in student achievement. Bootstrap, which is similar in many ways, has published research showing gains in student achievement on certain math word problems, but it was a smaller study with limited scope. In general, this problem is hard, and many have failed.

If the results here are different, it could make a big impact. This could be a large-scale research project demonstrating both success and transfer learning from computer science and functional programming to other fields (especially mathematics), and it could have a major impact in education. On the other hand, if the study produces no evidence of learning, that could matter as well!

Fernando told a powerful cautionary tale about Logo and Seymour Papert. Papert captivated a large part of the education community with his Logo language, which I even learned in my own elementary school education. Roy Pea followed up with empirical research, which showed little to no measurable learning gains to support Papert’s claims about its educational benefits. Fernando suspects that the problem here was that the curriculum was too open-ended. Pure discovery learning, with little or no direct instruction or guidance, tends to only work for students with a lot of confidence and background knowledge, and Papert was a consummate believer in discovery learning. Yet, the results tarnished not just Papert’s own teaching style, but also Logo as a language, and even computing in the elementary classroom in general.

Similarly, this study is about whether LSU’s computational thinking curriculum works. But the results are likely to be cited for broader questions. Does CodeWorld work in K-12? Does Haskell work in K-12? Does functional programming work in K-12?

And there are definitely challenges here: The teachers are not experts, the curriculum is new and in flux, and there’s not even a standard way to measure student achievement in computational thinking in the first place! Answers to these questions are now more urgent than they were before.

#3: LSU has empirical support for Haskell in computational thinking.

Fernando laid out how LSU is building a full set of four “STEM pathways” that high school students can follow to earn endorsements on their high school diplomas. The four pathways include pre-engineering, computation, digital design, and biomedical sciences. Each of these pathways will include some technology classes and often their own programming languages and tools — whether that’s JavaScript and Unity for digital design, or R for statistical analysis in biomedical sciences, or Arduino for building smart devices. The decision was made to add one class at the beginning that’s a common introduction to computational thinking before splitting into domain-specific directions. And that’s where Haskell and CodeWorld come in.

Fernando noted that they have seen the expected resistance to the choice of Haskell for the introductory language. Some of this resistance comes from familiarity, as stakeholders wonder what’s wrong with just using Python like “everyone else”. Some comes from more substantive objections, as well, and Fernando talked a bit about how CodeWorld’s functions are sometimes harder to read than object-oriented dot notation because of how they separate operations like translation and rotation from the data they use. Despite the objections, though, they’ve seen some surprising support:

  • Most teachers in their 6-week summer training program panic around week 2. By week 6, though, they’ve become huge fans of the tools, and advocate strongly for them.
  • Students, too, fall in love with it. Fernando shared a story of a teacher who first taught computational thinking with Haskell & CodeWorld, then later an AP Computer Science Principles class in the same school, using MIT’s Scratch. Students set up protests and chanted “CodeWorld! CodeWorld!” at various points in the class, begging for a return to the Haskell tool.

Another key part of the decision was a desire to integrate with mathematics education. Louisiana schools are struggling with math achievement, and LSU specifically designed the curriculum to include a lot of mathematical thinking as well. This was great to hear, since building math skills was my fundamental goal in the CodeWorld project in the first place. A big part of the EIR grant is to observe and quantify this effect. My choice of Haskell for CodeWorld, in the beginning, came from the observation that writing Haskell feels like writing mathematics in a way that’s true of no other language or tool that I know.

#4: Learning progressions and stories are important.

One of the best moments of Fernando’s talk, and one that drew spontaneous applause, was the progression of generating a star from overlapping triangles. The progression (which I’m modifying a bit) goes like this:

Punchline: Suddenly, you can change the number of points! https://code.world/#PyeIKl57dFGPYsub71Ly_Qg

The point here (pun intended) is that by communicating the structure behind numbers with an expression, you can capture repeated reasoning, generalize it, and then extend your generalizations. By removing that information from your notation (for example, by simplifying arithmetic), you lose the opportunity. This is similar to John Mason’s writing on tracking arithmetic, which I’ve blogged about here in the past.

Fernando also talks about how he uses randomness and interactivity to prompt students to generalize and parameterize their thinking. This is all good stuff.

#5: There’s still a long way to go.

One thing that became clear as Fernando finished is that he’s still struggling with how to convey some ideas. Interacting with the outside world is difficult from CodeWorld’s purely functional models. Students and teachers alike find CodeWorld’s stateful activities to be too difficult to use.

The good news here is that for an introductory course, these things aren’t as important. But they matter eventually. How do we help the teacher who wants to build complex demonstrations, or do statistics with outside data sets, or build stateful models of economics or physics systems? What does an “advanced” computational thinking course with Haskell or CodeWorld look like? These are open questions, and Fernando presented some compelling (and controversial) ideas.

Hope you have the chance to watch, and share your thoughts.

by Chris Smith at December 06, 2019 09:44 PM

Matt Parsons

Splitting Persistent Models

Reddit user /u/qseep made a comment on my last blog post, asking if I had any advice for splitting up persistent model definitions:

A schema made using persistent feels like a giant Types module. One change to an entity definition requires a recompile of the entire schema and everything that depends on it. Is there a similar process to break up a persistent schema into pieces?

Yes! There is. In fact, I’ve been working on this at work, and it’s made a big improvement in our overall compile-times. I’m going to lay out the strategy and code here to make it all work out.

You’d primarily want to do this to improve compilation times, though it’s also logically nice to “only import what you need” I guess.

Starting Point and Background

persistent is a database library in Haskell that focuses on rapid productivity and iteration with relatively simple types. It’s heavier than a raw SQL library, but much simpler than something like opaleye or beam. It also offers less features and type-safety than those two libraries. Trade-offs abound!

Usually, persistent users will define the models/tables for their database using the persistent QuasiQuoter language. The examples in the Persistent chapeter in the Yesod book use the QuasiQuoter directly in line with the Haskell code:

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    name String
    age Int Maybe
    deriving Show
BlogPost
    title String
    authorId PersonId
    deriving Show
|]

The Yesod scaffold, however, loads a file:

-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
    $(persistFileWith lowerCaseSettings "config/models")

For smaller projects, I’d recommend using the QuasiQuoter - it causes less problems with GHCi (no need to worry about relative file paths). Once the models file gets big, compilation will become slow, and you’ll want to split it into many files. I investigated this slowness to see what the deal was, initially suspecting that the Template Haskell code was slowing things down. What I found was a little surprising: for a 1,200 line models file, we were spending less than a second doing TemplateHaskell. The rest of the module would take several minutes to compile, largely because the generated module was over 390,000 lines of code, and GHC is superlinear in compiling large modules.

Another reason to split it up is to avoid GHCi linker issues. GHCi can exhaust linker ticks (or some other weird finite resource?) when compiling a module, and it will do this when you get more than ~1,000 lines of models (in my experience).

Split Up Approaches

I am aware of two approaches for splitting up the modules - one uses the QuasiQuoter, and the other uses external files for compilation. We’ll start with external files, as it works best with persistent migrations and requires the least amount of fallible human error checking.

Separate Files

I prepared a GitHub pull request that demonstrates the changes in this section. Follow along for exactly what I did:

In the Yesod scaffold, you have a config/models file which contains all of the entity definitions. We’re going to rename the file to config/models_backup, and we’re going to create a folder config/models/ where we will put the new entity files. For consistency/convention, we’re going to name the files ${EntityName}.persistentmodels, so we’ll end up with this directory structure:

config
└── models
    ├── Comment.persistentmodels
    ├── Email.persistentmodels
    └── User.persistentmodels

Now, we’re going to create a Haskell file for each models file.

{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Model.User where

import ClassyPrelude.Yesod
import Database.Persist.Quasi

share [mkPersist sqlSettings]
    $(persistFileWith lowerCaseSettings "config/models/User.persistentmodels")

So far, so good! The contents of the User.persistentmodels file only has the entity definition for the User table:

-- config/models/User.persistentmodels
User
    ident Text
    password Text Maybe
    UniqueUser ident
    deriving Typeable

Next up, we’ll do Email, which is defined like this:

Email
    email Text
    userId UserId Maybe
    verkey Text Maybe
    UniqueEmail email

Email refers to the UserId type, which is defined in Model.User. So we need to add that import to the Model.Email module.

{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Model.Email where

import ClassyPrelude.Yesod
import Database.Persist.Quasi

import Model.User

share [mkPersist sqlSettings]
    $(persistFileWith lowerCaseSettings "config/models/Email.persistentmodels")

We need to do the same thing for the Comment type and module.

Now, we have a bunch of modules that are defining our data entities. You may want to reexport them all from the top-level Model module, or you may choose to have finer grained imports. Either way has advantages and disadvantages.

Migrations

Let’s get those persistent migrations back. If you’re not using persistent migrations, then you can just skip this bit. We’ll define a new module, Model.Migration, which will load up all the *.persistentmodels files and make a migration out of them.

{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Model.Migration where

import System.Directory
import ClassyPrelude.Yesod
import Database.Persist.Quasi

mkMigrate "migrateAll" $(do
    files <- liftIO $ do
        dirContents <- getDirectoryContents "config/models/"
        pure $ map ("config/models/" <>) $ filter (".persistentmodels" `isSuffixOf`) dirContents
    persistManyFileWith lowerCaseSettings files
    )

Some tricks here:

  1. You can write do notation in a TemplateHaskell splice, because Q is a monad, and a splice only expects that the result have Q splice where splice depends on syntactically where it’s going. Here, we have Q Exp because it’s used in an expression context.
  2. We do a relatively simple scan - get directory contents for our models, then filter to the suffix we care about, and then map the full directory path on there.
  3. Finally we call persistManyFileWith, which takes a list of files and parses it into the [EntityDef].

Now we’ve got migrations going, and our files are split up. This speeds up compilation quite a bit.

QuasiQuotes

If you’re not using migrations, this approach has a lot less boilerplate and extra files you have to mess about with. However, the migration story is a little more complicated.

Basically, you just put your QuasiQuote blocks in separate Haskell modules, and import the types you need for the references to work out. Easy-peasy!

Migrations

Okay, so this is where it gets kind of obnoxious.

In each quasiquote block, you have it generate migrations for your types. Then, you’ll make a Model.Migration file, which will need to import the migrations from each of your Model files and then run them in order. You need to manually topologically sort the migrations based on references, or it will try to create eg foreign keys to tables you haven’t created yet, which borks the migrations.

At least, I think that’s what you’d need to do - that’s about where I got when exploring this method on the work codebase, and I decided against it because it seemed less flexible and useful than the above approach since we use the persistent migrations.

December 06, 2019 12:00 AM

December 05, 2019

Michael Snoyman

Tokio 0.2 - Rust Crash Course lesson 9

In the previous lesson in the crash course, we covered the new async/.await syntax stabilized in Rust 1.39, and the Future trait which lives underneath it. This information greatly supercedes the now-defunct lesson 7 from last year, which covered the older Future approach.

Now it’s time to update the second half of lesson 7, and teach the hot-off-the-presses Tokio 0.2 release. For those not familiar with it, let me quote the project’s overview:

Tokio is an event-driven, non-blocking I/O platform for writing asynchronous applications with the Rust programming language.

If you want to write an efficient, concurrent network service in Rust, you’ll want to use something like Tokio. That’s not to say that this is the only use case for Tokio; you can do lots of great things with an event driven scheduler outside of network services. It’s also not to say that Tokio is the only solution; the async-std library provides similar functionality.

However, network services are likely the most common domain agitating for a non-blocking I/O system. And Tokio is the most popular and established of these systems today. So this combination is where we’re going to get started.

And as a side note, if you have some other topic you’d like me to cover around this, please let me know on Twitter.

Exercise solutions will be included at the end of the blog post. Yes, I keep changing the rules, sue me.

This post is part of a series based on teaching Rust at FP Complete. If you’re reading this post outside of the blog, you can find links to all posts in the series at the top of the introduction post. You can also subscribe to the RSS feed.

Hello Tokio!

Let’s kick this off. Go ahead and create a new Rust project for experimenting:

$ cargo new --bin usetokio

If you want to make sure you’re using the same compiler version as me, set up your rust-toolchain correctly:

$ echo 1.39.0 > rust-toolchain

And then set up Tokio as a dependency. For simplicity, we’ll install all the bells and whistles. In your Cargo.toml:

[dependencies]
tokio = { version = "0.2", features = ["full"] }

PROTIP You can run cargo build now to kick off the download and build of crates while you keep reading…

And now we’re going to write an asynchronous hello world application. Type this into your src/main.rs:

use tokio::io;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut stdout = io::stdout();
    let mut hello: &[u8] = b"Hello, world!\n";
    io::copy(&mut hello, &mut stdout).await?;
    Ok(())
}

NOTE I specifically said “type this in” instead of “copy and paste.” For getting comfortable with this stuff, I recommend manually typing in the code.

A lot of this should look familiar from our previous lesson. To recap:

  • Since we’ll be awaiting something and generating a Future, our main function is async.
  • Since main is async, we need to use an executor to run it. That’s why we use the #[tokio::main] attribute.
  • Since performing I/O can fail, we return a Result.

The first really new thing since last lesson is this little bit of syntax:

.await?

I mentioned it last time, but now we’re seeing it in real life. This is just the combination of our two pieces of prior art: .await for chaining together Futures, and ? for error handling. The fact that these work together so nicely is really awesome. I’ll probably mention this a few more times, because I love it that much.

The next thing to note is that we use tokio::io::stdout() to get access to some value that lets us interact with standard output. If you’re familiar with it, this looks really similar to std::io::stdout(). That’s by design: a large part of the tokio API is simply async-ifying things from std.

And finally, we can look at the actual tokio::io::copy call. As you may have guessed, and as stated in the API docs:

This is an asynchronous version of std::io::copy.

However, instead of working with the Read and Write traits, this works with their async cousins: AsyncRead and AsyncWrite. A byte slice (&[u8]) is a valid AsyncRead, so we’re able to store our input there. And as you may have guessed, Stdout is an AsyncWrite.

EXERCISE 1 Modify this application so that instead of printing “Hello, world!”, it copies the entire contents of standard input to standard output.

NOTE You can simplify this code using stdout.write_all after useing tokio::io::AsyncWriteExt, but we’ll stick to tokio::io::copy, since we’ll be using it throughout. But if you’re curious:

use tokio::io::{self, AsyncWriteExt};

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut stdout = io::stdout();
    stdout.write_all(b"Hello, world!\n").await?;
    Ok(())
}

Spawning processes

Tokio provides a tokio::process module which resembles the std::process module. We can use this to implement Hello World once again:

use tokio::process::Command;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    Command::new("echo").arg("Hello, world!").spawn()?.await?;
    Ok(())
}

Notice how the ? and .await bits can go in whatever order they are needed. You can read this line as:

  • Create a new Command to run echo
  • Give it the argument "Hello, world!"
  • Spawn this, which may fail
  • Using the first ?: if it fails, return the error. Otherwise, return a Future
  • Using the .await: wait until that Future completes, and capture its Result
  • Using the second ?: if that Result is Err, return that error.

Pretty nice for a single line!

One of the great advantages of async/.await versus the previous way of doing async with callbacks is how easily it works with looping.

EXERCISE 2 Extend this example so that it prints Hello, world! 10 times.

Take a break

So far we’ve only really done a single bit of .awaiting. But it’s easy enough to .await on multiple things. Let’s use delay_for to pause for a bit.

use tokio::time;
use tokio::process::Command;
use std::time::Duration;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    Command::new("date").spawn()?.await?;
    time::delay_for(Duration::from_secs(1)).await;
    Command::new("date").spawn()?.await?;
    time::delay_for(Duration::from_secs(1)).await;
    Command::new("date").spawn()?.await?;
    Ok(())
}

We can also use the tokio::time::interval function to create a stream of “ticks” for each time a certain amount of time has passed. For example, this program will keep calling date once per second until it is killed:

use tokio::time;
use tokio::process::Command;
use std::time::Duration;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut interval = time::interval(Duration::from_secs(1));
    loop {
        interval.tick().await;
        Command::new("date").spawn()?.await?;
    }
}

EXERCISE 3 Why isn’t there a Ok(()) after the loop?

Time to spawn

This is all well and good, but we’re not really taking advantage of asynchronous programming at all. Let’s fix that! We’ve seen two different interesting programs:

  1. Infinitely pausing 1 seconds and calling date
  2. Copying all input from stdin to stdout

It’s time to introduce spawn so that we can combine these two into one program. First, let’s demonstrate a trivial usage of spawn:

use std::time::Duration;
use tokio::process::Command;
use tokio::task;
use tokio::time;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    task::spawn(dating()).await??;
    Ok(())
}

async fn dating() -> Result<(), std::io::Error> {
    let mut interval = time::interval(Duration::from_secs(1));
    loop {
        interval.tick().await;
        Command::new("date").spawn()?.await?;
    }
}

You may be wondering: what’s up with that ?? operator? Is that some special super-error handler? No, it’s just the normal error handling ? applied twice. Let’s look at some type signatures to help us out here:

pub fn spawn<T>(task: T) -> JoinHandle<T::Output>;

impl<T> Future for JoinHandle<T> {
    type Output = Result<T, JoinError>;
}

Calling spawn gives us back a JoinHandle<T::Output>. In our case, the Future we provide as input is dating(), which has an output of type Result<(), std::io::Error>. So that means the type of task::spawn(dating()) is JoinHandle<Result<(), std::io::Error>>.

We also see that JoinHandle implements Future. So when we apply .await to this value, we end up with whatever that type Output = Result<T, JoinError> thing is. Since we know that T is Result<(), std::io::Error>, this means we end up with Result<Result<(), std::io::Error>, JoinError>.

The first ? deals with the outer Result, exiting with the JoinError on an Err, and giving us a Result<(), std::io::Error> value on Ok. The second ? deals with the std::io::Error, giving us a () on Ok. Whew!

EXERCISE 4 Now that we’ve seen spawn, you should modify the program so that it calls both date in a loop, and copies stdin to stdout.

Synchronous code

You may not have the luxury of interacting exclusively with async-friendly code. Maybe you have some really nice library you want to leverage, but it performs blocking calls internally. Fortunately, Tokio’s got you covered with the spawn_blocking function. Since the docs are so perfect, let me quote them:

The task::spawn_blocking function is similar to the task::spawn function discussed in the previous section, but rather than spawning an non-blocking future on the Tokio runtime, it instead spawns a blocking function on a dedicated thread pool for blocking tasks.

EXERCISE 5 Rewrite the dating() function to use spawn_blocking and std::thread::sleep so that it calls date approximately once per second.

Let’s network!

I could keep stepping through the other cools functions in the Tokio library. I encourage you to poke around at them yourself. But I promised some networking, and by golly, I’m gonna deliver!

I’m going to slightly extend the example from the TcpListener docs to (1) make it compile and (2) implement an echo server. This program has a pretty major flaw in it though, I recommend trying to find it.

use tokio::io;
use tokio::net::{TcpListener, TcpStream};

#[tokio::main]
async fn main() -> io::Result<()> {
    let mut listener = TcpListener::bind("127.0.0.1:8080").await?;

    loop {
        let (socket, _) = listener.accept().await?;
        echo(socket).await?;
    }
}

async fn echo(socket: TcpStream) -> io::Result<()> {
    let (mut recv, mut send) = io::split(socket);
    io::copy(&mut recv, &mut send).await?;
    Ok(())
}

We use TcpListener to bind a socket. The binding itself is asynchronous, so we use .await to wait for the listening socket to be available. And we use ? to deal with any errors while binding the listening socket.

Next, we loop forever. Inside the loop, we accept new connections, using .await? like before. We capture the socket (ignoring the address as the second part of the tuple). Then we call our echo function and .await it.

Within echo, we use tokio::io::split to split up our TcpStream into its constituent read and write halves, and then pass those into tokio::io::copy, as we’ve done before.

Awesome! Where’s the bug? Let me ask you a question: what should the behavior be if a second connection comes in while the first connection is still active? Ideally, it would be handled. However, our program has just one task. And that task .awaits on each call to echo. So our second connection won’t be serviced until the first one closes.

EXERCISE 6 Modify the program above so that it handles concurrent connections correctly.

TCP client and ownership

Let’s write a poor man’s HTTP client. It will establish a connection to a hard-coded server, copy all of stdin to the server, and then copy all data from the server to stdout. To use this, you’ll manually type in the HTTP request and then hit Ctrl-D for end-of-file.

use tokio::io;
use tokio::net::TcpStream;

#[tokio::main]
async fn main() -> io::Result<()> {
    let stream = TcpStream::connect("127.0.0.1:8080").await?;
    let (mut recv, mut send) = io::split(stream);
    let mut stdin = io::stdin();
    let mut stdout = io::stdout();

    io::copy(&mut stdin, &mut send).await?;
    io::copy(&mut recv, &mut stdout).await?;

    Ok(())
}

That’s all well and good, but it’s limited. It only handles half-duplex protocols like HTTP, and doesn’t actually support keep-alive in any way. We’d like to use spawn to run the two copys in different tasks. Seems easy enough:

let send = spawn(io::copy(&mut stdin, &mut send));
let recv = spawn(io::copy(&mut recv, &mut stdout));

send.await??;
recv.await??;

Unfortunately, this doesn’t compile. We get four nearly-identical error messages. Let’s look at the first:

error[E0597]: `stdin` does not live long enough
  --> src/main.rs:12:31
   |
12 |     let send = spawn(io::copy(&mut stdin, &mut send));
   |                      ---------^^^^^^^^^^------------
   |                      |        |
   |                      |        borrowed value does not live long enough
   |                      argument requires that `stdin` is borrowed for `'static`
...
19 | }
   | - `stdin` dropped here while still borrowed

Here’s the issue: our copy Future does not own the stdin value (or the send value, for that matter). Instead, it has a (mutable) reference to it. That value remains in the main function’s Future. Ignoring error cases, we know that the main function will wait for send to complete (thanks to send.await), and therefore the lifetimes appear to be correct. However, Rust doesn’t recognize this lifetime information. (Also, and I haven’t thought this through completely, I’m fairly certain that send may be dropped earlier than the Future using it in the case of panics.)

In order to fix this, we need to convince the compiler to make a Future that owns stdin. And the easiest way to do that here is to use an async move block.

Exercise 7 Make the code above compile using two async move blocks.

Playing with lines

This section will have a series of modifications to a program. I recommend you solve each challenge before looking at the solution. However, unlike the other exercises, I’m going to show the solutions inline since they build on each other.

Let’s build an async program that counts the number of lines on standard input. You’ll want to use the lines method for this. Read the docs and try to figure out what uses and wrappers will be necessary to make the types line up.

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let stdin = io::stdin();
    let stdin = io::BufReader::new(stdin);
    let mut count = 0u32;
    let mut lines = stdin.lines();
    while let Some(_) = lines.next_line().await? {
        count += 1;
    }
    println!("Lines on stdin: {}", count);
    Ok(())
}

OK, bumping this up one more level. Instead of standard input, let’s take a list of file names as command line arguments, and count up the total number of lines in all the files. Initially, it’s OK to read the files one at a time. In other words: don’t bother calling spawn. Give it a shot, and then come back here:

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut args = std::env::args();
    let _me = args.next(); // ignore command name
    let mut count = 0u32;

    for filename in args {
        let file = tokio::fs::File::open(filename).await?;
        let file = io::BufReader::new(file);
        let mut lines = file.lines();
        while let Some(_) = lines.next_line().await? {
            count += 1;
        }
    }

    println!("Total lines: {}", count);
    Ok(())
}

But now it’s time to make this properly asynchronous, and process the files in separate spawned tasks. In order to make this work, we need to spawn all of the tasks, and then .await each of them. I used a Vec of Future<Output=Result<u32, std::io::Error>>s for this. Give it a shot!

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut args = std::env::args();
    let _me = args.next(); // ignore command name
    let mut tasks = vec![];

    for filename in args {
        tasks.push(tokio::spawn(async {
            let file = tokio::fs::File::open(filename).await?;
            let file = io::BufReader::new(file);
            let mut lines = file.lines();
            let mut count = 0u32;
            while let Some(_) = lines.next_line().await? {
                count += 1;
            }
            Ok(count) as Result<u32, std::io::Error>
        }));
    }

    let mut count = 0;
    for task in tasks {
        count += task.await??;
    }

    println!("Total lines: {}", count);
    Ok(())
}

And finally in this progression: let’s change how we handle the count. Instead of .awaiting the count in the second for loop, let’s have each individual task update a shared mutable variable. You should use an Arc<Mutex<u32>> for that. You’ll still need to keep a Vec of the tasks though to ensure you wait for all files to be read.

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;
use std::sync::Arc;

// avoid thread blocking by using Tokio's mutex
use tokio::sync::Mutex;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut args = std::env::args();
    let _me = args.next(); // ignore command name
    let mut tasks = vec![];
    let count = Arc::new(Mutex::new(0u32));

    for filename in args {
        let count = count.clone();
        tasks.push(tokio::spawn(async move {
            let file = tokio::fs::File::open(filename).await?;
            let file = io::BufReader::new(file);
            let mut lines = file.lines();
            let mut local_count = 0u32;
            while let Some(_) = lines.next_line().await? {
                local_count += 1;
            }

            let mut count = count.lock().await;
            *count += local_count;
            Ok(()) as Result<(), std::io::Error>
        }));
    }

    for task in tasks {
        task.await??;
    }

    let count = count.lock().await;
    println!("Total lines: {}", *count);
    Ok(())
}

LocalSet and !Send

Thanks to @xudehseng for the inspiration on this section.

OK, did that last exercise seem a bit contrived? It was! In my opinion, the previous approach of .awaiting the counts and summing in the main function itself was superior. However, I wanted to teach you something else.

What happens if you replace the Arc<Mutex<u32>> with a Rc<RefCell<u32>>? With this code:

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;
use std::rc::Rc;
use std::cell::RefCell;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut args = std::env::args();
    let _me = args.next(); // ignore command name
    let mut tasks = vec![];
    let count = Rc::new(RefCell::new(0u32));

    for filename in args {
        let count = count.clone();
        tasks.push(tokio::spawn(async {
            let file = tokio::fs::File::open(filename).await?;
            let file = io::BufReader::new(file);
            let mut lines = file.lines();
            let mut local_count = 0u32;
            while let Some(_) = lines.next_line().await? {
                local_count += 1;
            }

            *count.borrow_mut() += local_count;
            Ok(()) as Result<(), std::io::Error>
        }));
    }

    for task in tasks {
        task.await??;
    }

    println!("Total lines: {}", count.borrow());
    Ok(())
}

You get an error:

error[E0277]: `std::rc::Rc<std::cell::RefCell<u32>>` cannot be shared between threads safely
  --> src/main.rs:15:20
   |
15 |         tasks.push(tokio::spawn(async {
   |                    ^^^^^^^^^^^^ `std::rc::Rc<std::cell::RefCell<u32>>` cannot be shared between threads safely
   |
  ::: /Users/michael/.cargo/registry/src/github.com-1ecc6299db9ec823/tokio-0.2.2/src/task/spawn.rs:49:17
   |
49 |     T: Future + Send + 'static,
   |                 ---- required by this bound in `tokio::task::spawn::spawn`

Tasks can be scheduled to multiple different threads. Therefore, your Future must be Send. And Rc<RefCell<u32>> is definitely !Send. However, in our use case, using multiple OS threads is unlikely to speed up our program; we’re going to be doing lots of blocking I/O. It would be nice if we could insist on spawning all our tasks on the same OS thread and avoid the need for Send. And sure enough, Tokio provides such a function: tokio::task::spawn_local. Using it (and adding back in async move instead of async), our program compiles, but breaks at runtime:

thread 'main' panicked at '`spawn_local` called from outside of a local::LocalSet!', src/libcore/option.rs:1190:5

Uh-oh! Now I’m personally not a big fan of this detect-it-at-runtime stuff, but the concept is simple enough: if you want to spawn onto the current thread, you need to set up your runtime to support that. And the way we do that is with LocalSet. In order to use this, you’ll need to ditch the #[tokio::main] attribute.

EXERCISE 8 Follow the documentation for LocalSet to make the program above work with Rc<RefCell<u32>>.

Conclusion

That lesson felt short. Definitely compared to the previous Tokio lesson which seemed to go on forever. I think this is a testament to how easy to use the new async/.await` syntax is.

There’s obviously a lot more that can be covered in asynchronous programming, but hopefully this establishes the largest foundations you need to understand to work with the async/.await syntax and the Tokio library itself.

If we have future lessons, I believe they’ll cover additional libraries like Hyper as they move over to Tokio 0.2, as well as specific use cases people raise. If you want something covered, mention it to me on Twitter or in the comments below.

Solutions

Solution 1

use tokio::io;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let mut stdin = io::stdin();
    let mut stdout = io::stdout();
    io::copy(&mut stdin, &mut stdout).await?;
    Ok(())
}

Solution 2

use tokio::process::Command;

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    for _ in 1..=10 {
        Command::new("echo").arg("Hello, world!").spawn()?.await?;
    }
    Ok(())
}

Solution 3

Since the loop will either run forever or be short circuited by an error, any code following loop will never actually be called. Therefore, code placed there will generate a warning.

Solution 4

use std::time::Duration;
use tokio::process::Command;
use tokio::{io, task, time};

#[tokio::main]
async fn main() -> Result<(), std::io::Error> {
    let dating = task::spawn(dating());
    let copying = task::spawn(copying());

    dating.await??;
    copying.await??;

    Ok(())
}

async fn dating() -> Result<(), std::io::Error> {
    let mut interval = time::interval(Duration::from_secs(1));
    loop {
        interval.tick().await;
        Command::new("date").spawn()?.await?;
    }
}

async fn copying() -> Result<(), std::io::Error> {
    let mut stdin = io::stdin();
    let mut stdout = io::stdout();
    io::copy(&mut stdin, &mut stdout).await?;
    Ok(())
}

Solution 5

async fn dating() -> Result<(), std::io::Error> {
    loop {
        task::spawn_blocking(|| { std::thread::sleep(Duration::from_secs(1)) }).await?;
        Command::new("date").spawn()?.await?;
    }
}

Solution 6

The simplest tweak is to wrap the echo call with tokio::spawn:

loop {
    let (socket, _) = listener.accept().await?;
    tokio::spawn(echo(socket));
}

There is a downside to this worth noting, however: we’re ignoring the errors produced by the spawned tasks. Likely the best behavior in this case is to handle the errors inside the spawned task:

#[tokio::main]
async fn main() -> io::Result<()> {
    let mut listener = TcpListener::bind("127.0.0.1:8080").await?;

    let mut counter = 1u32;
    loop {
        let (socket, _) = listener.accept().await?;
        println!("Accepted connection #{}", counter);
        tokio::spawn(async move {
            match echo(socket).await {
                Ok(()) => println!("Connection #{} completed successfully", counter),
                Err(e) => println!("Connection #{} errored: {:?}", counter, e),
            }
        });
        counter += 1;
    }
}

Exericse 7

use tokio::io;
use tokio::spawn;
use tokio::net::TcpStream;

#[tokio::main]
async fn main() -> io::Result<()> {
    let stream = TcpStream::connect("127.0.0.1:8080").await?;
    let (mut recv, mut send) = io::split(stream);
    let mut stdin = io::stdin();
    let mut stdout = io::stdout();

    let send = spawn(async move {
        io::copy(&mut stdin, &mut send).await
    });
    let recv = spawn(async move {
        io::copy(&mut recv, &mut stdout).await
    });

    send.await??;
    recv.await??;

    Ok(())
}

Solution 8

use tokio::prelude::*;
use tokio::io::AsyncBufReadExt;
use std::rc::Rc;
use std::cell::RefCell;

fn main() -> Result<(), std::io::Error> {
    let mut rt = tokio::runtime::Runtime::new()?;
    let local = tokio::task::LocalSet::new();
    local.block_on(&mut rt, main_inner())
}

async fn main_inner() -> Result<(), std::io::Error> {
    let mut args = std::env::args();
    let _me = args.next(); // ignore command name
    let mut tasks = vec![];
    let count = Rc::new(RefCell::new(0u32));

    for filename in args {
        let count = count.clone();
        tasks.push(tokio::task::spawn_local(async move {
            let file = tokio::fs::File::open(filename).await?;
            let file = io::BufReader::new(file);
            let mut lines = file.lines();
            let mut local_count = 0u32;
            while let Some(_) = lines.next_line().await? {
                local_count += 1;
            }

            *count.borrow_mut() += local_count;
            Ok(()) as Result<(), std::io::Error>
        }));
    }

    for task in tasks {
        task.await??;
    }

    println!("Total lines: {}", count.borrow());
    Ok(())
}

December 05, 2019 12:57 PM

Shin-Cheng Mu

How to Compute Fibonacci Numbers?

In early 2019, due to a silly flamewar, some friends in Taiwan and I took an interest in computation of Fibonacci numbers. This post involving some inductive proofs and some light program derivation. If you think the fastest way to compute Fibonacci numbers is by a closed-form formula, you should read on!

Source: sciencefreak @ pixabay.

Let Nat be the type of natural numbers. We shall all be familiar with the following definition of Fibonacci number:

‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib :: Nat -> Nat
   fib 0     = 0
‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib 1     = 1
‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib (n+2) = fib (n+1) + fib n

(When defining functions on natural numbers I prefer to see 0, (+1) (and thus (+2)
= (+1) . (+1)
), as constructors that can appear on the LHS, while avoiding subtraction on the RHS. It makes some proofs more natural, and it is not hard to recover the Haskell definition anyway.)

Executing the definition without other support (such as memoization) gives you a very slow algorithm, due to lots of re-computation. I had some programming textbooks in the 80’s wrongly using this as an evidence that “recursion is slow” (fib is usually one of the only two examples in a sole chapter on recursion in such books, the other being tree traversal).

By defining fib2 n = (fib n, fib (n+1)), one can easily derive an inductive definition of fib2,

‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib2 :: Nat -> (Nat, Nat)
   fib2 0     = (0, 1)
‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib2 (n+1) = (y, x+y)
      where (x,y) = fib2 n 

which computes fib n (and fib (n+1)) in O(n) recursive calls. Be warned, however, that it does not imply that fib2 n runs in O(n) time, as we shall see soon.

Binet’s Formula

To be even faster, some might recall, do we not have a closed-form formula for Fibonacci numbers?

‍‍‍‍‍‍ ‍‍  fib n = (((1+√5)/2)^n - ((1-√5)/2)^n) /√5

It was believed that the formula was discovered by Jacques P. M. Binet in 1843, thus we call it Binet’s formula by convention, although the formula can be traced back earlier. Proving (or even discovering) the formula is a very good exercise in inductive proofs. On that I recommend this tutorial by Joe Halpern (CS 280 @ Cornell, , 2005). Having a closed-form formula gives one an impression that it give you a quick algorithm. Some even claim that it delivers a O(1) algorithm for computing Fibonacci numbers. One shall not assume, however, that ((1+√5)/2)^n and ((1-√5)/2)^n can always be computed in a snap!

When processing large numbers, we cannot assume that arithmetic operations such as addition and multiplication take constant time. In fact, it is fascinating knowing that multiplying large numbers, something that appears to be the most fundamental, is a research topic that can still see new breakthrough in 2019 [HvdH19].

Vorobev’s Equation

There is another family of algorithms that manages to compute fib n in O(log n) recursive calls. To construct such algorithms, one might start by asking oneself: can we express fib (n+k) in terms of fib n and fib k (and some other nearby fib if necessary)? Given such a formula, we can perhaps compute fib (n+n) from fib n, and design an algorithm that uses only O(log n) recursive calls.

Indeed, for n >= 1, we have

‍‍‍‍‍‍‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib (n+k) = fib (n-1) * fib k + fib n * fib (k+1) .      -- (Vor)

This property can be traced back to Nikolai. N. Vorobev, and we therefore refer to it as Vorobev’s Equation. A proof will be given later. For now, let us see how it helps us.

With Vorobev’s equation we can derive a number of (similar) algorithms that computes fib n in O(log n) recursive calls. For example, let n, k in (Vor) be n+1, n, we get

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍   fib (2n+1) = (fib (n+1))^2 + (fib n)^2                   -- (1)

Let n, k be n+1, n+1, we get

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍   fib (2n+2) = 2 * fib n * fib (n+1) + (fib (n+1))^2       -- (2)

Subtract (1) from (2), we get

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍fib 2n = 2 * fib n * fib (n+1) - (fib n)^2               -- (3)


The LHS of (1) and (3) are respectively odd and even, while their RHSs involve only fib n and fib (n+1). Define fib2v n = (fib n, fib (n+1)), we can derive the program below, which uses only O(log n) recursive calls.

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍  fib2v :: Nat -> (Nat, Nat)
  fib2v 0 = (0, 1)
  fib2v n | n `mod` 2 == 0 = (c,d)
          | otherwise      = (d, c + d)
     where (a, b) = fib2v (div n 2)
           c      = 2 * a * b - a * a
           d      = a * a + b * b

Which Runs Faster?

Having so many algorithms, the ultimate question is: which runs faster?

Interestingly, in 1988, James L. Holloway devoted an entire Master’s thesis to analysis and benchmarking of algorithms computing Fibonacci numbers. The thesis reviewed algorithms including (counterparts of) all those mentioned in this post so far, and some more algorithms based on matrix multiplication. I will summarise some of his results below.

For a theoretical analysis, we need know the number of bits needed to represent fib n. Holloway estimated that to represent fib n, we need approximately n * 0.69424 bits. We will denote this number by N n. That N n is linear in n is consistent with our impression that fib n grows exponentially in n.

Algorithm fib2 makes O(n) recursive calls, but it does not mean that the running time is O(n). Instead, fib2 n needs around N (n^2/2 - n/2) bit operations to compute. (Note that we are not talking about big-O here, but an approximated upper bound.)

What about Binet formula? We can compute √5 by Newton’s method. One can assume that each n bit division needs n^2 operations. In each round, however, we need only the most significant N n + log n bits. Overall, the number of bit operations needed to compute Binet formula is dominated by log n * (N n + log n)^2 — not faster than fib2.

Holloway studied several matrix based algorithm. Generally, they need around (N n)^2 bit operations, multiplied by different constants.

Meanwhile, algorithms based on Vorobev’s Equation perform quite well — it takes about 1/2 * (N n)^2 bit operations to compute fib2v n!

What about benchmarking? Holloway ran each algorithm up to five minutes. In one of the experiments, the program based on Binet’s formula exceeds 5 minutes when log n = 7. The program based on fib2 terminated within 5 minutes until log n = 15. In another experiment (using simpler programs considering only cases when n is a power of 2), the program based on Binet’s formula exceeds 5 minutes when log n = 13. Meanwhile the matrix-based algorithms terminated within 3 to 5 seconds, while the program based on Vorobev’s Equation terminated within around 2 seconds.

Proving Vorobev’s Equation

Finally, let us see how Vorobev’s Equation can be proved. We perform induction on n. The cases when n := 1 and 2 can be easily established. Assuming the equation holds for n (that is, (Vor)) and n:= n+1 (abbreviating fib to f):

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n+1+k) = f n * f k + f (n+1) * f(k+1)      -- (Vor')

we prove the case for n:=n+2:

‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍‍ ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n+2+k)
  = { definition of f }
  ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n+k) + f (n+k+1)
  = { (Vor) & (Vor') }
  ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n-1) * f k + f n * f (k+1) +
  ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f n * f k + f (n+1) * f(k+1)
  = { f (n+1) = f n + f (n-1) }
  ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n+1) * f k + f n * f (k+1) + f (n+1) * f (k+1)
  = { f (n+2) = f (n+1) + f n } 
  ‍‍‍‍‍‍ ‍‍ ‍‍‍‍‍‍ ‍‍f (n+1) * f k + f (n+2) * f (k+1) .

Thus completes the proof.

Related Work

Dijkstra derived another algorithm that computes fib n in O(log n) recursive calls in EWD654 [Dij78].

Besides his master’s thesis, Holloway and his supervisor Paul Cull also published a journal version of their results [CH89]. I do not know the whereabouts of Holloway — it seems that he didn’t pursue a career in academics. I wish him all the best. It comforts me imagining that any thesis that is written with enthusiasm and love, whatever the topic, will eventually be found by some readers who are also enthusiastic about it, somewhere, sometime.

I found many interesting information on this page hosted by Ron Knott from University of Surrey, and would recommend it too.

After the flamewar, Yoda Lee (李祐棠) conducted many experiments computing Fibonacci, taking into considerations things like precision of floating point computation and choosing suitable floating point libraries. It is worth a read too. (In Chinese.)

So, what was the flamewar about? It started with someone suggesting that we should store on the moon (yes, the moon. Don’t ask me why) some important constants such as π and e and, with the constants being available in very large precision, many problems can be solved in constant time. Then people started arguing what it means computing something in constant time, whether Binet’s formula gives you a constant time algorithm… and here we are. Silly, but we learned something fun.

References

[CH89] Paul Cull, James L. Holloway. Computing fibonacci numbers quickly. Information Processing Letters, 32(3), pp 143-149. 1989.

[Dij78] Dijkstra. In honor of Fibonacci. EWD654, 1978.

[Hol88] James L. Holloway. Algorithms for Computing Fibonaci Numbers Quickly. Master Thesis, Oregon State University, 1988.

[HvdH19] David Harvey, Joris Van Der Hoeven. Integer multiplication in time O(n log n). 2019. hal-02070778.

The post How to Compute Fibonacci Numbers? appeared first on niche computing science.

by Shin at December 05, 2019 07:00 AM

December 04, 2019

Chris Penner

Advent of Optics: Day 4

Advent of Optics: Day 4

Since I'm releasing a book on practical lenses and optics later this month I thought it would be fun to do a few of this year's Advent of Code puzzles using as many obscure optics features as possible!

To be clear, the goal is to be obscure, strange and excessive towards the goal of using as many optics as possible in a given solution, even if it's awkward, silly, or just plain overkill. These are NOT idiomatic Haskell solutions, nor are they intended to be. Maybe we'll both learn something along the way. Let's have some fun!

You can find today's puzzle here.


Hey folks! Today's is a nice clean one! The goal is to find all the numbers within a given range which pass a series of predicates! The conditions each number has to match include:

  • Should be within the range; my range is 307237-769058
  • Should be six digits long; my range includes only 6 digit numbers, so we're all set here
  • Two adjacent digits in the number should be the same (e.g. '223456')
  • The digits should be in monotonically increasing order (e.g. increase or stay the same from left to right)

And that's it!

In normal Haskell we'd make a list of all possibilities, then either chain a series of filter statements or use do-notation with guards to narrow it down. Luckily, folds have filters too!

First things first, since our checks have us analyzing the actual discrete digits we'll convert our Int to a String so we can talk about them as characters:

main = ([307237..769058] :: [Int])
        & toListOf (traversed . re _Show)
        & print

>>> main
["307237","307238","307239","307240","307241","307242","307243","307244","307245",
"307246", ...]

_Show is the same prism we've used for parsing in the previous examples, but re flips it in reverse and generates a Getter which calls show! This is equivalent to to show, but will get you an extra 20 optics points...

Now let's start adding filters! We'll start by checking that the digits are all ascending. I could write some convoluted fold which does this, but the quick and dirty way is simply to sort the digits lexicographically and see if the ordering changed at all:

main :: IO ()
main = ([307237..769058] :: [Int])
        & toListOf (traversed . re _Show
                    . filtered (\s -> s == sort s)
                   )
        & print

>>> main
["333333","333334","333335","333336","333337","333338",...]

filtered removes any focuses from the fold which don't match the predicate.

We can already see this filters out a ton of possibilities. Not done yet though; we need to ensure there's at least one double consecutive digit. I'll reach for my favourite hammer: lens-regex-pcre:

main :: IO ()
main = ([307237..769058] :: [Int])
        & toListOf (traversed . re _Show
                    . filtered (\s -> s == sort s)
                    . filteredBy (packed . [regex|(\d)\1+|])
                   )


>>> main 
["333333","333334","333335","333336","333337","333338",...]

Unfortunately we don't really see much difference in the first few options, but trust me, it did something. Let's see how it works:

I'm using filteredBy here instead of filtered, filteredBy is brand new in lens >= 4.18, so make sure you've got the latest version if you want to try this out. It's like filtered, but takes a Fold instead of a predicate. filteredBy will run the fold on the current element, and will filter out any focuses for which the fold yields no results.

The fold I'm passing in converts the String to a Text using packed, then runs a regex which matches any digit, then requires at least one more of that digit to be next in the string. Since regex only yields matches, if no matches are found the candidate will be filtered out.

That's all the criteria! Now we've got a list of all of them, but all we really need is the count of them, so we'll switch from toListOf to lengthOf:

main :: IO ()
main = ([307237..769058] :: [Int])
        & lengthOf ( traversed . re _Show
                   . filtered (\s -> s == sort s)
                   . filteredBy (packed . [regex|(\d)\1+|])
                   )
        & print

>>> main
889

That's the right answer, not bad!

Part 2

Part 2 only adds one more condition:

  • The number must have a group of exactly 2 consecutive numbers, e.g. 333 is no good, but 33322 is fine.

Currently we're just checking that it has at least two consecutive numbers, but we'll need to be smarter to check for groups of exactly 2. Luckily, it's not too tricky.

The regex traversal finds ALL non-overlapping matches within a given piece of text, and the + modifier is greedy, so we know that for a given string 33322 our current pattern will find the matches: ["333", "22"]. After that it's easy enough to just check that we have at least one match of length 2!

main :: IO ()
main = ([307237..769058] :: [Int])
        & lengthOf (traversed . re _Show
                   . filtered (\s -> s == sort s)
                   . filteredBy (packed . [regex|(\d)\1+|] . match . to T.length . only 2)
                   )
        & print

>>> main
589

I just get the match text, get its length, then use only 2 to filter down to only lengths of 2. filteredBy will detect whether any of the matches make it through the whole fold and kick out any numbers that don't have a group of exactly 2 consecutive numbers.

That's it for today! Hopefully tomorrow's is just as optical! 🤞

Hopefully you learned something 🤞! Did you know I'm currently writing a book? It's all about Lenses and Optics! It takes you all the way from beginner to optics-wizard and it's currently in early access! Consider supporting it, and more posts like this one by pledging on my Patreon page! It takes quite a bit of work to put these things together, if I managed to teach your something or even just entertain you for a minute or two maybe send a few bucks my way for a coffee? Cheers! �

Become a Patron!

December 04, 2019 12:00 AM

December 03, 2019

Chris Penner

Advent of Optics: Day 3

Advent of Optics: Day 3

Since I'm releasing a book on practical lenses and optics later this month I thought it would be fun to do a few of this year's Advent of Code puzzles using as many obscure optics features as possible!

To be clear, the goal is to be obscure, strange and excessive towards the goal of using as many optics as possible in a given solution, even if it's awkward, silly, or just plain overkill. These are NOT idiomatic Haskell solutions, nor are they intended to be. Maybe we'll both learn something along the way. Let's have some fun!

You can find today's puzzle here.


Today's didn't really have any phenomenal optics insights, but I did learn about some handy types and instances for handling points in space, so we'll run through it anyways and see if we can have some fun! You know the drill by now so I'll jump right in.

Sorry, this one's a bit rushed and messy, turns out writing a blog post every day is pretty time consuming.

We've got two sets of instructions, each representing paths of wires, and we need to find out where in the space they cross, then determine the distances of those points from the origin.

We'll start as always with parsing in the input! They made it a bit harder on us this time, but it's certainly nothing that lens-regex-pcre can't handle. Before we try parsing out the individual instructions we need to split our instruction sets into one for each wire! I'll just use the lines function to split the file in two:

main :: IO ()
main = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines

I'm using that handy <&> pipelining operator, which basically allows me to pass the contents of a monadic action through a bunch of operations. It just so happens that >>= has the right precedence to tack it on the end!

Now we've got a list of two Texts, with a path in each!

Keeping a list of the two elements is fine of course, but since this is a post about optics and obfuscation, we'll pack them into a tuple just for fun:

    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               >>= print

>>> main
("R999,U626,R854,D200,R696,...", "D424,L846,U429,L632,U122,...")
>>> 

This is a fun (and useless) trick! If you look closely, we're actually applying traverseOf to all of its arguments! What we're doing is applying view to each traversal (i.e. ix 0), which creates a function over our list of wire texts. traverseOf then sequences the function as the effect and returns a new function: [Text] -> (Text, Text) which is pretty cool! When we pass in the list of wires this is applied and we get the tuple we want to pass forwards. We're using view on a traversal here, but it's all good because Text is a Monoid. This of course means that if the input doesn't have at least two lines of input that we'll continue on silently without any errors... but there aren't a lot of adrenaline pumping thrills in software development so I guess I'll take them where I can get them. We'll just trust that the input is good. We could use singular or even preview to be safer if we wanted, but ain't nobody got time for that in a post about crazy hacks!

Okay! Next step is to figure out the crazy path that these wires are taking. To do that we'll need to parse the paths into some sort of pseudo-useful form. I'm going to reach for lens-regex-pcre again, at least to find each instruction. We want to run this over both sides of our tuple though, so we'll add a quick incantation for that as well

import Linear

main :: IO ()
main = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               <&> both %~
                     (   toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput)

parseInput :: (Char, String) -> (Int, V2 Int)
parseInput (d, n) = (,) (read n) $ case d of
    'U' -> V2 0 (-1)
    'D' -> V2 0 1
    'L' -> V2 (-1) 0
    'R' -> V2 1 0

>>> main
([(999,V2 1 0),(626,V2 0 (-1)),...], [(854,V2 1 0),(200,V2 0 1),...]

Okay, there's a lot happening here, first I use the simple regex \w\d+ to find each "instruction", then grab the full match as Text.

Next in line I unpack it into a String since I'll need to use Read to parse the Ints.

After that I use the _Cons prism to split the string into its first char and the rest, which happens to get us the direction and the distance to travel respectively.

Then I run parseInput which converts the String into an Int with read, and converts the cardinal direction into a vector equivalent of that direction. This is going to come in handy soon I promise. I'm using V2 from the linear package for my vectors here.

Okay, so now we've parsed a list of instructions, but we need some way to determine where the wires intersect! The simplest possible way to do that is just to enumerate every single point that each wire passes through and see which ones they have in common; simple is good enough for me!

Okay here's the clever bit, the way we've organized our directions is going to come in handy, I'm going to create n copies of each vector in our stream so we effectively have a single instruction for each movement we'll make!

(toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput . folding (uncurry replicate))

uncurry will make replicate into the function: replicate :: (Int, V2 Int) -> [V2 Int], and folding will run that function, then flatten out the list into the focus of the fold. Ultimately this gives us just a huge list of unit vectors like this:

[V2 0 1, V2 1 0, V2 (-1) 0...]

This is great, but we also need to keep track of which actual positions this will cause us to walk, we need to accumulate our position across the whole list. Let's use a scan:

import Control.Category ((>>>))

main :: IO ()
main = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               <&> both %~
                     (   toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput . folding (uncurry replicate))
                     >>> scanl1 (+)
                     >>> S.fromList
                     )
                     >>= print

-- Trying to print this Set crashed my computer, 
-- but here's what it looked like on the way down:
>>> main
(S.fromList [V2 2003 1486,V2 2003 1487,...], S.fromList [V2 1961 86,V2 (-433), 8873,...])

Normally I really don't like >>>, but it allows us to keep writing code top-to-bottom here, so I'll allow it just this once.

The scan uses the Num instance of V2 which adds the x and y components separately. This causes us to move in the right direction after every step, and keeps track of where we've been along the way! I dump the data into a set with S.fromList because next we're going to intersect!

main :: IO ()
main = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               <&> both %~
                     (   toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput . folding (uncurry replicate))
                     >>> scanl1 (+)
                     >>> S.fromList
                     )
               <&> foldl1Of each S.intersection
                     >>= print

-- This prints a significantly shorter list and doesn't crash my computer
>>> main
fromList [V2 (-2794) (-390),V2 (-2794) 42,...]

Okay we've jumped back out of our both block, now we need to intersect the sets in our tuple! A normal person would use uncurry S.intersection, but since this is an optics post we'll of course use the excessive version foldl1Of each S.intersection which folds over each set using intersection! A bonus is that this version won't need to change if we eventually switch to many wires stored in a tuple or list, it'll just workâ„¢.

Almost done! Now we need to find which intersection is closest to the origin. In our case the origin is just (0, 0), so we can get the distance by simply summing the absolute value of the aspects of the Vector (which is acting as a Point).

main :: IO ()
main = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               <&> both %~
                     (   toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput . folding (uncurry replicate))
                     >>> scanl1 (+)
                     >>> S.fromList
                     )
               <&> foldl1Of each S.intersection
               <&> minimumOf (folded . to (sum . abs))
                     >>= print

>>> main
Just 399

And that's my answer! Wonderful!

Part 2

Part 2 is a pretty reasonable twist, now we need to pick the intersection which is the fewest number of steps along the wire from the origin. We sum together the steps along each wire and optimize for the smallest total.

Almost all of our code stays the same, but a Set isn't going to cut it anymore, we need to know which step we were on when we reached each location! Maps are kinda like sets with extra info, so we'll switch to that instead. Instead of using S.fromList we'll use toMapOf! We need the index of each element in the list (which corresponds to it's distance from the origin along the wire). a simple zip [0..] would do it, but we'll use the much more obtuse version:

toMapOf (reindexed (+1) traversed . withIndex . swapped . ito id)

Fun right? traversed has a numerically increasing index by default, reindexed (+1) makes it start at 1 instead (since the first step still counts!). Make sure you don't forget this or you'll be confused for a few minutes before realizing your answer is off by 2...

toMapOf uses the index as the key, but in our case we actually need the vector as the key! Again, easiest would be to just use a proper M.fromList, but we won't give up so easily. We need to swap our index and our value within our lens path! We can pull the index down from it's hiding place into value-land using withIndex which adds the index to your value as a tuple, in our case: (Int, V2 Int), then we swap places using the swapped iso, and reflect the V2 Int into the index using ito:

ito :: (s -> (i, a)) -> IndexedGetter i s a

Now toMapOf properly builds a Map (V2 Int) Int!

Let's finish off part 2:

main2 :: IO ()
main2 = do
    TIO.readFile "./src/Y2019/day03.txt"
               <&> T.lines
               <&> traverseOf both view (ix 0, ix 1)
               <&> each %~
                     (   toListOf ([regex|\w\d+|] . match . unpacked . _Cons . to parseInput . folding (uncurry replicate))
                     >>> scanl1 (+)
                     >>> toMapOf (reindexed (+1) traversed . withIndex . swapped . ito id)
                     )
               <&> foldl1Of each (M.intersectionWith (+))
               <&> minimum
               >>= print

We use M.intersectionWith (+) now so we add the distances when we hit an intersection, so our resulting Map has the sum of the two wires' distances at each intersection.

Now we just get the minimum distance and print it! All done!

This one wasn't so "opticsy", but hopefully tomorrow's puzzle will fit a bit better! Cheers!

Hopefully you learned something 🤞! Did you know I'm currently writing a book? It's all about Lenses and Optics! It takes you all the way from beginner to optics-wizard and it's currently in early access! Consider supporting it, and more posts like this one by pledging on my Patreon page! It takes quite a bit of work to put these things together, if I managed to teach your something or even just entertain you for a minute or two maybe send a few bucks my way for a coffee? Cheers! �

Become a Patron!

December 03, 2019 12:00 AM

December 02, 2019

Monday Morning Haskell

Ownership: Managing Memory in Rust

ownership.jpg

When we first discussed Rust we mentioned how it has a different memory model than Haskell. The suggestion was that Rust allows more control over memory usage, like C++. In C++, we explicitly allocate memory on the heap with new and de-allocate it with delete. In Rust, we do allocate memory and de-allocate memory at specific points in our program. Thus it doesn't have garbage collection, as Haskell does. But it doesn't work quite the same way as C++.

In this article, we'll discuss the notion of ownership. This is the main concept governing Rust's memory model. Heap memory always has one owner, and once that owner goes out of scope, the memory gets de-allocated. We'll see how this works; if anything, it's a bit easier than C++!

For a more detailed look at getting started with Rust, take a look at our Rust video tutorial!

Scope (with Primitives)

Before we get into ownership, there are a couple ideas we want to understand. First, let's go over the idea of scope. If you code in Java, C, or C++, this should be familiar. We declare variables within a certain scope, like a for-loop or a function definition. When that block of code ends, the variable is out of scope. We can no longer access it.

int main() {
  for (int i = 0; i < 10; ++i) {
    int j = 0;

    // Do something with j...
  }

  // This doesn't work! j is out of scope!
  std::cout << j << std::endl;
}

Rust works the same way. When we declare a variable within a block, we cannot access it after the block ends. (In a language like Python, this is actually not the case!)

fn main() {

  let j: i32 = {
    let i = 14;
    i + 5
  };

  // i is out of scope. We can't use it anymore.

  println!("{}", j);
}

Another important thing to understand about primitive types is that we can copy them. Since they have a fixed size, and live on the stack, copying should be inexpensive. Consider:

fn main() {

  let mut i: i32 = 10;
  let j = i;
  i = 15;

  // Prints 15, 10
  println!("{}, {}", i, j);
}

The j variable is a full copy. Changing the value of i doesn't change the value of j. Now for the first time, let's talk about a non-primitive type, String.

The String Type

We've dealt with strings a little by using string literals. But string literals don't give us a complete string type. They have a fixed size. So even if we declare them as mutable, we can't do certain operations like append another string. This would change how much memory they use!

let mut my_string = "Hello";
my_string.append(" World!"); // << This doesn't exist for literals!

Instead, we can use the String type. This is a non-primitive object type that will allocate memory on the heap. Here's how we can use it and append to one:

let mut my_string = String::from("Hello");
my_string.push_str(" World!");

Now let's consider some of the implications of scope with object types.

Scope with Strings

At a basic level, some of the same rules apply. If we declare a string within a block, we cannot access it after that block ends.

fn main() {

  let str_length = {
    let s = String::from("Hello");
    s.len()
  }; // s goes out of scope here

  // Fails!
  println!("{}", s);
}

What's cool is that once our string does go out of scope, Rust handles cleaning up the heap memory for it! We don't need to call delete as we would in C++. We define memory cleanup for an object by declaring the drop function. We'll get into more details with this in a later article.

C++ doesn't automatically de-allocate for us! In this example, we must delete myObject at the end of the for loop block. We can't de-allocate it after, so it will leak memory!

int main() {
  for (int i = 0; i < 10; ++i) {
    // Allocate myObject
    MyType* myObject = new MyType(i);

    // Do something with myObject …

    // We MUST delete myObject here or it will leak memory!
    delete myObject; 
  }

  // Can't delete myObject here!
}

So it's neat that Rust handles deletion for us. But there are some interesting implications of this.

Copying Strings

What happens when we try to copy a string?

let len = {
  let s1 = String::from("Hello");
  let s2 = s1;
  s2.len()
};

This first version works fine. But we have to think about what will happen in this case:

let len = {
  let mut s1 = String::from("123");
  let mut s2 = s1;
  s1.push_str("456");
  s1.len() + s2.len()
};

For people coming from C++ or Java, there seem to be two possibilities. If copying into s2 is a shallow copy, we would expect the sum length to be 12. If it's a deep copy, the sum should be 9.

But this code won't compile at all in Rust! The reason is ownership.

Ownership

Deep copies are often much more expensive than the programmer intends. So a performance-oriented language like Rust avoids using deep copying by default. But let's think about what will happen if the example above is a simple shallow copy. When s1 and s2 go out of scope, Rust will call drop on both of them. And they will free the same memory! This kind of "double delete" is a big problem that can crash your program and cause security problems.

In Rust, here's what would happen with the above code. Using let s2 = s1 will do a shallow copy. So s2 will point to the same heap memory. But at the same time, it will invalidate the s1 variable. Thus when we try to push values to s1, we'll be using an invalid reference. This causes the compiler error.

At first, s1 "owns" the heap memory. So when s1 goes out of scope, it will free the memory. But declaring s2 gives over ownership of that memory to the s2 reference. So s1 is now invalid. Memory can only have one owner. This is the main idea to get familiar with.

Here's an important implication of this. In general, passing variables to a function gives up ownership. In this example, after we pass s1 over to add_to_len, we can no longer use it.

fn main() {
  let s1 = String::from("Hello");
  let length = add_to_length(s1);

  // This is invalid! s1 is now out of scope!
  println!("{}", s1);
}

// After this function, drop is called on s
// This deallocates the memory!
fn add_to_length(s: String) -> i32 {
  5 + s.len()
}

This seems like it would be problematic. Won't we want to call different functions with the same variable as an argument? We could work around this by giving back the reference through the return value. This requires the function to return a tuple.

fn main() {
  let s1 = String::from("Hello");
  let (length, s2) = add_to_length(s1);

  // Works
  println!("{}", s2);
}

fn add_to_length(s: String) -> (i32, String) {
  (5 + s.len(), s)
}

But this is cumbersome. There's a better way.

Borrowing References

Like in C++, we can pass a variable by reference. We use the ampersand operator (&) for this. It allows another function to "borrow" ownership, rather than "taking" ownership. When it's done, the original reference will still be valid. In this example, the s1 variable re-takes ownership of the memory after the function call ends.

fn main() {
  let s1 = String::from("Hello");
  let length = add_to_length(&s1);

  // Works
  println!("{}", s1);
}

fn add_to_length(s: &String) -> i32 {
  5 + s.len()
}

This works like a const reference in C++. If you want a mutable reference, you can do this as well. The original variable must be mutable, and then you specify mut in the type signature.

fn main() {
  let mut s1 = String::from("Hello");
  let length = add_to_length(&mut s1);

  // Prints "Hello World!"
  println!("{}", s1);
}

fn add_to_length(s: &mut String) -> i32 {
  s.push_str(", World!");
  5 + s.len()
}

There's one big catch though! You can only have a single mutable reference to a variable at a time! Otherwise your code won't compile! This helps prevent a large category of bugs!

As a final note, if you want to do a true deep copy of an object, you should use the clone function.

fn main() {
  let s1 = String::from("Hello");
  let s2 = s1.clone();

  // Works!
  println!("{}", s1);
  println!("{}", s2);
}

Notes On Slices

We can wrap up with a couple thoughts on slices. Slices give us an immutable, fixed-size reference to a continuous part of an array. Often, we can use the string literal type str as a slice of an object String. Slices are either primitive data, stored on the stack, or they refer to another object. This means they do not have ownership and thus do not de-allocate memory when they go out of scope.

What's Next?

Hopefully this gives you a better understanding of how memory works in Rust! Next time, we'll start digging into how we can define our own types. We'll start seeing some more ways that Rust acts like Haskell!

by James Bowen at December 02, 2019 03:30 PM

Shin-Cheng Mu

Deriving Monadic Programs

Around 2016-17, my colleagues in Academia Sinica invited me to join their project reasoning about Spark, a platform for distributive computation. The aim was to build a Haskell model of Spark and answer questions like “under what conditions is this Spark aggregation deterministic?” Being a distributive computation model, Spark is intrinsically non-deterministic. To properly model non-determinism, I thought, I had to use monads.

Monad Only. By Bradley Gordon. CC-by 2.0.

That was how I started to take an interest in reasoning and derivation of monadic programs. Several years having passed, I collaborated with many nice people, managed to get some results published, failed to publish some stuffs I personally like, and am still working on some interesting tiny problems. This post summaries what was done, and what remains to be done.

Non-determinism

Priori to that, all program reasoning I have done was restricted to pure programs. They are beautiful mathematical expressions suitable for equational reasoning, while effectful programs are the awkward squad not worthy of rigorous treatment — so I thought, and I could not have been more wrong! It turned out that there are plenty of fun reasoning one can do with monadic programs. The rule of the game is that you do not know how the monad you are working with is implemented, thus you rely only on the monad laws:

      return >>= f  =  f
      m >>= return  =  m
   (m >>= f) >>= g  =  m >>= (\x -> f x >>= g)

and the laws of the effect operators. For non-determinism monad we usually assume two operators: 0 for failure, and (|) for non-deterministic choice (usually denoted by mzero and mplus of the type class MonadPlus). It is usually assumed that (|) is associative with 0 as its identity element, and they interact with (>>=) by the following laws:

                  0 >>= f  =  0                         (left-zero)
          (m1 | m2) >>= f  =  (m1 >>= f) | (m2 >>= f)   (left-distr.)
                  m >>= 0  =  0                         (right-zero)
m >>= (\x -> f1 x | f2 x)  =  (m >>= f1) | (m >>= f2)   (right-distr.)

The four laws are respectively named left-zero, left-distributivity, right-zero, and right-distributivity, about which we will discuss more later. These laws are sufficient for proving quite a lot of interesting properties about non-deterministic monad, as well as properties of Spark programs. I find it very fascinating.

Unfortunately, it turns out that monads were too heavy a machinery for the target readers of the Spark paper. The version we eventually published in NETYS 2017 [CHLM17] consists of pure-looking functional programs that occasionally uses “non-deterministic functions” in an informal, but probably more accessible way. Ondřej Lengál should be given credit for most, if not all of the proofs. My proofs using non-deterministic monad was instead collected in a tech. report [Mu19a]. (Why a tech. report? We will come to this later.)

State and Non-determinism

Certainly, it would be more fun if, besides non-determinism, more effects are involved. I have also been asking myself: rather than proving properties of given programs, can I derive monadic programs? For example, is it possible to start from a non-deterministic specification, and derive a program solving the problem using states?

The most obvious class of problems that involve both non-determinism and state are backtracking programs. Thus I tried to tackle a problem previously dealt with by Jeremy Gibbons and Ralf Hinze [GH11], the n-Queens problem — placing n queens on a n by n chess board in such a way that no queen can attack another. The specification non-deterministically generates all chess arrangements, before filtering out safe ones. We wish to derive a backtracking program that remembers the currently occupied diagonals in a state monad.

Jeremy Gibbons suggested to generalise the problem a bit: given a problem specification in terms of a non-deterministic scanl, is it possible to transform it to a non-deterministic and stateful foldr?

Assuming all the previous laws and, in addition, laws about get and put of state monad (the same as those assumed by Gibbons and Hinze [GH11], omitted here), I managed to come up with some general theorems for such transformations.

The interaction between non-determinism and state turned out to be intricate. Recall the right-zero and right-distributivity laws:

                  m >>= 0  =  0                        (right-zero)
m >>= (\x -> f1 x | f2 x)  =  (m >>= f1) | (m >>= f2)  (right-distr.)

While they do not explicit mention state at all, with the presence of state, these two laws imply that each non-deterministic branch has its own copy of the state. In the right-zero law, if a computation fails, it just fails — all state modifications in m are forgotten. In right-distributivity, the two m on the RHS each operates on their local copy of the state, thus locally it appears that the side effects in m happen only once.

We call a non-deterministic state monad satisfying these laws a local state monad. A typical example is M a = S -> List (a, S) where S is the type of the state — modulo order and repetition in the list monad, that is. The same monad can be constructed by StateT s (ListT Identity) in the Monad Transformer Library. With effect handling [KI15], we get the desired monad if we run the handler for state before that for list.

The local state monad is the ideal combination of non-determinism and state we would like to have. It has nice properties, and is much more manageable. However, there are practical reasons where one may want a state to be shared globally. For example, when the state is a large array that is costly to copy. Typically one uses operations to explicit “roll back” the global state to its previous configuration upon the end of each non-deterministic branch.

Can we reason about programs that use a global state?

Global State

The non-determinism monad with a global state turns out to be a weird beast to tame.

While we are concerned with what laws a monad satisfy, rather than how it is implemented, we digress a little and consider how to implement a global state monad, just to see the issues involved. By intuition one might guess M a = S -> (List a, S), but that is not even a monad — the direct but naive implementation of its (>>=) does not meet the monad laws! The type ListT (State s) generated using the Monad Transformer Library expands to essentially the same implementation, and is flawed in the same way (but the authors of MTL do not seem to bother fixing it). For correct implementations, see discussions on the Haskell wiki. With effect handling [KI15], we do get a monad by running the handler for list before that for state.

Assuming that we do have a correct implementation of a global state monad. What can we say about the it? We do not have right-zero and right-distributivity laws anymore, but left-zero and left-distributivity still hold. For now we assume an informal, intuitive understanding of the semantics: a global state is shared among non-deterministic branches, which are executed left-to-right. We will need more laws to, for example, formally specify what we mean by “the state is shared”. This will turn out to be tricky, so we postpone that for illustrative purpose.

In backtracking algorithms that keep a global state, it is a common pattern to

  1. update the current state to its next step,
  2. recursively search for solutions, and
  3. roll back the state to the previous step.

To implement such pattern as a monadic program, one might come up with something like the code below:

  modify next >> search >>= modReturn prev

where next advances the state, prev undoes the modification of next, and modify and modReturn are defined by:

modify f       = get >>= (put . f)
modReturn f v  = modify f >> return v

Let the initial state be st and assume that search found three choices m1 | m2 | m3. The intention is that m1, m2, and m3 all start running with state next st, and the state is restored to prev (next st) = st afterwards. By left-distributivity, however,

 modify next >> (m1 | m2 | m3) >>= modReturn prev =
   modify next >> (  (m1 >>= modReturn prev) |
                     (m2 >>= modReturn prev) |
                     (m3 >>= modReturn prev))

which, with a global state, means that m2 starts with state st, after which the state is rolled back too early to prev st. The computation m3 starts with prev st, after which the state is rolled too far to prev (prev st).

Nondeterministic Choice as Sequencing

We need a way to say that “modify next and modReturn prev are run exactly once, respectively before and after all non-deterministic branches in solve.” Fortunately, we have discovered a curious technique. Since non-deterministic branches are executed sequentially, the program

 (modify next >> 0) | m1 | m2 | m3 | (modify prev >> 0)

executes modify next and modify prev once, respectively before and after all the non-deterministic branches, even if they fail. Note that modify next >> 0 does not generate a result. Its presence is merely for the side-effect of modify next.

The reader might wonder: now that we are using (|) as a sequencing operator, does it simply coincide with (>>)? Recall that we still have left-distributivity and, therefore, (m1 | m2) >> n equals (m1 >> n) | (m2 >> n). That is, (|) acts as “insertion points”, where future code followed by (>>) can be inserted into! This is certainly a dangerous feature, whose undisciplined use can lead to chaos.

To be slightly disciplined, we can go a bit further by defining the following variations of put, which restores the original state when it is backtracked over:

putR s = get >>= (\s0 -> put s | (put s0 >> 0))

To see how it works, assuming that some computation comp follows putR s. By left-distributivity we get:

   putR s >> comp
=  (get >>= (\s0 -> put s | (put s0 >> 0))) >> comp
=    { monad laws, left dist., left zero }
   get >>= (\s0 -> put s >> comp |
                   (put s0 >> 0))

Therefore, comp runs with new state s. After it finishes, the current state s0 is restored.

The hope is that, by replacing all put with putR, we can program as if we are working with local states, while there is actually a shared global state.

(I later learned that Tom Schrijvers had developed similar and more complete techniques, in the context of simulating Prolog boxes in Haskell.)

Handling Local State with Global State

So was the idea. I had to find out what laws are sufficient to formally specify the behaviour of a global state monad (note that the discussion above has been informal), and make sure that there exists a model/implementation satisfying these laws.

I prepared a draft paper containing proofs about Spark functions using non-determinism monad, a derivation of backtracking algorithms solving problems including n-Queens using a local state monad and, after proposing laws a global state monad should satisfy, derived another backtracking algorithm using a shared global state. I submitted the draft and also sent the draft to some friends for comments. Very soon, Tom Schrijvers wrote back and warned me: the laws I proposed for the global state monad could not be true!

I quickly withdrew the draft, and invited Tom Schrijvers to collaborate and fix the issues. Together with Koen Pauwels, they carefully figured out what the laws should be, showed that the laws are sufficient to guarantee that one can simulate local states using a global state (in the context of effect handling), that there exists a model/implementation of the monad, and verified key theorems in Coq. That resulted in a paper Handling local state with global state, which we published in MPC 2019.

The paper is about semantical concerns of the local/global state interaction. I am grateful to Koen and Tom, who deserve credits for most of the hard work — without their help the paper could not have been done. The backtracking algorithm, meanwhile, became a motivating example that was briefly mentioned.

Tech. Reports

I was still holding out hope that my derivations could be published in a conference or journal, until I noticed, by chance, a submission to MPC 2019 by Affeldt et al [ANS19]. They formalised a hierarchy of monadic effects in Coq and, for demonstration, needed examples of equational reasoning about monadic programs. They somehow found the draft that was previously withdrawn, and corrected some of its errors. I am still not sure how that happened — I might have put the draft on my web server to communicate with my students, and somehow it showed up on the search engine. The file name was test.pdf. And that was how the draft was cited!

“Oh my god,” I thought in horror, “please do not cite an unfinished work of mine, especially when it is called test.pdf!”

I quickly wrote to the authors, thanked them for noticing the draft and finding errors in it, and said that I will turn them to tech. reports, which they can cite more properly. That resulted in two tech. reports: Equational reasoning for non-determinism monad: the case of Spark aggregation [Mu19a] contains my proofs of Spark programs, and Calculating a backtracking algorithm: an exercise in monadic program derivation [Mu19b] the derivation of backtracking algorithms.

Pointwise Relational Program Calculation

There are plenty of potentially interesting topics one can do with monadic program derivation. For one, people have been suggesting pointwise notations for relational program calculation (e.g. de Moor and Gibbons [dMG00], Bird and Rabe [RB19]). I believe that monads offer a good alternative. Plenty of relational program calculation can be carried out in terms of non-determinism monad. Program refinement can be defined by

m1 ⊆ m2  ≡  m1 | m2 = m2

This definition applies to monads having other effects too. I have a draft demonstrating the idea with quicksort. Sorting is specified by a non-determinism monad returning a permutation of the input that is sorted — when the ordering is not anti-symmetric, there can be more than one ways to sort a list, therefore the specification is non-deterministic. From the specification, one can derive pure quicksort on lists, as well as quicksort that mutates an array. Let us hope I have better luck publishing it this time.

With Kleisli composition, there is even a natural definition of factors. Lifting (⊆) to functions (that is f ⊆ g ≡ (∀ x : f x ⊆ g x)), and recall that (f >=> g) x = f x >>= g, the left factor (\) can be specified by the Galois connection:

(f >=> g) ⊆ h  ≡  g ⊆ (f \ h)

That is, f \ h is the most non-deterministic (least constrained) monadic program that, when ran after the postcondition set up by f, still meets the result specified by h.

If, in addition, we have a proper notion of converses, I believe that plenty of optimisation problems can be specified and solved using calculation rules of factors and converses. I believe these are worth exploring.

References

[ANS19] Reynald Affeldt, David Nowak and Takafumi Saikawa. A hierarchy of monadic effects for program verification using equational reasoning. In Mathematics of Program Construction (MPC), Graham Hutton, editor, pp. 226-254. Springer, 2019.

[BR19] Richard Bird, Florian Rabe. How to calculate with nondeterministic functions. In Mathematics of Program Construction (MPC), Graham Hutton, editor, pp. 138-154. Springer, 2019.

[CHLM17] Yu-Fang Chen, Chih-Duo Hong, Ondřej Lengál, Shin-Cheng Mu, Nishant Sinha, and Bow-Yaw Wang. An executable sequential specification for Spark aggregation. In Networked Systems (NETYS), pp. 421-438. 2017.

[GH11] Jeremy Gibbons, Ralf Hinze. Just do it: simple monadic equational reasoning. In International Conference on Functional Programming (ICFP), pp 2-14, 2011.

[KI15] Oleg Kiselyov, Hiromi Ishii. Freer monads, more extensible effects. In Symposium on Haskell, pp 94-105, 2015.

[dMG00] Oege de Moor, Jeremy Gibbons. Pointwise relational programming. In Rus, T. (ed.) Algebraic Methodology and Software Technology. pp. 371–390, Springer, 2000.

[Mu19a] Shin-Cheng Mu. Equational reasoning for non-determinism monad: the case of Spark aggregation. Tech. Report TR-IIS-19-002, Institute of Information Science, Academia Sinica, June 2019.

[Mu19b] Shin-Cheng Mu. Calculating a backtracking algorithm: an exercise in monadic program derivation. Tech. Report TR-IIS-19-003, Institute of Information Science, Academia Sinica, June 2019.

[PSM19] Koen Pauwels, Tom Schrijvers and Shin-Cheng Mu. Handling local state with global state. In Mathematics of Program Construction (MPC), Graham Hutton, editor, pp. 18-44. Springer, 2019.

The post Deriving Monadic Programs appeared first on niche computing science.

by Shin at December 02, 2019 01:53 PM

FP Complete

Haskell Support in Mainstream IDEs

Haskell Support in Mainstream IDEs

I've tested out the Haskell support of the top mainstream IDEs. Here's a rundown of the current state of things.

As a dyed-in-the-wool Emacs hacker I've never used any of the more recent mainstream IDEs, so I can probably offer an unbiased review of the support provided by each.

Note: I tried approaching it as a client would, or prospective Haskell user, so for any manual intervention I had to do, I've used a tone that indicates I'm not happy about having to do it, and anything that doesn't just work I just discard with little patience, as a real person would and do today. Even if I know there are probably extra manual investigations that I could do knowing what I do about Haskell, a normal user wouldn't have that advantage.

IntelliJ IDEA

I installed it according to the instructions on the IntelliJ IDEA web site. I downloaded it to my Ubuntu laptop and installed it under /opt/intellij.

After installing IntelliJ, running it opens up a splash screen. Rather than starting a project, I went straight to the Configure->Plugins button. In the plugins list, I chose IntelliJ-Haskell. After that, it was suggested that I restart, so I hit Restart IDE.

After restarting, on the splash screen I hit Create New Project and chose "Haskell module". At this point, it asked me to "Select the stack binary". I picked the one at /home/chris/.local/bin/stack, but someone else might find it under /usr/local/bin/stack. I hit Next.

Warning: there was a long wait after this step. I entered my project name and proceeded. Opening the project workspace, it now claims "busy installing hlint", which is a Haskell linting tool. It does this for various tools; hlint, hindent, stylish-haskell, hoogle. This took easily 15 minutes on my machine. Go make a cup of tea.

Finally, after finishing this process, it's ready to go. Here are some things that I observed work correctly:

  1. Compile errors when changing code on the fly. Slow, but works. You can hit the "Haskell Problems" tab to see the actual compiler messages.
  2. Hitting Ctrl and mousing over something, which is how you get metadata in IDEA.
    1. Go to definition of library code.
    2. Go to definition of local code.
    3. Type info at point.
    4. Go to definition of local bindings.

I tested this out by opening the Stack codebase itself. Took about 10 seconds on "Indexing..." and then was ready.

There's a very picky set of steps to opening an existing project properly:

  1. You have to go "Create project from existing source"
  2. Choose "Create from external model"
  3. Choose the "Haskell" SDK.

Then it should be good to go. Other ways didn't work for me and I got stuck.

I've also seen that it's possible to define test and executable targets quite reasonably.

IntelliJ has support to "optimize imports" which will remove unneeded ones, which is very common when refactoring. I'd call that feature a must-have.

Overall, this IDE experience is not bad. As a Haskeller, I could get by if I had to use this.

Visual Studio Code

I followed along with the install instructions for Linux. I downloaded the .deb and ran sudo apt install ./<file>.deb.

I launched Visual Studio Code from the Ubuntu Activities menu. It displays its full UI immediately, which was quite a lot faster than IntelliJ, which takes about 5 seconds before displaying a UI window. Not that I care about start-up times: I use Emacs.

Visual Studio Code: Haskero

I went to the Customize section and then "Tools and languages". Up pops a menu for language choices (also quite quickly). I tried installing the Haskero plugin, which, as I understand, is in spirit the same backend and functionality of IntelliJ-Haskell. It said "This extension is enabled globally".

Assuming that it was ready to use, I looked for a way to create a project. I didn't find one, so I opted to try opening an existing Haskell project: stack. I used File -> Open Workspace and chose the repository root directory.

VSC reports "Unable to watch for file changes in this large workspace." I followed the link which had a hint to increase the limit. I edited my sysctl.conf file as instructed to allow VSC to watch all the files in my project.

Opening, for example, src/main/Main.hs, it opens quickly, but doesn't appear to be doing any work like IntelliJ was. So I create some obvious errors in the file to see whether anything works.

After waiting a while, it seems that I have to save the file to see any kind of reaction from VSC. So I save the file and wait. I timed it:

$ date
Wed 13 Nov 10:09:38 CET 2019
$ date
Wed 13 Nov 10:10:40 CET 2019

After a full minute, I got in the Problems tab the problem.

It seems to be recompiling the whole project on every change. This pretty much makes this plugin unusable. I don't think the author has tested this on a large project.

In its current state, I would not recommend Haskero. I uninstalled it and decided to look at others.

Visual Studio Code: Haskelly

I decided to try the other similar offering called Haskelly. After a reload and re-opening Stack, I made an intentional error in src/main/Main.hs again and found that nothing happened. No CPU usage by any process.

There weren't any indicators on the screen of anything failing to work. However, I had an intentional type error in my file that was not flagged up anywhere.

Another plugin that I would rate as not usable. I uninstalled it.

Visual Studio Code: Haskell Language Server

I installed the "Haskell Language Server", which is supposed to be the latest state of the art in language backends for Haskell.

Enabling it, I see the message:

hie executable missing, please make sure it is installed, see github.com/haskell/haskell-ide-engine.

Apparently I have to manually install something. Okay, sure, why not?

There's a variety of installation methods. I'm not sure which one will work. But I already have stack installed, so I try the install from source option:

$ git clone https://github.com/haskell/haskell-ide-engine --recurse-submodules --depth 1

This seems to clone the whole world and takes a while. Definitely a get a cup of tea moment. After that was done, I went to the directory and ran this as per the instructions:

$ stack ./install.hs help

I am presented with a myriad of options:

Targets:
   [snip]
    stack-build             Builds hie with all installed GHCs; with stack
    stack-build-all         Builds hie for all installed GHC versions and the data files; with stack
    stack-build-data        Get the required data-files for `hie` (Hoogle DB); with stack
    stack-install-cabal     Install the cabal executable. It will install the required minimum version for hie (currently 2.4.1.0) if it isn't already present in $PATH; with stack
    stack-hie-8.4.2         Builds hie for GHC version 8.4.2; with stack
    stack-hie-8.4.3         Builds hie for GHC version 8.4.3; with stack
    stack-hie-8.4.4         Builds hie for GHC version 8.4.4; with stack
    stack-hie-8.6.1         Builds hie for GHC version 8.6.1; with stack
    stack-hie-8.6.2         Builds hie for GHC version 8.6.2; with stack
    stack-hie-8.6.3         Builds hie for GHC version 8.6.3; with stack
    stack-hie-8.6.4         Builds hie for GHC version 8.6.4; with stack
    stack-hie-8.6.5         Builds hie for GHC version 8.6.5; with stack
   [snip]

I lookup the GHC version that's being used by the stack source code:

~/Work/fpco/stack$ stack ghc -- --version
The Glorious Glasgow Haskell Compilation System, version 8.2.2

Apparently the GHC version in use by stack is too old. At this point I stop and uninstall the plugin.

Visual Studio Code: ghcid

As a last resort, I tried one more plugin. But nothing seemed to happen with this one either. So I uninstalled it.

SublimeText

Another popular editor is SublimeText. I installed it via the apt repository documented here. I decided to try the SublimeHaskell plugin which seems popular.

Installing things in SublimeHaskell is a little arcane: you first have to install "Package Control". I don't remember which menu item this was from. However, SublimeText installs this for you. Once that's done, you have to use Tools->Command Pallete, which is a kind of quick-access tool that's apparently common in SublimeText. In there you have to literally type "package control" and then go to "Package Control: Install Package" and hit RET. Then you can type SublimeHaskell and hit RET. As an Emacs user, I'm not afraid of arcane UIs.

After installing, it pops up a dialog with:

No usable backends (hsdev, ghc-mod) found in PATH. [..] Please check or update your SublimeHaskell user settings or install hsdev or ghc-mod.

It displays a tab with the README from SublimeHaskell and I assume this is where SublimeText is done helping me.

Okay, let's install hsdev!

I had to create a file hsdev.yaml:

packages: []
resolver: lts-13.29
extra-deps:
- hsdev-0.3.3.1
- haddock-api-2.21.0
- hdocs-0.5.3.1
- network-3.0.1.1

And then run

$ stack install hsdev --stack-yaml hsdev.yaml

That took 5 minutes but succeeded. There isn't a "next button" on SublimeText, so I just restarted it. I did File->Open Folder and opened the stack directory and the Main.hs file.

I see "Inspecting stack" which indicates that it's actually doing something. However, after that finishes, I still don't see any error messages for my type error. Finally, I make a new change and save the file, and a little messages area pops up below.

Could not find module ‘Data.Aeson’

And so one for pretty much every library module in the project.

At this point I can't find a menu or anything else to help me configure packages or anything related.

At this point it seems like SublimeText is almost workable. The cons appear to be the manual install process, and the complete lack of guidance in the user experience. I'm afraid I can't recommend this to clients either at the moment.

Summary

The story for Visual Studio Code is pretty dire. I did not find a straight-forward install or reliably working IDE for Haskell in Visual Studio Code, and therefore, at the moment, cannot recommend it to our clients. Perhaps a little work done on Haskero could bring it up to par.

SublimeText falls over at the finish line. It seems like with a little work on the user experience could bring this up to par.

IntelliJ IDEA however worked quite well with little to no intervention required. So I would indeed recommend it to clients.

Read more about Haskell development, tooling and business on our blog. Email us to setup a free consultation with our engineering team to discuss editor options.

December 02, 2019 05:30 AM

Michael Snoyman

Down and dirty with Future - Rust Crash Course lesson 8

It’s about a year since I wrote the last installment in the Rust Crash Course series. That last post was a doozy, diving into async, futures, and tokio. All in one post. That was a bit sadistic, and I’m a bit proud of myself on that front.

Much has happened since then, however. Importantly: the Future trait has moved into the standard library itself and absorbed a few modifications. And then to tie that up in a nicer bow, there’s a new async/.await syntax. It’s hard for me to overstate just how big a quality of life difference this is when writing asynchronous code in Rust.

I recently wrote an article on the FP Complete tech site that demonstrates the Future and async/.await stuff in practice. But here, I want to give a more thorough analysis of what’s going on under the surface. Unlike lesson 7, I’m going to skip the motivation for why we want to write asynchronous code, and break this up into more digestible chunks. Like lesson 7, I’m going to include the exercise solutions inline, instead of a separate post.

NOTE I’m going to use the async-std library in this example instead of tokio. My only real reason for this is that I started using async-std before tokio released support for the new async/.await syntax. I’m not ready to weigh in on, in general, which of the libraries I prefer.

You should start a Cargo project to play along. Try cargo new --bin sleepus-interruptus. If you want to ensure you’re on the same compiler version, add a rust-toolchain file with the string 1.39.0 in it. Run cargo run to make sure you’re all good to go.

This post is part of a series based on teaching Rust at FP Complete. If you’re reading this post outside of the blog, you can find links to all posts in the series at the top of the introduction post. You can also subscribe to the RSS feed.

Sleepus Interruptus

I want to write a program which will print the message Sleepus 10 times, with a delay of 0.5 seconds. And it should print the message Interruptus 5 times, with a delay of 1 second. This is some fairly easy Rust code:

use std::thread::{sleep};
use std::time::Duration;

fn sleepus() {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500));
    }
}

fn interruptus() {
    for i in 1..=5 {
        println!("Interruptus {}", i);
        sleep(Duration::from_millis(1000));
    }
}

fn main() {
    sleepus();
    interruptus();
}

However, as my clever naming implies, this isn’t my real goal. This program runs the two operations synchronously, first printing Sleepus, then Interruptus. Instead, we would want to have these two sets of statements printed in an interleaved way. That way, the interruptus actually does some interrupting.

EXERCISE Use the std::thread::spawn function to spawn an operating system thread to make these printed statements interleave.

There are two basic approaches to this. One—maybe the more obvious—is to spawn a separate thread for each function, and then wait for each of them to complete:

use std::thread::{sleep, spawn};

fn main() {
    let sleepus = spawn(sleepus);
    let interruptus = spawn(interruptus);

    sleepus.join().unwrap();
    interruptus.join().unwrap();
}

Two things to notice:

  • We call spawn with spawn(sleepus), not spawn(sleepus()). The former passes in the function sleepus to spawn to be run. The latter would immediately run sleepus() and pass its result to spawn, which is not what we want.
  • I use join() in the main function/thread to wait for the child thread to end. And I use unwrap to deal with any errors that may occur, because I’m being lazy.

Another approach would be to spawn one helper thread instead, and call one of the functions in the main thread:

fn main() {
    let sleepus = spawn(sleepus);
    interruptus();

    sleepus.join().unwrap();
}

This is more efficient (less time spawning threads and less memory used for holding them), and doesn’t really have a downside. I’d recommend going this way.

QUESTION What would be the behavior of this program if we didn’t call join in the two-spawn version? What if we didn’t call join in the one-spawn version?

But this isn’t an asynchronous approach to the problem at all! We have two threads being handled by the operating system which are both acting synchronously and making blocking calls to sleep. Let’s build up a bit of intuition towards how we could have our two tasks (printing Sleepus and printing Interruptus) behave more cooperatively in a single thread.

Introducing async

We’re going to start at the highest level of abstraction, and work our way down to understand the details. Let’s rewrite our application in an async style. Add the following to your Cargo.toml:

async-std = { version = "1.2.0", features = ["attributes"] }

And now we can rewrite our application as:

use async_std::task::{sleep, spawn};
use std::time::Duration;

async fn sleepus() {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500)).await;
    }
}

async fn interruptus() {
    for i in 1..=5 {
        println!("Interruptus {}", i);
        sleep(Duration::from_millis(1000)).await;
    }
}

#[async_std::main]
async fn main() {
    let sleepus = spawn(sleepus());
    interruptus().await;

    sleepus.await;
}

Let’s hit the changes from top to bottom:

  • Instead of getting sleep and spawn from std::thread, we’re getting them from async_std::task. That probably makes sense.
  • Both sleepup and interruptus now say async in front of fn.
  • After the calls to sleep, we have a .await. Note that this is not a .await() method call, but instead a new syntax.
  • We have a new attribute #[async_std::main] on the main function.
  • The main function also has async before fn.
  • Instead of spawn(sleepus), passing in the function itself, we’re now calling spawn(sleepus()), immediately running the function and passing its result to spawn.
  • The call to interruptus() is now followed by .await.
  • Instead of join()ing on the sleepus JoinHandle, we use the .await syntax.

EXERCISE Run this code on your own machine and make sure everything compiles and runs as expected. Then try undoing some of the changes listed above and see what generates a compiler error, and what generates incorrect runtime behavior.

That may look like a large list of changes. But in reality, our code is almost identical structural to the previous version, which is a real testament to the async/.await syntax. And now everything works under the surface the way we want: a single operating system thread making non-blocking calls.

Let’s analyze what each of these changes actually means.

async functions

Adding async to the beginning of a function definition does three things:

  1. It allows you to use .await syntax inside. We’ll get to the meaning of that in a bit.
  2. It modified the return type of the function. async fn foo() -> Bar actually returns impl std::future::Future<Output=Bar>.
  3. Automatically wraps up the result value in a new Future. We’ll demonstrate that better later.

Let’s unpack that second point a bit. There’s a trait called Future defined in the standard library. It has an associated type Output. What this trait means is: I promise that, when I complete, I will give you a value of type Output. You could imagine, for instance, an asynchronous HTTP client that looks something like:

impl HttpRequest {
    fn perform(self) -> impl Future<Output=HttpResponse> { ... }
}

There will be some non-blocking I/O that needs to occur to make that request. We don’t want to block the calling thread while those things happen. But we do want to somehow eventually get the resulting response.

We’ll play around with Future values more directly later. For now, we’ll continue sticking with the high-level async/.await syntax.

EXERCISE Rewrite the signature of sleepus to not use the async keyword by modifying its result type. Note that the code will not compile when you get the type right. Pay attention to the error message you get.

The result type of async fn sleepus() is the implied unit value (). Therefore, the Output of our Future should be unit. This means we need to write our signature as:

fn sleepus() -> impl std::future::Future<Output=()>

However, with only that change in place, we get the following error messages:

error[E0728]: `await` is only allowed inside `async` functions and blocks
 --> src/main.rs:7:9
  |
4 | fn sleepus() -> impl std::future::Future<Output=()> {
  |    ------- this is not `async`
...
7 |         sleep(Duration::from_millis(500)).await;
  |         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ only allowed inside `async` functions and blocks

error[E0277]: the trait bound `(): std::future::Future` is not satisfied
 --> src/main.rs:4:17
  |
4 | fn sleepus() -> impl std::future::Future<Output=()> {
  |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ the trait `std::future::Future` is not implemented for `()`
  |
  = note: the return type of a function must have a statically known size

The first message is pretty direct: you can only use the .await syntax inside an async function or block. We haven’t seen an async block yet, but it’s exactly what it sounds like:

async {
    // async noises intensify
}

The second error message is a result of the first: the async keyword causes the return type to be an impl Future. Without that keyword, our for loop evaluates to (), which isn’t an impl Future.

EXERCISE Fix the compiler errors by introducing an await block inside the sleepus function. Do not add async to the function signature, keep using impl Future.

Wrapping the entire function body with an async block solves the problem:

fn sleepus() -> impl std::future::Future<Output=()> {
    async {
        for i in 1..=10 {
            println!("Sleepus {}", i);
            sleep(Duration::from_millis(500)).await;
        }
    }
}

.await a minute

Maybe we don’t need all this async/.await garbage though. What if we remove the calls to .await usage in sleepus? Perhaps surprisingly, it compiles, though it does give us an ominous warning:

warning: unused implementer of `std::future::Future` that must be used
 --> src/main.rs:8:13
  |
8 |             sleep(Duration::from_millis(500));
  |             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  |
  = note: `#[warn(unused_must_use)]` on by default
  = note: futures do nothing unless you `.await` or poll them

We’re generating a Future value but not using it. And sure enough, if you look at the output of our program, you can see what the compiler means:

Interruptus 1
Sleepus 1
Sleepus 2
Sleepus 3
Sleepus 4
Sleepus 5
Sleepus 6
Sleepus 7
Sleepus 8
Sleepus 9
Sleepus 10
Interruptus 2
Interruptus 3
Interruptus 4
Interruptus 5

All of our Sleepus messages print without delay. Intriguing! The issue is that the call to sleep no longer actually puts our current thread to sleep. Instead, it generates a value which implements Future. And when that promise is eventually fulfilled, we know that the delay has occurred. But in our case, we’re simply ignoring the Future, and therefore never actually delaying.

To understand what the .await syntax is doing, we’re going to implement our function with much more direct usage of the Future values. Let’s start by getting rid of the async block.

Dropping async block

If we drop the async block, we end up with this code:

fn sleepus() -> impl std::future::Future<Output=()> {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500));
    }
}

This gives us an error message we saw before:

error[E0277]: the trait bound `(): std::future::Future` is not satisfied
 --> src/main.rs:4:17
  |
4 | fn sleepus() -> impl std::future::Future<Output=()> {
  |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ the trait `std::future::Future` is not implemented for `()`
  |

This makes sense: the for loop evaluates to (), and unit does not implement Future. One way to fix this is to add an expression after the for loop that evaluates to something that implements Future. And we already know one such thing: sleep.

EXERCISE Tweak the sleepus function so that it compiles.

One implementation is:

fn sleepus() -> impl std::future::Future<Output=()> {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500));
    }
    sleep(Duration::from_millis(0))
}

We still get a warning about the unused Future value inside the for loop, but not the one afterwards: that one is getting returned from the function. But of course, sleeping for 0 milliseconds is just a wordy way to do nothing. It would be nice if there was a “dummy” Future that more explicitly did nothing. And fortunately, there is.

EXERCISE Replace the sleep call after the for loop with a call to ready.

fn sleepus() -> impl std::future::Future<Output=()> {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500));
    }
    async_std::future::ready(())
}

Implement our own Future

To unpeel this onion a bit more, let’s make our life harder, and not use the ready function. Instead, we’re going to define our own struct which implements Future. I’m going to call it DoNothing.

use std::future::Future;

struct DoNothing;

fn sleepus() -> impl Future<Output=()> {
    for i in 1..=10 {
        println!("Sleepus {}", i);
        sleep(Duration::from_millis(500));
    }
    DoNothing
}

EXERCISE This code won’t compile. Without looking below or asking the compiler, what do you think it’s going to complain about?

The problem here is that DoNothing does not provide a Future implementation. We’re going to do some Compiler Driven Development and let rustc tell us how to fix our program. Our first error message is:

the trait bound `DoNothing: std::future::Future` is not satisfied

So let’s add in a trait implementation:

impl Future for DoNothing {
}

Which fails with:

error[E0046]: not all trait items implemented, missing: `Output`, `poll`
 --> src/main.rs:7:1
  |
7 | impl Future for DoNothing {
  | ^^^^^^^^^^^^^^^^^^^^^^^^^ missing `Output`, `poll` in implementation
  |
  = note: `Output` from trait: `type Output;`
  = note: `poll` from trait: `fn(std::pin::Pin<&mut Self>, &mut std::task::Context<'_>) -> std::task::Poll<<Self as std::future::Future>::Output>`

We don’t really know about the Pin<&mut Self> or Context thing yet, but we do know about Output. And since we were previously returning a () from our ready call, let’s do the same thing here.

use std::pin::Pin;
use std::task::{Context, Poll};

impl Future for DoNothing {
    type Output = ();

    fn poll(self: Pin<&mut Self>, ctx: &mut Context) -> Poll<Self::Output> {
        unimplemented!()
    }
}

Woohoo, that compiles! Of course, it fails at runtime due to the unimplemented!() call:

thread 'async-std/executor' panicked at 'not yet implemented', src/main.rs:13:9

Now let’s try to implement poll. We need to return a value of type Poll<Self::Output>, or Poll<()>. Let’s look at the definition of Poll:

pub enum Poll<T> {
    Ready(T),
    Pending,
}

Using some basic deduction, we can see that Ready means “our Future is complete, and here’s the output” while Pending means “it’s not done yet.” Given that our DoNothing wants to return the output of () immediately, we can just use the Ready variant here.

EXERCISE Implement a working version of poll.

fn poll(self: Pin<&mut Self>, _ctx: &mut Context) -> Poll<Self::Output> {
    Poll::Ready(())
}

Congratulations, you’ve just implemented your first Future struct!

The third async difference

Remember above we said that making a function async does a third thing:

Automatically wraps up the result value in a new Future. We’ll demonstrate that better later.

Now is later. Let’s demonstrate that better.

Let’s simplify the definition of sleepus to:

fn sleepus() -> impl Future<Output=()> {
    DoNothing
}

The compiles and runs just fine. Let’s try switching back to the async way of writing the signature:

async fn sleepus() {
    DoNothing
}

This now gives us an error:

error[E0271]: type mismatch resolving `<impl std::future::Future as std::future::Future>::Output == ()`
  --> src/main.rs:17:20
   |
17 | async fn sleepus() {
   |                    ^ expected struct `DoNothing`, found ()
   |
   = note: expected type `DoNothing`
              found type `()`

You see, when you have an async function or block, the result is automatically wrapped up in a Future. So instead of returning a DoNothing, we’re returning a impl Future<Output=DoNothing>. And our type wants Output=().

EXERCISE Try to guess what you need to add to this function to make it compile.

Working around this is pretty easy: you simply append .await to DoNothing:

async fn sleepus() {
    DoNothing.await
}

This gives us a little more intuition for what .await is doing: it’s extracting the () Output from the DoNothing Future… somehow. However, we still don’t really know how it’s achieving that. Let’s build up a more complicated Future to get closer.

SleepPrint

We’re going to build a new Future implementation which:

  • Sleeps for a certain amount of time
  • Then prints a message

This is going to involve using pinned pointers. I’m not going to describe those here. The specifics of what’s happening with the pinning isn’t terribly enlightening to the topic of Futures. If you want to let your eyes glaze over at that part of the code, you won’t be missing much.

Our implementation strategy for SleepPrint will be to wrap an existing sleep Future with our own implementation of Future. Since we don’t know the exact type of the result of a sleep call (it’s just an impl Future), we’ll use a parameter:

struct SleepPrint<Fut> {
    sleep: Fut,
}

And we can call this in our sleepus function with:

fn sleepus() -> impl Future<Output=()> {
    SleepPrint {
        sleep: sleep(Duration::from_millis(3000)),
    }
}

Of course, we now get a compiler error about a missing Future implementation. So let’s work on that. Our impl starts with:

impl<Fut: Future<Output=()>> Future for SleepPrint<Fut> {
    ...
}

This says that SleepPrint is a Future if the sleep value it contains is a Future with an Output of type (). Which, of course, is true in the case of the sleep function, so we’re good. We need to define Output:

type Output = ();

And then we need a poll function:

fn poll(self: Pin<&mut Self>, ctx: &mut Context) -> Poll<Self::Output> {
    ...
}

The next bit is the eyes-glazing part around pinned pointers. We need to project the Pin<&mut Self> into a Pin<&mut Fut> so that we can work on the underlying sleep Future. We could use a helper crate to make this a bit prettier, but we’ll just do some unsafe mapping:

let sleep: Pin<&mut Fut> = unsafe { self.map_unchecked_mut(|s| &mut s.sleep) };

Alright, now the important bit. We’ve got our underlying Future, and we need to do something with it. The only thing we can do with it is call poll. poll requires a &mut Context, which fortunately we’ve been provided. That Context contains information about the currently running task, so it can be woken up (via a Waker) when the task is ready.

NOTE We’re not going to get deeper into how Waker works in this post. If you want a real life example of how to call Waker yourself, I recommend reading my pid1 in Rust post.

For now, let’s do the only thing we can reasonably do:

match sleep.poll(ctx) {
    ...
}

We’ve got two possibilities. If poll returns a Pending, it means that the sleep hasn’t completed yet. In that case, we want our Future to also indicate that it’s not done. To make that work, we just propagate the Pending value:

Poll::Pending => Poll::Pending,

However, if the sleep is already complete, we’ll receive a Ready(()) variant. In that case, it’s finally time to print our message and then propagate the Ready:

Poll::Ready(()) => {
    println!("Inside SleepPrint");
    Poll::Ready(())
},

And just like that, we’ve built a more complex Future from a simpler one. But that was pretty ad-hoc.

TwoFutures

SleepPrint is pretty ad-hoc: it hard codes a specific action to run after the sleep Future completes. Let’s up our game, and sequence the actions of two different Futures. We’re going to define a new struct that has three fields:

  • The first Future to run
  • The second Future to run
  • A bool to tell us if we’ve finished running the first Future

Since the Pin stuff is going to get a bit more complicated, it’s time to reach for that helper crate to ease our implementation and avoid unsafe blocks ourself. So add the following to your Cargo.toml:

pin-project-lite = "0.1.1"

And now we can define a TwoFutures struct that allows us to project the first and second Futures into pinned pointers:

use pin_project_lite::pin_project;

pin_project! {
    struct TwoFutures<Fut1, Fut2> {
        first_done: bool,
        #[pin]
        first: Fut1,
        #[pin]
        second: Fut2,
    }
}

Using this in sleepus is easy enough:

fn sleepus() -> impl Future<Output=()> {
    TwoFutures {
        first_done: false,
        first: sleep(Duration::from_millis(3000)),
        second: async { println!("Hello TwoFutures"); },
    }
}

Now we just need to define our Future implementation. Easy, right? We want to make sure both Fut1 and Fut2 are Futures. And our Output will be the output from the Fut2. (You could also return both the first and second output if you wanted.) To make all that work:

impl<Fut1: Future, Fut2: Future> Future for TwoFutures<Fut1, Fut2> {
    type Output = Fut2::Output;

    fn poll(self: Pin<&mut Self>, ctx: &mut Context) -> Poll<Self::Output> {
        ...
    }
}

In order to work with the pinned pointer, we’re going to get a new value, this, which projects all of the pointers:

let this = self.project();

With that out of the way, we can interact with our three fields directly in this. The first thing we do is check if the first Future has already completed. If not, we’re going to poll it. If the poll is Ready, then we’ll ignore the output and indicate that the first Future is done:

if !*this.first_done {
    if let Poll::Ready(_) = this.first.poll(ctx) {
        *this.first_done = true;
    }
}

Next, if the first Future is done, we want to poll the second. And if the first Future is not done, then we say that we’re pending:

if *this.first_done {
    this.second.poll(ctx)
} else {
    Poll::Pending
}

And just like that, we’ve composed two Futures together into a bigger, grander, brighter Future.

EXERCISE Get rid of the usage of an async block in second. Let the compiler errors guide you.

The error message you get says that () is not a Future. Instead, you need to return a Future value after the call to println!. We can use our handy async_std::future::ready:

second: {
    println!("Hello TwoFutures");
    async_std::future::ready(())
},

AndThen

Sticking together two arbitrary Futures like this is nice. But it’s even nicer to have the second Futures depend on the result of the first Future. To do this, we’d want a function like and_then. (Monads FTW to my Haskell buddies.) I’m not going to bore you with the gory details of an implementation here, but feel free to read the Gist if you’re interested. Assuming you have this method available, we can begin to write the sleepus function ourselves as:

fn sleepus() -> impl Future<Output = ()> {
    println!("Sleepus 1");
    sleep(Duration::from_millis(500)).and_then(|()| {
        println!("Sleepus 2");
        sleep(Duration::from_millis(500)).and_then(|()| {
            println!("Sleepus 3");
            sleep(Duration::from_millis(500)).and_then(|()| {
                println!("Sleepus 4");
                async_std::future::ready(())
            })
        })
    })
}

And before Rust 1.39 and the async/.await syntax, this is basically how async code worked. This is far from perfect. Besides the obvious right-stepping of the code, it’s not actually a loop. You could recursively call sleepus, except that creates an infinite type which the compiler isn’t too fond of.

But fortunately, we’ve now finally established enough background to easily explain what the .await syntax is doing: exactly what and_then is doing, but without the fuss!

EXERCISE Rewrite the sleepus function above to use .await instead of and_then.

The rewrite is really easy. The body of the function becomes the non-right-stepping, super flat:

println!("Sleepus 1");
sleep(Duration::from_millis(500)).await;
println!("Sleepus 2");
sleep(Duration::from_millis(500)).await;
println!("Sleepus 3");
sleep(Duration::from_millis(500)).await;
println!("Sleepus 4");

And then we also need to change the signature of our function to use async, or wrap everything in an async block. Your call.

Besides the obvious readability improvements here, there are some massive usability improvements with .await as well. One that sticks out here is how easily it ties in with loops. This was a real pain with the older futures stuff. Also, chaining together multiple await calls is really easy, e.g.:

let body = make_http_request().await.get_body().await;

And not only that, but it plays in with the ? operator for error handling perfectly. The above example would more likely be:

let body = make_http_request().await?.get_body().await?;

main attribute

One final mystery remains. What exactly is going on with that weird attribute on main:

#[async_std::main]
async fn main() {
    ...
}

Our sleepus and interruptus functions do not actually do anything. They return Futures which provide instructions on how to do work. Something has to actually perform those actions. The thing that runs those actions is an executor. The async-std library provides an executor, as does tokio. In order to run any Future, you need an executor.

The attribute above automatically wraps the main function with async-std’s executor. The attribute approach, however, is totally optional. Instead, you can use async_std::task::block_on.

EXERCISE Rewrite main to not use the attribute. You’ll need to rewrite it from async fn main to fn main.

Since we use .await inside the body of main, we get an error when we simply remove the async qualifier. Therefore, we need to use an async block inside main (or define a separate helper async function). Putting it all together:

fn main() {
    async_std::task::block_on(async {
        let sleepus = spawn(sleepus());
        interruptus().await;

        sleepus.await;
    })
}

Each executor is capable of managing multiple tasks. Each task is working on producing the output of a single Future. And just like with threads, you can spawn additional tasks to get concurrent running. Which is exactly how we achieve the interleaving we wanted!

Cooperative concurrency

One word of warning. Futures and async/.await implement a form of cooperative concurrency. By contrast, operating system threads provide preemptive concurrency. The important different is that in cooperative concurrency, you have to cooperate. If one of your tasks causes a delay, such as by using std::thread::sleep or by performing significant CPU computation, it will not be interrupted.

The upshot of this is that you should ensure you do not perform blocking calls inside your tasks. And if you have a CPU-intensive task to perform, it’s probably worth spawning an OS thread for it, or at least ensuring your executor will not starve your other tasks.

Summary

I don’t think the behavior under the surface of .await is too big a reveal, but I think it’s useful to understand exactly what’s happening here. In particular, understanding the difference between a value of Future and actually chaining together the outputs of Future values is core to using async/.await correctly. Fortunately, the compiler errors and warnings do a great job of guiding you in the right direction.

In the next lesson, we can start using our newfound knowledge of Future and the async/.await syntax to build some asynchronous applications. We’ll be diving into writing some async I/O, including networking code, using Tokio 0.2.

Exercises

Here are some take-home exercises to play with. You can base them on the code in this Gist.

  1. Modify the main function to call spawn twice instead of just once.
  2. Modify the main function to not call spawn at all. Instead, use join. You’ll need to add a use async_std::prelude::*; and add the "unstable" feature to the async-std dependency in Cargo.toml.
  3. Modify the main function to get the non-interleaved behavior, where the program prints Sleepus multiple times before Interruptus.
  4. We’re still performing blocking I/O with println!. Turn on the "unstable" feature again, and try using async_std::println. You’ll get an ugly error message until you get rid of spawn. Try to understand why that happens.
  5. Write a function foo such that the following assertion passes: assert_eq!(42, async_std::task::block_on(async { foo().await.await }));

December 02, 2019 04:00 AM

Chris Penner

Advent of Optics: Day 2

Advent of Optics: Day 2

Since I'm releasing a book on practical lenses and optics later this month I thought it would be fun to do a few of this year's Advent of Code puzzles using as many obscure optics features as possible!

To be clear, the goal is to be obscure, strange and excessive towards the goal of using as many optics as possible in a given solution, even if it's awkward, silly, or just plain overkill. These are NOT idiomatic Haskell solutions, nor are they intended to be. Maybe we'll both learn something along the way. Let's have some fun!

You can find today's puzzle here.


Every year of Advent of Code usually has some sort of assembly language simulator, looks like this year's came up early!

So we have a simple computer with registers which store integers, and an instruction counter which keeps track of our current execution location in the "program". There are two operations, addition and multiplication, indicated by a 1 or a 2 respectively. Each of these operations will also consume the two integers following the instruction as the addresses of its arguments, and a final integer representing the address to store the output. We then increment the instruction counter to the next instruction and continue. The program halts if ever there's a 99 in the operation address.

As usual, we'll need to start by reading in our input. Last time we could just use words to split the string on whitespace and everything worked out. This time there are commas in between each int; so we'll need a slightly different strategy. It's almost certainly overkill for this, but I've wanting to show it off anyways; so I'll pull in my lens-regex-pcre library for this. If you're following along at home, make sure you have at LEAST version 1.0.0.0.

{-# LANGUAGE QuasiQuotes #-}

import Control.Lens
import Control.Lens.Regex.Text
import Data.Text.IO as TIO

solve1 :: IO ()
solve1 = do
  input <- TIO.readFile "./src/Y2019/day02.txt" 
           <&> toMapOf ([regex|\d+|] . match . _Show @Int)
  print input

>>> solve1
["1","0","0","3","1","1","2"...]

Okay, so to break this down a bit I'm reading in the input file as Text, then using <&> (which is flipped (<$>)) to run the following transformation over the result. <&> is exported from lens, but is now included in base as part of Data.Functor, I enjoy using it over <$> from time to time, it reads more like a 'pipeline', passing things from left to right.

This pulls out all the integers as Text blocks, but we still need to parse them, I'll use the unpacked iso to convert from Text to String, then use the same _Show trick from yesterday's problem.

solve1 :: IO ()
solve1 = do
    input <- TIO.readFile "./src/Y2019/day02.txt"
               <&> toListOf ([regex|\d+|] . match . unpacked . _Show @Int)
    print input
>>> solve1
[1,0,0,3,1,1,2,3...]

Okay, so we've loaded our register values, but from a glance at the problem we'll need to have random access to different register values, I won't worry about performance too much unless it becomes a problem, but using a list seems a bit silly, so I'll switch from toListOf into toMapOf to build a Map out of my results. toMapOf uses the index of your optic as the key by default, so I can just wrap my optic in indexing (which adds an increasing integer as an index to an optic) to get a sequential Int count as the keys for my map:

solve1 :: IO ()
solve1 = do
    input <- TIO.readFile "./src/Y2019/day02.txt"
               <&> toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
    print input

>>> solve1
fromList [(0,1),(1,0),(2,0),(3,3),(4,1)...]

Great, we've loaded our ints into "memory".

Next step, we're told at the bottom of the program to initialize the 1st and 2nd positions in memory to specific values, yours may differ, but it told me to set the 1st to 12 and the second to 2. Easy enough to add that onto our pipeline!

input <- TIO.readFile "./src/Y2019/day02.txt"
           <&> toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
           <&> ix 1 .~ 12
           <&> ix 2 .~ 2

That'll 'pipeline' our input through and initialize the registers correctly.

Okay, now for the hard part, we need to actually RUN our program! Since we're emulating a stateful computer it only makes sense to use the State monad right? We've got a map to represent our registers, but we'll need an integer for our "read-head" too. Let's say our state is (Int, Map Int Int), the first slot is the current read-address, the second is all our register values.

Let's write one iteration of our computation, then we'll figure out how to run it until the halt.

oneStep :: State (Int, M.Map Int Int) ()
oneStep = do
    let loadRegister r = use (_2 . singular (ix r))
    let loadNext = _1 <<+= 1 >>= loadRegister
    let getArg = loadNext >>= loadRegister
    out <- getOp <$> loadNext <*> getArg <*> getArg
    outputReg <- loadNext
    _2 . ix outputReg .= out

getOp :: Int -> (Int -> Int -> Int)
getOp 1 = (+)
getOp 2 = (*)
getOp n = error $ "unknown op-code: " <> show n

Believe it or not, that's one step of our computation, let's break it down!

We define a few primitives we'll use at the beginning of the block. First is loadRegister. loadRegister takes a register 'address' and gets the value stored there. use is like get from MonadState, but allows us to get a specific piece of the state as focused by a lens. We use ix to get the value at a specific key out of the map (which is in the second slot of the tuple, hence the _2). However, ix r is a traversal, not a lens, we could either switch to preuse which returns a Maybe-wrapped result, or we can use singular to force the result and simply crash the whole program if its missing. Since we know our input is valid, I'll just go ahead and force it. Probably don't do this if you're building a REAL intcode computer :P

Next is loadNext, this fetches the current read-location from the first slot, then loads the value at that register. There's a bit of a trick here though, we load the read-location with _1 <<+= 1; this performs the += 1 action to the location, which increments it by one (we've 'consumed' the current instruction), but the leading << says to return the value there before altering it. This lets us cleanly get and increment the read-location all in one step. We then load the value in the current location using loadRegister.

We lastly combine these two combinators to build getArg, which gets the value at the current read-location, then loads the register at that address.

We can combine these all now! We loadNext to get the opcode, converting it to a Haskell function using getOp, then thread that computation through our two arguments getting an output value.

Now we can load the output register (which will be the next value at our read-location), and simply _2 . ix outputReg .= result to stash it in the right spot.

If you haven't seen these lensy MonadState helpers before, they're pretty cool. They basically let us write python-style code in Haskell!

Okay, now let's add this to our pipeline! If we weren't still inside the IO monad we could use &~ to chain directly through the MonadState action!

(&~) :: s -> State s a -> s 

Unfortunately there's no <&~> combinator, so we'll have to move our pipeline out of IO for that. Not so tough to do though:

solve1 :: IO ()
solve1 = do
    input <- TIO.readFile "./src/Y2019/day02.txt"
    let result = input
            & toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
            & ix 1 .~ 12
            & ix 2 .~ 2
            & (,) 0
            &~ do
                let loadRegister r = use (_2 . singular (ix r))
                let loadNext = _1 <<+= 1 >>= loadRegister
                let getArg = loadNext >>= loadRegister
                out <- getOp <$> loadNext <*> getArg <*> getArg
                outputReg <- loadNext
                _2 . ix outputReg .= out
    print result

This runs ONE iteration of our program, but we'll need to run the program until completion! The perfect combinator for this is untilM:

untilM :: Monad m => m a -> m Bool -> m [a] 

This let's us write it something like this:

&~ flip untilM ((==99) <$> (use _1 >>= loadRegister)) $ do ...

This would run our computation step repeatedly until it hits the 99 instruction. However, untilM is in the monad-loops library, and I don't feel like waiting for that to install, so instead we'll just use recursion.

Hrmm, using recursion here would require me to name my expression, so we could just use a let expression like this to explicitly recurse until we hit 99:

&~ let loop = do
              let loadRegister r = use (_2 . singular (ix r))
              let loadNext = _1 <<+= 1 >>= loadRegister
              let getArg = loadNext >>= loadRegister
              out <- getOp <$> loadNext <*> getArg <*> getArg
              outputReg <- loadNext
              _2 . ix outputReg .= out
              use _1 >>= loadRegister >>= \case
                99 -> return ()
                _ -> loop
   in loop

But the let loop = ... in loop construct is kind of annoying me, not huge fan.

Clearly the right move is to use anonymous recursion! (/sarcasm)

We can /simplify/ this by using fix!

fix :: (a -> a) -> a
&~ fix (\continue -> do
    let loadRegister r = use (_2 . singular (ix r))
    let loadNext = _1 <<+= 1 >>= loadRegister
    let getArg = loadNext >>= loadRegister
    out <- getOp <$> loadNext <*> getArg <*> getArg
    outputReg <- loadNext
    _2 . ix outputReg .= out
    use _1 >>= loadRegister >>= \case
      99 -> return ()
      _ -> continue
    )

Beautiful right? Well... some might disagree :P, but definitely fun and educational!

I'll leave you to study the arcane arts of fix on your own, but here's a teaser. Working with fix is similar to explicit recursion, you assume that you already have your result, then you can use it in your computation. In this case, we assume that continue is a state action which will loop until the program halts, so we do one step of the computation and then hand off control to continue which will magically solve the rest. It's basically identical to the let ... in version, but more obtuse and harder to read, so obviously we'll keep it!

If we slot this in it'll run the computation until it hits a 99, and &~ returns the resulting state, so all we need to do is view the first instruction location of our registers to get our answer!

solve1 :: IO ()
solve1 = do
    input <- TIO.readFile "./src/Y2019/day02.txt"
    print $ input
            & toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
            & ix 1 .~ 12
            & ix 2 .~ 2
            & (,) 0
            &~ fix (\continue -> do
                let loadRegister r = use (_2 . singular (ix r))
                let loadNext = _1 <<+= 1 >>= loadRegister
                let getArg = loadNext >>= loadRegister
                out <- getOp <$> loadNext <*> getArg <*> getArg
                outputReg <- loadNext
                _2 . ix outputReg .= out
                use _1 >>= loadRegister >>= \case
                  99 -> return ()
                  _ -> continue
                )
            & view (_2 . singular (ix 0))

>>> solve1
<my answer>

Honestly, aside from the intentional obfuscation it turned out okay!

Part 2

Just in case you haven't solved the first part on your own, the second part says we now need to find a specific memory initialization which results in a specific answer after running the computer. We need to find the exact values to put into slots 1 and 2 which result in this number, in my case: 19690720.

Let's see what we can do! First I'll refactor the code from step 1 so it accepts some parameters

solveSingle :: M.Map Int Int -> Int -> Int -> Int
solveSingle registers noun verb =
    registers
    & ix 1 .~ noun
    & ix 2 .~ verb
    & (,) 0
    &~ fix (\continue -> do
        let loadRegister r = use (_2 . singular (ix r))
        let loadNext = _1 <<+= 1 >>= loadRegister
        let getArg = loadNext >>= loadRegister
        out <- getOp <$> loadNext <*> getArg <*> getArg
        outputReg <- loadNext
        _2 . ix outputReg .= out
        use _1 >>= loadRegister >>= \case
          99 -> return ()
          _ -> continue
        )
    & view (_2 . singular (ix 0))

That was pretty painless. Now we need to construct some thingamabob which runs this with different 'noun' and 'verb' numbers (that's what the puzzle calls them) until it gets the answer we need. Unless we want to do some sort of crazy analysis of how this computer works at a theoretical level, we'll have to just brute force it. There're only 10,000 combinations, so it should be fine. We can collect all possibilities using a simple list comprehension:

[(noun, verb) | noun <- [0..99], verb <- [0..99]]

We need to run the computer on each possible set of inputs, which amounts to simply calling solveSingle on them:

solve2 :: IO ()
solve2 = do
    registers <- TIO.readFile "./src/Y2019/day02.txt"
               <&> toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
    print $ [(noun, verb) | noun <- [0..99], verb <- [0..99]]
              ^.. traversed . to (uncurry (solveSingle registers))

>>> solve2
[29891,29892,29893,29894,29895,29896,29897,29898,29899,29900...]

This prints out the answers to every possible combination, but we need to find a specific combination! We can easily find the answer by using filtered, or only or even findOf, these are all valid:

>>> [(noun, verb) | noun <- [0..99], verb <- [0..99]] 
      ^? traversed . to (uncurry (solveSingle registers)) . filtered (== 19690720)
Just 19690720

-- `only` is like `filtered` but searches for a specific value
>>> [(noun, verb) | noun <- [0..99], verb <- [0..99]] 
      ^? traversed . to (uncurry (solveSingle registers)) . only 19690720
Just 19690720

>>> findOf 
      (traversed . to (uncurry (solveSingle registers)) . only 19690720)
      [(noun, verb) | noun <- [0..99], verb <- [0..99]]
Just 19690720

These all work, but the tricky part is that we don't actually care about the answer, we already know that! What we need is the arguments we passed in to get that answer. There are many ways to do this, but my first thought is to just stash the arguments away where we can get them later. Indexes are great for this sort of thing (I cover tricks using indexed optics in my book). We can stash a value into the index using selfIndex, and it'll be carried alongside the rest of your computation for you! There's the handy findIndexOf combinator which will find the index of the first value which matches your predicate (in this case, the answer is equal to our required output).

Here's the magic incantation:

findIndexOf (traversed . selfIndex . to (uncurry (solveSingle registers)))
            (== 19690720)
            [(noun, verb) | noun <- [0..99], verb <- [0..99]]

This gets us super-duper close, but the problem says we actually need to run the following transformation over our arguments to get the real answer: (100 * noun) + verb. We could easily do it after running findIndexOf, but just to be ridiculous, we'll do it inline! We're stashing our "answer" in the index, so that's where we need to run the transformation. We can use reindexed to run a transformation over the index of an optic, so if we alter selfIndex (which stashes the value into the index) then we can map the index through the transformation:

reindexed (\(noun, verb) -> (100 * noun) + verb) selfIndex

That does it!

Altogether now, here's the entire solution for the second part:

getOp :: Int -> (Int -> Int -> Int)
getOp 1 = (+)
getOp 2 = (*)
getOp n = error $ "unknown op-code: " <> show n

solveSingle :: M.Map Int Int -> Int -> Int -> Int
solveSingle registers noun verb =
    registers
    & ix 1 .~ noun
    & ix 2 .~ verb
    & (,) 0
    &~ fix (\continue -> do
        let loadRegister r = use (_2 . singular (ix r))
        let loadNext = _1 <<+= 1 >>= loadRegister
        let getArg = loadNext >>= loadRegister
        out <- getOp <$> loadNext <*> getArg <*> getArg
        outputReg <- loadNext
        _2 . ix outputReg .= out
        use _1 >>= loadRegister >>= \case
          99 -> return ()
          _ -> continue
        )
    & view (_2 . singular (ix 0))

solvePart2 :: IO ()
solvePart2 = do
    registers <- TIO.readFile "./src/Y2019/day02.txt"
               <&> toMapOf (indexing ([regex|\d+|] . match . unpacked . _Show @Int))
    print $ findIndexOf  ( traversed
                         . reindexed (\(noun, verb) -> (100 * noun) + verb) selfIndex
                         . to (uncurry (solveSingle registers)))
            (== 19690720)
            [(noun, verb) | noun <- [0..99], verb <- [0..99]]

This was a surprisingly tricky problem for only day 2, but we've gotten through it okay! Today we learned about:

  • regex: for precisely extracting text
  • toMapOf: for building maps from an indexed fold
  • &~: for running state monads as part of a pipeline
  • <&>: for pipelining data within a context,
  • <<+=: for simultaneous modification AND access using lenses in MonadState
  • fix: using fix for anonymous recursion (just for fun)
  • selfIndex: for stashing values till later
  • reindexed: for editing indices
  • findIndexOf: for getting the index of a value matching a predicate

Hopefully at least one of those was new for you! Maybe tomorrows will be easier :)

Hopefully you learned something 🤞! Did you know I'm currently writing a book? It's all about Lenses and Optics! It takes you all the way from beginner to optics-wizard and it's currently in early access! Consider supporting it, and more posts like this one by pledging on my Patreon page! It takes quite a bit of work to put these things together, if I managed to teach your something or even just entertain you for a minute or two maybe send a few bucks my way for a coffee? Cheers! �

Become a Patron!

December 02, 2019 12:00 AM

December 01, 2019

Chris Penner

Advent of Optics: Day 1

Advent of Optics: Day 1

Since I'm releasing a book on practical lenses and optics later this month I thought it would be fun to do a few of this year's Advent of Code puzzles using optics as much as possible!

I'm not sure how many I'll do, or even if any problems will yield interesting solutions with optics, but there's no harm trying! The goal is to use optics for as much of the solution as possible, even if it's awkward, silly, or just plain overkill. Maybe we'll both learn something along the way. Let's have some fun!

You can find the first puzzle here.

Part One

So the gist of this one is that we have a series of input numbers (mass of ship modules) which each need to pass through a pipeline of mathematic operations (fuel calculations) before being summed together to get our puzzle solution (total fuel required).

This immediately makes me think of a reducing operation, we want to fold many inputs down into a single solution. We also need to map each input through the pipeline of transformations before adding them. Were I to use "normal" Haskell I could just foldMap to do both the fold and map at once! With optics however, the ideas of folds already encompass both the folding and mapping pieces. The optic we use provides the selection of elements as well as the mapping, and the action we run on it provides the reductions step (the fold).

Let's see if we can build up a fold in pieces to do what we need.

Assuming we have a String representing our problem input we need to break it into tokens to get each number from the file. Writing a parser is overkill for such a simple task; we can just use the worded fold which splits a String on whitespace and folds over each word individually!

Here's what we've got so far:

import Control.Lens

solve :: IO ()
solve =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ input ^.. worded

Running this yields something like this:

>>> solve
["76542","97993","79222"...] -- You get the idea

Now we need to parse the strings into a numeric type like Double. There's a handy prism in lens called _Show which will use Read instances to parse strings, simply skipping elements which fail to parse. Our input is valid, so we don't need to worry about errors, meaning we can use this prism confidently.

Here's the type of _Show by the way:

_Show :: (Read a, Show a) => Prism' String a

I'll add a type-application to tell it what the output type should be so it knows what type to parse into (i.e. which Read instance to use for the parsing):

{-# LANGUAGE TypeApplications #-}

solve :: IO ()
solve =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ input ^.. worded
                  . _Show @Double

>>> solve
[76542.0,97993.0,79222.0...]

Looks like that's working!

Next we need to pipe it through several numeric operations. I like to read my optics pipelines sequentially, so I'll use to to string each transformation together. If you prefer you can simply compose all the arithmetic into a single function and use only one to instead, but this is how I like to do it.

The steps are:

  1. Divide by 3
  2. Round down
  3. Subtract 2

No problem:

solve :: IO ()
solve =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ input ^.. worded
                  . _Show
                  . to (/ 3)
                  . to (floor @Double @Int)
                  . to (subtract 2)

>>> solve
[25512,32662,26405...]

I moved the type application to floor so it knows what its converting between, but other than that it's pretty straight forward.

Almost done! Lastly we need to sum all these adapted numbers together. We can simply change our aggregation action from ^.. (a.k.a. toListOf) into sumOf and we'll now collect results by summing!

solve :: IO ()
solve =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ input & sumOf ( worded
                        . _Show
                        . to (/ 3)
                        . to (floor @Double @Int)
                        . to (subtract 2)
                        )

>>> solve
3154112

First part's all done! That's the correct answer.

As a fun side-note, we could have computed the ENTIRE thing in a fold by using lens-action to thread the readFile into IO as well. Here's that version:

import Control.Lens
import Control.Lens.Action ((^!), act)

solve' :: IO (Sum Int)
solve' =  "./src/Y2019/day01.txt"
          ^! act readFile
          . worded
          . _Show
          . to (/3)
          . to floor @Double @Int
          . to (subtract 2)
          . to Sum

>>> solve'
Sum {getSum = 3154112}

The ^! is an action from lens-action which lets us 'view' a result from a Fold which requires IO. act allows us to lift a monadic action into a fold. By viewing we implicitly fold down the output using it's Monoid (in this case Sum).

I think the first version is cleaner though.

On to part 2!

Part 2

Okay, so the gist of part two is that we need to ALSO account for the fuel required to transport all the fuel we add! Rather than using calculus for this we're told to fudge the numbers and simply iterate on our calculations until we hit a negative fuel value.

So to adapt our code for this twist we should split it up a bit! First we've got a few optics for parsing the input, those are boring and don't need any iteration. Next we've got the pipeline part, we need to run this on each input number, but will also need to run it on each iteration of each input number. We'll need to somehow loop our input through this pipeline.

As it turns out, an iteration like we need to do here is technically an unfold (or anamorphism if you're feeling eccentric). In optics-land unfolds can be represented as a normal Fold which adds more elements when it runs. Lensy folds can focus an arbitrary (possibly infinite) number of focuses! Even better, there's already a fold in lens which does basically what we need!

iterated :: (a -> a) -> Fold a a

iterated takes an iteration function and, well, iterates! Let's try it out on it's own first to see how it does its thing:

>>> 1 ^.. taking 10 (iterated (+1))
[1,2,3,4,5,6,7,8,9,10]
>>>

Notice that I have to limit it with taking 10 or it'd go on forever. So it definitely does what we expect! Notice also that it also emits its first input without any iteration; so we see the 1 appear unaffected in the output. This tripped me up at first.

Okay, so we've got all our pieces, let's try patching them together!

solve2 :: IO ()
solve2 =  do
  input <- readFile "./src/Y2019/day01.txt"
  print
    $ input
    & toListOf ( worded
               . _Show
               . taking 20 (iterated calculateRequiredFuel)
               )
  where
    calculateRequiredFuel :: Double -> Double
    calculateRequiredFuel = (fromIntegral . subtract 2 . floor @Double @Int . (/ 3))

>>> solve2
[76542.0,25512.0,8502.0,2832.0,942.0,312.0,102.0,32.0,8.0,0.0,-2.0,-3.0,-3.0
...79222.0,26405.0,8799.0,2931.0...]

I've limited our iteration again here while we're still figuring things out, I also switched back to toListOf so we can see what's happening clearly. I also moved the fuel calculations into a single pure function, and added a fromIntegral so we can go from Double -> Double as is required by iterated.

In the output we can see the fuel numbers getting smaller on each iteration, until they eventually go negative (just like the puzzle predicted). Eventually we finish our 20 iterations and the fold moves onto the next input so we can see the numbers jump back up again as a new iteration starts.

The puzzle states we can ignore everything past the point where numbers go negative, so we can stop iterating at that point. That's pretty easy to do using the higher-order optic takingWhile; it accepts a predicate and another optic and will consume elements from the other optic until the predicate fails, at which point it will yield no more elements. In our case we can use it to consume from each iteration until it hits a negative number, then move on to the next iteration.

solve2 :: IO ()
solve2 =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ 
    input & toListOf 
            ( worded
            . _Show
            . takingWhile (>0) (iterated calculateRequiredFuel)
            )

>>> solve2
[76542.0,25512.0,8502.0,2832.0,942.0,312.0,102.0,32.0,8.0
,97993.0,32662.0,10885.0,3626.0,1206.0,400.0,131.0,41.0,11.0...]

We don't need the taking 20 limiter anymore since now we stop when we hit 0 or below. In this case we technically filter out an actual 0; but since 0 has no effect on a sum it's totally fine.

Okay, we're really close! On my first try I summed up all these numbers and got the wrong answer! As I drew attention to earlier, when we use iterated it passes through the original value as well. We don't want the weight of our module in our final sum, so we need to remove the first element from each set of iterations. I'll use ANOTHER higher-order optic to wrap our iteration optic, dropping the first output from each iteration:

solve2 :: IO ()
solve2 =  do
  input <- readFile "./src/Y2019/day01.txt"
  print $ 
    input & sumOf 
            ( worded
            . _Show
            . takingWhile (>0) (dropping 1 (iterated calculateRequiredFuel))
            )

>>> solve2
4728317.0

Great! That's the right answer!

It depends on how you like to read your optics, but I think the multiple nested higher-order-optics is a bit messy, we can re-arrange it to use fewer brackets like this; but it really depends on which you find more readable:

solve2 :: IO ()
solve2 =  do
  input <- readFile "./src/Y2019/day01.txt"
  print
    $ input
    & sumOf (worded
             . _Show
             . (takingWhile (> 0) . dropping 1 . iterated) calculateRequiredFuel
            )

That'll do it!

Once you get comfortable with how folds nest inside paths of optics, and how to use higher-order folds (spoilers: there's a whole chapter on this in my book launching later this month: Optics By Example), then we can solve this problem very naturally with optics! I hope some of the other problems work out just as well.

See you again soon!

Hopefully you learned something 🤞! Did you know I'm currently writing a book? It's all about Lenses and Optics! It takes you all the way from beginner to optics-wizard and it's currently in early access! Consider supporting it, and more posts like this one by pledging on my Patreon page! It takes quite a bit of work to put these things together, if I managed to teach your something or even just entertain you for a minute or two maybe send a few bucks my way for a coffee? Cheers! �

Become a Patron!

December 01, 2019 12:00 AM

November 28, 2019

FP Complete

Using Packer for building Windows Server Images

Packer is a useful tool for creating pre-built machine images. While it's usually associated with creating Linux images for a variety of platforms, it also has first class support for Windows.

We'd like to explain why someone should consider adding Packer made images and dive into the variety of ways it benefits a Windows server DevOps environment.

Motivation

Pre-built images are useful in a number of ways. Packer can use the same build configuration and provisioning recipe to create AWS AMI's and Azure machine images that will be used in production, as well as the machine images for testing locally in Virtualbox and Vagrant. This allows teams to develop and test their code using the same setup running in production, as well as the setup their colleagues are using.

In this kind of a setup, you use Packer early in your development process. We follow the workflow where we create the image first, then at any point in the future the image is available for development and deployments. This shifts the work that goes into installing software and configuring an image to long before your deployment time. Therefore there's one less step at deployment and the Windows server image will come out of the gates fully configured and provisioned with the correct software and settings.

Using a pre-built image also has the added benefit that we're able to catch configuration and setup bugs early during the machine creation phase. Any errors which would have occurred during deployment are caught early while we're creating our Windows server image. We'll be confident that our pre-built Windows server image will be ready at the time of deployment.

This could be handy in any number of situations. Imagine a scenario where we need to install an outside piece of software on our Windows server. Maybe we need to setup our Windows server as a Puppet agent prior to deployment. As part of this we'd like to download the .msi package using a simple Powershell script during setup:

$msi_source = "https://downloads.puppetlabs.com/windows/puppet6/puppet-agent-6.4.2-x64.msi"
$msi_dest   = "C:\Windows\Temp\puppet-agent-6.4.2-x64.msi"
Invoke-WebRequest -Uri $msi_source -OutFile $msi_dest

Any issue downloading and retrieving that piece of software from its vendor could delay our entire Windows server deployment and potentially cause downtime or production errors. This sort of problem could arise for a number of reasons:

  • There's an unexpected issue with the network preventing our server from getting the file
  • The software vendor's site is down
  • There's even a humble typo in our download URL

These sort of DevOps pain points should not be allowed to occur at deployment. If we instead started with a pre-built and pre-configured image for our production Windows servers, we could deploy new servers knowing that they would be safely provisioned and set up to our liking.

What is Packer?

So far we've discussed why an engineer would use pre-built Windows images in their DevOps setup without discussing specific tools and methodology. Let's introduce the Packer tool and why it's such a good fit for this problem space.

Packer is an open-source tool developed by HashiCorp for creating machine images. It's an ideal tool to use for our purposes here where we want to create images for multiple platforms (AWS, Azure, Virtualbox) from one build template file.

At a high level, Packer works by allowing us to define which platform we'd like to create our machine or image for with a builder. There are builders for a variety of platforms and we'll touch on using a few of these in our example.

The next thing that Packer lets us do is use provisioners to define steps we want packer to run. We define these provisioning steps in our packer config file and packer will use them to setup our machine images identically, independent of the platforms we target with our builders.

As we mentioned earlier, Packer has excellent Windows support. We'll touch on using the file provisioner as well as as the powershell provisioner in depth later. For now it's worth knowing that we can use the file provisioner to upload files to the Windows server machines we're building. Likewise we can use the PowerShell provisioner to run Powershell scripts that we have on our host machine (the one we're using to create our Windows server images from) on the Windows server we're building.

The nitty gritty - a real world example

Packer works by using a JSON formatted config file. This config file is also referred to as the Packer build template. You specify the builders and provisioners for Packer that we discussed earlier within this build template.

At this point if you would like to follow along and try the next few steps in this example on your own, you should first install Packer on your machine. The official install guide for Packer is here and if you need to install Vagrant, then please follow the official install guide here. Also, check out the corresponding code repository for this blog post here.

Packer is a mature, well-used tool and there are many excellent templates and examples available for a variety of use cases. For our example we're basing our template code on the Packer Windows templates by Stefan Scherer. The set of templates available in that repository are an excellent resource for getting started. The build template specific to our example is available in its entirety at the code repo associated with this blog, but we'll go over a few of the important details next.

The first thing that we'd like to cover is the builder section. For the Vagrant box builder we're using:

{
  "boot_wait": "2m",
  "communicator": "winrm",
  "cpus": 2,
  "disk_size": "{{user `disk_size`}}",
  "floppy_files": [
    "{{user `autounattend`}}",
    "./scripts/disable-screensaver.ps1",
    "./scripts/disable-winrm.ps1",
    "./scripts/enable-winrm.ps1",
    "./scripts/microsoft-updates.bat",
    "./scripts/win-updates.ps1",
    "./scripts/unattend.xml",
    "./scripts/sysprep.bat"
  ],
  "guest_additions_mode": "disable",
  "guest_os_type": "Windows2016_64",
  "headless": "{{user `headless`}}",
  "iso_checksum": "{{user `iso_checksum`}}",
  "iso_checksum_type": "{{user `iso_checksum_type`}}",
  "iso_url": "{{user `iso_url`}}",
  "memory": 2048,
  "shutdown_command": "a:/sysprep.bat",
  "type": "virtualbox-iso",
  "vm_name": "WindowsServer2019",
  "winrm_username": "vagrant",
  "winrm_password": "vagrant",
  "winrm_timeout": "{{user `winrm_timeout`}}"
}

Here the line:

"{{user `autounattend`}}",

is referring to the autounattend variable from the variables section of the Packer build template file:

"variables": {
    "autounattend": "./answer_files/Autounattend.xml",

When you boot a Windows server installation image (like we're doing here with Packer) you'll typically use the Autounattend.xml to automate installation instructions that the user would normally be prompted for. Here we're mounting this file on the virtual machine using the floppy drive (the floppy_files section). We also use this functionality to load PowerShell scripts onto the virtual machine as well. win-updates.ps1 for example installs the latest updates at the time the Windows server image is created.

We're also going to add additional scripts to run with provisioners. These are in the provisioners section of the packer build template and are independent of any specific platform specified by each of the builders section entries.

The provisioners section in our build template looks like the following:

"provisioners": [
  {
    "execute_command": "{{ .Vars }} cmd /c \"{{ .Path }}\"",
    "scripts": [
      "./scripts/vm-guest-tools.bat",
      "./scripts/enable-rdp.bat"
    ],
    "type": "windows-shell"
  },
  {
    "scripts": [
      "./scripts/debloat-windows.ps1"
    ],
    "type": "powershell"
  },
  {
    "restart_timeout": "{{user `restart_timeout`}}",
    "type": "windows-restart"
  },
  {
    "execute_command": "{{ .Vars }} cmd /c \"{{ .Path }}\"",
    "scripts": [
      "./scripts/pin-powershell.bat",
      "./scripts/set-winrm-automatic.bat",
      "./scripts/uac-enable.bat",
      "./scripts/compile-dotnet-assemblies.bat",
      "./scripts/dis-updates.bat"
    ],
    "type": "windows-shell"
  }
],

We're using both the powershell provisioner as well as the Windows Shell provisioner for older Windows CMD scripts. The reason we're using provisioners to run these scripts instead of placing them in the floppy drive like we did in the builder for the Vagrant box earlier is that these scripts are generic to all platforms we'd like our build template to target. For that reason, we would like these to run regardless of the platforms we're using our build template for.

Creating and running a local Windows server in Vagrant

For running our Windows server locally, the general overview is:

  1. First we will build our Windows server Vagrant box file with Packer
  2. We will add that box to Vagrant
  3. We'll then initialize it with our Vagrantfile template
  4. And finally we'll boot it

Building the Packer box can be done with the packer build command. In our example our Windows server build template is called windows_2019.json so we start the packer build with

packer build windows_2019.json

If we have multiple builders we can tell packer that we would only like to use the virtualbox type with the command:

packer build --only=virtualbox-iso windows_2019.json

(Note the type value we set earlier in our Vagrant box builder section of the packer build template was: "type": "virtualbox-iso",).

Next, we'll add the box to vagrant with the vagrant box add command which is used in the following way:

vagrant box add BOX_NAME BOX_FILE

Or more precisely for our example we're invoking this command as:

vagrant box add windows_2019_virtualbox windows_2019_virtualbox.box

We then need to initialize our

vagrant init --template vagrantfile-windows_2019.template windows_2019_virtualbox

and boot it with:

vagrant up

At this point we will have a fully provisioned and running Windows server in Vagrant.

The set of commands we used above to build and use our Packer build template are neatly encapsulated in the Makefile targets. If you're using the example code in the accompanying repo for this blog post you can simply run the following make commands:

make packer-build-box
make vagrant-add-box
make vagrant-init
make vagrant-up

Conclusion

At this point even though we're only going to be using this Vagrant box and its associated Vagrantfile for local testing purposes, we've eliminated the potential for errors that could occur during our Windows server setup. When we use this box for future development and testing (or give it to other colleagues to do likewise) we won't need to be worried that one of our setup scripts may fail and we would need to fix it in order to continue working. We've been able to eliminate an entire category of DevOps errors and a particular development pain point by using Packer to create our Windows server image.

We also know that if we're able to build our box with Packer, and run the provisioning steps, that we'll have a image that will be identical to our production images that we can use to test and work with.

Next steps

If this blog post sounded interesting, or you're curious about other ways modern DevOps tools like Packer can improve your projects, you should check out our future blog posts. We have a series coming soon on using tools, like Packer, to improve your DevOps environment.

In future posts we'll cover ways to use Vagrant with Packer as well as how to use Packer to produce AWS AMI's to deploy your production environment. These will be natural next steps if you wanted to pursue the topics covered in this post further.

We're also adding new DevOps posts all the time and you can sign up for our DevOps mailing list if you would like our latest DevOps articles delivered to your inbox.

November 28, 2019 06:08 AM

Functional Jobs

Software Engineer - Haskell at Capital Match Platform (Full-time)

WHO WE ARE

Capital Match is an innovative fintech business with a range of financial solutions to corporate and individual clients, investors and borrowers. Capital Match is the largest marketplace invoice financing platform in Southeast Asia based in Singapore, funded more than US$80 million in Singapore and Hong Kong over the past 3 years. Capital Match is backed by multiple VCs and institutional investors including Dymon Asia Capital, an alternative asset manager with $6bn AUM and Eduardo Saverin's B Capital Group.

Since November 2018, we have merged with SESAMi, the largest procurement platform in Singapore where we will bring a fully integrated supply chain financing solution to corporates and their suppliers for more timely, automated and cost efficient B2B financing. Our next mission is to expand to other countries in Southeast Asia through greenfield development, partnerships and/or acquisitions.

THE ROLE

We are looking for experienced Software Engineer - Haskell to lead our tech growth in the fintech space, expand into surrounding countries, develop new products and integrations. You will be involved in all aspects of the creation, growth and operations of a secure web-based platform. Experience in front-to-back feature development, distributed deployment and automation in the cloud, build and test automation is highly desirable.

OUR PLATFORM

  • AWS (EC2, S3, ECR)
  • CI & CD with Jenkins
  • Container and deployment Docker, Nix, Ansible, Terraform
  • Haskell backend
  • React based frontend with TypeScript and ClosureScript

QUALIFICATIONS

  • Adequate software engineer experience.
  • Knowledge and passion with Haskell.
  • Strong foundation in data structures, algorithms, and software design.
  • Experience in developing both server and web applications.
  • Experience in system design, API and data modelling.
  • Experience with Peer Review, CI & CD, automated testing.
  • Familiarity with Linux systems, command line environments and cloud-based deployments.
  • A background in fintech and especially the lending space would be an advantage but is not essential.
  • Willing to relocate to Singapore.

WHAT WE OFFER

  • Competitive salary depending on experience and qualifications.
  • Attractive equity options for outstanding candidates.
  • Foreign who relocate from most countries do not need to pay their country income tax and the proposed remuneration income tax in Singapore is <10%.
  • Visa sponsorship shall be provided to the right candidate.
  • Singapore is a great place to live, a vibrant city rich with diverse cultures, a very strong financial sector and a central location in Southeast Asia.

HOW TO APPLY Send your CV and github link to careers [at] capital-match [dot] com

Get information on how to apply for this position.

November 28, 2019 02:36 AM

Tweag I/O

How to make your papers run: Executable formal semantics for your language

Teodoro Freund

This post will show a simple example of how to use Makam, a very powerful, not yet widely-known, programming language to specify executable semantics of a simply typed lambda calculus with recursion and numbers (PCF).

I'm using Makam during my internship at Tweag to specify and experiment with the design of a new configuration language. Makam allows me to try new ideas quickly, without worrying about low-level details. In the long run, it'll also work as documentation for the language.

The Problem

Scene: EXTERIOR, BEACH, SUNNY

A woman is relaxing on a chair on the beach, clearly on vacation, drinking an ice-cold drink. Her phone beeps. The text message asks 'Can you come back to the office? We upgraded the compiler and the program you wrote last week stopped working'.

Ok, I might have exaggerated a bit, but every programmer has likely found themself, at least once, trying to understand why a program that was working with compiler A, suddenly stopped working when switching to compiler B. Or even worse, maybe it was working with compiler A, version 4.5.64, and it stopped after an update to version 4.6.23.

Ideally, programming language designers and implementors would like to keep this kind of situation to a minimum. And, when it does happen, they'd like to have a definitive answer as to how the compiler should behave. A specification. A ground truth.

There are many ways to specify this kind of document; two are commonly used. A reference implementation allows a skeptical programmer to check what the expected behavior of a program is. However, it does not give an explanation for the reference behavior. On the other hand, using plain English can be pretty useful since it's understandable by a human. However, it may be really hard to understand how a program should behave by trying to run it in your head. Ideally we'd like something simple enough so a person can get something out of it, but that is still executable and unambiguous.

We should ask ourselves, what would a PLT researcher do? A favorite when writing about λ-calculus and the like is to use operational semantics. The basic idea is to specify the semantics of a program by stating what a given term evaluates to, assuming we know how to evaluate its subterms.

Operational semantics seem to be an amazing deal: it's simple enough that a human can understand it quite easily, while at the same time having a clear, unambiguous, computer-readable syntax. But if you came across this kind of thing before, you probably know that it has a trick; it assumes that the really difficult stuff (like variable substitution) is taken care of by the meta-theory, thus relieving the researcher from the burden of writing a whole interpreter for it. However, our goal is to have an executable specification, so we can't just expect the meta-theory to take care of everything.

A solution!

What if I told you that there's a language out there that can take care of abstractions, variable substitution, the transformation of programs—and that its name is a palindrome?

Enter Makam

Makam is a dialect of λ-Prolog designed as a tool for rapid language prototyping. I won't go into details, but it's based on the idea of higher-order logic programming.

With Makam, we can write relations between higher-order terms, stating what shape (or properties) different terms should have to be considered related. Then, we can ask the Makam interpreter to try to come up with terms that make a given proposition true, and we can even add restrictions to these terms.

In this paradigm, computing something is searching for a proof of a given proposition, i.e., showing terms exists that make true all the requested constraints. Add to this that Makam can work with higher-order terms, and you have a powerful enough language to manipulate abstractions in a really high-level way.

An example

Let's dive into the implementation of PCF on Makam. PCF is a simply typed lambda calculus, with Peano-like numbers and a case destructor for them, as well as a primitive recursion operator. We'll work under the assumption that we only care about closed terms (i.e., with no free variables).

In what follows, I'll go through the main parts we'd like to specify (syntax, type checking, and operational semantics), first showing a research-paper-like specification, followed by the Makam implementation.

Syntax

We can think of PCF terms and types as:

$$ A, B ≔ Num ~|~ A → B \\[5pt] s, ~ t, ~ u ≔ x ~|~ s ~ t ~|~ λx.s ~|~ fix ~ x.s ~|~ zero ~|~ succ(s) ~|~ \text{case} ~ s ~ \text{of} ~ \{ 0 ⇒ t ~ ; ~ succ(x) ⇒ u \} $$

... where a type (noted \(A\), \(B\), ...) can be either a \(Num\), representing numbers, or an arrow \(→\) from one type to another, representing functions. On the other side, a term (noted \(s\), \(t\), ...) can be a variable (\(x\)), an application of two terms, a lambda abstraction (\(λ\)), a recursive term (\(fix\)), zero, the successor of a term or a case over a term to handle numbers.

Now, let's see how to write this in Makam:

tp, term : type. 

num : tp.
arrow : tp -> tp -> tp.

app : term -> term -> term.
lam : (term -> term) -> term.
fix : (term -> term) -> term.
zero : term.
succ : term -> term.
case : term -> term -> (term -> term) -> term.

On the first line, we're defining two new types, tp is the type of types and term is the type of terms. The next block is showing how tps are constructed, num is a tp by itself, but arrows require two tp parameters to make a tp. The last six declarations show how terms are constructed. However, variables seem to be missing.

The answer lies in the constructor for lam (aka the binder for variables), notice how in order to construct a λ-abstraction we don't take a term with some nebulous notion of free variable to bind, but rather a function from term to term. But this is a Makam function, not a PCF function. Remember how PLT researchers depended a lot on meta-theory? Well, Makam is like an executable meta-theory, so we pass the responsibilities to the meta-language.

Types

On top of that, we want to define a type system over these terms.

$$ \frac{Γ ⊢ s: A → B \hskip 1em Γ ⊢ t: A}{Γ ⊢ s ~ t: B} \hskip 1em \tau\text{-} app \\[15pt] \frac{Γ, x \text{:} A ⊢ s: B}{Γ ⊢ λx.s: A → B } \hskip 1em \tau\text{-}lam \\[15pt] \frac{Γ, x \text{:} A ⊢ s: A}{Γ ⊢ fix ~ x.s: A} \hskip 1em \tau\text{-}fix \\[15pt] \frac{x \text{:} A ∈ Γ}{Γ ⊢ x: A} \hskip 1em \tau\text{-}var \\[15pt] \frac{}{Γ ⊢ zero: Num} \hskip 1em \tau\text{-}zero \\[15pt] \frac{Γ ⊢ n: Num}{Γ ⊢ succ(n): Num} \hskip 1em \tau\text{-}succ \\[15pt] \frac{Γ ⊢ n: Num \hskip 1em Γ ⊢ z: A \hskip 1em Γ ⊢ λp.s: Num → A} {Γ ⊢ \text{case} ~ n ~ \text{of} ~ \{ 0 ⇒ z ~ ; ~ succ(p) ⇒ s \} : A} \hskip 1em \tau\text{-}case $$

These are pretty standard, so there should be no surprises here. Let's implement them on Makam:

typeof: term -> tp -> prop.


typeof (app S T) B :- typeof S (arrow A B), typeof T A.

typeof (lam S) (arrow A B) :-
    (x: term ->
     typeof x A ->
     typeof (S x) B).

typeof (fix S) T :-
    (x: term ->
     typeof x T ->
     typeof (S x) T).

typeof zero num.

typeof (succ N) num :- typeof N num.

typeof (case N Z P) Ty :-
    typeof N num,
    typeof Z Ty,
    (x: term ->
     typeof x num ->
     typeof (P x) Ty).

On the first line, we define a new relation called typeof, which defines a relation between termss and tps. Notice how typeof is a constructor of a proposition (prop), which is a primitive datatype on Makam representing relations, over which the Makam interpreter can look for a proof. Let's go over a few of them:

  • First, notice how the rule for zero doesn't have a :- part. This means that we don't need any hypothesis to type the term zero.
  • Also, check the rule for succ N. There are two kinds of identifiers, lower and upper case. The lower case are used for the constructors we've been declaring, but the upper case are unification variables, which means they'll match with anything that makes the bit after :- true. In this case, N must be a term with type num.
  • Now, look at typeof (lam S) (arrow A B). Since we don't have variables anymore, we can't have a context like \(Γ\); we need something else. Let's read it together: x: term -> introduces a fresh term, called x. You can assume that x has type A (typeof x A ->). And you need to show that S x has type B.

You should be able to understand the remaining ones by yourself, but the important part is to compare how similar these definitions are to the judgment ones at the beginning of this section. In fact, they are arguably simpler since we don't have to deal with the context bureaucracy at all in Makam.

Now, in case you were wondering why this is useful, if you load this into the Makam interpreter, you can ask it for the type of any expression. Let's try with \(λx. \text{case} ~ x ~ \text{of} ~ \{ 0 ⇒ succ(zero) ~ ; ~ succ(y) ⇒ zero \} \):

typeof (lam (fun x => case x (succ zero) (fun _ => zero))) Ty ?

And get answered back:

Ty := arrow num num.

Evaluation

Finally, we can give meaning to our PCF formalization by defining operational semantics rules. Remember that only closed terms that actually type check reach this point. The final result is always a value, which can either be a number of the form \(succ(succ(...succ(zero)))\) (with zero or more \(succ\)s) or a λ-abstraction.

$$ \frac{s ⇓ λx.s' \hskip 1em t ⇓ t' \hskip 1em s'[x/t'] ⇓ v}{s ~ t ⇓ v} \hskip 1em ε\text{-} app \\[15pt] \frac{}{λx.s ⇓ λx.s} \hskip 1em ε\text{-}lam \\[15pt] \frac{t[x/fix ~ x.t] ⇓ v}{fix ~ x.t ⇓ v} \hskip 1em ε\text{-}fix \\[15pt] \frac{}{zero ⇓ zero} \hskip 1em ε\text{-}zero \\[15pt] \frac{n ⇓ m}{succ(n) ⇓ succ(m)} \hskip 1em ε\text{-}succ \\[15pt] \frac{n ⇓ zero \hskip 1em s ⇓ v} {\text{case} ~ n ~ \text{of} ~ \{ 0 ⇒ s ~ ; ~ succ(x) ⇒ t \} ⇓ v} \hskip 1em ε\text{-}czero \\[15pt] \frac{n ⇓ succ(m) \hskip 1em t[x/m] ⇓ v} {\text{case} ~ n ~ \text{of} ~ \{ 0 ⇒ s ~ ; ~ succ(x) ⇒ t \} ⇓ v} \hskip 1em ε\text{-}csucc $$

Again, this definition is quite standard, so let's go straight to the Makam implementation:

eval : term -> term -> prop.


eval (app S T) V :-
    eval S (lam S'),
    eval T T',
    eval (S' T') V.

eval (lam S) (lam S).

eval (fix S) V :- eval (S (fix S)) V.

eval zero zero.

eval (succ E) (succ V) :- eval E V.

eval (case N Z _) V :- eval N zero, eval Z V.

eval (case SN _ P) V :- eval SN (succ N), eval (P N) V.

Similarly to typeof, eval will relate a term with the value it evaluates to. This value is itself a term, so we should try to do a special value type for values—but that's out of the scope of this post. This is actually much easier than the typeof proposition, but let's still go through some of the cases:

  • eval (fix S) V tells us that fix S evaluates to a value V, when S, substituting its abstracted variable with fix S, evaluates to V, very similarly to \(ε\text{-}fix\) above.
  • Notice how we have two cases for case expressions, one that only applies if the number evaluates to zero, and the other if the number evaluates to the successor of another number.

Then, you can go ahead and ask the Makam interpreter to evaluate something:

>>> eval (lam (fun x => case x (succ zero) (fun _ => zero))) V?
 Yes:
V := lam (fun x => case x (succ zero) (fun _ => zero)).


>>> eval (app (lam (fun x => case x (succ zero) (fun _ => zero))) zero) V?
 Yes:
V := succ zero.

The first example doesn't change, since a function is already a value. But the second example applies this same function to zero and gives back 1 (succ zero). If we interpret zero as false and succ zero as true, then we could probably name this function as isZero.

Final (and further) thoughts

What I showed here is only the tip of the iceberg of what Makam is perfectly capable of handling. I suggest reading this paper by Originate's Antonis Stampoulis, the creator of Makam, for more complete (and way more complex) examples. Be sure to also check out Makam's repo—especially the examples directory—to learn plenty more.

Also, I only showed a tiny bit of what specifying a language means, and there are many more challenges (that I don't even know of). I found Makam to be a quite useful tool, hopefully this post whetted your appetite and you'll start to specify every language out there.

November 28, 2019 12:00 AM

November 27, 2019

Sandy Maguire

Low-Tech AST Extensibility with Extension Patterns

Today I want to share a common pattern I’ve been using for extending AST-like data structures that I don’t own. It’s an extremely low-tech solution to the problem (as opposed to something like the dreaded Trees That Grow, which is more far complicated than any problem is worth.)

A common problem I run into is wanting to add custom annotations to abstract syntax trees. As one example, a while back I was writing a Haskell editor that would write Haskell code for you. The idea was to get rid of the text representation of code entirely, and work directly with the Haskell AST. However, it’s often useful to insert metadata into the AST — for example, which bit of the tree you’re currently editing.

As another example, I’m currently writing a book in markdown, and want to express high-level concepts that markdown doesn’t have any primitives for — things like exercises or inline this snippet of code from a real codebase or this thing is like a footnote, but should have a special graphic. If I were a pleb, I’d just manually write the low-level markdown necessary to achieve the visual goal I want.

But: two problems. Firstly, I did that on the last book, and it turned out to be the biggest mistake I’ve made in quite a long time. The issue is that while this works for the representation you’re currently looking at, it all falls apart when you want to change the representation. My book looked great as a PDF, but it took me weeks and literal tears to turn that thing into an e-book.

Secondly, this book I’m writing is all about how the root of all evil is a premature loss of precision — which is to say, it’s about designing and using abstractions. The irony would be too salty if I didn’t take my own advice here and build my book out of the abstractions I claim are so valuable.

So this is the question: how can we add new abstraction primitives to a datatype that we don’t control?

Let’s take a particular example that I implemented today. In The Hardest Program I’ve Ever Written, Bob Nystrom walks through the implementation of an interesting program. Throughout the prose, there are little skulls which are footnotes describing a wrong path he took during the implementation. These mistakes are, in my opinion, more interesting than the essay itself.

My book has a few case studies in which I work through building a real program using the techniques I’m advocating. The idea is to give readers an actual taste of how it works in practice, and to show that often times the journey is more valuable than the destination. As such, I thought Bob’s skull footnotes would make an excellent addition to these chapters.

I dug in to see how Bob had implement his, and I was amazed! The poor bastard had done it all by hand! My god, if that’s not commitment, I don’t know what is. There are like seventeen footnotes in that blog post. Someone should probably make Bob a saint for just how how patient he must be.

While this is commendable, it is antithetical to our purposes. This is clearly an abstraction leak; markdown is supposed to be human-readable format that eschews 15th-century technology like HTML. As soon as you have an abstraction leak, your abstraction is worth nothing. At this point it will only bring you pain.

But what can we do instead?

Well, my book is being authored in markdown, and then processed via pandoc to turn it into pretty PDFs. I’ve separated the semantic bits from the presentation bits, in an act of forward thinking for when I make an e-book copy. What this means is that, even though I’m writing markdown, my book is actually a Pandoc document. Which is to say, there is a Text.Pandoc.Definition.Block somewhere in the platonic realm that describes my book.

And so we return to the question of how to annotate ASTs. The Pandoc AST is a rather expressive format, but it primarily describes basic typographic elements. It primarily captures meaning as to how to layout a document, rather than capturing the meaning of what is being expressed.

While Pandoc already has the option to annotate a Footnote, I don’t want to replace all footnotes with deathnotes (as I’ve taken to calling these little skull things.)

The trick is a rather stupid one. While usual footnotes are written in markdown like this:

I’ve decided to annotate my deathnotes like this:

The only difference is that the text of a deathnote starts with the word death. That’s it. There is nothing clever going on here. When parsed into a Block, the above has this structure:

The bit of interest to us is the part of the AST that begins Note [ Para [ Str "death". Because this is an easy thing to annotate directly in markdown, and because it won’t happen by accident, we can decide that this is the canonical representation for annotating a deathnote.

Here’s the trick: we can reify that decision in Haskell via a pattern synonym. If you’re unfamiliar with pattern synonyms, they allow you to “create” “new” data constructors, which are just synonyms for arbitrary patterns you’d like to pick out. In our case, we want to pick out that Note [ Para [ Str "death" structure.

We begin by writing a little function that will pattern match on the part we want, and remove the word "death" from the first paragraph.

The function splitDeathNote will try to match our deathnote pattern, and if it succeeds, give back the rest of the content. As a second step, we enable -XViewPatterns and -XPatternSynonyms and write a pattern:

Patterns have egregious syntax, but it can be read in two parts. The first bit is the pattern DeathNote bs <- Note ... bit, which is used for defining a pattern match. It says, “if you do a pattern match on the thing left of the <-, instead replace it with the pattern match on the right. This weird -> thing is a view pattern, which says”run the splitDeathNote function, and only match if it returns a Just."

The other part of the pattern synonym, the part after the where, allows us to build an Inline out of a Block. Which is to say, it works like a data constructor; we can write something like let foo = DeathNote blah.

In other words, after defining the DeathNote pattern synonym, for all intents and purposes it’s like we’ve added a new data constructor to the pandoc Inline type. For example, we can write a function that pattern matches on it:

GHC will happily compile this thing, and it will work as expected! Cool!

The final step to actually getting these things working is to walk the pandoc AST, and transform our nice, newly-annotated deathnotes into something more amenable for a PDF. But! We want to do this as part of generating a PDF. That way we hold onto our semantic annotations until the very last moment, i.e., when we send our document to the printers.

We can get this transformation for free via Scrap Your Boilerplate(SYB for short.) SYB lets us write tiny transformations that operate only on a piece of data that we care about, and then lift that into a leaf-first transformation over arbitrarily large data structures.

In our case, we can write a function like this:

And then use SYB to lift it over the entire Pandoc structure

And just like that, we’ve added a custom annotation to markdown, and separately given a presentation strategy for it. We can use toJSONFilter to connect our little latePreProcess transformation to pandoc, and no one is any the wiser.

November 27, 2019 10:15 PM

Matt Parsons

Keeping Compilation Fast

You’re a Haskell programmer, which means you complain about compilation times.

We typically spend a lot of time waiting for GHC to compile code. To some extent, this is unavoidable - GHC does a tremendous amount of work for us, and we only ever ask it to do more. At some point, we shouldn’t be terribly surprised that “doing more work” ends up meaning “taking more time.” However, there are some things we can do to allow GHC to avoid doing more work than necessary. For the most part, these are going to be code organization decisions.

In my experience, the following things are true, and should guide organization:

  • Superlinear: GHC takes more time to compile larger modules than smaller modules.
  • Constant costs: GHC takes a certain amount of start-up time to compile a module
  • Parallelism: GHC can compile modules in parallel (and build tools can typically compile packages in parallel)
  • Caching: GHC can cache modules

So let’s talk about some aspects of project organization and how they can affect compile times.

The Project.Types Megamodule

You just start on a new project, and you get directed to the God module - Project.Types. It’s about 4,000 lines long. “All the types are defined in here, it’s great!” However, this is going to cause big problems for your compilation time:

  • A super large module is going to take way longer to compile
  • Any change to any type requires touching this module, and recompiling everything in it
  • Any change to this module requires recompiling any module that depends on it, which is usually everything

We pretty much can’t take advantage of caching, because GHC doesn’t cache any finer than the module-level. We can’t take advantage of parallelism, as GHC’s parallelism machinery only seems to work at module granularity. Furthermore, we’re tripping this constantly, which is causing GHC to recompile a lot of modules that probably don’t need to be recompiled.

Resolution

Factor concepts out of your Project.Types module. This will require manually untangling the dependency graph, which can be a little un-fun. It’s probably also a good excuse to learn .hs-boot files for breaking mutual recursion.

There’s a small constant cost to compile a module, so you probably shouldn’t define a module for every single type. Group related types into modules. The sweet spot is probably between 50-200 lines, but that’s a number I just summoned out of the intuitional aether.

This process can be done incrementally. Pick a concept or type from the bottom of your dependency graph, and put it in it’s own module. You’ll need to import that into Project.Types - but do not reexport it! Everywhere that complains, add another import to your new module.

As you factor more and more modules out, eventually you’ll start dropping the dependency on Project.Types. Now, as you edit Project.Types, you won’t have to recompile these modules, and your overall compile-times will improve dramatically. All the types that are pulled out of Project.Types will be cached, so recompiling Project.Types itself will become much faster.

Before too long, you’ll be minimizing the amount of compilation you have to do, and everything will be happy.

Package Splitting

Okay so you think “I know! I’ll make a bunch of packages to separate my logical concerns!” This is probably smart but it comes with some important trade-offs for development velocity and compile-times.

GHCi

GHCi is pretty picky about loading specific targets, and what you load is going to determine what it will pick up on a reload. You need to ensure that each target has the same default extensions, dependencies, compiler flags, etc. because all source files will be loaded as though they were in a single project. This is a good reason to either use Cabal or hpack common stanzas for all of this information, or to use file-specific stuff and avoid using implicit configuration.

What’s a “load target”? A target is a part of a package, like a library, a specific test-suite, a specific executable, or a sub-library. In a multi-package Cabal or Stack project, load targets can come from different packages.

Another gotcha is that any relative filepaths must resolve based on where you’re going to invoke {stack,cabal} ghci. Suppose you decide you want to split your web app into two packages: database and web, where database has a file it loads for the model definitions, and web has a bunch of files it loads for HTML templating. The Template Haskell file-loading libraries pretty much assume that your paths are relative to the directory containing the .cabal file. When you invoke stack ghci (or cabal repl), it puts your CWD in the directory you launch it, and the relative directories there are probably not going to work.

Once you’ve created that package boundary, it becomes difficult to operate across it. The natural inclination - indeed, the reason why you might break it up - is to allow them to evolve independently. The more they evolve apart, the less easily you can load everything into GHCi.

You can certainly load things into GHCi - in the above example, web depends on database, and so you can do stack ghci web, and it’ll compile database just fine as a library and load web into GHCi. However, you won’t be able to modify a module in database, and hit :reload to perform a minimal recompilation. Instead, you’ll need to kill the GHCi session and reload it from scratch. This takes a lot more time than an incremental recompilation.

Module Parallelism

GHC is pretty good at compiling modules in parallel. It’s also pretty good at compiling packages in parallel.

Unfortunately, it can’t see across the package boundary. Suppose your package hello depends on module Tiny.Little.Module in the package the-world, which also contains about a thousand utility modules and Template Haskell splices and derived Generic instances for data types and type family computations and (etc……). You’d really want to just start compiling hello as soon as Tiny.Little.Module is completely compiled, but you can’t - GHC must compile everything else in the package before it can start on yours.

Breaking up your project into multiple packages can cause overall compile-times to go up significantly in this manner. If you do this, it should ideally be to split out a focused library that will need to change relatively rarely while you iterate on the rest of your codebase. I’d beware of breaking things up until absolutely necessary - a package boundary is a heavy tool to merely separate responsibilities.

Package parallelism

The good news is that it is quite easy to cache entire packages, and the common build tools are quite good at compiling packages in parallel. It’s not that big of a deal to depend on lens anymore, largely because of how good sharing and caching has gotten. So certaily don’t be afraid to split out libraries and push them to GitHub or Hackage, but if you’re not willing to GitHub it, then it should probably stay in the main package.

Big Ol Instances Module

Well, you did it. You have a bunch of packages and you don’t want to merge them together. Then you defined a bunch of types in foo, and then defined a type class in bar. bar depends on foo, so you can’t put the instances with the type definitions, and you’re a Good Haskeller so you want to avoid orphan instances, which means you need to put all the instances in the same module.

Except - you know how you had a 4,000 line types module, which was then split-up into dozens of smaller modules? Now you have to import all of those, and you’ve got a big 3,000 class/instance module. All the same problems apply - you’ve got a bottleneck in compilation, and any touch to any type causes this big module to get recompiled, which in turn causes everything that depends on the class to be recompiled.

A solution is to ensure that all your type classes are defined above the types in the module graph. This is easiest to do if you have only a single package. But you may not be able to do that easily, so here’s a solution:

Hidden Orphans

The real problem is that you want to refer to the class and operations without incurring the wrath of the dependency graph. You can do this with orphan instances. Define each instance in it’s own module and import them into the module that defines the class. Don’t expose the orphan modules - you really want to ensure that you don’t run into the practical downsides of orphans while allowing recompilation and caching.

You’ll start with a module like this:

module MyClass where

import Types.Foo
import Types.Bar
import Types.Baz

class C a

instance C Foo
instance C Bar
instance C Baz

where a change to any Types module requires a recompilation of the entirety of the MyClass module.

You’ll create an internal module for the class (and any helpers etc), then a module for each type/instance:

module MyClass.Class where

class C a


module MyClass.Foo where

import MyClass.Class
import Types.Foo

instance C Foo


module MyClass.Bar where

import MyClass.Class
import Types.Bar

instance C Bar


module MyClass.Baz where

import MyClass.Class
import Types.Baz

instance C Baz


module MyClass (module X) where

import MyClass.Class as X
import MyClass.Foo as X
import MyClass.Bar as X
import MyClass.Baz as X

So what happens when we touch Types.Foo? With the old layout, it’d trigger a recompile of MyClass, which would have to start entirely over and recompile everything. With the new layout, it triggers a recompile of MyClass.Foo, which is presumably much smaller. Then, we do need to recompile MyClass, but because all the rest of the modules are untouched, they can be reused and cached, and compiling the entire module is much faster.

This is a bit nasty, but it can break up a module bottleneck quite nicely, and if you’re careful to only use the MyClass interface, you’ll be safe from the dangers of orphan instances.

Some random parting thoughts

  • Don’t do more work than you need to. Derived type class instances are work that GHC must redo every time the module is compiled.
  • Keep the module graph broad and shallow.
  • TemplateHaskell isn’t that bad for compile times.
    • You pay a 200-500ms hit to fire up the interpreter at all, but from there, most TH code is quite fast - running the TH code to parse and generate models from 1,500 lines of persistent quasiquoter takes about 50ms.
    • The slow part is compiling the resulting code - those 1,500 lines of model definitions expanded out to something like 200kloc
    • The solution is to split up the module, following the tips in this post!
  • The following command speeds up compilation significantly, especially after exposing all those parallelism opportunities:
      stack build --fast --file-watch --ghc-options "-j4 +RTS -A128m -n2m -qg -RTS"
    

    These flags give GHC 4 threads to work with (more didn’t help on my 8 core computer), and -A128m gives it more memory before it does GC. -qg turns off the parallel garbage collector, which is almost always a performance improvement. Thanks to /u/dukerutledge for pointing out -n2m, which I don’t understand but helped!

  • Try to keep things ghci friendly as much as possible. :reload is the fastest way to test stuff out usually, and REPL-friendly code is test-friendly too!

November 27, 2019 12:00 AM

November 26, 2019

Mark Jason Dominus

Chalupas

A chalupa is a fried tortilla that has been filled with meat, shredded cheese, or whatever. But it is also the name of the mayor of Prague from 2002–2011.

=
Tortilla  Tomáš

The boat-shaped food item is named after a kind of boat called a chalupa; I think the name is akin to English sloop. But in Czech a chalupa is neither a boat nor a comestible, but a cottage.

[ Other people whose names are accidentally boats ]

[ Addendum 20191201: I should probably mention that the two words are not pronounced the same; in Spanish, the “ch” is like in English “church”, and in Czech it is pronounced like in English “challah” or “loch”. To get the Spanish pronunciation in Czech you need to write “čalupa”, and this is indeed the way they spell the name of the fried-tortilla dish in Czech. ]

by Mark Dominus (mjd@plover.com) at November 26, 2019 06:41 PM

FP Complete

Implementing pid1 with Rust and async/await

A few years back, I wrote up a detailed blog post on Docker's process 1, orphans, zombies, and signal handling. Please read the gory details if you're interested, but the high level summary is:

  • On Linux, the process with ID 1 is treated specially, since it's typically an init process.
  • Process 1 is responsible for "reaping orphans," or calling waitpid on processes which have died after their parent processes died. (Yes, this sounds really morbid.)
  • Also, process 1 will by default not shut down in response to the interrupt signal, meaning Ctrl-C will not shut down the process.
  • In Docker, due to how it uses cgroups, the process you launch is usually process 1.
  • Instead of rewriting all of your processes to have support for reaping and responding to SIGINT, it's easier to write a separate pid1 executable and use it as your Docker entrypoint.

The solution from three years ago was a Haskell executable providing this functionality and a Docker image based on Ubuntu. I use that image for the base of almost all of my Docker work, and problem solved.

Signup for our Rust mailing list

Side note: as a few people pointed out to me, including u/valarauca14 on Reddit, Docker has a --init flag which addresses the concerns around a missing PID1 process. There are still some downsides to that versus an ENTRYPOINT calling a pid1 executable, including (1) needing remember the extra flag each time, and lack of support in higher level tooling. But this post isn't about solving a real problem anyway, it's about playing with Rust!

Rewrite it in Rust!

A few of the Haskellers on the FP Complete team have batted around the idea of rewriting pid1 in Rust as an educational exercise, and to have a nice comparison with Haskell. No one got around to it. However, when Rust 1.39 came out with async/await support, I was looking for a good use case to demonstrate, and decided I'd do this with pid1. While the real motivation here is to demonstrate Rust to those curious—especially my Haskell-favoring coworkers—there are some real advantages to Rust over Haskell for this use case:

  • The executables are smaller, which is nice.
  • It's easier to make a Rust static executable than a Haskell one (though the latter is possible). Usually, you need to ensure you have the right libc available.
  • Rust has no runtime and essentially 0 overhead for a situation like this, once the subprocess is launched.
  • Cross-compilation is easier, significantly. This can be great for creating a Docker image on Mac or Windows.

But to reiterate, this was mostly about learning and teaching. So the rest of this post will be about walking through the implementation and explaining some of the interesting points. We'll be hitting topics like:

  • Futures
  • async/.await syntax
  • Unsafe and FFI
  • Error handling

The full code for this is available on Github as pid1-rust-poc. Apologies to my many coworkers who insisted that I rename this to "the grim reaper."

Intended behavior

The program we're writing is intended to be called with a command line invocation such as pid1 command arg1 arg2 arg3. It will then:

  • Parse the command line arguments, exiting with an error if no command name is given.
  • Launch the child process requested.
  • Install a SIGCHLD signal handler, which will indicate that a child or orphan process is ready to be reaped.
  • Install a SIGINT signal handler which will send a SIGINT to the child process. This will make Ctrl-C work.
  • Start a loop that reaps a child each time SIGCHLD occurs.
  • As soon as the direct child exits, pid1 will exit. In the Docker case, this means that when the process launched by the user exits, the Docker container will exit.

There's a slight race condition in the above, since we launch the child process before the signal handlers are installed. I'm leaving that as-is to make the code a bit easier to understand, but feel free to improve this if you're looking for a challenge!

Additionally, as pointed out by /u/wmanley on Reddit, locking a mutex inside a signal handler may deadlock. If you're looking for another challenge, you can rewrite this using signal_hook::pipe.

Parse the command

You can get the list of command line arguments as an iterator. This iterator will have the current executable's name as the first value, which we want to ignore. We want to return a pair of the command name and a vector of the rest of the arguments. And if there's no command provided, we'll use a Result to capture the error. Putting that all together, the function looks like this:

fn get_command() -> Result<(String, Vec<String>), Pid1Error> {
    let mut args = std::env::args();
    let _me = args.next();
    match args.next() {
        None => Err(Pid1Error::NoCommandGiven),
        Some(cmd) => Ok((cmd, args.collect())),
    }
}

We have to capture the result of std::env::args() inside a mutable variable, since each subsequent call to next() mutates the value, essentially popping a value off a stack. We're able to ignore the first value, then pattern match on the second value. If it's None, then the command is missing, and we return an Err value.

Otherwise, if there's a Some value, we take that as the command, and collect all of the remaining arguments from args into a Vec. Some interesting things to point out, especially to Haskellers:

  • Rust has sum types, which is refers to as enums. Don't be fooled though: these are fully powered sum types. I personally think the separation of sum types (enums) and product types (structs) in Rust is an improvement over Haskell's data types, but that's a discussion for another time.
  • Pattern matching is beautiful and powerful.
  • Rust does not at all constrain side effects. Calling args.collect() consumes the args value, and is part of a larger expression. This feels foreign to a Haskeller, but is right in line with "normal" programming languages.
  • Even though Rust allows mutation and effects, the actual impact is really nicely constrained here, due to immutability by default. While this function could theoretically "fire the missiles," it behaves in a nice, almost-functional way here.
  • I think the double wrapping of parentheses in Ok((cmd, args)) looks weird, but it's at least logically consistent.
  • We're explicit in our errors in Rust in general, as opposed to using unchecked runtime exceptions. I've spoken about both systems a lot in the past, and my opinion is pretty simple: both systems work, and you should fully embrace whatever your current language is promoting as best practice. In Haskell, I feel fine using unchecked runtime exceptions. In Rust, I have no problem creating enums of error types and propagating explicitly.
    • I didn't show you the definition of Pid1Error yet, I'm saving that for later.

Enough of that, let's move on!

The type of main

Our application needs to be able to handle a few things:

  • If any errors occur, they should propagate out and produce an error message (from the tyep Pid1Error) to the user.
  • We want to use the new async/.await and Futures stuff in Rust 1.39 (we'll see how later).
  • If everything goes OK, we want to just exit gracefully.

We're going to represent all of this with the signature of the main function. This looks like:

async fn main() -> Result<(), Pid1Error>

By returning a Result, we're telling the compiler: if this function produces an Err variant, print an error message to stderr and set the exit code to a failure. By adding async, we're saying: this function may await some stuff. Under the surface, this means that main is actually producing a value that is an instance of Future, but we'll get to that later. For now, the important thing to understand is that, in order to run a function like this, we need some kind of a scheduler to be available.

One option would be to rename main to main_inner, and then write a main function like:

fn main() -> Result<(), Pid1Error> {
    async_std::task::block_on(main_inner())
}

However, there's a crate called async-attributes which let's us do something a little bit slicker:

#[async_attributes::main]
async fn main() -> Result<(), Pid1Error> {
    // all of our code with .await
}

This almost makes Rust feel like a language like Haskell, Go, or Erlang, with a green threaded system just built in. Instead, Rust requires a little more effort for getting this async code, but it's almost entirely userland-code instead of a runtime system. It also means you can easily swap out different schedulers.

Launching and error handling

Inside our main function, we start by calling the get_command function:

let (cmd, args) = get_command()?;

To the uninitiated, two questions may pop up:

  1. I thought that function returns a Result value, why does it look like it's returning a pair?
  2. What's that question mark?

Perhaps unsurprisingly, one of these answers the other. The question mark can be added to any expression in Rust to ease error handling. The exact details are more complicated than this, but the above code essentially converts to:

let (cmd, args) = match get_command() {
    Ok(pair) => pair,
    Err(e) => return Err(e),
};

In other words, if the value is an Ok, it continues the current function with that value. Otherwise, it exits this function, propagating the error value itself. Pretty nice for a single character! Explicit error handling without much noise.

The next line is a little more interesting:

let child = std::process::Command::new(cmd).args(args).spawn()?.id();

We create a new command with the cmd value, set its argument to args, and then spawn the process. Spawning may fail, so it returns a Result. We're able to put the ? in the middle of the expression, and then continue chaining additional method calls. That's really slick, and composes very nicely with the .await syntax we'll see in a bit.

However, there's one curious bit here: spawn() doesn't use Pid1Error for indicating something went wrong. Instead, it uses std::io::Error. So how does the std::io::Error become a Pid1Error? There's a special trait (like a typeclass in Haskell, or interface in Java) called From in Rust. And now we can look at our definition of Pid1Error and the implementation of the From trait:

#[derive(Debug)]
enum Pid1Error {
    IOError(std::io::Error),
    NoCommandGiven,
    ChildPidTooBig(u32, std::num::TryFromIntError),
}

impl std::convert::From<std::io::Error> for Pid1Error {
    fn from(e: std::io::Error) -> Self {
        Pid1Error::IOError(e)
    }
}

It's not necessary to be this verbose; there are helper crates available providing helper attributes for more easily deriving this trait implementation. But I still prefer being verbose, and don't mind a bit of boilerplate like this.

Converting to pid_t

The child value we got above is of type u32, meaning "unsigned 32-bit integer." This is a reasonable representation for a child PID, since they cannot be negative. However, in libc the type pid_t is represented as a signed integer: type pid_t = i32. The reason for this distinction isn't documented, but it makes sense: libc has some functions that use negative values for special cases, like sending signals to entire process groups. We'll see one of those later.

Anyway, casting from a u32 to a i32 may fail. Languages like C and even Haskell encourage unchecked casting. But the default way to do this in Rust is more explicit:

use std::convert::TryInto;
let child: libc::pid_t = match child.try_into() {
    Ok(x) => x,
    Err(e) => return Err(Pid1Error::ChildPidTooBig(child, e)),
};

The TryInto trait defines a method try_into() which we want to use. In Rust, you need to use a trait to have its methods available. Fortunately, the compiler is smart about this and provides helpful error messages. Then we pattern match on the Result and return a Pid1Error::ChildPidToBig variant if the conversion fails.

You may be wondering why we used this pattern matching instead of ?. With the right From implementation, ? would work just fine. However, if you want to include additional context with your error, like the value we were trying to convert, you need to do a bit more work like above. Alternatively, you can play with the map_err method.

Filicide

Now that we know the process ID of the child, we can install a signal handler to capture any incoming SIGINTs, and send a signal ourselves to the child. Let's start with the callback that will actually send the SIGINT along.

let interrupt_child = move || {
    unsafe {
        libc::kill(child, libc::SIGINT); // ignoring errors
    }
};

Let's start from the inside out. libc::kill is a direct FFI call to the C library's kill function, which is how you send signals. We pass in the child PID and the signal we want to send. This function can result in an error result, and ideally we would handle that correctly in Rust. But we're just ignoring such errors here.

Moving out, the next thing we see is unsafe. The FFI calls to libc are all marked as unsafe. You can read more about unsafe in the Rust book.

Next, we see this weird || { ... } syntax. The pipes are used for defining a lambda/closure. We could put a comma-separated list of arguments inside the pipes, but we don't have any. Since we're trying to create a callback that will be used later, some kind of lambda is necessary.

Finally, the move. Inside our lambda, we refer to the child variable, which is defined outside of the closure. This variable is captured in the closure's environment. By default, this is captured via a borrow. This gets us into lifetime issues, where the lifetime of the closure itself must be less than or equal to the lifetime of child itself. Otherwise, we'd end up with a closure which refers to a piece of memory that's no longer being maintained.

move changes this, and causes the child value to instead be moved into the environment of the closure, making the closure the new owner of the value. Normally in Rust, this would mean that child can no longer be used in the original context, since it's been moved. However, there's something special about child: it's an i32 value, which has an implementation of Copy. That means that the compiler will automatically create a copy (or clone) of the value when needed.

OK! Now that we have our callback, we're going to use the really helpful signal-hook crate to install a handler for SIGINTs:

let sigid: signal_hook::SigId =
    unsafe { signal_hook::register(signal_hook::SIGINT, interrupt_child)? };

This register call is also unsafe, so we have an unsafe block. We pass in both SIGINT and the interrupt_child callback. And we stick a question mark at the end in case this fails; if so, our whole program will exit, which seems reasonable. We capture the resulting sigid so we can unregister this handler later. It's honestly not really necessary in a program like this, but why not.

The rest of our main function looks like this:

// something about handling the reaping of zombies...

signal_hook::unregister(sigid);
Ok(())

This unregisters the handler and then uses Ok(()) to indicate that everything went fine. Now we just need to deal with that reaping business.

Futures, Streams, signals, tasks and wakers

The last thing we need to do is reap the orphans in a loop, stopping when the direct child we spawned itself exits. Using the libc blocking waitpid call, this would actually work just fine as a normal loop with blocking system calls. Since our pid1 program doesn't have anything else to do, the blocking calls will not tie up an otherwise-useful system thread.

However, the goal of this exercise is to use the new async/.await syntax and Futures, and to use only non-blocking calls. So that's what we're going to do! To do this, we're going to need to talk about tasks. A task is similar to a thread, but is implemented in pure Rust using cooperative multithreading. Instead of the OS scheduling things, with tasks:

  • There's a scheduler inside a Rust library, such as async-std or tokio
  • Tasks define their work in terms of the Future trait (which we'll get to in a bit)
  • The async/.await syntax provides a much more user-friendly interface versus the raw Futures stuff
  • Tasks are able to indicate that they are waiting for something else to be ready, in which case
    • They don't tie up an OS thread blocking
    • The scheduler will wake up the task when the data is ready

We want the ability to "block" until a new child thread has died. Our application will be notified of this by the SIGCHLD signal. We then want to be able to generate a Stream of values indicating when a child process has died. A Stream is a slight extension of a Future which allows multiple values to be produced instead of just a single value. To represent this, we have a Zombies struct:

struct Zombies {
    sigid: signal_hook::SigId,
    waker: Arc<Mutex<(usize, Option<Waker>)>>,
}

This holds onto the SigId generating when we register the callback action, the same as we had from the SIGINT above. It also has a waker field. This waker follows the common pattern of Arc (atomic reference counted) around a Mutex around some data. This allows for reading and writing data from multiple threads with explicit locking, thereby avoiding race conditions. Rust is very good at using the type system itself to avoid many race conditions. For example, try replacing the Arc with an Rc (non-atomic reference counted) and see what happens.

Within out Arc<Mutex<...>>, we are storing a pair of values:

  • A usize, which is the number of zombies that still need to be reaped. Each time we get a SIGCHLD, we want to increment it. Each time we return a value from our Stream, we want to decrement it.
  • An Option<Waker>. This is how we tie into the task system.
    • When we are inside our task and ask for a zombie, we'll check the usize.
      • If it's greater than 0, we'll decrement it and keep going.
      • If it's 0, then we want to go to sleep until a new SIGCHLD arrives, and then get woken up. In that case, we'll set the Option<Waker> to the Waker for the current task.
    • When we receive a SIGCHLD, we'll first increment the usize, and then check if there's a value inside Option<Waker>. If present, we'll trigger it.

OK, enough talking about code. Let's look at the implementation of Zombies.

New Zombies

Within our impl Zombies { ... }, we define a new function. This is not an async function. It will do its work synchronously, and return once everything is set up. First we're going to create our Arc<Mutex<...>> bit and make a clone of it for a callback function:

let waker = Arc::new(Mutex::new((0, None)));
let waker_clone = waker.clone();

Next, the callback function, which should be called each time we get a SIGCHLD. Remember our goal: to increment the counter and call the waker if present.

let handler = move || {
    let mut guard = waker_clone.lock().unwrap();
    let pair: &mut (usize, Option<Waker>) = &mut guard;
    pair.0 += 1;
    match pair.1.take() {
        None => (),
        Some(waker) => waker.wake(),
    }
};

We use a move closure to capture the waker_clone. Unlike previously with the usize child value, our Arc<Mutex<...>> is not a Copy, so we need to explicit make our clone. Next, we lock the mutex. The lock may fail, which we handle with unwrap(). This will cause a panic. Generally that's not recommended, but if taking a lock on a mutex fails, it means you have a fundamental flaw in your program. Once we have a MutexGuard, we can use it to get a mutable reference to the pair of the count and the waker.

Incrementing the count is easy enough. So is calling waker.wake(). However, we first have to call take() to get the value inside the Option and pattern match. This also replaces the waker with a None, so that the same Waker will not be triggered a second time.

By the way, if you're looking to code golf this, you can get functional with a call to map:

pair.1.take().map(|waker| waker.wake());

But personally I prefer the explicit pattern matching. Maybe it's my Haskeller ways that make me uncomfortable about performing actions inside a map, who knows.

Finally, we can finish off the new function by registering the handler and returning a Zombies value with the Arc<Mutex<...>> and the new signal ID.

let sigid = unsafe { signal_hook::register(signal_hook::SIGCHLD, handler)? };
Ok(Zombies { waker, sigid })

Dropping Zombies

When we're done with the Zombies value, we'd like to restore the original signal handler for SIGCHLD. For our application, it doesn't actually make a difference, but it may be better in general. In any event, an implementation of Drop is easy enough:

impl Drop for Zombies {
    fn drop(&mut self) {
        signal_hook::unregister(self.sigid);
    }
}

Streaming

In order to work with the async system, we need something Future-like. As mentioned though, instead of producing a single value, we'll produce a stream of values to indicate "there's a new zombie to reap." To handle that, we'll instead use the Stream trait.

There's no additional information available each time a zombie is available, so we'll use a () unit value to represent the zombie. We could define a new struct, or perhaps do something fancy where we capture the time when the signal is received. But none of that is necessary. Here's the beginning of our trait implementation:

impl Stream for Zombies {
    type Item = ();
    fn poll_next(self: Pin<&mut Self>, cx: &mut Context) -> Poll<Option<()>> {
        unimplemented!()
    }
}

We have an associated type Item set to (). Our poll_next receives a pinned, mutable reference to the Zombies value itself, as well as a mutable reference to the Context of the task that requested a value. We'll return a Poll<Option<()>>, which can be one of three values:

  • Poll::Ready(Some()) means "There's a zombie waiting for you right now."
  • Poll::Pending means "There isn't a zombie waiting right now, but there will be in the future."
  • Poll::Ready(None) means "I know that there will be no more zombies." In reality, this case can never occur for us, and therefore we'll never produce that value.

Now let's look at the implementation. The first thing we're going to do is lock the waker and see if there's a waiting zombie:

let mut guard = self.waker.lock().unwrap();
let pair = &mut guard;
if pair.0 > 0 {
    // there's a waiting zombie
} else {
    // there isn't a waiting zombie
}

In the waiting zombie case (pair.0 > 0), we want to decrement the counter and then return our Poll::Ready(Some(())). Easy enough:

pair.0 -= 1;
Poll::Ready(Some(()))

And when there isn't a waiting zombie, we want to set the Waker to our current task's Waker (discovered via the Context), and then return a Poll::Pending:

pair.1 = Some(cx.waker().clone());
Poll::Pending

And that's it, we can now produce a stream of zombies! (Sounds like a good time to move to Hollywood, right?)

Reaping

We want to now consume that stream of zombies, reaping them in the process. We want to do this until our direct child process exits. Some information about how the system calls work for reaping:

  • There's a waitpid syscall we're going to use
  • If you tell it to reap the special process -1, it will reap any process available.
  • If you give it the WNOHANG option, it will be a non-blocking system call, returning a 0 if nothing is available to reap or -1 if there is an error.
  • It takes an additional mutable pointer to return status information, which we don't care about.
  • If it actually reaped a process, it will return the ID of that process.

Let's create our infinite loop of waiting forever for zombies:

while let Some(()) = self.next().await {
    // time to reap
}

panic!("Zombies should never end!");

The Stream trait doesn't represent the possibility of an infinite stream, so we need to do two things:

  1. Pattern match in the while using let Some(()).
  2. Add a panic! (or just an Ok(())) after the loop to handle the case that the compiler thinks can happen: that self.next().await will return a None.

Let's go back to that .await bit though. This is the real magic of the new async/.await syntax in Rust 1.39. .await can be appended to any expression which contains an impl Future. Under the surface, the compiler is converting this into callback-laden code. From prior experience, writing that code manually is at best tedious, especially:

  • when you have to deal with the borrow checker
  • when you have some kind of looping

However, as you can see here, the code is trivial to write, read, and explain. This is a huge usability improvement for Rust. There's another incremental improvement I can potentially see here:

async for () in self {
  ...
}

But that's a minor improvement, and would require standardizing the Stream trait. I'm more than happy with the code above.

Each step of that loop, we need to call waitpid and check its result. We have four cases:

  • It's the child we're waiting on: exit the function.
  • It's a different child: ignore.
  • It's a 0, indicating there wasn't a waiting zombie: that's a program error, because we already received a SIGCHLD.
  • It's a negative value, indicating the system call failed. Time to error out.

You can slice up the error handling differently, and decide to use panic!ing differently than I have, but here's my implementation:

let mut status = 0;
let pid = unsafe { libc::waitpid(-1, &mut status, libc::WNOHANG) };
if pid == till {
    return Ok(());
} else if pid == 0 {
    panic!("Impossible: I thought there was something to reap but there wasn't");
} else {
    return Err(Pid1Error::WaitpidFailed(pid));
}

Back to main

And finally, to tie it all together, let's see what the complete end of our main function looks like, including the zombie reaping code:

let sigid: signal_hook::SigId =
    unsafe { signal_hook::register(signal_hook::SIGINT, interrupt_child)? };

Zombies::new()?.reap_till(child).await?;

signal_hook::unregister(sigid);
Ok(())

And with that, we have a non-blocking, interrupt driven, user friendly grim reaper.

Conclusion

That was a detailed walkthrough of a fairly simple program. Hopefully the takeaway, however, was how simple it was to make this happen. I believe the async/.await syntax is a real game changer for Rust. While I've strongly believed in a green threaded runtimes for concurrency applications in the past, such a powerful system giving safety guarantees is very appealing. I look forward to using this in anger and comparing against both my previous tokio callback-ridden code, as well as Haskell I would write.

If you want to hear more about my endeavors here, please let me know this is a topic you're interested in. You can ping me on Twitter @snoyberg.

Also, if you want to hear more from FP Complete about Rust, please considering signing up for our mailing list.

Signup for our Rust mailing list

Are you interested to hear more about commercial services at FP Complete around software, DevOps, training, and consulting? Contact us for a free consultation with one of our engineers.

Free engineering consultation with FP Complete

November 26, 2019 09:40 AM

November 25, 2019

Monday Morning Haskell

Digging Into Rust's Syntax

digging_into_syntax.jpg

Last time we kicked off our study of Rust with a quick overview comparing it with Haskell. In this article, we'll start getting familiar with some of the basic syntax of Rust. The initial code looks a bit more C-like. But we'll also see how functional principles like those in Haskell are influential!

For a more comprehensive guide to starting out with Rust, take a look at our Rust video tutorial!

Hello World

As we should with any programming language, let's start with a quick "Hello World" program.

fn main() {
  println!("Hello World!");
}

Immediately, we can see that this looks more like a C++ program than a Haskell program. We can call a print statement without any mention of the IO monad. We see braces used to delimit the function body, and a semicolon at the end of the statement. If we wanted, we could add more print statements.

fn main() {
  println!("Hello World!");
  println!("Goodbye!");
}

There's nothing in the type signature of this main function. But we'll explore more further down.

Primitive Types and Variables

Before we can start getting into type signatures though, we need to understand types more! In another nod to C++ (or Java), Rust distinguishes between primitive types and other more complicated types. We'll see that type names are a bit more abbreviated than in other languages. The basic primitives include:

  1. Various sizes of integers, signed and unsigned (i32, u8, etc.)
  2. Floating point types f32 and f64.
  3. Booleans (bool)
  4. Characters (char). Note these can represent unicode scalar values (i.e. beyond ASCII)

We mentioned last time how memory matters more in Rust. The main distinction between primitives and other types is that primitives have a fixed size. This means they are always stored on the stack. Other types with variable size must go into heap memory. We'll see next time what some of the implications of this are.

Like "do-syntax" in Haskell, we can declare variables using the let keyword. We can specify the type of a variable after the name. Note also that we can use string interpolation with println.

fn main() {
  let x: i32 = 5;
  let y: f64 = 5.5;
  println!("X is {}, Y is {}", x, y);
}

So far, very much like C++. But now let's consider a couple Haskell-like properties. While variables are statically typed, it is typically unnecessary to state the type of the variable. This is because Rust has type inference, like Haskell! This will become more clear as we start writing type signatures in the next section. Another big similarity is that variables are immutable by default. Consider this:

fn main() {
  let x: i32 = 5;
  x = 6;
}

This will throw an error! Once the x value gets assigned its value, we can't assign another! We can change this behavior though by specifying the mut (mutable) keyword. This works in a simple way with primitive types. But as we'll see next time, it's not so simple with others! The following code compiles fine!

fn main() {
  let mut x: i32 = 5;
  x = 6;
}

Functions and Type Signatures

When writing a function, we specify parameters much like we would in C++. We have type signatures and variable names within the parentheses. Specifying the types on your signatures is required. This allows type inference to do its magic on almost everything else. In this example, we no longer need any type signatures in main. It's clear from calling printNumbers what x and y are.

fn main() {
  let x = 5;
  let y = 7;
  printNumbers(x, y);
}

fn printNumbers(x: i32, y: i32) {
  println!("X is {}, Y is {}", x, y);
}

We can also specify a return type using the arrow operator ->. Our functions so far have no return value. This means the actual return type is (), like the unit in Haskell. We can include it if we want, but it's optional:

fn printNumbers(x: i32, y: i32) -> () {
  println!("X is {}, Y is {}", x, y);
}

We can also specify a real return type though. Note that there's no semicolon here! This is important!

fn add(x: i32, y: i32) -> i32 {
  x + y
}

This is because a value should get returned through an expression, not a statement. Let's understand this distinction.

Statements vs. Expressions

In Haskell most of our code is expressions. They inform our program what a function "is", rather than giving a set of steps to follow. But when we use monads, we often use something like statements in do syntax.

addExpression :: Int -> Int -> Int
addExpression x y = x + y

addWithStatements ::Int -> Int -> IO Int
addWithStatements x y = do
  putStrLn "Adding: "
  print x
  print y
  return $ x + y

Rust has both these concepts. But it's a little more common to mix in statements with your expressions in Rust. Statements do not return values. They end in semicolons. Assigning variables with let and printing are expressions.

Expressions return values. Function calls are expressions. Block statements enclosed in braces are expressions. Here's our first example of an if expression. Notice how we can still use statements within the blocks, and how we can assign the result of the function call:

fn main() {
  let x = 45;
  let y = branch(x);
}

fn branch(x: i32) -> i32 {
  if x > 40 {
    println!("Greater");
    x * 2
  } else {
    x * 3
  }
}

Unlike Haskell, it is possible to have an if expression without an else branch. But this wouldn't work in the above example, since we need a return value! As in Haskell, all branches need to have the same type. If the branches only have statements, that type can be ().

Note that an expression can become a statement by adding a semicolon! The following no longer compiles! Rust thinks the block has no return value, because it only has a statement! By removing the semicolon, the code will compile!

fn add(x: i32, y: i32) -> i32 {
  x + y; // << Need to remove the semicolon!
}

This behavior is very different from both C++ and Haskell, so it takes a little bit to get used to it!

Tuples, Arrays, and Slices

Like Haskell, Rust has simple compound types like tuples and arrays (vs. lists for Haskell). These arrays are more like static arrays in C++ though. This means they have a fixed size. One interesting effect of this is that arrays include their size in their type. Tuples meanwhile have similar type signatures to Haskell:

fn main() {
  let my_tuple: (u32, f64, bool) = (4, 3.14, true);
  let my_array: [i8; 3] = [1, 2, 3];
}

Arrays and tuples composed of primitive types are themselves primitive! This makes sense, because they have a fixed size.

Another concept relating to collections is the idea of a slice. This allows us to look at a contiguous portion of an array. Slices use the & operator though. We'll understand why more after the next article!

fn main() {
  let an_array = [1, 2, 3, 4, 5];
  let a_slice = &a[1..4]; // Gives [2, 3, 4]
}

What's Next

We've now got a foothold with the basics of Rust syntax. Next time, we'll start digging deeper into more complicated types. We'll discuss types that get allocated on the heap. We'll also learn the important concept of ownership that goes along with that.

by James Bowen at November 25, 2019 03:30 PM

November 24, 2019

Joachim Breitner

Faster Winter: Statistics (the making-of)

(This is an appendix to the “faster winter” series, please see that post for background information.)

Did you like the graph and the stats that I produced? Just for completeness, I am including the various scripts I used. Nothing super exciting to see here, but maybe someone finds this useful.

This little shell one-liner collects the run-time statistics for each commit in the interesting range (line-wrapped for your convenience):

for h in $(git log 1cea7652f48fad348af914cb6a56b39f8dd99c6a^..5406efd9e057aebdcf94d14b1bc6b5469454faf3 --format=%H)
do
  echo -n "$h"
  git checkout -q "$h"
  cabal new-build -v0
  echo -n ":"
  rm -f stats/$h.txt
  for i in $(seq 1 5)
  do
    cabal -v0 new-run exe:wasm-invoke -- -w loop.wasm  -f canister_init +RTS -t >/dev/null 2>> stats/$h.txt
    echo -n .
  done
  echo
done

A small Perl script takes the minimum for each measurement across the five runs, and produces a CSV file:

#!/usr/bin/perl

use List::Util qw(min);

my @alloc;
my @in_use;
my @time;

while (<>) {
  m!<<ghc: (\d+) bytes, \d+ GCs, \d+/\d+ avg/max bytes residency \(\d+ samples\), (\d+)M in use, [\d.]+ INIT \(([\d.]+) elapsed\), [\d.]+ MUT \(([\d.]+) elapsed\), [\d.]+ GC \(([\d.]+) elapsed\) :ghc>>! or die $!;
  push @alloc, 0+$1;
  push @in_use, $2;
  push @time, $3+$4+$5;
}

printf "%d;%d;%f\n", min(@alloc), min(@in_use), min(@time);

To create a full file for all the commits in the range that have files, I used this bash one-liner (again line-wrapped for your convenience):

echo 'commit;allocations;memory;time' > stats.csv
for h in $(git log 1cea7652f48fad348af914cb6a56b39f8dd99c6a^..5406efd9e057aebdcf94d14b1bc6b5469454faf3 --format=%H|tac)
do
  git log -n 1 --oneline $h
  test -f stats/$h.txt && echo "$(echo $h|cut -c-7);$(./tally.pl < stats/$h.txt)" | tee -a stats.csv
done

The stats can be turned into the graphc using pgfplots by compiling this LaTeX file:

\documentclass[class=minimal]{standalone}
\usepackage{mathpazo}
\usepackage{pgfplots}
\definecolor{skyblue1}{rgb}{0.447,0.624,0.812}
\definecolor{scarletred1}{rgb}{0.937,0.161,0.161}
\pgfplotsset{width=12cm,compat=newest}

% From https://tex.stackexchange.com/a/63340/15107
\makeatletter
\pgfplotsset{
    /pgfplots/flexible xticklabels from table/.code n args={3}{%
        \pgfplotstableread[#3]{#1}\coordinate@table
        \pgfplotstablegetcolumn{#2}\of{\coordinate@table}\to\pgfplots@xticklabels
        \let\pgfplots@xticklabel=\pgfplots@user@ticklabel@list@x
    }
}
\makeatother

\begin{document}
\begin{tikzpicture}

\pgfplotsset{every axis/.style={ymin=0}}
\begin{semilogyaxis}[
  skyblue1,
  scale only axis,
  axis y line*=left,
  ylabel=Allocation (bytes),
  flexible xticklabels from table={stats.csv}{[index]0}{col sep=semicolon},
  xticklabel style={rotate=90, anchor=east, text height=1.5ex, font=\ttfamily, color=black},
  xtick=data,
  ]
\addplot[const plot mark mid, color=skyblue1]
  table [x expr=\coordindex+1, y index=1, col sep=semicolon] {stats.csv};
\end{semilogyaxis}

\begin{semilogyaxis}[
  green,
  scale only axis,
  axis y line*=right,
  ylabel=Memory (MB),
  x tick style={draw=none},
  xtick=\empty,
  ]
\addplot[const plot mark mid, color=green]
  table [x expr=\coordindex+1, y index=2, col sep=semicolon] {stats.csv};
\end{semilogyaxis}


\begin{semilogyaxis}[
  red,
  scale only axis,
  axis y line*=right,
  ylabel=Time (seconds),
  x tick style={draw=none},
  xtick=\empty,
  ]
\pgfplotsset{every outer y axis line/.style={xshift=2cm}, every tick/.style={xshift=2cm}, every y tick label/.style={xshift=2cm} }
\addplot[const plot mark mid, color=red]
  table [x expr=\coordindex+1, y index=3, col sep=semicolon] {stats.csv};
\end{semilogyaxis}
\end{tikzpicture}
\end{document}

And finally this Perl script allows me to paste any two lines from the CSV file and produces appropriate Markdown for the “improvement” lines in my posts:

#!/usr/bin/perl

my $first = 1;

my $commit;
my $alloc;
my $in_use;
my $time;

while (<>) {
  /(.*);(.*);(.*);(.*)/ or die;
  unless ($first) {
    printf "**Improvement**: Allocations: %+.2f%%  Memory: %+.2f%%  Time: %+.2f%% (Commit [%s...%s](http://github.com/dfinity/winter/compare/%s...%s))\n",
      (100 * ($2/$alloc - 1)),
      (100 * ($3/$in_use - 1)),
      (100 * ($4/$time - 1)),
      $commit,
      $1,
      $commit,
      $1;
  }
  $first = 0;
  $commit = $1;
  $alloc = $2;
  $in_use = $3;
  $time = $4;
}

by Joachim Breitner (mail@joachim-breitner.de) at November 24, 2019 10:03 PM

Faster Winter 7: The Zipper

(This is the seventh optimization presented in the “faster winter” series, please see that post for background information.)

The last bit of performance could be considered a domain-specific optimization, as one might describe it as “introducing a control stack to the interpreter”. But in a different light, one could consider it the introduction of a more appropriate data structure, by applying a “zipper”-like transformation to the existing data structure.

The problem is that the state of the system (datatype Code) is a stack of values and a stack of instructions. Simplifying this for this post, we might have

data Code = Code [Value] [Instr]
data Instr
  = Const Value | Add | Sub | Return
  | Labled Int Code

The interpreter gets such a Code, but does not always just execute the top-most instruction: If that is a Labeled instruction, it has to execute the next instruction in the argument of that Labeled. (It is not very important at this point to understand what a Labeled is used for). So we might have a Code that looks like the following:

c1 = Code [] [Labeled 1 (Code [2] [Labeled 2 (Code [3,4] [Add]), Sub]), Return]

The next instruction to execute is actually the Add. But in order to find that, the function step has to look under the first Labeled, look under the second Labeled, then execute step (Code [3,4] [Add]) = Code [7] [], and finally wrap it again in the two Labeled, to produce:

c2 = Code [] [Labeled 1 (Code [2] [Labeled 2 (Code [7] []), Sub]), Return]

Then eval calls step again, and step has to look inside the Labeled again to find the next instruction to execute.

It would be easier if the next instruction to execute would be presented to step more conveniently, right as a field of Code. But in order to do this, we have to move the Labeled entries “out of the way”. I do that by adding a new, first parameter to Code where I keep a stack of all the Label constructor that were in the way, in reverse order. So the c1 above would now be

data Code = Code Control [Value] Instr
data Control = Empty | Labeled Int Code

c1' = Code (Labeled 2 (Code (Labeled 1 (Code Empty [] [Return])) [2] [Sub]) [3,4] [Add]

Can you see how this relates to c1 above? The important piece here is that the interpreter finds the next instruction to execute always at the head of the instruction list right of the outermost code, and as long as there is something to execute there, it doesn't have to touch the Control stack at all.

This required touching some more lines of code than the previous optimizations, but doing so didn't require much creativity, as the old and new Code types are in clear correspondance, and that guides me in how to use adjust the code. And it’s certainly worth it:

Improvement: Allocations: -46.17% Time: -36.88% (Commit e66f1e0...57f3e9d)

by Joachim Breitner (mail@joachim-breitner.de) at November 24, 2019 09:57 PM

Mark Jason Dominus

The least common divisor and the greatest common multiple

One day Katara reported that her middle school math teacher had gone into a rage (whether real or facetious I don't know) about some kids’ use of the phrase “greatest common multiple”. “There is no greatest common multiple!” he shouted.

But that got me thinking. There isn't a greatest common multiple, but there certainly is a least common divisor; the least common divisor of and is , for any and .

The least common multiple and greatest common divisor are beautifully dual, via the identity $$\operatorname{lcm}(a,b)\cdot\gcd(a,b) = ab,$$ so if there's a simple least common divisor I'd expect there would be a greatest common multiple also. I puzzled over this for a minute and realized what is going on. Contrary to Katara's math teacher, there is a greatest common multiple if you understand things properly.

There are two important orderings on the positive integers. One is the familiar total ordering by magnitude: $$0 ≤ 1≤ 2≤ 3≤ 4≤ \ldots.$$ (The closely related is nearly the same: just means that and .)

But there is another important ordering, more relevant here, in which the numbers are ordered not by magnitude but by divisibility. We say that only when is a multiple of . This has many of the same familiar and comforting properties that enjoys. Like , it is reflexive. That is, for all , because is a multiple of itself; it's .

is also transitive: Whenever and , then also , because if is a multiple of , and is a multiple of , then is a multiple of .

Like , the relation is also antisymmetric. We can have both and , but only if . Similarly, we can have both and but only if .

But unlike the familiar ordering, is only a partial ordering. For any given and it must be the case that either or , with both occurring only in the case where . does not enjoy this property. For any given or , it might be the case that or , or both (if ) or neither. For example, neither of and holds, because neither of and is a multiple of the other.

The total ordering lines up the numbers in an infinite queue, first , then , and so on to infinity, each one followed directly by its successor.

as described in the previous paragraph

The partial ordering is less rigid and more complex. It is not anything like an infinite queue, and it is much harder to draw. A fragment is shown below:

one node for thirty of the first 42 positive integers, arranged in a complex graph; further description in the main text

The nodes here have been arranged so that each number is to the left of all the numbers it divides. The number , which divides every other number, is leftmost. The next layer has all the prime numbers, each one with a single arrow pointing to its single divisor , although I've omitted most of them from the picture. The second layer has all the numbers of the form and where and are primes: , each one pointing to its prime divisors in the first layer. The third layer should have all the numbers of the form and , but I have shown only and . The complete diagram would extend forever to the right.

In this graph, “least” and “greatest” have a sort-of-geometric interpretation, “least” roughly corresponding to “leftmost”. But you have to understand “leftmost” in the correct way: it really means “leftmost along the arrows”. In the picture is left of , but that doesn't count because it's not left of 4 along an arrow path. In the ordering, and . Similarly “greatest” means “rightmost, but only along the arrows”.

A divisor of a number is exactly a node that can be reached from by following the arrows leftward. A common divisor of and is a node that can be reached from both and . And the greatest common divisor is the rightmost such node. For example, the greatest common divisor of and is the rightmost node that can be reached from both and ; that's . is right of but can't be reached from . is right of but can't be reached from . can be reached from both, but is right of . So the greatest common divisor is .

Is there a least common divisor of and ? Sure there is, it's the leftmost node that can be reached from both and . Clearly, it's always , regardless of what and are.

Going in the other direction, a multiple of is a node from which you can reach by following the arrows. A common multiple of and is one from which you can reach both and , and the least common multiple of and is the leftmost such node.

But what about the greatest common multiple, angrily denied by Katara's math teacher? It should be the rightmost node from which you can reach both and . The diagram extends infinitely far to the right, so surely there isn't a rightmost such node?

Not so! There is a rightmost node! is a multiple of for every , we have for every , and so zero is to the right of every other node. The diagram actually looks like this:

The same as the previous, but with zero added on the right margin.  There are no explicit connections with any of the other nodes, because in every case there are (infinite many) nodes on the path between, which are omitted from the diagram.

where I left out an infinite number of nodes in between and the rest of the diagram.

It's a bit odd to think of by itself there, all the way on the right, because in every other case, we have only when , and is the exception. But when you're thinking about divisibility, that's how you have to think about it: is least, as you expect, not because it's smallest but because it's a divisor of every number. And dually, is greatest, because it's a multiple of every number.

So that's the answer. Consideration of the seemingly silly question of the greatest common multiple has led us to a better understanding of the multiplicative structure of the integers, and we see that there is a greatest common multiple, which is exactly dual to the least common divisor, just as the least common multiple is dual to the greatest common divisor.

by Mark Dominus (mjd@plover.com) at November 24, 2019 07:30 PM

Joachim Breitner

Faster Winter 6: Simpler Code

(This is the sixth optimization presented in the “faster winter” series, please see that post for background information.)

The Wasm reference interpreter has a function step that performs one single one step of evaluation, by taking the state before (in a type called code), and returning the state after the step. The function eval calls step, checks if the result is “done” (no instructions left to do), and if it is not done, recursively calls eval again. This way, evaluation progresses step by step until it is done.

The Haskell port follows the same pattern of a single-step step and a driver eval, but it chose to write the code continuation passing style: Instead of returning, the function step takes a function that it passes the result to. So the code looks like this (slightly simplified):

type CEvalT m a = ReaderT Config (ExceptT EvalError m) a

step :: PrimMonad => Code -> (Code -> CEvalT m r) -> CEvalT m r
step c k =  … k new_c …

eval :: PrimMonad => Code -> CEvalT m (Stack Value)
eval c =
    if is_done c
    then stack c
    else step c eval

There must have been a good reason to prefer this style over the plain style, but I was curious if it was really helpful. So I changed it to the following, more straight-forward code:

type CEvalT m a = ReaderT Config (ExceptT EvalError m) a

step :: PrimMonad => Code -> CEvalT m Code
step c k =  … new_c …

eval :: PrimMonad => Code f m -> CEvalT f m (Stack Value)
eval c =
    if is_done c
    then stack c
    else step c >>= eval

And indeed, the simpler code worked better:

Improvement: Allocations: -9.6 Time: -16.91% (Commit eb8add3...e66f1e0)

Again, avoiding function values (as we construct them as the contination closure) might have helped here.

Or maybe the simpler code allowed GHC to notice that the Code value, which is simply a tuple with a different name, is constructed by step but immediatelly deconstructed by eval, and thus GHC could optimize that away (by “unboxing” the argument and/or result of step and simply passing the components of the tuple).

And finally, independent of all the performance questions, it also makes the code easier to understand.

by Joachim Breitner (mail@joachim-breitner.de) at November 24, 2019 11:55 AM

November 23, 2019

Chris Smith 2

CodeWorld Import by Hash

In short: CodeWorld has been extended with a new feature that makes it easy to import code across different projects and users. I discuss why I added this capability, how to use the feature, and what you can do with it.

Over eight years of developing and teaching mathematics and functional programming with CodeWorld, I have ruthlessly insisted on keeping it simple. To this end, I’ve discarded even the things that come standard with most programming languages — among them, a story for modularity and code reuse. CodeWorld is used for short exercises, to play around, to write a few dozen lines of code and see a result. It has never been a serious tool for programming in the large. One project is one text document, and it runs by itself. This simple rule keeps the UI clean and students’ mental model very simple.

But it hasn’t always been a bed of roses. Here, I want to talk about three challenges that have come up in the past:

  • Students have learned to do a lot of copy and paste, to reuse their drawings in new projects. This initially didn’t bother me much, since I’m not teaching software engineering practices. However, it encourages students to write complex expressions in a single top-level definition so that it’s easier to copy around. That’s not a good strategy.
  • Teachers have wanted to provide scaffolding and setup for assignments and classes, but struggled with their students copying boilerplate code. Fernando Alegre solved this by contributing modules of extra functionality to CodeWorld itself. But other projects, such as setting up virtual physics labs or biology simulations, have been abandoned.
  • Haskell community members have found creative uses for CodeWorld beyond the classroom, and have struggled with the limitation. Joachim Breitner even created a horrifying (but awesome) tool to help him write code in multiple files and then mush it all together in a single file to run inside CodeWorld, and used this to create the presentation for a talk at ICFP in 2017.

Clearly, there’s an opportunity to do better. And, indeed, one of the first issues in the CodeWorld bug tracker was for some kind of library project that students and teachers could use to define reusable components. Library projects, though, turned out to be a bad idea. Having two project types is quite complex for the children who are the primary users, and trying to share code with other students is even harder. How do we resolve names, or handle versioning?

Introducing: Import by Hash

The solution to all of this was to piggyback on the existing sharing system in CodeWorld, and allow projects to be imported by hash.

Importing a program by its hash in CodeWorld

The way this works is simple. First, you create your original code in its own project. Now run it. Now you’ll see a hash added to the URL, beginning with the letter ‘P’. You can just import this into another project, and any symbols exported from the module are now available in your other projects.

There are a few subtleties to keep in mind that might be surprising at first.

  • You can include a module header, if you choose, and it is useful for controlling exports. However, the module is imported by its hash rather than its module name, so the module name itself doesn’t matter.
  • Even if a project exists only to define things for reuse, it should compile and run on its own. So go ahead and use the main entry point (remember, that’s program in the educational dialect, or main in plain Haskell) to define a test or demo. These are not exported (or rather, they are exported but the name is mangled), because they would conflict with the entry point of the code that imports them.
  • Don’t go too crazy! While this does make organizing your code easier, it’s also easy to end up with long chains of dependencies, with the result that you might build a lot of code every time you compile a short file and your builds may time out.
  • If you give students your program hashes (beginning with “P”), they can also use those to get at the code you’ve written. Sometimes that’s not what you want. For instance, if your import is a unit test used for grading, you may want to hide exactly which test cases you’re checking. So you can also import deployed hashes, which have the same behavior, but cannot be used to access source code. To get a deployed hash, run your code, click Share, and then “Share Without Code”. You can copy the dhash parameter from that URL, and import it as a module.

What do I do with this?

Some of the use cases for import-by-hash in CodeWorld were mentioned above. As a student or self-motivated learner, you can easily import and reuse things you’ve defined in other projects. As a teacher or blogger, you can give your students/readers a link or import statement that they can use to get access to setup or scaffolding without too much boilerplate. But the use case I’m most interested in is to build and collect sets of useful educational environments.

Several years ago at TFPIE, I learned about Scott Walck’s library for letting students set up quantum physics experiments on light beams in a Haskell DSL. His library is available on Hackage. Today, Scott’s students have to set up a Haskell compiler, and interact with it via GHCi or a command line that shows the final observation. They cannot see the experiment so easily, and may not realize if they’ve described the setup incorrectly. Now, though, a dedicated teacher could write a graphical subset of Scott’s library in CodeWorld, and hand out an import statement for students to add to their code and watch these light-beam experiments take place, observe the configuration of lasers and filters, etc.

This is, of course, not the only opportunity. There’s room for designing easy-to-use programmatic environments to explore classical mechanics, circuits, ecology, probability, finance, AI and simple neural nets… the possibilities are endless. The DSL gives students a flexible way to try out complex and structured systems easily, while the web-based environment makes it low setup, and the graphics keeps it visual and interesting.

The significance of this change is that before, doing something like this would have meant sending a pull request to the CodeWorld project and convincing me it’s important enough to add to my public API. It is now as easy as just writing the code. The results can be shared via class notes, blogs, YouTube, etc., and doesn’t need to go through any central gatekeeper!

I hope you play around with this and that we find it leads to exciting places.

by Chris Smith at November 23, 2019 06:27 AM

November 22, 2019

Joachim Breitner

Faster Winter 5: Eta-Expanding ReaderT

(This is the fifth optimization presented in the “faster winter” series, please see that post for background information.)

Another good approach to performance turning is look at the code after GHC optimized it. So I planted a

{-# OPTIONS_GHC -ddump-simpl -dsuppress-coercions -dsuppress-unfoldings -dsuppress-module-prefixes #-}

at the top of Eval.hs, and looked through the code. This is not Haskell, but rather “GHC Core”, a simpler functional programming language that GHC uses internally. It is more verbose and less pretty, so it takes a bit of getting used to, but it’s nothing to be afraid of when you are a somewhat experienced Haskell developer.

There I found (much simplified) the following pattern:

step :: Instr -> Config -> IO Result
step e = case e of
  Add -> \c ->do stuff …
  Del -> \c ->do stuff …
  …

That’s bad! Yes, Haskell is a functional language, and passing around anonymous functions is very nice to write expressive code, and for most purposes it is not too slow … but in an inner loop, you really don’t want any such closures. So where did this come from? And as expected, the Haskell source did not have those inner lambdas. Instead, it was using a very innocent looking monad transformer:

step :: Instr -> ReaderT Config IO Result
step e = case e of
  Add -> do stuff …
  Del -> do stuff …
  …

A ReaderT r m a is just a different way of writing r -> m a that allows us to use do-notation or the monad combinators without having to pass the r around explicity, and as such it is indeed very convenient. But not as efficient as if we had written

step :: Instr -> Config -> IO Result
step e c = case e of
  Add ->do stuff …
  Del ->do stuff …
  …

where the step function takes two arguments right away, and no anonymous functions are created.

Why doesn’t our amazing Haskell compiler figure out that this would be better? Because it is not better in all situations: If we store step e :: ReaderT Config IO Result somewhere and and use it many times, with the same e but passing many different c :: Config, then we have to do the case e analysis only once. This can sometimes be better, so the compiler has to leave it in that form, in case we did it intentionally.

(Incidentially, the question of how to allow the compiler to eta-expand more functions seems to eternally haunt me, and its pursuit even led to a PhD thesis.

So how can we fix it? One relatively crude way is to shove it into the compiler face that we really want step to be a function with two parameters by wrapping the whole body in, well, a lambda.. But we still want to use the Reader monad in the body of step

So I came up with this:

step :: Instr -> ReaderT Config IO Result
step e = ReaderT $ \c -> ($ c) $ runReaderT $ case e of
  Add ->do stuff …
  Del ->do stuff …
  …

Now the \c -> is outside the case, the compiler adds it to the arguments of step and we get the code that we want (confirmed by a quick peek at the Core).

Improvement: Allocations: -23.20% Time: -23.00% (Commit f5a0dd2...894070f)

I used this pattern in more than once place, so I wanted to abstract it into a little helper definition. But that’s not so easy: If I just write

etaReaderT :: ReaderT r m a -> ReaderT r m a
etaReaderT m = ReaderT $ \c -> ($ c) $ runReaderT m

step :: Instr -> ReaderT Config IO Result
step e = etaReaderT $ case e of
  Add ->do stuff …
  Del ->do stuff …
  …

then the whole thing doesn't work any more! Because now, the case e is again “outside” the \c ->.

I whined on twitter about this, and Sebastian Graf reminded me helpfully of GHC.Exts.oneShot, a little magic function that was added to GHC 5 years ago … by some forgetful person: me.

If we use this in the right place inside etaReaderT it tells GHC in a soothing voice “hey! it’s ok! you can move this lambda out of cases. believe me. it’s gonna be ok”. And with this, it works:

etaReaderT :: ReaderT r m a -> ReaderT r m a
etaReaderT = ReaderT . oneShot . runReaderT

I wonder if this function would make a good addition to Control.Monad.Trans.Reader.

Incidentally, if you look at the code at the end of all my optimizations, there is no mention of etaReaderT any more: Subsequent optimizations simplified the code so much that eventually GHC was able to be able to do this transformation without my help.

by Joachim Breitner (mail@joachim-breitner.de) at November 22, 2019 09:59 AM

November 21, 2019

Michael Snoyman

Boring Haskell Manifesto

Goal: how to get Haskell into your organization, and how to make your organization more productive and profitable with better engineering.

I wrote this content 1.5 years ago after conversations with people at LambdaConf 2018. I discussed it offline with some people (at least… I think I did). Then I promptly did nothing else with it. After having some conversations with people at Functional Conf 2019, I decided it was time to resurrect and post this.

If the ideas I’m sharing here resonate with you, and you’re interested in getting involved with spreading this further, please reach out to me (privately is great, michael at snoyman dot com). I have additional, more concrete ideas on how to make some of this a reality, which I’ll be sharing with people offline.

Thanks to everyone at Functional Conf for the inspiration and motivation to move ahead with this!


Haskell is in many ways a revolutionary language. Many languages in widespread use today are incremental changes on previous languages. However, Haskell doesn’t fit this model. Concepts like referential transparency, purely functional programming, laziness, and immutability are a stark departure from common programming approaches today.

Most any Haskeller would argue that these radical changes are well justified, and deliver great benefit. At the same time, this inherent culture of making revolutionary changes attracts a certain mindset to the language. As a result, we end up in a situation where Haskell has essentially two distinct (and overlapping) subcultures:

  • Explore interesting and revolutionary concepts in computer science, software engineering, and mathematics
  • Make better software

Again, these are overlapping subcultures. The entire history of Haskell is cases of esoteric, academic, intellectual, and “useless” concepts becoming an elegant solution to challenging problems. Monads are probably the most prominent example of this, and we’re seeing a reality where many other languages are slowly adopting the concept to solve problems in concurrency and error handling.

On the other hand, not every new concept turns into one of these fundamental and useful techniques. And even for those that do: finding the most practical way to leverage the technique is an arduous, time-consuming process.

Exploring these concepts can be fun, rewarding, and—long term—a huge benefit for productivity. Short and medium term, however, this exploration can lead to slower and less reliable results. As a company or project manager assessing Haskell for a project, this uncertainty can thwart the possibility of adopting Haskell.

We’re now faced with a situation where Haskell is often eliminated for usage, representing a massive loss for two parties:

  • Companies, projects, and managers who could have realized great benefits in productivity, reliability, and performance from the less revolutionary pieces of Haskell. Instead, they’re losing this competitive advantage.
  • Engineers who would much prefer working in Haskell—even its less revolutionary subset—are unable to do so because of employer fears of choosing it.

We’d like to improve the situation.

The Boring Haskell Manifesto

Our claim is simple: for many cases of software engineering, a simple, well-defined subset of Haskell’s language and ecosystem will deliver large value for a project, while introducing little to no risk compared to alternative options. We call this subset, somewhat tongue-in-cheek, “boring Haskell.” Our goal is to:

  • Define such a subset
  • Provide straightforward documentation, tutorials, cookbooks, and libraries that encourage this subset
  • Continue to evolve the subset to optimize its best practices
  • Help interested engineers to learn how to use boring Haskell, and get it adopted in their companies

The most concrete step in this direction was creating the rio library, which is intended to capture these principles. If you want to embrace Boring Haskell today, we recommend using that library. The rest of this document discusses what we believe counts as “Boring Haskell,” and motivates these choices.

Power-to-weight ratio

We want to analyze the features of Haskell that we recommend based on its power-to-weight ratio, also known as a cost-benefit analysis. Put more directly: we want to choose features which provide lots of benefits while minimizing costs. Let’s give some examples of these two sides:

Power/benefit

  • More maintainable code
  • Less bugs in production
  • Higher performance
  • Higher productivity

Weight/cost

  • Learning curve
  • Ongoing cognitive overhead
  • Ongoing tweaking
  • Slower compile time
  • Poor performance

A concrete example of something with a great power to weight ratio are sum types. Sum types are a relatively simple concept to explain. Most people can grok the concept almost immediately. Pattern matching feels natural fairly quickly. And sum types solve large classes of problems people regularly encounter in programming tasks.

Reducing risk

This section is draft quality at best, feel free to stop reading here :)

A recurring theme I hear from people in industry is the risk of adopting Haskell. Let me address some of the common concerns directly:

If I’m stuck, there’s no support available. Haskell has a number of companies specializing in consulting services who are able to help. I work for one of them.

We can’t find people to hire. This is a valid concern; there are fewer total Haskell engineers. However, you’ve got some great advantages in Haskell:

  • There’s less competition on the hiring side versus larger languages.
  • People who like Haskell are very motivated to find a job with it.
  • If you’re willing to hire remotely, there’s a large pool of candidates.
  • Training people to work with Haskell is a real option. (This is an area that I intend to talk about more in the future.)

I don’t want to invest in learning Haskell if we’re just going to keep writing Javascript. Functional programming principles are powerful, and are being adopted into many languages today. The best way to get good at using them is to learn a language like Haskell that forces you to learn FP.

I’m afraid that I’m going to hit a wall and Haskell won’t work anymore. This isn’t a major issue in practice; most common code people will write is absolutely fine in pure Haskell. However:

  • If you need to use some other language because of library availability or something similar, you can always connect with other languages. Microservices architectures—even if I’m not a huge fan—come into play here.
  • If you hit a performance concern, you can usually solve it in Haskell itself by going lower level. However, the FFI in Haskell is really easy to use, so calling out to something like C or Rust is pretty easy.
  • If you’re having trouble finding a way to solve things in a functional style, you can always drop down to imperative Haskell. Writing in a full-on imperative style in Haskell, such as all code living in IO, may not be idiomatic, but it works. As SPJ has said (quote may not be exact), Haskell is the world’s finest imperative language.

Next steps

For now, I’m just sniffing out interest in this general topic. I have some follow up ideas, but I’d rather get feedback on this idea before going further. Be in touch, and stay tuned!

November 21, 2019 11:28 AM

Joachim Breitner

Faster Winter 4: Export lists

(This is the forth optimization presented in the “faster winter” series, please see that post for background information.)

This is on a funny one: You can speed up your code by adding export lists to your modules!

Why is that so?

Without an export, the compiler has to assume that every top-level function can possibly called from the outside, even functions that you think of as “internal”. If you have a function that you do not export, like instr, step_work and step after my change, the compiler can see all the places the function is called. If the function is only called in one place, it may inline it (copy its definition into where it is called), and simplify the code around the edges. And even if it does not inline the function, it might learn something about how the functions are used, and optimize them based on that (e.g. based on Demand Analysis).

Improvement: Allocations: -22.59% Memory: +0.00% Time: -11.79% (Commit bbe8af7...6f2ba09)

Besides being a performance win, an explicit export list is also very helpful to those who want to read or edit your code: they can refactor with greater ease while maintaining the external interface of the module.

by Joachim Breitner (mail@joachim-breitner.de) at November 21, 2019 07:52 AM

Tweag I/O

Untrusted CI: Using Nix to get automatic trusted caching of untrusted builds

Florian Klink

Nix's infrastructure offers a cache for the build products of derivations contained in Nixpkgs, which greatly accelerates the CI process. Ideally, the CI cache should benefit developers too: no need to build packages yourself if CI already did. However, sharing the CI cache with developers raises security issues.

In this post, we show an approach based on multi-user Nix and post-build hooks that solves these security issues and more.

The standard cache setup

Let's walk through the standard procedure for setting up such a Nix cache. First, create a signing keypair:

nix-store --generate-binary-cache-key example-nix-cache-1 ./nix-cache-key.sec ./nix-cache-key.pub

The substituter url and the key generated in nix-cache-key.pub should be added to /etc/nix/nix.conf on developer machines and CI nodes, which should look like this:

substituters = https://cache.nixos.org/ https://s3.amazonaws.com/example-nix-cache/
trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= example-nix-cache-1:1/cKDz3QCCOmwcztD2eV6Coggp6rqc9DGjWv7C0G+rM=

On NixOS, this can be accomplished by setting

nix.binaryCachePublicKeys = [ "example-nix-cache-1:1/cKDz3QCCOmwcztD2eV6Coggp6rqc9DGjWv7C0G+rM=" ];
nix.binaryCaches = [ "https://s3.amazonaws.com/example-nix-cache/" ];

We used Amazon S3 in our example above but Nix can also use other S3-based backends or simple HTTP/WebDAV-like (supporting GET and PUT) endpoints—there's even a PR for Google Cloud Storage (GCS) support. You can also use Cachix.

The following assumes a public S3 Bucket called example-nix-cache. For other binary cache backends, instructions will slightly differ.

Building and uploading

Now Nix is configured to substitute from our new cache too, but how do we upload to that cache? Assuming your project contains a default.nix with an attribute deps, a naive solution to upload build artifacts would be something like the following:

for o in $(nix-build --no-out-link -A deps); do
  nix copy --to s3://example-nix-cache?secret-key=/run/keys/nix-signing-key $o
done

The above nix-build command will build all dependencies and execute nix copy for each of them, which will take care of signing and uploading the whole closure. If these paths already exist on the binary cache, uploading will be skipped.

But there is a problem. You can't allow untrusted contributors to upload packages to the cache: they could easily replace the uploaded build artifact by another, possibly with a backdoor. This artifact would masquerade as the build product of a legitimate Nix expression, it would be signed, and used by all the developers' machines, or even production systems. This would be a serious security vulnerability.

On the other hand, preventing untrusted contributors to upload—which creates a build artifact—means that many caching opportunities will be lost. That leads to increased load on CI that can seriously impact the cache hit ratio and roundtrip time when iterating over a work in progress.

This vulnerability can happen in one of two ways:

  • The untrusted contributor can populate the Nix store with the wrong build artifact, after which, nix copy will happily sign the faulty artifacts and upload them.
  • The untrusted contributor can sign an unrelated build artifact themselves, and upload the faulty artifact regardless of what is actually in the Nix store.

We need to harden both of these vulnerabilities so we can restore the ability to cache build artifacts from untrusted contributors. Let's begin.

Multi-user Nix: trusted building

Multi-User Nix decouples the steps of assembling the build recipe (nix-instantiate), doing the actual build and writing to the store, and executes these as different users.

This means that untrusted contributors can upload a "build recipe" to a privileged Nix daemon which takes care of running the build as an unprivileged user in a sandboxed context, and of persisting the build output to the local Nix store afterward.

This "build recipe" effectively prevents untrusted contributors from manipulating the local Nix store—assuming there are no user privilege escalation exploits or hash collisions. They simply can't manipulate it directly, and the only way to get something in the store is by uploading a build recipe, with the output hash being done by the daemon.

Post-build hooks: trusted uploading

Multi-user Nix prevents the manipulation of the local Nix store, and isolates different parts of a nix-build between different users. However, we still need to sign and upload the build artifacts to the binary cache so other machines can make use of it.

It is clear that we should not let an untrusted contributor sign packages, because this would provide a way to sign and copy bad outputs into the remote Nix store. Luckily, since Nix 2.3, there's a way around this issue. With post-build hooks, the Nix daemon can be configured to execute a script after building a derivation.

In order to do so, add to your /etc/nix/nix.conf:

post-build-hook = /etc/nix/upload-to-cache.sh

where a trivial implementation of upload-to-cache.sh could be[1]:

set -eu
set -f # disable globbing
export IFS=' '

echo "Signing and uploading paths" $OUT_PATHS
exec nix copy --to 's3://example-nix-cache?secret-key=/run/keys/nix-signing-key' $OUT_PATHS

In a multi-user Nix setting, this runs in the context of the daemon (that is, as a root user), so we can properly shield the signing keys from the untrusted contributor, by making sure that the key file if only readable by the root user. In a cloud environment, special care needs to be taken in how the instance retrieves secrets on startup—a regular user shouldn't be able to extract the secret by querying the metadata server for its startup script.

More benefits

We can now safely upload build artifacts from untrusted contributors to the cache, greatly improving caching. But we gain more along the way.

With the standard setup, the uploading process is a step in your CI pipeline with an explicit list of all the build artifacts you want to upload. This approach has three unfortunate consequences:

  • If one of the packages in the deps list fails to build, intermediate build artifacts won't be uploaded: nix copy is never issued on the store path introducing that dependency, as it was never built.
  • Even if all the deps succeed, how do you know you have cached everything? Build dependencies might not all be readily available at a central location that can be called via nix-build. Often, multiple scripts are invoking Nix by themselves, via nix-shell, via Bazel rules (rules_haskell, rules_nixpkgs, or calling nix-build themselves during build) to provide dependencies. Manually tracing these dependencies in a .nix file (and keeping them in sync) is an arduous task, it gets even harder if some of your packages rely on IFD.
  • The logic for uploads has to be copied to each of your pipeline definition.

Nix's post-build hook moves the caching logic out of the pipeline definition and into the builder environment—that means it's shareable across all of your pipelines. And, we upload every single build artifact: it doesn't matter if later builds fail, it doesn't matter if we don't know what these artifacts are.

Conclusion

We learned how Nix's new post-build hooks feature can automatically sign and upload artifacts to a binary cache in a trusted way.

How? This post-build-hook setup lets untrusted contributors' artifacts be uploaded on CI: contributors don't have direct access to the local Nix store anymore and don't have access to the signing key. So there's no way to produce a modified signed artifact under the original store path or to upload it to the cache. In some cloud environments, it might still be possible to alter files in the cache. But, since the signatures will be broken, substitutions on other machines using that cache will fail, and they will fall back to building locally.

The post-build-hook setup has other benefits valuable enough that you should consider using it even if you don't have any untrusted contributors. For example, CI pipeline setup is much easier since your developers won't need to remember the invocations required to upload cache, or figure out what list of artifacts they want to cache: it's all configured in the builder already and done automatically. The caching is even improved slightly with successful partial builds since intermediate builds are cached.

Currently, this setup is most suitable when you provide self-hosted builders because:

  • Multi-User Nix requires multiple users, ruling out some of the hosted CI solutions which don't allow to provide self-hosted runners. However, by just using post-build hooks in a single-user Nix setting, you still have simpler and better caching.

  • Running Nix inside Docker currently requires a privileged container (because we want sandboxing to be enabled to ensure some of the isolation properties) [2], making it unsuitable for some container platforms. On top of that, the "official" nixos/nix docker image doesn't provide a multi-user Nix installation, it's a single-user installation based on Alpine (there's lnl7/nix though).

For more on this subject, you can also watch my NixCon 2019 talk.


  1. Please refer to the "Implementation Caveats" section in the Nix manual-depending on the circumstances, it might be desirable to handle uploads in an asynchronous fashion without blocking the build loop. ↩︎

  2. https://github.com/NixOS/nix/issues/2636 ↩︎

November 21, 2019 12:00 AM

November 18, 2019

Monday Morning Haskell

Get Ready for Rust!

rust_logo.jpg

I'm excited to announce that for the next few weeks, we'll be exploring the Rust language! Rust is a very interesting language to compare to Haskell. It has some similar syntax. But it is not as similar as, say, Elm or Purescript. Rust can also look a great deal like C++. And its similarities with C++ are where a lot of its strongpoints are.

In these next few weeks we'll go through some of the basics of Rust. We'll look at things like syntax and building small projects. In this article, we'll do a brief high level comparison between Haskell and Rust. Next time, we'll start digger deeper in some actual code.

To get jump started on your Rust development, take a look at our Starting out with Rust video tutorial!.

Why Rust?

Rust has a few key differences that make it better than Haskell for certain tasks and criteria. One of the big changes is that Rust gives more control over the allocation of memory in one's program.

Haskell is a garbage collected language. The programmer does not control when items get allocated or deallocated. Every so often, your Haskell program will stop completely. It will go through all the allocated objects, and deallocate ones which are no longer needed. This simplifies our task of programming, since we don't have to worry about memory. It helps enable language features like laziness. But it makes the performance of your program a lot less predictable.

I once proposed that Haskell's type safety makes it good for safety critical programs. There's still some substance to this idea. But the specific example I suggested was a self-driving car, a complex real-time system. But the performance unknowns of Haskell make it a poor choice for such real-time systems.

With more control over memory, a programmer can make more assertions over performance. One could assert that a program never uses too much memory. And they'll also have the confidence that it won't pause mid-calculation. Besides this principle, Rust is also made to be more performant in general. It strives to be like C/C++, perhaps the most performant of all mainstream languages.

Rust is also currently more popular with programmers. A larger community correlates to certain advantages, like a broader ecosystem of packages. Companies are more likely to use Rust than Haskell since it will be easier to recruit engineers. It's also a bit easier to bring engineers from non-functional backgrounds into Rust.

Similarities

That said, Rust still has a lot in common with Haskell! Both languages embrace strong type systems. They view the compiler as a key element in testing the correctness of our program. Both embrace useful syntactic features like sum types, typeclasses, polymorphism, and type inference. Both languages also use immutability to make it easier to write correct programs.

What's Next?

Next time, we'll start digging into the language itself. We'll go over some basic examples that show some of the important syntactic points about Rust. We'll explore some of the cool ways in which Rust is like Haskell, but also some of the big differences.

by James Bowen at November 18, 2019 03:30 PM

November 17, 2019

Joey Hess

watch me program for half an hour

In this screencast, I implement a new feature in git-annex. I spend around 10 minutes writing haskell code, 10 minutes staring at type errors, and 10 minutes writing documentation. A normal coding session for me. I give a play-by-play, and some thoughts of what programming is like for me these days.

git-annex coding in haskell.ogg (38 MB) | on vimeo

Not shown is the hour I spent the next day changing the "optimize" subcommand implemented here into "--auto" options that can be passed to git-annex's get and drop commands.

watched it all, liked it (59%)


watched some, boring (8%)


too long for me (3%)


too haskell for me (14%)


not interested (12%)


Total votes: 101

November 17, 2019 09:12 PM

November 15, 2019

Donnacha Oisín Kidney

A Small Proof that Fin is Injective

Posted on November 15, 2019
Tags: Agda

Imports etc.

{-# OPTIONS --safe --without-K #-}

module Post where

open import Data.Fin                              using (Fin; suc; zero; _≟_)
open import Data.Nat                              using (; suc; zero; _+_; compare; equal; greater; less)
open import Data.Nat.Properties                   using (+-comm)
open import Data.Bool                             using (not; T)
open import Relation.Nullary                      using (yes; no; does; ¬_)
open import Data.Product                          using (Σ; Σ-syntax; proj₁; proj₂; _,_)
open import Data.Unit                             using (tt; )
open import Function                              using (_∘_; id; _⟨_⟩_)
open import Relation.Binary.PropositionalEquality using (subst; trans; cong; sym; _≡_; refl; _≢_)
open import Data.Empty                            using (⊥-elim; )

variable n m : 

Here’s a puzzle: can you prove that Fin is injective? That’s the type constructor, by the way, not the type itself. Here’s the type of the proof we want:

Goal : Set₁
Goal =  {n m}  Fin n  Fin m  n  m

I’m going to present a proof of this lemma that has a couple interesting features. You should try it yourself before reading on, though: it’s difficult, but great practice for understanding Agda’s type system.

First off, I should say that it’s not really a “new” proof: it’s basically Andras Kovac’s proof, with one key change. That proof, as well as this one, goes --without-K: because I actually use this proof in some work I’m doing in Cubical Agda at the moment, this was non optional. It does make things significantly harder, and disallows nice tricks like the ones used by effectfully.

Computational Inequalities

The trick we’re going to use comes courtesy of James Wood. The central idea is the following type:

_≢ᶠ_ : Fin n  Fin n  Set
x ≢ᶠ y = T (not (does (x  y)))

This proof of inequality of Fins is different from the usual definition, which might be something like:

_≢ᶠ′_ : Fin n  Fin n  Set
x ≢ᶠ′ y = x  y  

Our definition is based on the decidable equality of two Fins. It also uses the standard library’s new Dec type. Basically, we get better computation behaviour from our definition. It behaves as if it were defined like so:

_≢ᶠ″_ : Fin n  Fin n  Set
zero  ≢ᶠ″ zero  = 
zero  ≢ᶠ″ suc y = 
suc x ≢ᶠ″ zero  = 
suc x ≢ᶠ″ suc y = x ≢ᶠ″ y

The benefit of this, in contrast to _≢ᶠ′_, is that each case becomes a definitional equality we don’t have to prove. Compare the two following proofs of congruence under suc:

cong-suc″ :  {x y : Fin n}  x ≢ᶠ″ y  suc x ≢ᶠ″ suc y
cong-suc″ p = p

cong-suc′ :  {x y : Fin n}  x ≢ᶠ′ y  suc x ≢ᶠ′ suc y
cong-suc′ {n = suc n} p q = p (cong fpred q)
  where
  fpred : Fin (suc (suc n))  Fin (suc n)
  fpred (suc x) = x
  fpred zero = zero

The Proof

First, we will describe an “injection” for functions from Fins to Fins.

_F↣_ :     Set
n F↣ m = Σ[ f  (Fin n  Fin m) ]  {x y}  x ≢ᶠ y  f x ≢ᶠ f y

We’re using the negated from of injectivity here, which is usually avoided in constructive settings. It actually works a little better for us here, though. Since we’re working in the domain of Fins, and since our proof is prop-valued, it’s almost like we’re working in classical logic.

Next, we have the workhorse of the proof, the shrink lemma:

shift : (x y : Fin (suc n))  x ≢ᶠ y  Fin n
shift         zero    (suc y) x≢y = y
shift {suc _} (suc x) zero    x≢y = zero
shift {suc _} (suc x) (suc y) x≢y = suc (shift x y x≢y)

shift-inj :  (x y z : Fin (suc n)) y≢x z≢x  y ≢ᶠ z  shift x y y≢x ≢ᶠ shift x z z≢x
shift-inj         zero    (suc y) (suc z) y≢x z≢x neq = neq
shift-inj {suc _} (suc x) zero    (suc z) y≢x z≢x neq = tt
shift-inj {suc _} (suc x) (suc y) zero    y≢x z≢x neq = tt
shift-inj {suc _} (suc x) (suc y) (suc z) y≢x z≢x neq = shift-inj x y z y≢x z≢x neq

shrink : suc n F↣ suc m  n F↣ m
shrink (f , inj) .proj₁ x = shift (f zero) (f (suc x)) (inj tt)
shrink (f , inj) .proj₂ p = shift-inj (f zero) (f (suc _)) (f (suc _)) (inj tt) (inj tt) (inj p)

This will give us the inductive step for the overall proof. Notice the absence of any congs or the like: the computation behaviour of ≢ᶠ saves us on that particular front. Also we don’t have to use ⊥-elim at any point: again, because of the computation behaviour of ≢ᶠ, Agda knows that certain cases are unreachable, so we don’t even have to define them.

Next, we derive the proof that a Fin cannot inject into a smaller Fin.

¬plus-inj :  n m  ¬ (suc (n + m) F↣ m)
¬plus-inj zero    (suc m) inj       = ¬plus-inj zero m (shrink inj)
¬plus-inj (suc n) m       (f , inj) = ¬plus-inj n m (f  suc , inj)
¬plus-inj zero    zero    (f , _) with f zero
... | ()

That’s actually the bulk of the proof done: the rest is Lego, joining up the pieces and types. First, we give the normal definition of injectivity:

Injective :  {a b} {A : Set a} {B : Set b}  (A  B)  Set _
Injective f =  {x y}  f x  f y  x  y

_↣_ :  {a b}  Set a  Set b  Set _
A  B = Σ (A  B) Injective

Then we convert from one to the other:

toFin-inj : (Fin n  Fin m)  n F↣ m
toFin-inj f .proj₁ = f .proj₁
toFin-inj (f , inj) .proj₂ {x} {y} x≢ᶠy with x  y | f x  f y
... | no ¬p | yes p = ¬p (inj p)
... | no _  | no _  = tt

And finally we have our proof:

n≢sn+m :  n m  Fin n  Fin (suc (n + m))
n≢sn+m n m n≡m =
  ¬plus-inj m n (toFin-inj (subst (_↣ Fin n)
                             (n≡m  trans  cong (Fin  suc) (+-comm n m))
                             (id , id)))

Fin-inj : Injective Fin
Fin-inj {n} {m} n≡m with compare n m
... | equal _ = refl
... | less    n k = ⊥-elim (n≢sn+m n k n≡m)
... | greater m k = ⊥-elim (n≢sn+m m k (sym n≡m))

_ : Goal
_ = Fin-inj

All in all, the proof is about 36 lines, which is pretty short for what it does.

by Donnacha Oisín Kidney at November 15, 2019 12:00 AM

November 14, 2019

Mark Jason Dominus

Soondubu victory

Katara and I are in a virtuous cycle where she thinks of some food she wants to eat and then asks me to cook it, I scratch my head and say "Well, I never did, but I could try", and then I do, and she tells me it was really good. This time she suggested I should make soondubu jjigae (순두부찌개), which is a Korean stew that features very soft tofu. (“Dubu” (두부) is tofu, and “soon dubu” is soft tofu.)

I did it and it came out good, everyone was happy and told me how great I am. Cooking for my family makes me feel like a good dad and husband. Hey, look, I am doing my job! I love when I do my job.

Soondubu in the bot on the range.  The  pot is dark-glazed heavy earthenware.  The soondubu is a dark-red soup (from the chili paste) full of floating pieces of white dubu and green-edged zucchini.

I thought maybe soondubu would be one of those things where you can make it at home with endless toil but in the end you have a product that is almost as good as the $6.95 version you could get from the place downstairs. But it was actually pretty easy. Korean cuisine is often very straightforward and this was one of those times. I approximately followed this recipe but with several changes. (One of these days I'll write a blog article about how so many people stress out about the details of recipes.) The overall method is:

Dice up some onion and garlic finely and put them in the pot with sesame oil and kochujang. Then you add the meat if you are doing that, and then about a half a cup of chopped up kimchi. Then you put in broth and you add the soondubu. Easy-peasy.

The recipe on that page called for beef but I used chicken meat in cubes because that was what Katara asked for. All the soondubu recipes I found call for kochugaru (red pepper flakes) instead of kochujang (red pepper soybean paste) but I didn't have any handy and so what?

Somewhere in the world there is some food snob who will sneer and say that Real Soondubu is always made with kochugaru, and using kochujang is totally inauthentic. But somewhere else there is someone who will say “well, my grandmother always liked to use kojujang instead”, and Grandma outranks the food snob. Also I decided this year that the whole idea of “authentic” recipes is bullshit and I am going to forget about it.

I used chicken broth out of a box. The recipe called for scallions but I think I didn't have any handy that time. The recipe called for anchovy paste but I left them out because Lorrie doesn't like the way they taste. But I put did in some thin slices of zucchini. We do have a nice Korean-style glazed earthenware pot which I cooked in and then transported directly to the table.

Everyone in my family likes soondubu and it made me really happy that they considered my first one successful.

by Mark Dominus (mjd@plover.com) at November 14, 2019 02:52 PM

November 11, 2019

Monday Morning Haskell

Looking Ahead with More Steps!

more_steps.jpg

In last week's article, we set ourselves up to make our agent use temporal difference learning. But TD is actually a whole family of potential learning methods we can use. They intertwine with other concepts in a bigger category of reinforcement learning algorithms.

In this article, we'll consider a couple possible TD approaches. We'll also examine a bit of theory surrounding other reinforcement learning topics.

For a more high level overview of using Haskell and AI, take a look at our Haskell AI Series! This series will also help you better grasp some of the basics of TensorFlow.

One Step Temporal Difference

Temporal difference learning has one general principle. The evaluation of the current game position should be similar to the evaluation of positions in the future. So at any given step we have our "current" evaluation. Then we have a "target" evaluation based on the future. We want to train our network so that the current board gets evaluated more like the target value.

We can see this in the way we defined our model. The tdTrainStep takes two different values, the target evaluation and the current evaluation.

data TDModel = TDModel
  { …
  , tdTrainStep :: TensorData Float -> TensorData Float -> Session ()
  }

And in fact, doing this calculation isn't so different from what we've done before. We'll take the difference between these evaluations, square it, and use reduceSum. This gives our loss function. Then we'll have TensorFlow minimize the loss function.

createTDModel :: Session TDModel
createTDModel = do
  ...
  -- Train Model
  targetEval <- placeholder (Shape [1])
  currentEval <- placeholder (Shape [1])
  let diff = targetEval `sub` currentEval
  let loss = reduceSum (diff `mul` diff)
  trainer <- minimizeWith
    adam loss [hiddenWeights, hiddenBias, outputWeights, outputBias]
  let trainStep = \targetEvalFeed currentEvalFeed ->
        runWithFeeds [feed targetEval targetEvalFeed, feed currentEval currentEvalFeed] trainer
  return $ TDModel
    { ...
    , tdTrainStep = trainStep
    }

Let's now recall how we got our target value last week. We looked at all our possible moves, and used them to advance the world one step. We then took the best outcome out of those, and that was our target value. Because we're advancing one step into the world, we call this "one-step" TD learning.

Adding More Steps

But there's no reason we can't look further into the future! We can consider what the game will look like in 2 moves, not just one move! To do this, let's generalize our function for stepping forward. It will be stateful over the same parameters as our main iteration function. But we'll call it in a way so that it doesn't affect our main values.

We'll make one change to our approach from last time. If a resulting world is over, we'll immediately put the "correct" evaluation value. In our old approach, we would apply this later. Our new function will return the score from advancing the game, the game result, and the World at this step.

advanceWorldAndGetScore :: Float -> TDModel
  -> StateT (World, StdGen) Session (Float, GameResult, World)
advanceWorldAndGetScore randomChance model = do
  (currentWorld, gen) <- get
  let allMoves = possibleMoves currentWorld
  let newWorlds = fst <$> map ((flip stepWorld) currentWorld) allMoves
  allScoresAndResults <- Data.Vector.fromList <$>
    (forM newWorlds $ \w -> case worldResult w of
      GameLost -> return (0.0, GameLost)
      GameWon -> return (1.0, GameWon)
      GameInProgress -> do
        let worldData = encodeTensorData
              (Shape [1, inputDimen]) (vectorizeWorld8 w)
        scoreVector <- lift $ (tdEvaluateWorldStep model) worldData
        return $ (Data.Vector.head scoreVector, GameInProgress))

  let (chosenIndex, newGen) = bestIndexOrRandom
                                allScoresAndResults gen 
  put (newWorlds !! chosenIndex, newGen)
  let (finalScore, finalResult) = allScoresAndResults ! chosenIndex
  return $ (finalScore, finalResult, newWorlds !! chosenIndex)
  where
    -- Same as before, except with resultOrdering
    bestIndexOrRandom :: Vector (Float, GameResult) -> StdGen
      -> (Int, StdGen)
    ...

    -- First order by result (Win > InProgress > Loss), then score
    resultOrdering :: (Float, GameResult) -> (Float, GameResult)
      -> Ordering
    ...

Now we'll call this from our primary iteration function. It seems a little strange. We unwrap the World from our state only to re-wrap it in another state call. But it will make more sense in a second!

runWorldIteration :: Float -> TDModel
  -> StateT (World, StdGen) Session Bool
runWorldIteration randomChance model = do
  (currentWorld, gen) <- get

  ((chosenNextScore, finalResult, nextWorld), (_, newGen)) <-
    lift $ runStateT
      (advanceWorldAndGetScore randomChance model)
      (currentWorld, gen)

So at the moment, our code is still doing one-step temporal difference. But here's the key. We can now sequence our state action to look further into the future. We'll then get many values to compare for the score. Here's what it looks like for us to look two moves ahead and take the average of all the scores we get:

runWorldIteration :: Float -> TDModel
  -> StateT (World, StdGen) Session Bool
runWorldIteration randomChance model = do
  (currentWorld, gen) <- get

  let numSteps = 2
  let repeatedUpdates = sequence $ replicate numSteps
        (advanceWorldAndGetScore randomChance model)
  (allWorldResults, (_, newGen)) <- lift $
    runStateT repeatedUpdates (currentWorld, gen)

  let allScores = map (\(s, _, _) -> s) allWorldResults
  let averageScore = sum allScores / fromIntegral (length allScores)
  let nextScoreData = encodeTensorData
        (Shape [1]) (Data.Vector.singleton averageScore)
  ...

When it comes to continuing the function though, we only consider the first world and result:

runWorldIteration :: Float -> TDModel
  -> StateT (World, StdGen) Session Bool
runWorldIteration randomChance model = do
  let (_, result1, nextWorld1) = Prelude.head allWorldResults
  put (nextWorld1, newGen)
  case result1 of
    GameLost -> return False
    GameWon -> return True
    GameInProgress -> runWorldIteration randomChance model

We could take more steps if we wanted! We could also change how we get our target score. We could give more weight to near-future scores. Or we could give more weight to scores in the far future. These are all just parameters we can tune now. We can now refer to our temporal difference algorithm as "n-step", rather than 1-step.

Monte Carlo vs. Dynamic Programming

With different parameters, our TD approach can look like other common learning approaches. Dynamic Programming is an approach where we adjust our weights after each move in the game. We expect rewards for a particular state to be like those of near-future states. We use the term "bootstrapping" for "online" learning approaches like this. TD learning also applies bootstrapping.

However, dynamic programming requires that we have a strong model of the world. That is, we would have to know the probability of getting into certain states from our current state. This allows us to more accurately predict the future. We could apply this approach to our maze game on a small enough grid. But the model size would increase exponentially with the grid size and enemies! So our approach doesn't actually do this! We can advance the world with a particular move, but we don't have a comprehensive model of how the world works.

In this regard, TD learning is more like Monte Carlo learning. This algorithm is "model free". But it is not an online algorithm! We must play through an entire episode of the game before we can update the weights. We could take our "n-step" approach above, and play it out over the course of the entire game. If we then chose to provide the full weighting to the final evaluation, our model would be like Monte Carlo!

In general, the more steps we add to our TD approach, the more it approximates Monte Carlo learning. The fewer steps we have, the more it looks like dynamic programming.

TD Lambda

TD Gammon, the algorithm we mentioned last time, uses a variation of TD learning called "TD Lambda". It involves looking both forward in time as well as backwards. It observes that the best solutions lie between the extremes of one-step TD and Monte Carlo.

Academic literature can help give a more complete picture of machine learning. One great text is Reinforcement Learning, by Sutton and Barto. It's one of the authoritative texts on the topics we've discussed in this article!

What's Next

This concludes our exploration of AI within the context of our Maze Game. We'll come back to AI and Machine Learning again soon. Next week, we'll start tackling a new subject in the realm of functional programming, something we've never looked at before on this blog! Stay tuned!

by James Bowen at November 11, 2019 03:30 PM

November 10, 2019

Ken T Takusagawa

[ljdyledo] Sort of UTF-6

We present an encoding of Unicode code points to printable ASCII characters that keeps English text vaguely readable.  It accomplishes a similar purpose as Quoted-Printable.  This design is modeled after UTF-8.  We use 6-bit bytes instead of UTF-8's 8-bit bytes.  We also do not encode the number of continuation bytes in the first byte; instead, the most significant bit (high bit) signifies whether a byte is followed by further continuation bytes.  The last byte of a sequence does not have its high bit set, signifying it is the last byte of a sequence representing one Unicode character.  The binary bits of the Unicode code point numbers of various magnitudes are encoded big-endian into the x's as follows:

  • 0xxxxx
  • 1xxxxx 0xxxxx
  • 1xxxxx 1xxxxx 0xxxxx
  • 1xxxxx 1xxxxx 1xxxxx 0xxxxx
  • ...

This encoding can encode values of arbitrary size, in contrast to the 36-bit limit of UTF-8 extended in the obvious way.  But this is a moot point (for now) as Unicode was originally limited to 31 bits, and later (including currently) limited further to 21 bits.

Here, in order, are the 64 printing characters used to encode a 6-bit byte.  It is modeled after ASCII, but some common punctuation namely ;,-.? has been moved so that it remains unchanged when encoded.  (The moved punctuation was moved only up or down a column of the 16-wide ASCII table, preserving low-order bits out of tradition).  The second row, beginning with @, are characters that will only be used in multibyte sequences.  The first row, beginning with space, represents characters which will be unchanged when encoded but can also occur as the last byte of a multibyte sequence.

 abcdefghijklmnopqrstuvwxyz;,-.?
@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_

The following is how Unicode code points 0 through 127 are encoded.  Here is a 16-wide ASCII table to see the corresponding original characters.

B BaBbBcBdBeBfBgBhBiBjBkBlBmBnBo
BpBqBrBsBtBuBvBwBxByBzB;B,B-B.B?
 CqCrCsCtCuCvCwCxCyCzC;,-.C?
C CaCbCcCdCeCfCgChCiCj;ClCmCn?
A AaAbAcAdAeAfAgAhAiAjAkAlAmAnAo
ApAqArAsAtAuAvAwAxAyAzA;A,A-A.A?
Cpabcdefghijklmno
pqrstuvwxyzCkC,C-C.Co

The fact that some multibyte sequences are terminated by space (e.g., code points 48 and 64, corresponding to the digit zero and the at-sign respectively) is a little unfortunate.

Here is some more text containing higher Unicode code points, followed by its vaguely readable encoding:

lowercase Capitalized camelCase UPPERCASE numbers 0123456789 common punctuation ;,-.? at-sign @ bob@example.com http://example.com exclamation ! (parentheses) time 12:01 tilde ~ ‘single curly quotes’ “double curly quotes� yen ¥ euro € en–dash em—dash ellipsis … y-umlaut ÿ eng ŋ tent emoji ⛺ fire kanji � canoe emoji 🛶 newline

lowercase Acapitalized camelAcase AuApApAeArAcAaAsAe numbers C CaCbCcCdCeCfCgChCi common punctuation ;,-.? at-sign A  bobA example.com httpCjC?C?example.com exclamation Cq CxparenthesesCy time CaCbCjC Ca tilde C. H@xsingle curly quotesH@y H@,double curly quotesH@- yen Ee euro HEl enH@sdash emH@tdash ellipsis HAf y-umlaut G? eng Jk tent emoji IWz fire kanji \Ck canoe emoji C]Wv newlineBj

We implemented an encoder and decoder in Haskell (after first trying in Perl but finding it to be the wrong tool).  Some code excerpts:

We represented bytes as lists of Bool, sometimes little-endian sometimes big-endian depending on where we were in the conversion.  This is highly space-inefficient, but does allow some elegant code.  Given a list of big-endian bytes, splitting off the initial bytes that all have their high (first) bit set is elegantly span head.  This is used in decoding.

type Bstring=[Bool];
myspan :: [Bstring] -> ([Bstring],[Bstring]);
myspan = span head; -- takeWhile (\l -> head l == True)

Conversion to binary is an unfold.  Output is little-endian.

to_binary :: Integer -> [Bool];
to_binary = unfoldr (\n -> if n==0 then Nothing else Just (case divMod n 2 of {(q,r) -> (r==1,q)}));

Conversion from big-endian binary to an integer is a fold.

from_binary :: [Bool] -> Integer;
from_binary = foldl' (\accum b -> 2*accum+(if b then 1 else 0)) 0;

A few times we relied on the fact that mod x y with x negative and y positive yields a positive result.  This is in contrast to rem x y which would return a negative result.

by Unknown (noreply@blogger.com) at November 10, 2019 04:36 AM

November 08, 2019

Tweag I/O

Probabilistic Programming with monad‑bayes, Part 2: Linear Regression

Siddharth Bhat, Matthias Meschede

This post is a continuation of Tweag's Probabilistic Programming with monad‑bayes Series. You can find Part 1 here. Want to make this post interactive? Try our notebook version. It includes a Nix shell, the required imports, and some helper routines for plotting. Let's start modeling!

Modeling

The lawn is wet, did it rain? The ground moves, is there an earthquake? Prices rise, are we in an economic crisis? Wiggly lines appear on the screen, did a black hole perturb gravity on Earth? Patterns emerge in software dependency graphs and source code, is this the outcome of a particular development style? Evidence is found in a legal discovery procedure, is anyone guilty of wrongdoing?

We continuously make observations similar to "the lawn is wet". Such data touches our senses either directly, or indirectly through a measurement device. It is visible, concrete, and therefore unquestioned here—contrary to the invisible and abstract processes that might have generated it.

Neither can every process generate this data— earthquakes don't (usually) wet the lawn, black holes don't (yet) influence prices, and criminal behaviour doesn't (often) bring about specific source code patterns— nor is there a unique process that can generate it: earthquakes and black holes can both move the ground; sprinklers and rain can wet the lawn equally well. Hence, a process implies data, but data doesn't imply a process.

The conclusion is that we can't conclude that a single process is behind the data, but processes aren't indistinguishable either. We can compare them by assessing how likely it is that they generate the data. Bayesian inference and the laws of probability tell us how to make this comparison rationally.

Conceptually it is simple: Define a set of processes that we want to compare and prior beliefs in each of them (the prior distribution). For each of these processes, describe and compute the probability that it generates the observed data (the likelihood). Score each process - that is multiply the prior belief in a process with the likelihood. Renormalize and examine the result, the posterior beliefs in each model (the posterior distribution).

In this blog post, we walk through this process step by step with monad-bayes. First, we set up a statistical model that describes an ensemble of data generation processes. Then, we generate synthetic data with one specific process in this ensemble. From this data, we try to infer which process we have used from the ones that our statistical model describes.

Model Setup

The data that we consider are two-dimensional points (x, y). These points could be observations of time and velocity, location and temperature, velocity and acceleration, or any other two continuous variables that we observe. Here is how we can describe such data with Haskell:

data Data
  = Data
      { xValue :: Double,
        yValue :: Double
      }
  deriving (Eq, Show)

The model that we consider generates data along lines with some Gaussian noise around. This means that the x and y values of our data points cannot take any value, but that y can be calculated from x with the equation m*x + b + n, with parameters m,b that are the same for all points and a random, normally-distributed deviation n that is independently drawn for each point. In Haskell, the model, i.e., the lines that it describes, can thus be characterized with:

data Params
  = Params
      { slope :: Double,
        intercept :: Double,
        noiseStd :: Double
      }
  deriving (Eq, Show)

The likelihood, the heart of our model, corresponds to this succinct Haskell function:

likelihood :: Params -> Data -> Log Double
likelihood (Params m b nStd) (Data x y) = normalPdf (m*x + b) nStd y

It describes the probability (Log Double) to observe some data (Data) given some model parameters (Params). In our case, it's just a Gaussian distribution (normalPdf), centered at m*x + b for a given x and standard deviation nStd. That's it—the model definition is unspectacular and short.

The Model As A Family Of Distributions

For a given value of Params, likelihood provides us with the (log-)probability for a Data point. In other words, it describes a probability distribution. We can pick data samples from such a sampling distribution—modeling a real-world data generating process. For instance, let's choose the following parameters:

params0 = Params {slope=2.3, intercept=(-1.2), noiseStd=2.0}

The associated sampling distribution can then be obtained with:

samplingDistribution' :: Data -> Double
samplingDistribution' = exp . ln . likelihood params0

The extra exp . ln snippet here is required to extract a Double from a Log Double, a data type that internally stores the logarithm of a number instead of the actual value. Here is a plot that shows how this 2D sampling distribution looks like:

points1 = [(x, y, samplingDistribution' (Data x y)) | x<-[-10..10], y<-[-10..10]]

vlShow $ plot -- [... x, y, prob ...]
-- (the full hvega plotting code can be found in the associated notebook)

png

You can think about it as a line with some noise around, or as a Gaussian distribution with fixed standard deviation in y direction and a mean that increases linearly with x, which is closer to the definition.

Our statistical model doesn't just describe a single distribution but a different one for each value of Params. A bunch of Params therefore corresponds to a bunch of sampling distributions. Or, expressed more confusingly, a distribution of Params corresponds to a distribution of sampling distributions. Take, for example, a distribution of Params that we call priorParams where slope, intercept and noise standard deviation are drawn from uniform distributions:

priorParams :: MonadSample m => m Params
priorParams = do
  intercept <- uniform (-5) 5
  slope <- uniform (-5) 5
  noise <- uniform 1 3
  return $ Params slope intercept noise

We can draw a few parameters from this model parameter distribution:

mkSampler = replicateM 9
params <- sampleIOfixed $ mkSampler priorParams

And compute and plot the corresponding sampling distributions for each parameter sample in the domain x=[-10, 10] and y=[-10, 10]:

points2 =
  [ [ (iparam, x, y, prob (Data x y))
      | x <- [-10, -9.5 .. 10],
        y <- [-10, -9.5 .. 10],
        let prob = exp . ln . likelihood param
    ]
    | (iparam, param) <- zip [0 ..] params
  ]

vlShow $ plot -- [... iparam, x, y, likelihood ...]

png

Each distribution varies in terms of its slope, intercept and standard deviation. Note that the maximum of a distribution is lower if it has a higher standard deviation, which is due to the normalized normalPdf function we used. However, we didn't properly normalize these distributions within the limited 2D domain but that's not important for what is coming. The important point to understand is that our likelihood model describes a family of distributions which are parametrized through Params.

Generating Data - MCMC

Now let's pick one of those distributions, the one with Params {slope=2.3, intercept=(-1.2), noiseStd=2.0} that we showed initially, and draw some synthetic data samples from it.

To sample with monad-bayes, we express likelihood directly as a distribution. This means, likelihood :: Params -> Data -> Log Double becomes likelihoodDist :: Params -> m Data. Here, m implements the MonadInfer typeclass that represents a distribution from which we can sample. It thus somehow deals with the Log Double probability behind the scenes:

likelihoodDist :: MonadInfer m => Params -> m Data
likelihoodDist params = do
  x <- uniform (-10) 10
  y <- uniform (-10) 10
  score $ likelihood params (Data x y)
  return $ Data x y

As we did in our previous blog post, we can sample from this distribution with MCMC:

mkSampler = prior . mh 300
pointsMCMC <- sampleIOfixed $ mkSampler $ likelihoodDist params0

vlShow $ plot -- [... pointsMCMC ...] 

png

Did this work? Well, we got some samples, and they are roughly distributed according to the desired distribution that we showed above. But, there is a problem:

First, there is an improbable outlier sample all the way on the left. We already blamed this on the initial state of the Markov chain previously. We will show you how to skip this initial state later in this post.

Then, the samples are not distributed as we would expect. They don't cover the full x-range, which we could fix by pulling more samples with MCMC—but still. And there is a deeper issue, the samples seem to be aligned along the y-axis (and the x-axis if you look closely). The reason is obvious, each sample in the Markov chain (except for the initial one) depends on the previous sample. The distribution of these samples would eventually converge to the one described by likelihood, but they are not independent. So, we need a different technique here to draw samples that are independent.

Generating Data - Rejection Sampling

Many possible ways exist to draw independent samples from a given distribution, but few approaches are accurate and efficient in any situation. Here we choose an inefficient but quite general approach called rejection sampling. It works like this: We first get a bunch of independent uniform 2D data points via monad-bayes.

uniform2D :: MonadSample m => m Data
uniform2D = do
  x <- uniform (-10) 10
  y <- uniform (-10) 10
  return $ Data x y

We then draw a list of 2000 points from this distribution with the help of replicateM and sampleIOfixed :

mkSampler = replicateM 2000 
uniformSamples <- sampleIOfixed $ mkSampler uniform2D

These samples aren't distributed according to the desired probability, our sampling distribution, but it is easy to compute it for each of these samples:

desiredProb = map samplingDistribution' uniformSamples

Now we can reject unlikely samples and accept the likely ones to get what we want. To decide which ones to accept, we draw a uniform random number for each sample. A sample is only accepted if this number is higher than the desired probability:

uniform0max <- sampleIOfixed $ mkSampler $ uniform 0 (maximum desiredProb)
points3 = [p | (p, u, l)<-zip3 uniformSamples uniform0max desiredProb, u<l]
length points3
190

The rejection procedure removes ~90% of all uniformly distributed points and reduces the initial number of 2000 points to only 190. But the probability to accept is proportional to the desired probability. The remaining points are therefore independent and distributed according to our desired sampling distribution, as this plot demonstrates:

vlShow $ plot -- [... points ...] 

png

Rejection sampling is often not very efficient, but it is simple and straight forward. By design, most rejected samples are in low probability regions, and it is thus crucial to choose an initial distribution that is concentrated around high probability regions—if we know where they are. Long story short, we now have data samples that correspond to the sampling distribution identified by Params {slope=2.3, intercept=(-1.2), noiseStd=2.0}.

Linear Regression - Inferring Slope and Intercept

Can we find the parameters that we have used from the data points only? In other words, can we find the specific distribution that generated the data points from the family of distributions that our model describes? Well, at least we can assess how probable it is that a distribution in the model generates the data - the likelihood. With this likelihood, we can score the distributions from the prior distribution of parameters priorParams that we have defined before. Now pay attention, here is the inference recipe, in English and in Haskell:

pull out a model parameter sample from the prior distribution and score it with the likelihood to observe all data points:

postParams :: MonadInfer m => m Params -> [Data] -> m Params
postParams pr obs = do
  param <- pr
  forM_ obs (\point -> score (likelihood param point))
  return param

Remember, the score function multiplies the relative probability of a model parameter sample with a factor: Our belief in model parameters that correspond to distributions that likely generate what we observe are multiplied with a high number. Our belief in model parameters that correspond to distributions that are unlikely to generate what we observe are multiplied with a low number. We thus update the prior probabilities of model parameters and get a new posterior distribution of model parameters.

But now the question is again how we can sample from this posterior distribution. The sampler that we use to handle the score operation, that is updating relative probabilities of samples in a distribution, is Metropolis-Hastings:

mkSampler = prior . mh 1000 
modelsamples <- sampleIOfixed $ mkSampler $ postParams priorParams points3

Here is how the posterior distribution looks like:

stable = take 800 modelsamples
vlShow $ plot -- [... stable ...]

png

This posterior distribution over model parameters describes how likely each sampling distribution in the model generates the observed data. It peaks at an intercept of -1.5 - -1 (the actual value was -1.2) and a slope of 1.5-2.5 (the actual value was 2.3). It seems to work, although we should have probably sampled a bit more to make this more accurate.

You might have noticed that we only use 800/1000 samples here (take 800 in the code snippet above). What is the reason? If you remember, we saw some random initial samples of the Markov chain in the posterior model parameter distribution in our last post. This was because the chain starts at a random position and needs some steps to reach the stable equilibrium that describes the posterior distribution. We therefore skip the initial part of it. Why do we use take rather than drop for this? Samples are by default appended at the beginning of the list. Therefore, take 800 means that we use the 800 latest samples of the chain and drop the 200 initial ones. Want to know why we skipped 200 and not 20 points? Check out the Appendix for more details!

Simulating Data

The posterior distribution of the model parameters tells us which distributions likely generate the observed data. What data would we generate from the sampling distributions defined by this posterior distribution?

Let's write a new sampler for a predictive distribution:

predDist :: MonadInfer m => m Params -> m Data
predDist paramDist = do
  params <- paramDist
  point <- likelihoodDist params
  return point

We draw samples from it with Metropolis-Hastings:

mkSampler = prior . mh 40000 
pts <- sampleIOfixed $ mkSampler $ predDist $ postParams priorParams points3
predPoints = take (length pts - 100) pts

The data looks like this:

vlShow $ plot  -- [... predPoints, points ...]

png

This looks quite OK; the simulated distribution (blue) looks similar to the original data (green). Although we have drawn 40000 samples with MCMC, you see that the distribution is still not as smooth and nice as we would expect. Of course, we could sample more, but we really should think about our sampling method and see how we adapt it to the problem and make it more efficient. But, that's not the aim of this post, so we'll postpone that discussion to later in our series.

Note that predDist looks very similar to likelihoodDist. The fundamental difference is that the former takes a distribution, in this case the posterior predictive distribution postParams priorParams points :: m Params as input, whereas the latter accepts a single value, in this case params :: Params. The resulting distributions, that we are comparing in the plot above, likelihoodDist params and predDist (postParams priorParams points) look similar—and it is fairly obvious why: The posterior predictive distribution peaks at values close to params and is zero elsewhere. Why does it peak at these values? Well, we gave a high score to those model parameters that are likely to produce the same data as params0. This explanation becomes somewhat circular, but it illustrates again why the predicted points look like the ones that we used for fitting by design.

Conclusions

We went step by step through the modeling process with monad-bayes and a linear regression example. We learned that the model setup takes only a few lines of code, that is the implementation of Data, Params, and likelihood plus the definition of prior and posterior. With these initial definitions, the composability of Haskell functions allows us to rapidly get new distributions like samplingDistribution or a predDist. Involved and with big implications is the sampling process, the choice of the sampling technique, and how it is adapted to the current situation. To sample, we used Metropolis-Hastings and rejection sampling but many other sampling strategies exist.

We hope you enjoyed this second post in our Probabilistic Programming with monad‑bayes Series and learned lots! A central aspect of monad-bayes is to enable the modeller to use and compose different sampling techniques for their models. Now, you're ready to start getting into such questions in our next post. We hope you join us!

Appendix - Stability of the Markov chain

The Markov chain, that we used to sample in this blog post, is a stochastic process that cycles through possible models. Models that are more likely are hit more often than models that are less likely, and over time we thus recover the model distribution that we are interested in. However, typically it needs a while to reach the unique stationary distribution that is equal to the model distribution distribution. A simple way to assess when it becomes stationary is to look at the likelihood that it reaches:

likelihoods = [Numeric.Log.sum (map prob points3) | param <- modelsamples, let prob = likelihood param]
nsamples = length likelihoods

vlShow $ plot  -- [... likelihoods ...]

png

Our MC chain is non-stationary in the beginning at imodel values up to 100, and then reaches stationary behaviour.

Notes

We use this GitHub version ofmonad-bayesin our posts and notebooks since it's neither on Hackage nor Stackage right now.

November 08, 2019 12:00 AM

November 07, 2019

Oleg Grenrus

Semi semi semi semi

Posted on 2019-11-07 by Oleg Grenrus

Semigroups, semigroupoids... are there more semithings?

Group, Semigroup, Monoid

Let’s start "from the beginning". Groups is 19th century thing. A group is a set G with a binary operation \bullet, identity element e and inverse element a^{-1} for each a \in G. With an obvious laws you can imagine relating these.

If we remove identity element from a group, "obviously" we get a semigroup. Because if there’s any element x \in G, we can recover the identity element by e = x \bullet x^{-1}.

So what’s a semigroup with identity element? For sometimes it were just that, until we started call it monoid. Go figure, naming is hard, not only in programming, but also in mathematics.

Category, Groupoid, Semigroupoid

You are hopefully familiar with a concept of a category. I repeat a definition here:

Definition (Awodey 1.1) A category consist of the following data

  • Objects: A, B, C, \ldots

  • Arrows: f, g, h, \ldots

  • For each arrow f, there are given objects

    \mathrm{dom}(f), \qquad \mathrm{cod}(f)

    called the domain and codomain of f. We write

    f : A \to B

    to indicate that A = \mathrm{dom}(f) and B = \mathrm{cod}(f).

  • Given arrows f : A \to B and g : B \to C, that is, with

    \mathrm{cod}(f) = \mathrm{dom}(g)

    there is given an arrow

    g \circ f : A \to C

    called the composite of f and g.

  • For each object A, there is given an arrow

    1_A : A \to A

    called the identity arrow of A.

  • Associativity:

    h \circ (g \circ f) = (h \circ g) \circ f

    for all f : A \to B, g : B \to C, h : C \to D.

  • Unit:

    f \circ 1_A = f = 1_B \circ f

    for all f : A \to B.

If you think hard (or read a book), you’ll learn that a single object category is a monoid: category arrows are monoid elements, and the laws work out.

The group analogue is called groupoid. In addition to category data, we require that for each arrow f : A \to B there is an inverse arrow f^{-1} : B \to A, such that f \circ f^{-1} = 1_B and f^{-1} \circ f = 1_A. Or more succinctly: that each arrow is an isomorphism.

But we can also remove stuff: if we remove identity arrows, and unit law we get semigroupoid.

Definition A semigroupoid consist of the following data

  • Objects: A, B, C, \ldots

  • Arrows: f, g, h, \ldots

  • For each arrow f, there are given objects

    \mathrm{dom}(f), \qquad \mathrm{cod}(f)

    called the domain and codomain of f. We write

    f : A \to B

    to indicate that A = \mathrm{dom}(f) and B = \mathrm{cod}(f).

  • Given arrows f : A \to B and g : B \to C, that is, with

    \mathrm{cod}(f) = \mathrm{dom}(g)

    there is given an arrow

    g \circ f : A \to C

    called the composite of f and g.

  • Associativity:

    h \circ (g \circ f) = (h \circ g) \circ f

    for all f : A \to B, g : B \to C, h : C \to D.

A reader probably ask themselves: are there interesting, not-contrived examples of semigroupoids, which aren’t also categories? There are. If poset (set with partial order) is an example of category, then a set with strict order1, is an example of semigroupoid.

As a concrete example, natural numbers with an unique arrow between n and m when n < m is a semigroupoid.

0 < 1 < 2 < 3 < 4 < \cdots

There are no identity arrow, as n \not< n, but associativity works out: if n < m and m < p then n < p. Let’s call this semigroupoid \mathbf{LT}.

Finally, a plot twist. nLab calls semigroupoids semicategories, and don’t even mention a semigroupoid as an alternative name!

Functors, Semifunctors...

Recall a definition of functor.

Definition (Awodey 1.2) A functor

F : \mathbf{C} \to \mathbf{D}

between categories \mathbf{C} and \mathbf{D} is a mapping of objects to objects and arrows to arrows, in such a way that

  • F (f : A \to B) = F(f) : F(A) \to F(B),

  • F(1_A) = 1_{F(A)},

  • F(g \circ f) = F(g) \circ F(f).

That is, F preserves domains and codomains, identity arrows, and composition. A functor F : \mathbf{C} \to \mathbf{D} thus gives a sort of "picture" – perhaps distorted – of \mathbf{C} in \mathbf{D}.

Functors preserve identities, but semigroupoids don’t have identities to be preserved. We need a weaker concept:

Definition A semifunctor

F : \mathbf{C} \to \mathbf{D}

between semigroupoids \mathbf{C} and \mathbf{D} is a mapping of objects to objects and arrows to arrows, in such a way that

  • F (f : A \to B) = F(f) : F(A) \to F(B),

  • F(g \circ f) = F(g) \circ F(f).

That is, F preserves domains and codomains, and composition. A functor F : \mathbf{C} \to \mathbf{D} thus gives a sort of "picture" – perhaps distorted – of \mathbf{C} in \mathbf{D}.

An identity functor is obviously a semifunctor, also a successor functor S : \mathbf{N} \to \mathbf{N} is a semifunctor \mathbf{LT} \to \mathbf{LT}.

In Haskell, that would be silly to define a class for (endo)semifunctors:

It’s the Functor type-class without an identity law. On the other hand, something like

would be valid.

Semimonad?

Now as we have semifunctors, would it make sense to ask whether endosemifunctors can form a monad

Semimonad A semimonad on semigroupoid C consists of

  • an endosemifunctor T : C \to C

  • semi natural transformation \eta : 1_C \to T (return)

  • semi natural transformation \mu : T^2 \to T (join)

  • Associativity (as semi natural transformations T^3 \to T)

    \mu \circ T \mu = \mu \circ \mu T

  • Identity (as semi natural transformations T \to T)

    \mu \circ T\eta = \mu \circ \eta T = 1_T

Looks a lot like monad, but for semifunctors. I have an example: the S semifunctor is a semimonad. Feels like (I didn’t check) that all strictly monotonic functions would fit. We need to find some more structured semigroupoid than \mathbf{LT} to find more interesting semimonads, but I haven’t yet.

I end with a catchy phrase:

A semimonad is a monoid (!) in the category of endosemifunctors.

What would be a semigroup in the category of endofunctors2, or a semigroup in the category of endosemifunctors?

Naming is hard.

References: More on the theory of semi-functors

There’s a paper The theory of semi-functors by Raymond Hoofman https://doi.org/10.1017/S096012950000013X.


  1. http://mathworld.wolfram.com/StrictOrder.html, I not dare to call the set with strict order a soset

  2. in Haskell we call it Bind, at least now (or Apply for different semigroup)

November 07, 2019 12:00 AM

November 05, 2019

Magnus Therning

Populating Projectile's cache

As I track the develop branch of Spacemacs I occasionally clean out my cache of projects known to Projectile. Every time it takes a while before I’m back at a stage where I very rarely have to visit something that isn’t already in the cache.

However, today I found the function projectile-add-known-project, which prompted me to write the following function that’ll help me quickly re-building the cache the next time I need to reset Spacemacs to a known state again.

November 05, 2019 12:00 AM

November 02, 2019

Donnacha Oisín Kidney

How to do Binary Random-Access Lists Simply

Posted on November 2, 2019
Tags: Agda

“Heterogeneous Random-Access Lists� by Wouter Swierstra (2019) describes how to write a simple binary random-access list (Okasaki 1995) to use as a heterogeneous tuple. If you haven’t tried to implement the data structure described in the paper before, you might not realise the just how elegant the implementation is. The truth is that arriving at the definitions presented is difficult: behind every simple function is a litany of complex and ugly alternatives that had to be tried and discarded first before settling on the final answer.

In this post I want to go through a very similar structure, with special focus on the “wrong turns� in implementation which can lead to headache.

Two Proofs on â„•, and How to Avoid Them

Here are a couple of important identities on â„•:

+0 : ∀ n → n + zero ≡ n
+0 zero    = refl
+0 (suc n) = cong suc (+0 n)

+-suc : ∀ n m → n + suc m ≡ suc n + m
+-suc zero    m = refl
+-suc (suc n) m = cong suc (+-suc n m)

These two show up all the time as proof obligations from the compiler (i.e. “couldn’t match type n + suc m with suc n + m�). The solution is obvious, right? subst in one of the proofs above and you’re on your way. Wait! There might be a better way.

We’re going to look at reversing a vector as an example. We have a normal-looking length-indexed vector:

infixr 5 _∷_
data Vec (A : Set a) : ℕ → Set a where
  [] : Vec A zero
  _∷_ : A → Vec A n → Vec A (suc n)

Reversing a list is easy: we do it the standard way, in <semantics>�(n)<annotation encoding="application/x-tex">\mathcal{O}(n)</annotation></semantics> time, with an accumulator:

list-reverse : List A → List A
list-reverse = go []
  where
  go : List A → List A → List A
  go acc [] = acc
  go acc (x ∷ xs) = go (x ∷ acc) xs

Transferring over to a vector and we see our friends +-suc and +0.

vec-reverse� : Vec A n → Vec A n
vec-reverse� xs = subst (Vec _) (+0 _) (go [] xs)
  where
  go : Vec A n → Vec A m → Vec A (m + n)
  go acc [] = acc
  go acc (x ∷ xs) = subst (Vec _) (+-suc _ _) (go (x ∷ acc) xs)

The solution, as with so many things, is to use a fold instead of explicit recursion. Folds on vectors are a little more aggressively typed than those on lists:

vec-foldr : (B : ℕ → Type b)
          → (∀ {n} → A → B n → B (suc n))
          → B zero
          → Vec A n
          → B n
vec-foldr B f b [] = b
vec-foldr B f b (x ∷ xs) = f x (vec-foldr B f b xs)

We allow the output type to be indexed by the list of the vector. This is a good thing, bear in mind: we need that extra information to properly type reverse.

For reverse, unfortunately, we need a left-leaning fold, which is a little trickier to implement than vec-foldr.

vec-foldl : (B : ℕ → Set b)
          → (∀ {n} → B n → A → B (suc n))
          → B zero
          → Vec A n
          → B n
vec-foldl B f b [] = b
vec-foldl B f b (x ∷ xs) = vec-foldl (B ∘ suc) f (f b x) xs

With this we can finally reverse.

vec-reverse : Vec A n → Vec A n
vec-reverse = vec-foldl (Vec _) (λ xs x → x ∷ xs) []

The real trick in this function is that the type of the return value changes as we fold. If you think about it, it’s the same optimisation that we make for the <semantics>�(n)<annotation encoding="application/x-tex">\mathcal{O}(n)</annotation></semantics> reverse on lists: the B type above is the “difference list� in types, allowing us to append on to the end without <semantics>�(n2)<annotation encoding="application/x-tex">\mathcal{O}(n^2)</annotation></semantics> proofs.

As an aside, this same trick can let us type the convolve-TABA (Danvy and Goldberg 2005; Foner 2016) function quite simply:

convolve : Vec A n → Vec B n → Vec (A × B) n
convolve =
  vec-foldl
    (λ n → Vec _ n → Vec _ n)
    (λ { k x (y ∷ ys) → (x , y) ∷ k ys})
    (λ _ → [])

Binary Numbers

Binary numbers come up a lot in dependently-typed programming languages: they offer an alternative representation of ℕ that’s tolerably efficient (well, depending on who’s doing the tolerating). In contrast to the Peano numbers, though, there are a huge number of ways to implement them.

I’m going to recommend one particular implementation over the others, but before I do I want to define a function on ℕ:

2* : ℕ → ℕ
2* zero = zero
2* (suc n) = suc (suc (2* n))

In all of the implementations of binary numbers we’ll need a function like this. It is absolutely crucial that it is defined in the way above: the other obvious definition (2* n = n + n) is a nightmare for proofs.

Right, now on to some actual binary numbers. The obvious way (a list of bits) is insufficient, as it allows multiple representations of the same number (because of the trailing zeroes). Picking a more clever implementation is tricky, though. One way splits it into two types:

module OneTerminated where
  infixl 5 _0ᵇ _1ᵇ
  infixr 4 �_

  data �� : Set where
    1ᵇ : ��
    _0ᵇ _1ᵇ : �� → ��

  data � : Set where
    �0ᵇ : �
    �_ : �� → �

�� is the strictly positive natural numbers (i.e. the naturals starting from 1). � adds a zero to that set. This removes the possibility for trailing zeroes, thereby making this representation unique for every natural number.

Evaluation is pretty standard

  ⟦_⇓⟧� : �� → ℕ
  ⟦ 1ᵇ   ⇓⟧� = 1
  ⟦ x 0ᵇ ⇓⟧� =      2* ⟦ x ⇓⟧�
  ⟦ x 1ᵇ ⇓⟧� = suc (2* ⟦ x ⇓⟧�)

  ⟦_⇓⟧ : � → ℕ
  ⟦ �0ᵇ  ⇓⟧ = 0
  ⟦ � x  ⇓⟧ = ⟦ x ⇓⟧�

The odd syntax lets us write binary numbers in the natural way:

  _ : ⟦ � 1ᵇ 0ᵇ 1ᵇ ⇓⟧ ≡ 5
  _ = refl

  _ : ⟦ � 1ᵇ 0ᵇ 0ᵇ 1ᵇ ⇓⟧ ≡ 9
  _ = refl

I would actually recommend this representation for most use-cases, especially when you’re using binary numbers “as binary numbers�, rather than as an abstract type for faster computation.

Another clever representation is one I wrote about before: the “gapless� representation. This is far too much trouble for what it’s worth.

Finally, my favourite representation at the moment is zeroless. It has a unique representation for each number, just like the two above, but it is still a list of bits. The difference is that the bits here are 1 and 2, not 0 and 1. I like to reuse types in combination with pattern synonyms (rather than defining new types), as it can often make parallels between different functions clearer.

Bit : Set
Bit = Bool

pattern 1ᵇ = false
pattern 2ᵇ = true

� : Set
� = List Bit

Functions like inc are not difficult to implement:

inc : � → �
inc [] = 1ᵇ ∷ []
inc (1ᵇ ∷ xs) = 2ᵇ ∷ xs
inc (2ᵇ ∷ xs) = 1ᵇ ∷ inc xs

And evaluation:

_∷⇓_ : Bit → ℕ → ℕ
1ᵇ ∷⇓ xs =      suc (2* xs)
2ᵇ ∷⇓ xs = suc (suc (2* xs))

⟦_⇓⟧ : � → ℕ
⟦_⇓⟧ = foldr _∷⇓_ zero

Since we’re working in Cubical Agda, we might as well go on and prove that � is isomorphic to ℕ. I’ll include the proof here for completeness, but it’s not relevant to the rest of the post (although it is very short, as a consequence of the simple definitions).

Proof that � and ℕ are isomorphic

⟦_⇑⟧ : ℕ → �
⟦ zero  ⇑⟧ = []
⟦ suc n ⇑⟧ = inc ⟦ n ⇑⟧

2*⇔1ᵇ∷ : ∀ n → inc ⟦ 2* n ⇑⟧ ≡ 1ᵇ ∷ ⟦ n ⇑⟧
2*⇔1ᵇ∷ zero = refl
2*⇔1ᵇ∷ (suc n) = cong (inc ∘ inc) (2*⇔1ᵇ∷ n)

�→ℕ→� : ∀ n → ⟦ ⟦ n ⇓⟧ ⇑⟧ ≡ n
�→ℕ→� [] = refl
�→ℕ→� (1ᵇ ∷ xs) =           2*⇔1ᵇ∷ ⟦ xs ⇓⟧  ; cong (1ᵇ ∷_) (�→ℕ→� xs)
�→ℕ→� (2ᵇ ∷ xs) = cong inc (2*⇔1ᵇ∷ ⟦ xs ⇓⟧) ; cong (2ᵇ ∷_) (�→ℕ→� xs)

inc⇔suc : ∀ n → ⟦ inc n ⇓⟧ ≡ suc ⟦ n ⇓⟧
inc⇔suc [] = refl
inc⇔suc (1ᵇ ∷ xs) = refl
inc⇔suc (2ᵇ ∷ xs) = cong (suc ∘ 2*) (inc⇔suc xs)

ℕ→�→ℕ : ∀ n → ⟦ ⟦ n ⇑⟧ ⇓⟧ ≡ n
ℕ→�→ℕ zero    = refl
ℕ→�→ℕ (suc n) = inc⇔suc ⟦ n ⇑⟧ ; cong suc (ℕ→�→ℕ n)

�⇔ℕ : � ⇔ ℕ
�⇔ℕ = iso ⟦_⇓⟧ ⟦_⇑⟧ ℕ→�→ℕ �→ℕ→�

Binary Arrays

Now on to the data structure. Here’s its type.

infixr 5 _1∷_ _2∷_
data Array (T : ℕ → Type a) : � → Type a where
  []  : Array T []
  _∷_ : T (bool 0 1 d) → Array (T ∘ suc) ds → Array T (d ∷ ds)

pattern _1∷_ x xs = _∷_ {d = 1ᵇ} x xs
pattern _2∷_ x xs = _∷_ {d = 2ᵇ} x xs

So it is a list-like structure, which contains elements of type T. T is the type of trees in the array: making the array generic over the types of trees is a slight departure from the norm. Usually, we would just use a perfect tree or something:

module Prelim where
  Perfect : Set a → ℕ → Set a
  Perfect A zero = A
  Perfect A (suc n) = Perfect (A × A) n

By making the tree type a parameter, though, we actually simplify some of the code for manipulating the tree. It’s basically the same trick as the type-changing parameter in vec-foldl.

As well as that, of course, we can use the array with more exotic tree types. With binomial trees, for example, we get a binomial heap:

mutual
  data BinomNode (A : Set a) : ℕ → Set a where
    binom-leaf   : BinomNode A 0
    binom-branch : Binomial A n → BinomNode A n → BinomNode A (suc n)

  Binomial : Set a → ℕ → Set a
  Binomial A n = A × BinomNode A n

But we’ll stick to the random-access lists for now.

Top-down and Bottom-up Trees

The perfect trees above are actually a specific instance of a more general data type: exponentiations of functors.

_^_ : (Set a → Set a) → ℕ → Set a → Set a
(F ^ zero ) A = A
(F ^ suc n) A = (F ^ n) (F A)

Nest : (Set a → Set a) → Set a → ℕ → Set a
Nest F A n = (F ^ n) A

Pair : Set a → Set a
Pair A = A × A

Perfect : Set a → ℕ → Set a
Perfect = Nest Pair

It’s a nested datatype, built in a bottom-up way. This is in contrast to, say, the binomial trees above, which are top-down.

Construction

Our first function on the array is cons, which inserts an element:

cons : (∀ n → T n → T n → T (suc n))
     → T 0 → Array T ds → Array T (inc ds)
cons branch x [] = x 1∷ []
cons branch x (y 1∷ ys) = branch 0 x y 2∷ ys
cons branch x (y 2∷ ys) = x 1∷ cons (branch ∘ suc) y ys

Since we’re generic over the type of trees, we need to pass in the “branch� constructor (or function) for whatever tree type we end up using. Here’s how we’d implement such a branch function for perfect trees.

perf-branch : ∀ n → Perfect A n → Perfect A n → Perfect A (suc n)
perf-branch zero = _,_
perf-branch (suc n) = perf-branch n

One issue here is that the perf-branch function probably doesn’t optimise to the correct complexity, because the n has to be scrutinised repeatedly. The alternative is to define a cons for nested types, like so:

nest-cons : (∀ {A} → A → A → F A) → A → Array (Nest F A) ds → Array (Nest F A) (inc ds)
nest-cons _∙_ x [] = x ∷ []
nest-cons _∙_ x (y 1∷ ys) = (x ∙ y) 2∷ ys
nest-cons _∙_ x (y 2∷ ys) = x ∷ nest-cons _∙_ y ys

perf-cons : A → Array (Perfect A) ds → Array (Perfect A) (inc ds)
perf-cons = nest-cons _,_

Indexing

Again, we’re going to keep things general, allowing multiple index types. For those index types we’ll need a type like Fin but for binary numbers.

data Fin� (A : Set a) : � → Type a where
  here� :                       Fin� A (1ᵇ ∷ ds)
  here₂ : (i : A)             → Fin� A (2ᵇ ∷ ds)
  there : (i : A) → Fin� A ds → Fin� A (d  ∷ ds)

lookup : (∀ {n} → P → T (suc n) → T n)
       → Array T ds
       → Fin� P ds
       → T 0
lookup ind (x ∷ xs) here� = x
lookup ind (x ∷ xs) (here₂ i) = ind i x
lookup ind (x ∷ xs) (there i is) = ind i (lookup ind xs is)

nest-lookup : (∀ {A} → P → F A → A)
            → Array (Nest F A) ds
            → Fin� P ds
            → A
nest-lookup ind (x ∷ xs) here� = x
nest-lookup ind (x ∷ xs) (here₂ i) = ind i x
nest-lookup ind (x ∷ xs) (there i is) = ind i (nest-lookup ind xs is)

We’ll once more use perfect to show how these generic functions can be concretised. For the index types into a perfect tree, we will use a Bool.

perf-lookup : Array (Perfect A) ds → Fin� Bool ds → A
perf-lookup = nest-lookup (bool fst snd)

Folding

This next function is quite difficult to get right: a fold. We want to consume the binary array into a unary, cons-list type thing. Similarly to foldl on vectors, we will need to change the return type as we fold, but we will also need to convert from binary to unary, as we fold. The key ingredient is the following function:

2^_*_ : ℕ → ℕ → ℕ
2^ zero  * n = n
2^ suc m * n = 2* (2^ m * n)

It will let us do the type-change-as-you-go trick from foldl, but in a binary setting. Here’s foldr:

array-foldr : (B : ℕ → Type b)
            → (∀ n {m} → T n → B (2^ n * m) → B (2^ n * suc m))
            → B 0 → Array T ds → B ⟦ ds ⇓⟧
array-foldr B c b []        = b
array-foldr B c b (x 1∷ xs) = c 0 x (array-foldr (B ∘ 2*) (c ∘ suc) b xs)
array-foldr B c b (x 2∷ xs) = c 1 x (array-foldr (B ∘ 2*) (c ∘ suc) b xs)

And, as you should expect, here’s how to use this in combination with the perfect trees. Here we’ll build a binary random access list from a vector, and convert back to a vector.

perf-foldr : (B : ℕ → Type b)
           → (∀ {n} → A → B n → B (suc n))
           → ∀ n {m}
           → Perfect A n
           → B (2^ n * m)
           → B (2^ n * suc m)
perf-foldr B f zero = f
perf-foldr B f (suc n) =
  perf-foldr (B ∘ 2*) (λ { (x , y) zs → f x (f y zs) }) n

toVec : Array (Perfect A) ds → Vec A ⟦ ds ⇓⟧
toVec = array-foldr (Vec _) (perf-foldr (Vec _) _∷_) []

fromVec : Vec A n → Array (Perfect A) ⟦ n ⇑⟧
fromVec = vec-foldr (Array (Perfect _) ∘ ⟦_⇑⟧) perf-cons []

Lenses

That’s the end of the “simple� stuff! The binary random-access list I’ve presented above is about as simple as I can get it.

In this section, I want to look at some more complex (and more fun) things you can do with it. First: lenses.

Lenses aren’t super ergonomic in dependently-typed languages, but they do come with some advantages. The lens laws are quite strong, for instance, meaning that often by constructing programs using a lot of lenses gives us certain properties “for free�. Here, for instance, we can define the lenses for indexing.

open import Lenses

Lenses into the head and tail of an array

head : Lens (Array T (d ∷ ds)) (T (bool 0 1 d))
head .into (x ∷ _ ) .get = x
head .into (_ ∷ xs) .set x = x ∷ xs
head .get-set (_ ∷ _) _ = refl
head .set-get (_ ∷ _) = refl
head .set-set (_ ∷ _) _ _ = refl

tail : Lens (Array T (d ∷ ds)) (Array (T ∘ suc) ds)
tail .into (_ ∷ xs) .get = xs
tail .into (x ∷ _ ) .set xs = x ∷ xs
tail .get-set (_ ∷ _) _ = refl
tail .set-get (_ ∷ _) = refl
tail .set-set (_ ∷ _) _ _ = refl
nest-lens : (∀ {A} → P → Lens (F A) A)
          → Fin� P ds
          → Lens (Array (Nest F A) ds) A
nest-lens ln here�        = head
nest-lens ln (here₂ i)    = head ⋯ ln i
nest-lens ln (there i is) = tail ⋯ nest-lens ln is ⋯ ln i

Top-down version

ind-lens : (∀ {n} → P → Lens (T (suc n)) (T n))
         → Fin� P ds
         → Lens (Array T ds) (T 0)
ind-lens ln here�        = head
ind-lens ln (here₂ i)    = head ⋯ ln i
ind-lens ln (there i is) = tail ⋯ ind-lens ln is ⋯ ln i

Fenwick Trees

Finally, to demonstrate some of the versatility of this data structure, we’re going to implement a tree based on a Fenwick tree. This is a data structure for prefix sums: we can query the running total at any point, and update the value at a given point, in <semantics>�(logn)<annotation encoding="application/x-tex">\mathcal{O}(\log n)</annotation></semantics> time. We’re going to make it generic over a monoid:

module _ {â„“} (mon : Monoid â„“) where
  open Monoid mon

  record Leaf : Set â„“ where
    constructor leaf
    field val : �
  open Leaf

  mutual
    SumNode : ℕ → Set ℓ
    SumNode