Writing compilers and interpreters requires rigorous management of source code locations harvested during syntax analysis and associated error handling mechanisms that involve reporting those locations along with details of errors they associate to.
This article does a "deep dive" into the the Location
module of the OCaml compiler. The original source can be found in the ocaml/parsing
directory of an OCaml distribution (copyright Xavier Leroy).
Location
is a masterclass in using the standard library Format
module. If you have had difficulties understanding Format
and what it provides the OCaml programmer, then this is for you. Furthermore, Location
contains invaluable idioms for error reporting & exception handling. Learn them here to be able to apply them in your own programs.
A location corresponds to a range of characters in a source file. Location
defines this type and a suite of functions for the production of location values.
type t = {
loc_start : Lexing.position;
loc_end : Lexing.position;
loc_ghost : bool
}
val none : t
val in_file : string → t
val init : Lexing.lexbuf → string → unit
val curr : Lexing.lexbuf → t
val symbol_rloc : unit → t
val symbol_gloc : unit → t
val rhs_loc : int → t
type 'a loc = {
txt : 'a;
loc : t;
}
val mkloc : 'a → t → 'a loc
val mknoloc : 'a → 'a loc
A value of the (standard library) type Lexing.position
describes a point in a source file.
The fields of this record have the following meanings:
type position = {
pos_fname : string;
pos_lnum : int;
pos_bol : int;
pos_cnum : int
}
pos_fname
is the file namepos_lnum
is the line numberpos_bol
is the offset of the beginning of the line (the number of characters between the beginning of the lexbuf and the beginning of the line)pos_cnum
is the offset of the position (number of characters between the beginning of the lexbuf (details below) and the position)pos_cnum
and pos_bol
is the character offset within the line (i.e. the column number, assuming each character is one column wide).
A location in a source file is defined by two positions : where the location starts and where the location ends.
The third field
type t = {
loc_start : position;
loc_end : position;
loc_ghost : bool
}
loc_ghost
is used to disambiguate locations that do not appear explicitly in the source file. A location will not be marked as ghost if it contains a piece of code that is syntactically valid and corresponds to an AST node and will be marked as a ghost location otherwise.
There is a specific value denoting a null position. It is called none
and it is defined by the function in_file
.
let in_file (name : string) : t =
let loc : position = {
pos_fname = name; (*The name of the file*)
pos_lnum = 1; (*The line number of the position*)
pos_bol = 0; (*Offset from the beginning of the lexbuf of the line*)
pos_cnum = 1; (*Offset of the position from the beginning of the lexbuf*)
} in
{ loc_start = loc; loc_end = loc; loc_ghost = true }
let none : t = in_file "_none_"
Lexing.lexbuf
is the (standard library) type of lexer buffers. A lexer buffer is the argument passed to the scanning functions defined by generated scanners (lexical analyzers). The lexer buffer holds the current state of the scanner plus a function to refill the buffer from the input.
At each token, the lexing engine will copy
type lexbuf = {
refill_buff : lexbuf → unit;
mutable lex_buffer : bytes;
mutable lex_buffer_len : int;
mutable lex_abs_pos : int;
mutable lex_start_pos : int;
mutable lex_curr_pos : int;
mutable lex_last_pos : int;
mutable lex_last_action : int;
mutable lex_eof_reached : bool;
mutable lex_mem : int array;
mutable lex_start_p : position;
mutable lex_curr_p : position;
}
lex_curr_p
to lex_start_p
then change the pos_cnum
field of lex_curr_p
by updating it with the number of characters read since the start of the lexbuf
. The other fields are left unchanged by the the lexing engine. In order to keep them accurate, they must be initialized before the first use of the lexbuf and updated by the relevant lexer actions. The location of the current token in a lexbuf is computed by the function
(*Set the file name and line number of the [lexbuf] to be the start
of the named file*)
let init (lexbuf : Lexing.lexbuf) (fname : string) : unit =
let open Lexing in
lexbuf.lex_curr_p < {
pos_fname = fname;
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
}
curr
.
(*Get the location of the current token from the [lexbuf]*)
let curr (lexbuf : Lexing.lexbuf) : t =
let open Lexing in {
loc_start = lexbuf.lex_start_p;
loc_end = lexbuf.lex_curr_p;
loc_ghost = false;
}
Parsing
is the runtime library for parsers generated by ocamlyacc
. The functions symbol_start
and symbol_end
are to be called in the action part of a grammar rule (only). They return the offset of the string that matches the lefthandside of the rule : symbol_start
returns the offset of the first character; symbol_end
returns the offset after the last character. The first character in a file is at offset 0.
symbol_start_pos
and symbol_end_pos
are like symbol_start
and symbol_end
but return Lexing.position
values instead of offsets.
(*Compute the span of the lefthandside of the matched rule in the
program source*)
let symbol_rloc () : t = {
loc_start = Parsing.symbol_start_pos ();
loc_end = Parsing.symbol_end_pos ();
loc_ghost = false
}
(*Same as [symbol_rloc] but designates the span as a ghost range*)
let symbol_gloc () : t = {
loc_start = Parsing.symbol_start_pos ();
loc_end = Parsing.symbol_end_pos ();
loc_ghost = true
}
The Parsing
functions rhs_start
and rhs_end
are the same as symbol_start
and symbol_end
but return the offset of the string matching the n
th item on the righthandside of the rule where n
is the integer parameter to rhs_start
and rhs_end
. n
is 1 for the leftmost item. rhs_start_pos
and rhs_end_pos
return a position instead of an offset.
(*Compute the span of the [n]th item of the righthandside of the
matched rule*)
let rhs_loc n = {
loc_start = Parsing.rhs_start_pos n;
loc_end = Parsing.rhs_end_pos n;
loc_ghost = false;
}
The type 'a
loc associates a value with a location.
(*A type for the association of a value with a location*)
type 'a loc = {
txt : 'a;
loc : t;
}
(*Create an ['a loc] value from an ['a] value and location*)
let mkloc (txt : 'a) (loc : t) : 'a loc = { txt ; loc }
(*Create an ['a loc] value bound to the distinguished location called
[none]*)
let mknoloc (txt : 'a) : 'a loc = mkloc txt none
Location
has a framework for error reporting across modules concerned with locations (think lexer, parser, typechecker, etc).
So, in the definition of the
open Format
type error =
{
loc : t;
msg : string;
sub : error list;
}
val error_of_printer : t → (formatter → 'a → unit) → 'a → error
val errorf_prefixed : ?loc : t → ?sub : error list → ('a, Format.formatter, unit, error) format4 → 'a
error
record, loc
is a location in the source code, msg
an explanation of the error and sub
a list of related errors. We deal here with the error formatting functions. The utility function print_error_prefix
simply writes an error prefix to a formatter. The syntax, "
let error_prefix = "Error"
let warning_prefix = "Warning"
let print_error_prefix (ppf : formatter) () : unit =
fprintf ppf "@{<error>%s@}:" error_prefix;
()
@{<error>%s}@
" associates the embedded text with the named tag "error".
Next another utility, pp_ksprintf
.
It proceeds as follows. A buffer and a formatter over that buffer is created. When presented with all of the arguments of the format operations implied by the
let pp_ksprintf
?(before : (formatter → unit) option)
(k : string → 'd)
(fmt : ('a, formatter, unit, 'd) format4) : 'a =
let buf = Buffer.create 64 in
let ppf = Format.formatter_of_buffer buf in
begin match before with
 None → ()
 Some f → f ppf
end;
kfprintf
(fun (_ : formatter) : 'd →
pp_print_flush ppf ();
let msg = Buffer.contents buf in
k msg)
ppf fmt
fmt
argument, if the before
argument is nonempty, call it on the formatter. Finally, call kfprintf
(from the standard library Format
module) which performs the format operations on the buffer before handing control to a function that retrieves the contents of the now formatted buffer and passes them to the user provided continuation k
.
With pp_ksprintf
at our disposal, one can write the function errorf_prefixed
.
let errorf_prefixed
?(loc:t = none)
?(sub : error list = [])
(fmt : ('a, Format.formatter, unit, error) format4) : 'a =
let e : 'a =
pp_ksprintf
~before:(fun ppf → fprintf ppf "%a " print_error_prefix ())
(fun (msg : string) : error → {loc; msg; sub})
fmt
in e
errorf_prefixed
computes a function. The function it computes provides the means to produce error
values by way of formatting operations to produce the msg
field of the error
result value. The formatting operations include prefixing the msg
field with the error_prefix
string. The type of the arguments of the computed function unifies with the type variable 'a
. In other words, the type of the computed function is 'a → error
. For example, the type of errorf_prefixed "%d %s"
is int → string → error
.
The groundwork laid with errorf_prefixed
above means a polymorphic function error_of_printer
can now be produced.
The idea is that
let error_of_printer
(loc : t)
(printer : formatter → 'error_t → unit)
(x : 'error_t) : error =
let mk_err : 'error_t → error =
errorf_prefixed ~loc "%a@?" printer in
mk_err x
error_of_printer
is provided a function that can format a value of type 'error
. This function is composed with errorf_prefixed
thereby producing a function of type 'error → error
. For example, we can illustrate how this works by making an error of a simple integer with code like the following:
# error_of_printer none (fun ppf x → Format.fprintf ppf "Code %d" x) 3;;
 : error =
{loc =
{loc_start =
{pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = 1};
loc_end = {pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = 1};
loc_ghost = true};
msg = "Error: Code 3"; sub = []}
So, that's error_of_printer
. The following utility function is much simpler  it simply writes a given filename to a formatter.
Next, a set of constants for consistent messages that involve locations and a function to get the file, line and column of a position.
let print_filename (ppf : formatter) (file : string) : unit =
fprintf ppf "%s" file
Making use of the above we have now
let (msg_file, msg_line, msg_chars, msg_to, msg_colon) =
("File \"", (*'msg file'*)
"\", line ", (*'msg line'*)
", characters ", (*'msg chars'*)
"", (*'msg to'*)
":") (*'msg colon'*)
let get_pos_info pos = (pos.pos_fname, pos.pos_lnum, pos.pos_cnum  pos.pos_bol)
print_loc
: a function to print a location on a formatter in terms of file, line and character numbers. Locations generally speaking come out in a format along the lines of:
let print_loc (ppf : formatter) (loc : t) : unit =
let (file, line, startchar) = get_pos_info loc.loc_start in
let endchar = loc.loc_end.pos_cnum  loc.loc_start.pos_cnum + startchar in
if file = "//toplevel//" then
fprintf ppf "Characters %i%i"
loc.loc_start.pos_cnum loc.loc_end.pos_cnum
else begin
fprintf ppf "%s@{<loc>%a%s%i" msg_file print_filename file msg_line line;
if startchar >= 0 then
fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar;
fprintf ppf "@}"
end
File "<string>, line 1, characters 010:"
That last function,
let print (ppf : formatter) (loc : t) : unit =
(* The syntax, [@{<loc>%a@}] associates the embedded text with the
named tag 'loc'*)
fprintf ppf "@{<loc>%a@}%s@." print_loc loc msg_colon
print
is just a small wrapper over print_loc
that appends a colon to the location.
This section is concerned with the following section of the Location
's signature.
val register_error_of_exn : (exn → error option) → unit
val error_of_exn : exn → error option
val error_reporter : (formatter → error → unit) ref
val report_error : formatter → error → unit
val report_exception : formatter → exn → unit
Location
contains a mutable list of exception handlers where an exception handler is a function of type exn → error option
. A function is provided that adds an exception handler to the above list.
let error_of_exn : (exn → error option) list ref = ref []
The next function
let register_error_of_exn f = error_of_exn := f :: !error_of_exn
error_of_exn
(yes, it is the only remaining function that manipulates the list error_exn
previously defined directly) walks the list looking for a handler returning the contents of the result of the first such function that doesn't return a None
value.
let error_of_exn exn =
let rec loop = function
 [] → None
 f :: rest →
match f exn with
 Some _ as r → r
 None → loop rest
in
loop !error_of_exn
We define now a "default" error reporting function. Given a formatter and an error, write the error location, an explanation of the error to the formatter and the same for any associated "sub" errors.
Now,
let rec default_error_reporter
(ppf : formatter) ({loc; msg; sub} : error) : unit =
print ppf loc;
Format.pp_print_string ppf msg;
List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub
error_reporter
itself is a reference cell with default value default_error_reporter
. This next function,
let error_reporter = ref default_error_reporter
print_updating_num_loc_lines
looks more complicated than it is but does demonstrate a rather advanced usage of Format
by containing calls to the functions pp_get_formatter_out_functions
, pp_set_formatter_out_functions
to tempoarily replace the default function for writing strings. The semantic of the function is to print an error on a formatter incidentally recording the number of lines required to do so. The function
(* A mutable line count*)
let num_loc_lines : int ref = ref 0
(*Prints an error on a formatter incidentally recording the number of
lines required to do so*)
let print_updating_num_loc_lines
(ppf : formatter)
(f : formatter → error → unit)
(arg : error) : unit =
(*A record of functions of output primitives*)
let out_functions : formatter_out_functions
= pp_get_formatter_out_functions ppf () in
(*The strategoy is to temporarily replace the basic function for
writing a string with this one*)
let out_string (str : string) (start : int) (len : int) : unit =
(*A function for counting line breaks in [str]. [c] is the current
count, [i] is the current char under consideration*)
let rec count (i : int) (c : int) : int=
if i = start + len then c
else if String.get str i = '\n' then count (succ i) (succ c)
else count (succ i) c
in
(*Update the count*)
num_loc_lines := !num_loc_lines + count start 0;
(*Write the string to the formatter*)
out_functions.out_string str start len
in
(*Replace the standard string output primitive with the one just
defined *)
pp_set_formatter_out_functions ppf
{out_functions with out_string} ;
(*Write the error to the formatter*)
f ppf arg ;
pp_print_flush ppf ();
(*Restore the standard primitive*)
pp_set_formatter_out_functions ppf out_functions
report_error
uses the currently installed error reporter to write an error report for a given error and formatter incidentally updating a count indicating the number of lines written.
let report_error (ppf : formatter) (err : error) : unit=
print_updating_num_loc_lines ppf !error_reporter err
This next function, report_exception_rec
tries a number of times to find a handler for a given error and if successful formats it. In the worst case a handler is never found and the exception propogates.
The last piece is
let rec report_exception_rec (n : int) (ppf : formatter) (exn : exn) : unit =
(*Try to find a handler for the exception*)
try match error_of_exn exn with
 Some err →
(*Format the resulting error using the current error reporter*)
fprintf ppf "@[%a@]@." report_error err
(*The syntax @[%a@]@ writes function output in a box followed by a
'cut' break hint*)
 None → raise exn (*A handler could not be found*)
with exn when n > 0 →
(*A handler wasn't found. Try again*)
report_exception_rec (n  1) ppf exn
report_exception
. It attempts to write an error report for the given exception on the provided formatter. The exception can be reraised if no handler is found.
let report_exception (ppf : formatter) (exn : exn) : unit =
report_exception_rec 5 ppf exn
In this section we see how an example of how the above machinery is used. Consider defining a lexical analyzer as an example. Suppose the scanner is defined by the file lexer.mll
(the input file to ocamllex
). We can imagine its header containing code like the following.
A function to handle errors with attached locations (in a REPL for example) is expressible as an idiom as simple as something like this.
{
(*The cases of lexer errors*)
type error =
 Illegal_character of char
 Unterminated_comment of Location.t
(*The lexer exception type*)
exception Error of error * Location.t
(*This function takes a formatter and an instance of type
[error] and writes a message to the formatter explaining the
meaning. This is a "printer"*)
let report_error (ppf : Format.formatter) : error → unit = function
 Illegal_character c →
Format.fprintf ppf "Illegal character (%s)" (Char.escaped c)
 Unterminated_comment _ →
Format.fprintf ppf "Comment not terminated"
(*Note that [report_error] is a function that unifies with
the [formatter → 'a → unit] parameter of
[error_of_printer]*)
(*Register an exception handler for the lexer exception type*)
let () =
Location.register_error_of_exn
(function
 Error (err, loc) →
Some (Location.error_of_printer loc report_error err)
 _ → None
)
}
/*...*/
rule token = ...
let handle_interpreter_error ?(finally=(fun () → ())) ex =
finally ();
Location.report_exception (Format.std_formatter) ex
let safe_proc ?finally f =
try f ()
with exn → handle_interpreter_error ?finally exn
The approach here, and my original implementation are both lifted almost entirely from Luka Horvat's plugin for
simpleeffects
. All praise should be directed to him.
Last time we chatted about using a GHC plugin to run custom CoretoCore transformations on the programs that GHC is compiling. Doing so allows us to add custom optimization passes, and even other, more exotic things like rewriting lambda expression as categorical operations.
Today I want to talk about another sort of GHC plugin: typechecker plugins! TC plugins let you hook into GHC's constraint machinery and help it solve domainspecific problems that it wouldn't be able to otherwise. One of the more interesting examples of a TC plugin is nomeata's ghcjustdoit  which will automatically generate a value of the correct type, essentially letting you leave implementations as "exercises for the compiler."
Polysemy uses a TC plugin in order to improve typeinference. The result is that it can provide typeinference that is as good as mtl
's, without succumbing to the pitfalls that accompany mtl
's approach.
Consider the following program:
foo :: MonadState Int m => m ()
foo = modify (+ 1)
Such a thing compiles and runs no problem. There are no surprises here for any Haskell programmers who have ever run into mtl
. But the reason it works is actually quite subtle. If we look at the type of modify
we see:
modify :: MonadState s m => (s > s) > m ()
which suggests that the s > s
function we pass to it should determine the s
parameter. But our function (+ 1)
has type Num a => a > a
, therefore the type of modify (+1)
should be this:
modify (+ 1) :: (MonadState s m, Num s) => m ()
So the question is, why the heck is GHC willing to use a MonadState Int m
constraint to solve the wanted (MonadState s m, Num s)
constraint arising from a use of modify (+1)
? The problem feels analogous to this one, which doesn't work:
bar :: Show Bool => a > String
bar b = show b  doesn't work
Just because we have a Show Bool
constraint in scope doesn't mean that a
is a Bool
! So how come we're allowed to use our MonadState Int m
constraint, to solve a (MonadState s m, Num s)
? Completely analogously, we don't know that s
is an Int
!
The solution to this puzzler is in the definition of MondState
:
class Monad m => MonadState s (m :: * > *)  m > s where
Notice this  m > s
bit, which is known as a functional dependency or a fundep for short. The fundep says "if you know m
, you also know s
," or equivalently, "s
is completely determined by m
." And so, when typechecking foo
, GHC is asked to solve both MonadState Int m
and (Num s, MonadState s m)
. But since there can only be a single instance of MonadState
for m, this means that MonadState Int m
and MonadState s m
must be the same. Therefore s ~ Int
.
This is an elegant solution, but it comes at a cost  namely that we're only allowed to use a single MonadState
at a time! If you're a longtime Haskell programmer, this probably doesn't feel like a limitation to you; just stick all the pieces of state you want into a single type, and then use some classy fields to access them, right? Matt Parsons has a blog post on the pain points, and some bandages, for doing this with typed errors. At the end of the day, the real problem is that we're only allowed a single MonadError
constraint.
Polysemy "fixes the glitch" by just not using fundeps. This means you're completely free to use as many state, error, and whatever effects you want all at the same time. The downside? Typeinference sucks again. Indeed, the equivalent program to foo
in polysemy
doesn't compile by default:
foo' :: Member (State Int) r => Sem r ()
foo' = modify (+ 1)
• Ambiguous use of effect 'State'
Possible fix:
add (Member (State s0) r) to the context of
the type signature
If you already have the constraint you want, instead
add a type application to specify
's0' directly, or activate polysemyplugin which
can usually infer the type correctly.
• In the expression: modify (+ 1)
In an equation for ‘foo'’: foo' = modify (+ 1)
This situation blows chunks. It's obvious what this program should do, so let's just fix it.
Let's forget about the compiler for a second and ask ourselves how the Human Brain Typechecker(TM) would typecheck this problem. Given the program:
foo' :: Member (State Int) r => Sem r ()
foo' = modify (+ 1)
A human would look at the modify
here, and probably run an algorithm similar to this:
State
is modify
running over here?Num
.Member (State Int) r
constraint in scope.modify
is running over State Int
.Pretty great algorithm! Instead, here's what GHC does:
State
is modify
running over here?Num
.(Num n, Member (State n) r)
constraint.Member (State Int) r
constraint here?And then worse, it won't compile because the generated n
type is now ambiguous and not mentioned anywhere in the type signature!
Instead, let's use a TC plugin to make GHC reason more like a human when it comes to Member
constraints. In particular, we're going to mock the fundep lookup algorithm:
Member (effect a) r
constraintMember (effect b) r
a ~ b
constraint, allowing GHC to use the given Member (effect b) r
constraint to solve the wanted Member (effect a) r
At its heart, a TC plugin is a value of type TcPlugin
, a record of three methods:
data TcPlugin = forall s. TcPlugin
{ tcPluginInit :: TcPluginM s
, tcPluginSolve :: s > [Ct] > [Ct] > [Ct] > TcPluginM TcPluginResult
, tcPluginStop :: s > TcPluginM ()
}
The tcPluginInit
field can be used to allocate a piece of state that is passed to the other two records, and tcPluginStop
finalizes that state. Most plugins I've seen use the s
parameter to lookup the GHC representation of classes that they want to help solve. However, the most interesting bit is the tcPluginSolve
function.
tcPluginSolve
takes three lists of Ct
s, which are different varieties of constraints relevant to the problem.
From these three lists, we are expected to provide a TcPluginResult
, which for our purposes is a pair of new Ct
s we'd like GHC to solve; and a list of the Ct
s we solved, along with the corresponding dictionaries. Returning two empty lists here signals to GHC "I can't do any more work!"
So let's get to work. The first thing we need to do is get our hands on the Member
class we want to solve. In polysemy
, Member
is actually just a type synonym for a few other typeclasses; so the real typeclass we'd like to solve for is called Find
.
As a brief aside on the Find
class, its definition is this:
class Find (r :: [k]) (t :: k) where
and it means "lookup the index of t
inside r
". In Polysemy, r
is usually left polymorphic, for the same reasons that we leave the m
polymorphic in MonadState s m
.
Anyway, we want to find the Find
class. We can do this by writing a function for our tcPluginInit
function:
findFindClass :: TcPlugin Class
findFindClass = do
md < lookupModule
(mkModuleName "Polysemy.Internal.Union")
(fsLit "polysemy")
find_tc < lookupName md $ mkTcOcc "Find"
tcLookupClass find_tc
We first lookup the defining module, here Polysemy.Internal.Union
in package polysemy
. We then lookup the Find
name in that module, and then lookup the class with that name. By setting findFindClass
as our tcPluginInit
, our tcPluginSolve
function will receive the Find
class as a parameter.
Before diving into tcPluginSolve
, we're going to need some helper functions.
allFindCts :: Class > [Ct] > [(CtLoc, (Type, Type, Type))]
allFindCts cls cts = do
ct < cts
CDictCan { cc_tyargs = [ _, r, eff ] } < pure ct
guard $ cls == cc_class cd
let eff_name = getEffName eff
pure (ctLoc ct, (eff_name, eff, r))
getEffName :: Type > Type
getEffName t = fst $ splitAppTys t
The allFindCts
function searches through the Ct
s for Find
constraints, and unpacks the pieces we're going to need. We first pattern match on whether the Ct
is a CDictCan
, which corresponds to everyday typeclassy constraints. We ensure it has exactly three type args (Find
takes a kind, and then the two parameters we care about), and ensure that this class is the cls
we're looking for.
We return four things for each matching Ct
:
CtLoc
 corresponding to where the constraint came from. This is necessary to keep around so GHC can give good error messages if things go wrong.State
.t
parameter in a Find
constraint. In the ongoing example, State s
.r
in the Find
constraint).So remember, our idea is "see if there is exactly one matching given Find
constraint for any wanted Find
constraint  and if so, unify the two."
findMatchingEffect
:: (Type, Type, Type)
> [(Type, Type, Type)]
> Maybe Type
findMatchingEffect (eff_name, _, r) ts =
singleListToJust $ do
(eff_name', eff', r') < ts
guard $ eqType eff_name eff_name'
guard $ eqType r r'
pure eff
singleListToJust :: [a] > Maybe a
singleListToJust [a] = Just a
singleListToJust _ = Nothing
findMatchingEffect
takes the output of allFindCts
for a single wanted constraint, and all of the given constraints, and sees if there's a single match between the two. If so, it returns the matching effect.
We need one last helper before we're ready to put everything together. We wanted to be able to generate new wanted constraints of the form a ~ b
. Emitting such a thing as a new wanted constraint will cause GHC to unify a
and b
; which is exactly what we'd like in order to convince it to use one given constraint in place of another.
mkWanted :: CtLoc > Type > Type > TcPluginM (Maybe Ct)
mkWanted loc eff eff' = do
if eqType (getEffName eff) (getEffName eff')
then do
(ev, _) < unsafeTcPluginTcM
. runTcSDeriveds
$ newWantedEq loc Nominal eff eff'
pure . Just $ CNonCanonical ev
else
pure Nothing
What's going on here? Well we check if the two effects we want to unify have the same effect name. Then if so, we use the wanted's CtLoc
to generate a new, derived wanted constraint of the form eff ~ eff'
. In essence, we're promising the compiler that it can solve the wanted if it can solve eff ~ eff'
.
And finally we're ready to roll.
solveFundep :: Class > [Ct] > [Ct] > [Ct] > TcPluginM TcPluginResult
solveFundep find_cls giv _ want = do
let wanted_effs = allFindCts find_cls want
given_effs = fmap snd $ allFindCts find_cls giv
eqs < forM wanted_effs $ \(loc, e@(_, eff, r)) >
case findMatchingEffect e given_effs of
Just eff' > mkWanted loc eff eff'
Nothing > do
case splitAppTys r of
(_, [_, eff', _]) > mkWanted loc eff eff'
_ > pure Nothing
pure . TcPluginOk [] $ catMaybes eqs
We get all of the Find
constraints in the givens and the wanteds. Then, for each wanted, we see if there is a singularly matching given, and if so, generate a wanted constraint unifying the two.
However, if we don't find a singularly matching effect, we're not necessarily in hot water. We attempt to decompose r
into a type constructor and its arguments. Since r
has kind [k]
, there are three possibilities here:
r
is a polymorphic type variable, in which case we can do nothing.r
is '[]
, so we have no effects to possibly unify, and so we can do nothing.r
has form e ': es
, in which case we attempt to unify e
with the wanted.What's going on with this? Why is this bit necessary? Well, consider the case where we want to run our effect stack. Let's say we have this program:
foo' :: Member (State Int) r => Sem r ()
foo' = modify (+ 1)
main :: IO ()
main = do
result < runM . runState 5 $ foo'
print result
The type of runM . runState 5
is Num a => Sem '[State a, Lift IO] x > IO x
. But foo'
still wants a State Int
constraint, however, main
doesn't have any givens! Instead, the wanted we see is of the form Find '[State a, Lift IO] (State Int)
, and so we're justified in our logic above to unify State Int
with the head of the list.
Finally we can bundle everything up:
plugin :: Plugin
plugin = defaultPlugin
{ tcPlugin = const $ Just fundepPlugin
}
fundepPlugin :: TcPlugin
fundepPlugin = TcPlugin
{ tcPluginInit = findFindClass
, tcPluginSolve = solveFundep
, tcPluginStop = const $ pure ()
}
and voila, upon loading our module via the fplugin
flag, GHC will automatically start solving Member
constraints as though they were fundeps!
This isn't the whole story; there are still a few kinks in the implementation for when your given is more polymorphic than your wanted (in which case they shouldn't unify), but this is enough to get a feeling for the idea. As always, the full source code is on Github.
As we've seen, TC plugins are extraordinarily powerful for helping GHC solve domainspecific problems, and simultaneously quite easy to write. They're not often the right solution, but they're a great thing to keep in your tool belt!
If you are part of a society that votes, then do so. There may be no candidates and no measures you want to vote for ... but there are certain to be ones you want to vote against. [fromÂ Time Enough for Love]
In my previous post I explored solving a simple competitive programming problem in Haskell. The input of the problem just consisted of a bunch of lines containing specific data, so that we could parse it using lines
and words
. There is another common class of problems, however, which follow this pattern:
The first line of the input consists of an integer . Each of the next lines consists of…
That is, the input contains integers which are not input data per se but just tell you how many things are to follow. This is really easy to process in an imperative language like Java or C++. For example, in Java we might write code like this:
Scanner in = new Scanner(System.in);
int T = in.nextInt();
for (int i = 0; i < T; i++) {
// process each line
}
Occasionally, we can get away with completely ignoring the extra information in Haskell. For example, if the input consists of a number followed by lines, each of which contains a number followed by a list of numbers, we can just write
main = interact $
lines >>> drop 1 >>> map (words >>> drop 1 >>> map read) >>> ...
That is, we can ignore the first line containing since the endoffile will tell us how many lines there are; and we can ignore the at the beginning of each line, since the newline character tells us when the list on that line is done.
Sometimes, however, this isn’t possible, especially when there are multiple test cases, or when a single test case has multiple parts, each of which can have a variable length. For example, consider Popular Vote, which describes its input as follows:
The first line of input contains a single positive integer indicating the number of test cases. The first line of each test case also contains a single positive integer indicating the number of candidates in the election. This is followed by lines, with the th line containing a single nonnegative integer indicating the number of votes candidate received.
How would we parse this? We could still ignore —just keep reading until the end of the file—but there’s no way we can ignore the values. Since the values for each test case are all on separate lines instead of on one line, there’s otherwise no way to know when one test case ends and the next begins.
Once upon a time, I would have done this using splitAt
and explicit recursion, like so:
type Election = [Int]
readInput :: String > [Election]
readInput = lines >>> drop 1 { ignore T } >>> map read >>> go
where
go :: [Int] > [Election]
go [] = []
go (n:xs) = votes : go rest
where (votes,rest) = splitAt n xs
However, this is really annoying to write and easy to get wrong. There are way too many variable names to keep track of (n
, xs
, votes
, rest
, go
) and for more complex inputs it becomes simply unmanageable. You might think we should switch to using a real parser combinator library—parsec
is indeed installed in the environment Kattis uses to run Haskell solutions—and although sometimes a fullblown parser combinator library is needed, in this case it’s quite a bit more heavyweight than we would like. I can never remember which modules I have to import to get parsec
set up; there’s a bunch of boilerplate needed to set up a lexer; and so on. Using parsec
is only worth it if we’re parsing something really complex.
The heart of the issue is that we want to be able to specify a highlevel description of the sequence of things we expect to see in the input, without worrying about managing the stream of tokens explicitly. Another key insight is that 99% of the time, we don’t need the ability to deal with parse failure or the ability to parse multiple alternatives. With these insights in mind, we can create a very simple Scanner
abstraction, which is just a State
ful computation over a list of tokens:
type Scanner = State [String]
runScanner :: Scanner a > String > a
runScanner s = evalState s . words
To run a scanner, we just feed it the entire input as a String
, which gets chopped into tokens using words
. (Of course in some scenarios we might want to use lines
instead of words
, or even do more complex tokenization.)
Note since Scanner
is just a type synonym for State [String]
, it is automatically an instance of Functor
, Applicative
, and Monad
(but not Alternative
).
So let’s develop a little Scanner
DSL. The most fundamental thing we can do is read the next token.
str :: Scanner String
str = get >>= \case { s:ss > put ss >> return s }
(This uses the LambdaCase
extension, though we could easily rewrite it without.) str
gets the current list of tokens, puts it back without the first token, and returns the first token. Note that I purposely didn’t include a case for the empty list. You might think we want to include a case for the empty token list and have it return the empty string or something like that. But since the input will always be properly formatted, if this scenario ever happens it means my program has a bug—e.g. perhaps I misunderstood the description of the input format. In this scenario I want it to crash loudly, as soon as possible, rather than continuing on with some bogus data.
We can now add some scanners for reading specific token types other than String
, simply by mapping the read
function over the output of str
:
int :: Scanner Int
int = read <$> str
integer :: Scanner Integer
integer = read <$> str
double :: Scanner Double
double = read <$> str
Again, these will crash if they see a token in an unexpected format, and that is a very deliberate choice.
Now, as I explained earlier, a very common pattern is to have an integer followed by copies of something. So let’s make a combinator to encapsulate that pattern:
numberOf :: Scanner a > Scanner [a]
numberOf s = int >>= flip replicateM s
numberOf s
expects to first see an Int
value , and then it runs the provided scanner times, returning a list of the results.
It’s also sometimes useful to have a way to repeat a Scanner
some unknown number of times until encountering EOF (for example, the input for some problems doesn’t specify the number of test cases up front the way that Popular Vote does). This is similar to the many
combinator from Alternative
.
many :: Scanner a > Scanner [a]
many s = get >>= \case { [] > return []; _ > (:) <$> s <*> many s }
many s
repeats the scanner s
as many times as it can, returning a list of the results. In particular it first peeks at the current token list to see if it is empty. If so, it returns the empty list of results; if there are more tokens, it runs s
once and then recursively calls many s
, consing the results together.
Finally, it’s quite common to want to parse a specific small number of something, e.g. two double values representing a 2D coordinate pair. We could just write replicateM 2 double
, but this is common enough that I find it helpful to define dedicated combinators with short names:
two, three, four :: Scanner a > Scanner [a]
[two, three, four] = map replicateM [2..4]
The complete file can be found on GitHub. As I continue this series I’ll be putting more code into that repository. Note I do not intend to make this into a Hackage package, since that wouldn’t be useful: you can’t tell Kattis to go download a package from Hackage before running your submission. However, it is possible to submit multiple files at once, so you can include Scanner.hs
in your submission and just import Scanner
at the top of your main module.
So what have we gained? Writing the parser for Popular Vote is now almost trivial:
type Election = [Int]
main = interact $ runScanner elections >>> ...
elections :: Scanner [Election]
elections = numberOf (numberOf int)
In practice I would probably just inline the definition of elections
directly: interact $ runScanner (numberOf (numberOf int)) >>> ...
As a slightly more involved example, chosen almost at random, consider Board Wrapping:
On the first line of input there is one integer, , giving the number of test cases (moulds) in the input. After this line, test cases follow. Each test case starts with a line containing one integer , which is the number of boards in the mould. Then lines follow, each with five floating point numbers where and . The and are the coordinates of the center of the board and and are the width and height of the board, respectively. is the angle between the height axis of the board to the axis in degrees, positive clockwise.
Here’s how I would set up the input, using Scanner
and a custom data type to represent boards.
import Scanner
type V = [Double]  2D vectors/points
newtype A = A Double  angle (radians)
 newtype helps avoid conversion errors
fromDeg :: Double > A
fromDeg d = A (d * pi / 180)
data Board = Board { boardLoc :: V, boardDims :: V, boardAngle :: A }
board :: Scanner Board
board = Board
<$> two double
<*> two double
<*> ((fromDeg . negate) <$> double)
main = interact $
runScanner (numberOf (numberOf board)) >>> ...
I've been paying a lot of attention to performance in polysemy
. Getting it to be fast has been really hard. It's clearly possible, but for the longest time I was afraid I'd need to fork the compiler. And that didn't seem like a thing that would attract a largeuser base.
For example, polysemy
benefits greatly from a late specialization pass, and would benefit further from aggressive inlining after the late specialization pass. Unfortunately, GHC doesn't do any inlining passes after flatespecialise
, so it feels like we're stuck on this front.
Thankfully, the eternally helpful mpickering pointed me at the GHC plugin interface, which has support for directing the optimizer to do things it wouldn't usually.
Today, I want to talk about how I made the polysemyplugin
run two optimizations that greatly benefit code written with polysemy
.
The gist of writing a GHC plugin is to import ghc:Plugins
, and to create an exported toplevel bind plugin :: Plugin
. Other code can use this plugin by specifying the fplugin=
option to point at this module.
Plugin
s have a field called installCoreToDos
with type [CommandLineOption] > [CoreToDo] > CoreM [CoreToDo]
. A CoreToDo
is GHC's oddlynamed concept of a compiler pass over Core. This function receives the list of CoreToDo
s it was planning to do, and you can change that list if you want.
By default there's a big flowchart of CoreToDo
s that the compiler will run through in order to compile a module. The optimization level (O
) effects which passes get run, as do many of the individual optimization flags.
By attaching our extra optimization passes to the end of this list, we can make GHC optimize harder than it usually would. But because most code won't benefit from this extra work, we guard the new optimization passes behind two conditions. The user must be compiling with optimizations turned on, and the module being compiled must import Polysemy
.
Checking for the optimization level is simple enough, we can pull it out of the DynFlags
(GHC's datatype that stores all of the crazy flags you might have set):
dflags < getDynFlags
case optLevel dflags of
0 >  corresponds to O0
1 >  corresponds to O
2 >  corresponds to O2
Checking, however, for presence of the Polysemy
module is less straightforward. Honestly I'm not sure what the "correct" solution to this problem is, but I'm pretty happy with the disgusting hack I came up with.
The CoreM
monad (which is what you're running in when you install CoreToDo
s) doesn't exactly have stellar documentation. It has access to the HscEnv
, which in turn has a hsc_mod_graph :: ModuleGraph
 which sounds like the sort of thing that might contain the modules currently in scope. Unfortunately this is not so; hsc_mod_graph
contains the modules defined in the package being defined.
If we could get our hands on the ModGuts
(GHC's representation of a Haskell module), we could inspect its mg_deps :: Dependencies
field, which would surely have what we need. Unfortunately, I couldn't find any easy way to get access to the ModGuts
in a CoreM
without jumping through several hoops.
But one thing caught my eye! There is an operation getVisibleOrphanMods :: CoreM ModuleSet
, which after some investigation, turns out to contain any module in scope (directly or otherwise) that defines an orphan instance.
It's disgusting, but I made an internal module in polysemy
that contains the following definitions:
module Polysemy.Internal.PluginLookup where
class PluginLookup t
data Plugin
and the corresponding orphan instance in the module I wanted to track in my plugin:
{# OPTIONS_GHC fnowarnorphans #}
import Polysemy.Internal.PluginLookup
instance PluginLookup Plugin
I know, I know. But because the module that defines these things is internal, there's no way for anyone else to define instances of this thing. So at least it's a safe use of orphans.
Sure enough, this little gem is enough to get my module noticed by getVisibleOrphanMods
, and so I can check for the presence of my module via:
mods < moduleSetElts <$> getVisibleOrphanMods
if any ((== mkModuleName "Polysemy.Internal") . moduleName) mods
then ...
And voila, we're now ready to install our extra CoreToDo
s. In this case, I just cargoculted a few from GHC's existing passes list. Namely I added a CoreDoSpecialising
, a CoreDoStaticArgs
, yet another CoreDoSpecialising
, and a bevvy of simplification passes. The result might be overkill, but it's sufficient to massage this scary core into this  and get roughly a 1000x runtime performance improvement in the process.
But this lack of optimization passes wasn't the only thing slowly polysemy
down. The library depends on several library and userwritten functions that are complicated and necessarily selfrecursive.
GHC is understandably hesitant to inline recursive functions  the result would diverge  but as a sideeffect, it seems to refuse to optimize big recursive functions whatsoever. For my purposes, this meant that most of the crucial machinery in the library was being completely ignored by GHC's best optimization pass.
I accidentally stumbled upon a fix. To illustrate, let's pretend like the factorial
function is my complicated selfrecursive function. The optimizer would refuse to fire when the function was written like this:
factorial :: Int > Int
factorial 0 = 1
factorial n = n * factorial (n  1)
{# INLINE factorial #}
But, a minor syntactic tweak was enough to trick the compiler into optimizing it:
factorial :: Int > Int
factorial 0 = 1
factorial n = n * factorial' (n  1)
{# INLINE factorial #}
factorial' :: Int > Int
factorial' = factorial
{# NOINLINE factorial' #}
Now factorial
is no longer selfrecursive. It's mutually recursive, and for some reason, the NO/INLINE
pragmas are enough to keep GHC off our back. This is an easy fix, but it's annoying boilerplate. And I hate annoying boilerplate.
Early versions of polysemy
shipped with a function inlineRecursiveCalls :: Q [Dec] > Q [Dec]
which would use Template Haskell to transform our slow, selfrecursive factorial
above into the fast, mutuallyexclusive version below. While this worked, it was unsatisfactory; TH splices don't play nicely with haddock or with text editors.
But this isn't something that regular users should need to care about! Optimization concerns should lie solely in the responsibility of librarywriters  not in their users. It seemed like a good opportunity to write a custom optimization pass, and like any curious boy, I took it.
We can use the CoreDoPluginPass :: String > (ModGuts > CoreM ModGuts) > CoreToDo
constructor to inject our own ModGuts
transformation as an optimization pass. Recall that ModGuts
is GHC's definition of a module. For our purposes, we're interested in its mg_binds
field, which contains all of the valuelevel things in the module.
A mg_binds
is a [Bind CoreBndr]
, and a Bind CoreBndr
is a pair of a name and its corresponding expression definition. More specifically, the definition for Bind
is:
data Bind b = NonRec b (Expr b)
 Rec [(b, (Expr b))]
A nonrecursive binding is something like x = 5
, while a recursive binding is anything that is self or mutuallyrecursive.
So, if we want to transform selfrecursive calls into mutuallyrecursive calls, we first need to identify if a definition is selfrecursive. Fortunately, the incredible syb
library comes in handy here, as it lets us write small queries that get lifted over the entire datatype.
We can write containsName
using everywhere
, mkQ
and the Any
monoid to determine if the CoreBndr
name is used anywhere in the CoreExpr
^{1}.
containsName :: CoreBndr > CoreExpr > Bool
containsName n =
getAny .
everything
(<>)
(mkQ (Any False) matches)
where
matches :: CoreExpr > Any
matches (Var n')  n == n' = Any True
matches _ = Any False
If containsName b e
is True
for any (b, e)
in the mg_binds
, then that function is selfrecursive. As such, we'd like to generate a new NOINLINE
bind for it, and then replace the original selfcall to be to this new bind.
Replacing a call is just as easy as finding the recursion:
replace :: CoreBndr > CoreBndr > CoreExpr > CoreExpr
replace n n' = everywhere $ mkT go
where
go :: CoreExpr > CoreExpr
go v@(Var nn)
 nn == n = Var n'
 otherwise = v
go x = x
But creating the new binding is rather more work; we need to construct a new name for it, and then fiddle with its IdInfo
in order to set the inlining information we'd like.
loopbreaker :: Uniq > CoreBndr > CoreExpr > [(Var, CoreExpr)]
loopbreaker newUniq n e =
let Just info = zapUsageInfo $ idInfo n
info' = setInlinePragInfo info alwaysInlinePragma
n' = mkLocalVar
(idDetails n)
(mkInternalName newUniq (occName n) noSrcSpan)
(idType n)
$ setInlinePragInfo vanillaIdInfo neverInlinePragma
in [ (lazySetIdInfo n info', replace n n' e)
, (n', Var n)
]
First we use zapUsageInfo
to make GHC forget that this binding is selfrecursive^{2}, and then use setInlinePragInfo
to spiritually inject a {# INLINE n #}
pragma onto it. We then construct a new name (a nontrivial affair; loopbreaker
above is simplified in order to get the new Uniq
to ensure our variable is hygienic), and replace the selfrecursive call with a call to the new name. Finally, we need to spit out the two resulting binds.
There's a little machinery to call loopbreaker
on the mg_guts
, but it's uninteresting and this post is already long enough. If you're interested, the full code is available on Github. In total, it's a little less than 100 lines long; pretty good for adding a completely new optimization pass!
That's enough about writing plugins for improving performance; in the next post we'll discuss typechecker plugins, and how they can be used to extend GHC's constraintsolving machinery. Stay tuned!
Say $dt
is a Perl DateTime
object.
You are allowed to say
$dt>add( days => 2 )
$dt>subtract( days => 2 )
Today Jeff Boes pointed out that I had written a program that used
$dt>add({ days => 2 })
which as far as I can tell is not documented to work. But it did work. (I wrote it in 2016 and would surely have noticed by now if it hadn't.) Jeff told me he noticed when he copied my code and got a warning. When I tried it, no warning.
It turns out that
$dt>add({ days => 2 })
$dt>subtract({ days => 2 })
both work, except that:
The subtract
call produces a warning (add
doesn't! and Jeff
had changed my add
to subtract
)
If you included an end_of_month => $mode
parameter in the
arguments to subtract
, it would get lost.
Also, the workingness of what I wrote is a lucky fluke. It is
undocumented (I think) and works only because of a quirk of the
implementation. >add
passes its arguments to
DateTime::Duration>new
, which passes them to
Params::Validate::validate
. The latter is documented to accept
either form. But its use by DateTime::Duration
is an undocumented
implementation detail.
>subtract
works the same way, except that it does a little bit of
preprocessing on the arguments before calling
DateTime::Duration>new
. That's where the warning comes from, and
why end_of_month
won't work with the hashref form.
(All this is as of version 1.27. The current version is 1.51. Matthew Horsfall points out that 1.51 does not raise a warning, because of a different change to the same interface.)
This computer stuff is amazingly complicated. I don't know how anyone gets anything done.
Alphabetical order in Korean has an interesting twist I haven't seen in any other language.
(Perhaps I should mention up front that Korean does not denote words with individual symbols the way Chinese does. It has a 24letter alphabet, invented in the 15th century.)
Consider the Korean word “문어”, which means “octopus”. This is made up of five letters ㅁㅜㄴㅇㅓ. The ㅁㅜㄴ are respectively equivalent to English ‘m’, ‘oo‘ (as in ‘moon‘), and ‘n’. The ㅇis silent, just like ‘k’ in “knit”. The ㅓis a vowel we don't have in English, partway between “saw” and “bud”. Confusingly, it is usually rendered in Latin script as ‘eo’. (It is the first vowel in “Seoul”, for example.) So “문어” is transliterated to Latin script as “muneo”, or “munǒ”, and approximately pronounced “moonaw”.
But as you see, it's not written as “ㅁㅜㄴㅇㅓ” but as “문어”. The letters are grouped into syllables of two or three letters each. (Or, more rarely, four or even five.)
Now consider the word “무해” (“harmless”) This word is made of the four letters ㅁㅜㅎㅐ. The first two, as before, are ‘m’, ‘oo’. The ㅎ is ‘h’ and the ‘ㅐ’ is a vowel that is something like the vowel in “air”, usually rendered in Latin script as ‘ae’. So it is written “muhae” and pronounced something like “mooheh”.
ㅎis the last letter of the alphabet. Because ㅎfollows ㄴ, you might think that 무해 would follow 문어. But it does not. In Korean, alphabetization is also done at the syllable level. The syllable 무 comes before 문, because it is a proper prefix, so 무해 comes before 문어. If the syllable break in 문어 were different, causing it to be spelled 무너, it would indeed come before 무해. But it isn't, so it doesn't. (“무너” does not seem to be an actual word, but it appears as a consitutent in words like 무너지다 (“collapse”) and 무너뜨리다 (“demolish”) which do come before 무해 in the dictionary.)
As far as I know, there is nothing in Korean analogous to the English alphabet song.
Or to alphabet soup! Koreans love soup! And they love the alphabet, so why no hangeultang? There is a hundred dollar bill lying on the sidewalk here, waiting to be picked up.
[ Previously, but just barely related: Medieval Chinese typesetting technique. ]
We've spent a few weeks now refactoring a few things in our game. We made it more performant and examined some related concepts. This week, we're going to get back to adding new features to the game! We'll add some enemies, represented by little squares, to rove around our maze! If they touch our player, we'll have to restart the level!
In the next couple weeks, we'll make these enemies smarter by giving them a better search strategy. Then later, we'll give ourselves the ability to fight back against the enemies. So there will be interesting tradeoffs in features.
Remember we have a Github Repository for this project! You can find all the code for this part can in the part5
branch! For some other interesting Haskell project ideas, download our Production Checklist!
Let's remind ourselves of our process for adding new features. Remember that at the code level, our game has a few main elements:
World
state typeSo to change our game, we should update each of these in turn. Let's start with the changes to our world type. First, it's now possible for us to "lose" the game. So we'll need to expand our GameResult
type:
data GameResult = GameInProgress  GameWon  GameLost
Now we need to store the enemies. We'll add more data about our enemies as the game develops. So let's make a formal data type and store a list of them in our World
. But for right now, all we need to know about them is their current location:
data Enemy = Enemy
{ enemyLocation :: Location
}
data World = World
{ …
, worldEnemies :: [Enemy]
}
Now that our game contains information about the enemies, let's determine what they do! Enemies won't respond to any input events from the player. Instead, they'll update at a regular interval via our updateFunc
. Our first concern will be the game end condition. If the player's current location is one of the enemies locations, we've "lost".
updateFunc :: Float > World > World
updateFunc _ w =
 Game Win Condition
 playerLocation w == endLocation w = w { worldResult = GameWon }
 Game Loss Condition
 playerLocation w `elem` (enemyLocation <$> worldEnemies w) =
w { worldResult = GameLost }
 otherwise = ...
Now we'll need a function that updates the location for an individual enemy. We'll have the enemies move at random. This means we'll need to manipulate the random generator in our world. Let's make this function stateful over the random generator.
updateEnemy :: Maze > Enemy > State StdGen Enemy
...
We'll want to examine the enemy's location, and find all the possible locations it can move to. Then we'll select from them at random. This will look a lot like the logic we used when generating our random mazes. It would also be a great spot to use prisms if we were generating them for our types! We might explore this possibility later on in this series.
updateEnemy :: Maze > Enemy > State StdGen Enemy
updateEnemy maze e@(Enemy location) = if (null potentialLocs)
then return e
else do
gen < get
let (randomIndex, newGen) = randomR
(0, (length potentialLocs)  1)
gen
newLocation = potentialLocs !! randomIndex
put newGen
return (Enemy newLocation)
where
bounds = maze Array.! location
maybeUpLoc = case upBoundary bounds of
(AdjacentCell loc) > Just loc
_ > Nothing
maybeRightLoc = case rightBoundary bounds of
(AdjacentCell loc) > Just loc
_ > Nothing
maybeDownLoc = case downBoundary bounds of
(AdjacentCell loc) > Just loc
_ > Nothing
maybeLeftLoc = case leftBoundary bounds of
(AdjacentCell loc) > Just loc
_ > Nothing
potentialLocs = catMaybes
[maybeUpLoc, maybeRightLoc, maybeDownLoc, maybeLeftLoc]
Now that we have this function, we can incorporate it into our main update
function. It's a little tricky though. We have to use the sequence
function to combine all these stateful actions together. This will also give us our final list of enemies. Then we can insert the new generator and the new enemies into our state!
updateFunc _ w =
...
 otherwise =
w { worldRandomGenerator = newGen, worldEnemies = newEnemies}
where
(newEnemies, newGen) = runState
(sequence (updateEnemy (worldBoundaries w) <$> worldEnemies w))
(worldRandomGenerator w)
Now we need to draw our enemies on the board. Most of the information is already there. We have a conversion function to get the drawing coordinates. Then we'll derive the corner points of the square within that cell, and draw an orange square.
drawingFunc =
…
 otherwise = Pictures
[..., Pictures (enemyPic <$> worldEnemies world)]
where
...
enemyPic :: Enemy > Picture
enemyPic (Enemy loc) =
let (centerX, centerY) = cellCenter $ conversion loc
tl = (centerX  5, centerY + 5)
tr = (centerX + 5, centerY + 5)
br = (centerX + 5, centerY  5)
bl = (centerX  5, centerY  5)
in Color orange (Polygon [tl, tr, br, bl])
One extra part of updating the drawing function is that we'll have to draw a "losing" message. This will be a lot like the winning message.
drawingFunc :: (Float, Float) > Float > World > Picture
drawingFunc (xOffset, yOffset) cellSize world
...
 worldResult world == GameLost =
Translate (275) 0 $ Scale 0.12 0.25
(Text "Oh no! You've lost! Press enter to restart this maze!")
...
Two little things remain. First, we want a function to randomize the locations of the enemies. We'll use this to decide their positions at the beginning and when we restart. In the future we may add a powerup that allows the player to run this randomizer. As with other random functions, we'll make this function stateful over the StdGen
element.
generateRandomLocation :: (Int, Int) > State StdGen Location
generateRandomLocation (numCols, numRows) = do
gen < get
let (randomCol, gen') = randomR (0, numCols  1) gen
(randomRow, gen'') = randomR (0, numRows  1) gen'
put gen''
return (randomCol, randomRow)
As before, we can sequence these stateful actions together. In the case of initializing the board, we'll use replicateM
and the number of enemies. Then we can use the locations to make our enemies, and then place the final generator back into our world.
main = do
gen < getStdGen
let (maze, gen') = generateRandomMaze gen (25, 25)
numEnemies = 4
(randomLocations, gen'') = runState
(replicateM numEnemies (generateRandomLocation (25,25)))
gen'
enemies = Enemy <$> randomLocations
initialWorld = World (0, 0) (0,0) (24,24)
maze GameInProgress gen'' enemies
play ...
The second thing we'll want to do is update the event handler so that it restarts the game when we lose. We'll have similar code to when we win. However, we'll stick with the original maze rather than rerandomizing.
inputHandler :: Event > World > World
inputHandler event w
...
 worldResult w == GameLost = case event of
(EventKey (SpecialKey KeyEnter) Down _ _) >
let (newLocations, gen') = runState
(replicateM (length (worldEnemies w))
(generateRandomLocation (25, 25)))
(worldRandomGenerator w)
in World (0,0) (0,0) (24, 24)
(worldBoundaries w) GameInProgress gen'
(Enemy <$> newLocations)
_ > w
...
(Note we also have to update the game winning code!) And now we have enemies roving around our maze. Awesome!
Next week we'll step up the difficulty of our game! We'll make the enemies much smarter so that they'll move towards us! This will give us an opportunity to learn about the breadth first search algorithm. There are a few nuances to writing this in Haskell. So don't miss it! The week after, we'll develop a way to stun the enemies. Remember you can follow this project on our Github! The code for this article is on the part5
branch.
We've used monads, particularly the State
monad, quite a bit in this series. Hopefully you can see now how important they are! But they don't have to be difficult to learn! Check out our series on Functional Structures to learn more! It starts with simpler structures like functors. But it will ultimately teach you all the common monads!
Summary: Hoogle 5.0.17.6 and below have an XSS vulnerability, fixed in later versions.
On Friday afternoon I got an email from Alexander Gugel with the subject line "Nonpersistent XSS vulnerability on hoogle.haskell.org"  never a good thing to get. He had found that Hoogle was echoing the user search string back into the page, meaning that if you searched for %27"><marquee style
you could make all the results scroll past in a disturbingly hypnotic manner. Oh dear!
The first concern was to fix the website. While there aren't any cookies stored by Hoogle, and there are no logon forms or similar, the Project Zero blog has taught me that given the tiniest chink, everything can be broken. Fortunately, Alex emailed me using the email address on my webpage, described the problem, and provided a 3 line diff that escaped all the problematic variables. I applied this fix and pushed a new version to hoogle.haskell.org.
Like any good Haskeller, my first thought on encountering a bug is to use the type system to prevent it by construction. The problem boils down to taking user input and splicing it into an HTML page. My initial fix was to introduce a type Taint
:
newtype Taint a = Taint a
escapeUntaint :: Taint String > String
escapeUntaint (Taint x) = escapeHTML x
The idea is that instead of the query parameters to the web page being String
's that can be carelessly spliced into the output, they were Taint String
values whose only real unwrapping function involves escaping any HTML they may contain. Furthermore, Taint
can have instances for Monad
etc, meaning you can work on tainted values, but the result will always remain tainted.
Using this approach uncovered no additional problems, but gave me much more confidence there weren't any I just hadn't found.
At this point I made a release of Hoogle 5.0.17.7. This version has no known XSS issues with it.
While Taint
is an effective tool for some domains, the real problem for Hoogle was that I was building up HTML values using String
 making it way too easy to create invalid HTML, and providing an easy attack vector. The next change was to switch to blazehtml
, which uses strong typing to ensure the HTML is always valid. Instead of having to call escapeHTML
to turn bad String
into good String
, I instead used H.string
to turn bad String
into good Markup
. For the rare case where there genuinely was String
that contained HTML for good reasons I used H.preEscapedString
, making the "don't escape" explicit and longer, and the "do escape" the default  a much safer default.
There are a whole suite of headers that can be returned by the server to opt in to additional checking, known as CSP headers. These headers can ban inline script, detect XSS attacks, avoid confusion with MIME types, avoid http
downgrade attacks and more. Thanks to Gary Verhaegen many of these are now applied to Hoogle, meaning that even if my code is wrong, the chances of it causing any damange (even just hypnotic scrolling) are much reduced.
Hoogle 5.0.17.8 has all the security fixes listed and is deployed to hoogle.haskell.org. Hopefully no more security issues for a while!
Many thanks to Alexander Gugel for the responsible disclosure, and to Gary Verhaegen for his work on CSP headers.
In category theory a concept is called absolute if it is preserved by all functors. Identity arrows and composition are absolute by the definition of functor. Less trivially, isomorphisms are absolute. In general, anything that is described by a diagram commuting is absolute as that diagram will be preserved by any functor. This is generally the case, but if I tell you something is an absolute epimorphism, it’s not clear what diagram is causing that; the notion of epimorphism itself doesn’t reduce to the commutativity of a particular diagram.
Below I’ll be focused primarily on absolute colimits as those are the most commonly used examples. They are an important part of the theory of monadicity. The trick to many questions about absolute colimits and related concepts is to see what it means for \newcommand{\Set}{\mathbf{Set}}\newcommand{\Hom}{\mathsf{Hom}} \newcommand{onto}{\twoheadrightarrow}\Hom functors to preserve them.
To start, we can show that certain colimits cannot be absolute, at least for \Setenriched category theory. In particular, initial objects and coproducts are never absolute. Using the trick above, this is easily proven.
\[\Hom(0,0)\cong 1 \not\cong 0\]
\[\Set(\Hom(X+Y,Z),1)\cong 1 \not\cong 2\cong\Set(\Hom(X,Z),1)+\Set(\Hom(Y,Z),1)\]
What do absolute epimorphisms look like? We know that there are absolute epimorphisms because a split epimorphism is defined by a certain diagram commuting. Are there other absolute epimorphisms? To find out, we apply our trick.
Let r:X\onto Y be our epimorphism. The we have the surjection \[\Hom(Y,r):\Hom(Y,X)\onto\Hom(Y,Y)\] but this means that for every arrow f:Y\to Y, there’s an arrow s:Y\to X such that f = r \circ s. As you can no doubt guess, we want to choose f=id_Y, and we then have that r is a split epimorphism. Therefore split epimorphisms are the only examples of absolute epimorphisms.
Now let’s consider the coequalizer case. Let f,g:X\to Y and e:Y\onto C be their coequalizer which we’ll assume is absolute. Before we pull out our trick, we can immediately use the previous result to show that e has a section, i.e. an arrow s : C\rightarrowtail Y such that id_C=e\circ s. Moving on we use the trick to get the diagram: \[\Hom(Y,X)\rightrightarrows\Hom(Y,Y)\onto\Hom(Y,C)\]
Next, we use the explicit construction of the coequalizer in \Set which \Hom(Y,C) is supposed to be canonically isomorphic to. That is, the coequalizer of \Hom(Y,f) and \Hom(Y,g) is \Hom(Y,Y) quotiented by the equivalence relation generated by the relation which identifies h,k:Y\to Y when \exists j:Y\to X.h = f\circ j \land k = g\circ j. Let [h] represent the equivalence class of h. The claim that \Hom(Y,C) is (with \Hom(Y,e)) a coequalizer of the above arrows implies that e\circ h = \bar e([h]) and [h]=\bar e^{1}(e\circ h) with \bar e and \bar e^{1} forming an isomorphism. Of course our next move is to choose h=id_Y giving e=\bar e([id_Y]). However, e=e\circ s\circ e = \bar e([s\circ e]) so we get [id_Y]=[s\circ e] because \bar e is invertible.
If we call the earlier relation \sim and write \sim^* for its reflexive, symmetric, transitive closure, then [id_Y] = \{h:Y\to Y\mid id_Y\sim^* h\}. Therefore id_Y \sim^* s\circ e. Now let’s make a simplifying assumption and assume further that id_Y \sim s\circ e, i.e. that id_Y is directly related to s\circ e by \sim. By definition of \sim this means there is a t : Y\to X such that id_Y = f\circ t and s\circ e = g\circ t. Given f, g, and e such that e\circ f = e\circ g and equipped equipped with a s : C\to Y and t : Y\to X satisfying the previous two equations along with q\circ s = id_C is called a split coequalizer. This data is specified diagrammatically and so is preserved by all functors, thus split coequalizers are absolute. All that we need to show is that this data is enough, on its own, to show that e is a coequalizer.
Given any q : Y\to Z such that q\circ f = q\circ g, we need to show that there exists a unique arrow C\to Z which q factors through. The obvious candidate is q\circ s leading to us needing to verify that q=q\circ s\circ e. We calculate as follows: \[ \begin{align} q \circ s \circ e & = q \circ g \circ t \\ & = q \circ f \circ t \\ & = q \end{align}\] Uniqueness then quickly follows since if q = k\circ e then q\circ s = k\circ e \circ s = k. \square
There’s actually an even simpler example where s\circ e = id_Y which corresponds to the trivial case where f=g.
Split coequalizers show that (nontrivial) absolute coequalizers can exist, but they don’t exhaust all the possibilities. The obvious cause of this is the simplifying assumption we made where we said id_Y\sim s\circ e rather than id_Y\sim^* s\circ e. In the general case, the equivalence will be witnessed by a sequence of arrows t_i : Y\to X such that we have either s\circ e = g\circ t_0 or s \circ e = f\circ t_0, then f\circ t_0 = g\circ t_1 or g\circ t_0 = f\circ t_1 respectively, and so on until we get to f\circ t_n = id_Y or g\circ t_n = id_Y. As a diagram, this is a fan of diamonds of the form f\circ t_i = g\circ t_{i+1} or g\circ t_i = f\circ t_{i+1} with a diamond with side s\circ e on one end of the fan and a triangle with id_Y on the other. All this data is diagrammatic so it is preserved by all functors making the coequalizer absolute. That it is a coequalizer uses the same proof as for split coequalizers except that we have a series of equalities to show that q\circ s \circ e = q, namely all those pasted together diamonds. There is no conceptual difficulty here; it’s just awkward to notate.
The absolute coequalizer case captures the spirit of the general case, but you can see a description here. I’m not going to work through it, but you could as an exercise. Less tediously, you could work through absolute pushouts. If P is the pushout of Y \leftarrow X \to Z, then the functors to consider are \Hom(P,) and \Hom(Y,)+\Hom(Z,). For each, the pushout in \Set can be turned into a coequalizer of a coproduct. For the first functor, as before, this gives us an inverse image of id_P which will either be an arrow P\to Y or an arrow P\to Z which will play the role of s. The other functor produces a coequalizer of \Hom(Y,Y)+\Hom(Z,Y)+\Hom(Y,Z)+\Hom(Z,Z). The generating relation of the equivalence relation states that there exists either an arrow Y\to X or an arrow Z\to X such that the appropriate equation holds. The story plays out much as before except that we have a sequence of arrows from two different homsets.
In the course of tracking down why free monads were so slow, I fell into a deep labyrinth of scary GHC internals. Six weeks later, I emerged, significantly more knowledgeable, and having implemented some changes in the compiler that will allow polysemy
to be optimized much better. The improvements will be available in 8.10.1.
All of this seems like a good opportunity to share what I've learned, so today let's talk about GHC's specialization pass. This optimization is more popularly known as "the reason why mtl
is so fast."
At a high level, the specialization pass is responsible for optimizing away uses of adhoc polymorphism (typeclasses) in Haskell source code. When fspecialise
is enabled, GHC will make a monomorphic copy of every polymorphic method  one for every unique type it's called with. The result should feel similar to anyone who's written modern C++, as it's completely analogous to how templates work.
While polymorphic functions are great for humans to write, they're significantly slower for machines to execute, since you need to pass around vtables and perform dynamic dispatches, and all sorts of crazy things. This is exactly the purpose of GHC's specialization pass, to simply get rid of all of that machinery and keep only the pieces that are explicitly used.
Let's take an example. Consider the following program:
{# LANGUAGE FlexibleContexts #}
{# OPTIONS_GHC
ddumpsimpl
dsuppressidinfo
dsuppresscoercions
dsuppressmoduleprefixes
fforcerecomp
#}
import Control.Monad.State.Class
import qualified Control.Monad.Trans.State as S
countdown :: S.StateT Int IO ()
countdown = do
v < get
case v of
0 > pure ()
_ > do
put $ v  1
countdown
main :: IO ()
main = S.evalStateT countdown 10
When compiled via ghc Example.hs O fnospecialise
^{1}, we can look directly at the resulting Core of this program. If you're unfamiliar with Core, it's GHC's intermediate language between sourcelevel Haskell and the generated machine code. Core differs in two notable ways from source Haskell: its evaluation is explicit via case
expressions, and both types and typeclass instances are explicitly passed around.
Anyway, here's the relevant Core for our above program:
Rec {
 RHS size: {terms: 14, types: 13, coercions: 0, joins: 0/0}
$wcountdown
:: Int# > State# RealWorld > (# State# RealWorld, ((), Int) #)
$wcountdown
= \ (ww_s49L :: Int#) (w_s49I :: State# RealWorld) >
case ww_s49L of ds_X2I1 {
__DEFAULT > $wcountdown (# ds_X2I1 1#) w_s49I;
0# > (# w_s49I, lvl1_r4ap #)
}
end Rec }
 RHS size: {terms: 12, types: 29, coercions: 0, joins: 0/0}
main1 :: State# RealWorld > (# State# RealWorld, () #)
main1
= \ (s_a2Ks :: State# RealWorld) >
case $wcountdown 10# s_a2Ks of { (# ipv_a2Kv, ipv1_a2Kw #) >
(# ipv_a2Kv,
case ipv1_a2Kw of { (a1_a2I6, ds2_a2I7) > a1_a2I6 } #)
}
As you can see, this is very short and to the point. Reading Core is a bit of an art, but the gist of it is this: main1
calls $wcountdown
, which recursively calls itself, until the value of w_s49I
is 0#
when it stops. It's probably exactly the same code you'd write by hand, if for some reason you were writing Core by hand.
Our program above is written directly against transformers
, but nobody actually writes code against transformers
in the real world. Choosing a concrete monad transformer stack is limiting, and at the same time, prevents you from restricting access to pieces of the stack. Instead, we're encouraged to write code against abstract monad capabilities, traditionally mtl
.
So let's subtly change the type of countdown
above:
countdown :: MonadState Int m => m ()
Nothing else in the program needs to change. Let's now compile this program again via ghc Example.hs O fnospecialise
. The result is horrendously worse Core:
Rec {
 RHS size: {terms: 35, types: 47, coercions: 0, joins: 0/2}
$wcountdown
:: forall (m :: * > *).
Applicative m =>
(forall a b. m a > (a > m b) > m b)
> (forall a b. m a > m b > m b)
> m Int
> (Int > m ())
> m ()
$wcountdown
= \ (@ (m_s4WK :: * > *))
(ww_s4WR :: Applicative m_s4WK)
(ww1_s4WS :: forall a b. m_s4WK a > (a > m_s4WK b) > m_s4WK b)
(ww2_s4WT :: forall a b. m_s4WK a > m_s4WK b > m_s4WK b)
(ww3_s4WX :: m_s4WK Int)
(ww4_s4WY :: Int > m_s4WK ()) >
let {
lvl6_s4W1 :: m_s4WK ()
lvl6_s4W1
= $wcountdown
@ m_s4WK ww_s4WR ww1_s4WS ww2_s4WT ww3_s4WX ww4_s4WY } in
let {
lvl7_s4W2 :: m_s4WK ()
lvl7_s4W2 = pure @ m_s4WK ww_s4WR @ () () } in
ww1_s4WS
@ Int
@ ()
ww3_s4WX
(\ (v_a192 :: Int) >
case v_a192 of { I# ds_d3xJ >
case ds_d3xJ of ds1_X3xT {
__DEFAULT >
ww2_s4WT @ () @ () (ww4_s4WY (I# (# ds1_X3xT 1#))) lvl6_s4W1;
0# > lvl7_s4W2
}
})
end Rec }
 RHS size: {terms: 17, types: 32, coercions: 21, joins: 0/0}
main1 :: State# RealWorld > (# State# RealWorld, () #)
main1
= \ (s_a3z5 :: State# RealWorld) >
case (((($wcountdown
@ (StateT Int IO)
lvl_r4VN
lvl1_r50i
lvl2_r50j
(lvl3_r50k `cast` <Co:13>)
lvl4_r50l)
`cast` <Co:4>)
lvl5_r50m)
`cast` <Co:4>)
s_a3z5
of
{ (# ipv_a3z8, ipv1_a3z9 #) >
(# ipv_a3z8,
case ipv1_a3z9 of { (a1_a3y3, ds2_a3y4) > a1_a3y3 } #)
}
Yikes! What a mess! It's amazing how much of a difference that one type signature made! Our simple mtl
program above has turned into an unholy mess of passing around overlypolymorphic functions. We've paid an awful price to abstract away our monad stack, even though the actual program being run didn't change!
Of course, this isn't a real problem in the wild. Compile the program again, this time without the fnospecialise
flag^{2}  ghc Example.hs O
:
Rec {
 RHS size: {terms: 14, types: 13, coercions: 0, joins: 0/0}
$w$scountdown
:: Int# > State# RealWorld > (# State# RealWorld, ((), Int) #)
$w$scountdown
= \ (ww_s5dY :: Int#) (w_s5dV :: State# RealWorld) >
case ww_s5dY of ds_X3xU {
__DEFAULT > $w$scountdown (# ds_X3xU 1#) w_s5dV;
0# > (# w_s5dV, lvl1_r5jV #)
}
end Rec }
 RHS size: {terms: 12, types: 29, coercions: 0, joins: 0/0}
main1 :: State# RealWorld > (# State# RealWorld, () #)
main1
= \ (s_X3Bw :: State# RealWorld) >
case $w$scountdown 10# s_X3Bw of { (# ipv_a3z9, ipv1_a3za #) >
(# ipv_a3z9,
case ipv1_a3za of { (a1_a3y4, ds2_a3y5) > a1_a3y4 } #)
}
Whew! We're back to the speedy program we started with. fspecialise
has done the hard work of transforming our abstract code into fast code for us  exactly as a good compiler should.
It's amazing how drastic the differences are in the generated code, just from flipping a switch!
Before we can discuss exactly how this transformation helps, we need to first go over some details of how GHC implements a few sourcelevel Haskell features. The first is dictionaries, which are how typeclass dispatch works.
Consider the following program in sourcelevel Haskell:
class Eq a where
(==) :: a > a > Bool
instance Eq () where
(==) _ _ = True
equate :: Eq a => a > a > Bool
equate a1 a2 = a1 == a2
main :: IO ()
main = print $ equate () ()
Internally, GHC will generate the equivalent program:
data Eq a = Eq  #1
(a > a > Bool)
(==) :: Eq a > a > a > Bool
(==) dEq'a =  #2
case dEq'a of
Eq eqMethod > eqMethod
eqUnit :: Eq ()  # 3
eqUnit = Eq
(\_ _ > True)
equate :: Eq a > a > a > Bool  #4
equate dEq'a a1 a2 = (==) dEq'a a1 a2  #5
main :: IO ()
main = print $ equate eqUnit () ()  #6
Notably, the following changes occur:
class Eq a
is transformed into data Eq a
, with each class method becoming a field.(==)
receives a new Eq a
parameter, and becomes a function which pattern matches on it.instance Eq ()
becomes a toplevel declaration of an Eq ()
value.Eq a
constraint on equate
becomes a parameter of the new Eq a
datatype.(==)
in equate
receives the new dEq'a
parameter.equate
at type a ~ ()
in main
receives the new toplevel eqUnit :: Eq ()
value as an argument.We call the values eqUnit
and dEq'a
dictionaries. More precisely, a dictionary is any value whose type is a data type corresponding to a typeclass. Dictionaries do not exist in sourcelevel Haskell, only in the generated Core. In real Core, dictionaries have names that start with $d
, but we'll omit the leading $
today, so we don't get it confused with the ($)
operator.
From all of this that we see that, under the hood, class
definitions are just data
definitions, and that constraints are just invisible parameters.
Consider the following program:
blah =
case True of
True > foo
False > bar
Because we're scrutinizing on a constant value here, the result of this expression must always be foo
. As such, it's safe to replace the entire pattern match expression with foo
:
blah = foo
This transformation is known as the case of known constructor optimization. While humans would never write such a thing by hand, expressions like these often come up as the result of other optimizing transformations.
One final thing to discuss is GHC's term rewriting mechanism, known as rewrite rules.
Rewrite rules are little statements that say "this thing can be written as that thing." Whenever GHC encounters this thing, it will duly rewrite it as that thing. The motivating use case is to allow library authors to implement domainspecific optimizations  such as ensuring composing functions don't generate intermediate structures. You might have heard of "list fusion," which is implemented via rewrite rules.
Rewrite rules must preserve the type of the expression, but besides that are free to do anything they'd like. Just as an example, we can write a program which prints hello world
seemingly from nowhere:
{# RULES
"it's magic!"
pure () = putStrLn "hello world"
#}
main :: IO ()
main = pure ()
Compiling this with O0
won't print any message when run, but will print hello world
when compiled with O
. Spooky!
When XTypeApplications
is enabled, rewrite rules are allowed to match on types too! For example, the following program will print 2 1 1
:
{# LANGUAGE AllowAmbiguousTypes #}
{# LANGUAGE RankNTypes #}
{# LANGUAGE TypeApplications #}
magic :: forall b a. a > a
magic = id
{# NOINLINE magic #}
{# RULES "it's magic!"
forall (a :: Int).
magic @String a = a + 1
#}
main :: IO ()
main = do
print $ magic @String (1 :: Int)
print $ magic @Bool (1 :: Int)
print $ magic @String (1 :: Integer)
Of course, you shouldn't abuse rewrite rules like this  make sure any rules you write are just more efficient versions of an equivalent program  but it's helpful to demonstrate what's going on.
Internally, GHC uses lots of rewrite rules itself! All of its constantfolding (e.g. replacing 2 + 3
with 5
at compile time) is done via rewrite rules, which helps separate that logic from the main compiler.
So with all of that background information out of the way, we're finally ready to talk about how the specializer works.
Recall our our original mtl
program, transformed so it has its dictionaries explicitly passed:
countdown :: Monad m > MonadState Int m > m ()
 There is a `Monad m` constraint on `MonadState s m`, which is where this
 extra constraint comes from.
countdown dMonad'm dMonadState'm = do dMonad'm
v < get dMonadState'm
case v of
0 > pure dMonad'm ()
_ > do dMonad'm
put dMonadState'm $ v  1
countdown dMonad'm dMonadState'm
main :: IO ()
main =
S.evalStateT
(countdown
(dMonadStateT dMonadIO)
(dMonadStateStateT dMonadIO))
10
When fspecialise
is set, the specializer will look for any calls to polymorphic functions with all of their dictionaries saturated by "interesting" dictionaries. The dictionaries dMonad'm
and dMonadState'm
in countdown
aren't interesting, since they're just opaque dictionary variables; we don't know anything about them.
However, GHC notices that countdown
is called with m ~ StateT Int IO
, and that all of its dictionaries are statically known. As such, it emits a specialized version of countdown
, monomorphized to StateT Int IO ()
:
scountdown_StateT :: StateT Int IO ()
scountdown_StateT = do (dMonadStateT dMonadIO)
v < get (dMonadStateStateT dMonadIO)
case v of
0 > pure (dMonadStateT dMonadIO) ()
_ > do (dMonadStateT dMonadIO)
put (dMonadStateStateT dMonadIO) $ v  1
scountdown_StateT
In addition, the specializer will emit a rewrite rule:
{# RULES "SPEC countdown @ (StateT Int IO)"
forall (dMonad'm :: Monad (StateT Int IO))
(dMonadState'm :: MonadState Int (StateT Int IO)).
countdown @(StateT Int IO) dMonad'm dMonadState'm =
scountdown_StateT
#}
This rewrite rule will find any call to countdown at m ~ StateT Int IO
, ignore the dictionaries passed to it, and replace the entire expression with the specialized scountdown_StateT
function.
In particular, this means that main
becomes:
main :: IO ()
main = S.evalStateT scountdown_StateT 10
The rule takes advantage of the fact that dictionaries are known to be consistent (all expressions for a dictionary of a given type eventually evaluate to the same record), so it can completely ignore its two dictionary arguments. However, in principle there's absolutely no reason this same technique couldn't be used to specialize on other, nondictionary, arguments!
Notice now that pure
, get
, and the two doblocks in scountdown_StateT
are now called with interesting dictionaries, so pure
, get
and >>=
can now all also be specialized at StateT Int IO
.
Eventually the concrete dictionaries and corresponding specializations have propagated throughout the entire program. The optimizer can take advantage of two other properties now, namely that class methods were already transformed into pattern matches, and that all of the dictionaries are statically known. Which means, we have created several places in which we can now case of known case!
For example, let's consider the get
in countdown
. It now looks something like this:
v < case MonadState (StateT $ \s > implOfPureForIO (s, s)) ... of
MonadState getMethod _ _ > getMethod
which can obviously be simplified to
v < StateT $ \s > implOfPureForIO (s, s)
This is already a great improvement! But it gets better, recall that we're binding in the StateT
monad, which in turn is calling bind in IO
. But bind in IO
is itself implemented as a pattern match, and so caseofknownconstructor applies there too!
The end result is that GHC spins for a while, alternatingly specializing, inlining, caseofknowncasing, and performing a few other optimizations. Each of these in turn opens up additional opportunities for the others to fire. After a few iterations of this, the resulting code is often orders of magnitude faster!
Everything described above is how the compiler behaves today in GHC 8.6.5 (and has, since like 2007 or something.) However, when digging into the performance of my free monad library polysemy
, I noticed that code written against my library wasn't benefiting from the specialization pass! As a result, my library was performing anywhere between 10x and 1000x worse than mtl
, even though the eventual code being run was identical to mtl
.
Like our experiments above into mtl
, I was paying a performance cost for abstraction, even though the concrete program was identical.
Some investigation by the indefatigable mpickering pointed out that the specializer was failing to specialize. As it happens, the specializer is more than happy to optimize away dictionaries that are passed as the first nontype arguments to a function, but no others.
That means it will go home early if it runs into a function whose signature is of the form:
foo :: Int > forall a. Eq a => ...
Again, humans would never write such a thing, but the optimizer is more than happy to spit these things out. Additionally, code like this often shows up whenever you use a newtype to get around GHC's annoying error that it "does not (yet) support impredicative polymorphism".
Anyway, all of this is to say that in 8.10.1, the specialization pass is now smart enough to specialize functions like foo
. As a result, we should see very real performance improvements in libraries like polysemy
and lens
, and, excitingly, any programs which use them!
Last year a new Math Stack Exchange user asked What's the difference between and ?.
I wrote an answer I thought was pretty good, but the question was downvoted and deleted as “not about mathematics”. This is bullshit, but what can I do?
I can repatriate my answer here, anyway.
This long answer has two parts. The first one is about the arithmetic, and is fairly simple, and is not very different from the other answers here: neither nor has any clear meaning. But your intuition is a good one: if one looks at the situation more carefully, and behave rather differently, and there is more to the story than can be understood just from the arithmetic part. The second half of my answer tries to go into these developments.
The notation has a specific meaning:
The number for which $$x\cdot b=a.$$
Usually this is simple enough. There is exactly one number for which , namely , so . There is exactly one number for which , namely , so .
But when we can't keep the promise that is implied by the word "the" in "The number for which...". Let's see what goes wrong. When the definition says:
The number for which $$x\cdot 0=a.$$
When this goes severely wrong. The lefthand side is zero and the righthand size is not, so there is no number that satisfies the condition. Suppose is the ugliest gorilla on the dairy farm. But the farm has no gorillas, only cows. Any further questions you have about are pointless: is a male or female gorilla? Is its fur black or dark gray? Does prefer bananas or melons? There is no such , so the questions are unanswerable.
When and are both zero, something different goes wrong:
The number for which $$x\cdot 0=0.$$
It still doesn't work to speak of "The number for which..." because any will work. Now it's like saying that is ‘the’ cow from the dairy farm, But there are many cows, so questions about are still pointless, although in a different way: Does have spots? I dunno man, what is ?
Asking about this , as an individual number, never makes sense, for one reason or the other, either because there is no such at all ( when ) or because the description is not specific enough to tell you anything ().
If you are trying to understand this as a matter of simple arithmetic, using analogies about putting cookies into boxes, this is the best you can do. That is a blunt instrument, and for a finer understanding you need to use more delicate tools. In some contexts, the two situations ( and ) are distinguishable, but you need to be more careful.
Suppose and are some functions of , each with definite values for all numbers , and in particular . We can consider the quantity $$q(x) = \frac{f(x)}{g(x)}$$ and ask what happens to when gets very close to . The quantity itself is undefined, because at the denominator is . But we can still ask what happens to when gets close to zero, but before it gets all the way there. It's possible that as gets closer and closer to zero, might get closer and closer to some particular number, say ; we can ask if there is such a number , and if so what it is.
It turns out we can distinguish quite different situations depending on whether the numerator is zero or nonzero. When , we can state decisively that there is no such . For if there were, it would have to satisfy which is impossible; would have to be a gorilla on the dairy farm. There are a number of different ways that can behave in such cases, when its denominator approaches zero and its numerator does not, but all of the possible behaviors are bad: can increase or decrease without bound as gets close to zero; or it can do both depending on whether we approach zero from the left or the right; or it can oscillate more and more wildly, but in no case does it do anything like gently and politely approaching a single number .
But if , the answer is more complicated, because (if it exists at all) would only need to satisfy , which is easy. So there might actually be a that works; it depends on further details of and , and sometimes there is and sometimes there isn't. For example, when and then . This is still undefined at but at any other value of it is equal to , and as approaches zero, slides smoothly in toward along the straight line . When is close to (but not equal to) zero, is close to (but not equal to) ; for example when then , and as gets closer to zero gets even closer to . So the number we were asking about does exist, and is in fact equal to . On the other hand if and then there is still no such .
The details of how this all works, when there is a and when there isn't, and how to find it, are very interesting, and are the basic idea that underpins all of calculus. The calculus part was invented first, but it bothered everyone because although it seemed to work, it depended on an incoherent idea about how division by zero worked. Trying to frame it as a simple matter of putting cookies into boxes was no longer good enough. Getting it properly straightened out was a long process that took around 150 years, but we did eventually get there and now I think we understand the difference between and pretty well. But to really understand the difference you probably need to use the calculus approach, which may be more delicate than what you are used to. But if you are interested in this question, and you want the full answer, that is definitely the way to go.
This post is a long form essay version of a talk about PyTorch internals, that I gave at the PyTorch NYC meetup on May 14, 2019.
Hi everyone! Today I want to talk about the internals of PyTorch.
This talk is for those of you who have used PyTorch, and thought to yourself, "It would be great if I could contribute to PyTorch," but were scared by PyTorch's behemoth of a C++ codebase. I'm not going to lie: the PyTorch codebase can be a bit overwhelming at times. The purpose of this talk is to put a map in your hands: to tell you about the basic conceptual structure of a "tensor library that supports automatic differentiation", and give you some tools and tricks for finding your way around the codebase. I'm going to assume that you've written some PyTorch before, but haven't necessarily delved deeper into how a machine learning library is written.
The talk is in two parts: in the first part, I'm going to first introduce you to the conceptual universe of a tensor library. I'll start by talking about the tensor data type you know and love, and give a more detailed discussion about what exactly this data type provides, which will lead us to a better understanding of how it is actually implemented under the hood. If you're an advanced user of PyTorch, you'll be familiar with most of this material. We'll also talk about the trinity of "extension points", layout, device and dtype, which guide how we think about extensions to the tensor class. In the live talk at PyTorch NYC, I skipped the slides about autograd, but I'll talk a little bit about them in these notes as well.
The second part grapples with the actual nitty gritty details involved with actually coding in PyTorch. I'll tell you how to cut your way through swaths of autograd code, what code actually matters and what is legacy, and also all of the cool tools that PyTorch gives you for writing kernels.
The tensor is the central data structure in PyTorch. You probably have a pretty good idea about what a tensor intuitively represents: its an ndimensional data structure containing some sort of scalar type, e.g., floats, ints, et cetera. We can think of a tensor as consisting of some data, and then some metadata describing the size of the tensor, the type of the elements in contains (dtype), what device the tensor lives on (CPU memory? CUDA memory?)
There's also a little piece of metadata you might be less familiar with: the stride. Strides are actually one of the distinctive features of PyTorch, so it's worth discussing them a little more.
A tensor is a mathematical concept. But to represent it on our computers, we have to define some sort of physical representation for them. The most common representation is to lay out each element of the tensor contiguously in memory (that's where the term contiguous comes from), writing out each row to memory, as you see above. In the example above, I've specified that the tensor contains 32bit integers, so you can see that each integer lies in a physical address, each offset four bytes from each other. To remember what the actual dimensions of the tensor are, we have to also record what the sizes are as extra metadata.
So, what do strides have to do with this picture?
Suppose that I want to access the element at position tensor[0, 1] in my logical representation. How do I translate this logical position into a location in physical memory? Strides tell me how to do this: to find out where any element for a tensor lives, I multiply each index with the respective stride for that dimension, and sum them all together. In the picture above, I've color coded the first dimension blue and the second dimension red, so you can follow the index and stride in the stride calculation. Doing this sum, I get two (zeroindexed), and indeed, the number three lives two below the beginning of the contiguous array.
(Later in the talk, I'll talk about TensorAccessor, a convenience class that handles the indexing calculation. When you use TensorAccessor, rather than raw pointers, this calculation is handled under the covers for you.)
Strides are the fundamental basis of how we provide views to PyTorch users. For example, suppose that I want to extract out a tensor that represents the second row of the tensor above:
Using advanced indexing support, I can just write tensor[1, :] to get this row. Here's the important thing: when I do this, I don't create a new tensor; instead, I just return a tensor which is a different view on the underlying data. This means that if I, for example, edit the data in that view, it will be reflected in the original tensor. In this case, it's not too hard to see how to do this: three and four live in contiguous memory, and all we need to do is record an offset saying that the data of this (logical) tensor lives two down from the top. (Every tensor records an offset, but most of the time it's zero, and I'll omit it from my diagrams when that's the case.)
Question from the talk: If I take a view on a tensor, how do I free the memory of the underlying tensor?
Answer: You have to make a copy of the view, thus disconnecting it from the original physical memory. There's really not much else you can do. By the way, if you have written Java in the old days, taking substrings of strings has a similar problem, because by default no copy is made, so the substring retains the (possibly very large string). Apparently, they fixed this in Java 7u6.
A more interesting case is if I want to take the first column:
When we look at the physical memory, we see that the elements of the column are not contiguous: there's a gap of one element between each one. Here, strides come to the rescue: instead of specifying a stride of one, we specify a stride of two, saying that between one element and the next, you need to jump two slots. (By the way, this is why it's called a "stride": if we think of an index as walking across the layout, the stride says how many locations we stride forward every time we take a step.)
The stride representation can actually let you represent all sorts of interesting views on tensors; if you want to play around with the possibilities, check out the Stride Visualizer.
Let's step back for a moment, and think about how we would actually implement this functionality (after all, this is an internals talk.) If we can have views on tensor, this means we have to decouple the notion of the tensor (the uservisible concept that you know and love), and the actual physical data that stores the data of the tensor (called storage):
There may be multiple tensors which share the same storage. Storage defines the dtype and physical size of the tensor, while each tensor records the sizes, strides and offset, defining the logical interpretation of the physical memory.
One thing to realize is that there is always a pair of TensorStorage, even for "simple" cases where you don't really need a storage (e.g., you just allocated a contiguous tensor with torch.zeros(2, 2)).
By the way, we're interested in making this picture not true; instead of having a separate concept of storage, just define a view to be a tensor that is backed by a base tensor. This is a little more complicated, but it has the benefit that contiguous tensors get a much more direct representation without the Storage indirection. A change like this would make PyTorch's internal representation a bit more like Numpy's.
We've talked quite a bit about the data layout of tensor (some might say, if you get the data representation right, everything else falls in place). But it's also worth briefly talking about how operations on the tensor are implemented. At the very most abstract level, when you call torch.mm, two dispatches happen:
The first dispatch is based on the device type and layout of a tensor: e.g., whether or not it is a CPU tensor or a CUDA tensor (and also, e.g., whether or not it is a strided tensor or a sparse one). This is a dynamic dispatch: it's a virtual function call (exactly where that virtual function call occurs will be the subject of the second half of this talk). It should make sense that you need to do a dispatch here: the implementation of CPU matrix multiply is quite different from a CUDA implementation. It is a dynamic dispatch because these kernels may live in separate libraries (e.g., libcaffe2.so versus libcaffe2_gpu.so), and so you have no choice: if you want to get into a library that you don't have a direct dependency on, you have to dynamic dispatch your way there.
The second dispatch is a dispatch on the dtype in question. This dispatch is just a simple switchstatement for whatever dtypes a kernel chooses to support. Upon reflection, it should also make sense that we need to a dispatch here: the CPU code (or CUDA code, as it may) that implements multiplication on float is different from the code for int. It stands to reason you need separate kernels for each dtype.
This is probably the most important mental picture to have in your head, if you're trying to understand the way operators in PyTorch are invoked. We'll return to this picture when it's time to look more at code.
Since we have been talking about Tensor, I also want to take a little time to the world of tensor extensions. After all, there's more to life than dense, CPU float tensors. There's all sorts of interesting extensions going on, like XLA tensors, or quantized tensors, or MKLDNN tensors, and one of the things we have to think about, as a tensor library, is how to accommodate these extensions.
Our current model for extensions offers four extension points on tensors. First, there is the trinity three parameters which uniquely determine what a tensor is:
If you want to add an extension to PyTorch tensors (by the way, if that's what you want to do, please talk to us! None of these things can be done outoftree at the moment), you should think about which of these parameters you would extend. The Cartesian product of these parameters define all of the possible tensors you can make. Now, not all of these combinations may actually have kernels (who's got kernels for sparse, quantized tensors on FPGA?) but in principle the combination could make sense, and thus we support expressing it, at the very least.
There's one last way you can make an "extension" to Tensor functionality, and that's write a wrapper class around PyTorch tensors that implements your object type. This perhaps sounds obvious, but sometimes people reach for extending one of the three parameters when they should have just made a wrapper class instead. One notable merit of wrapper classes is they can be developed entirely out of tree.
When should you write a tensor wrapper, versus extending PyTorch itself? The key test is whether or not you need to pass this tensor along during the autograd backwards pass. This test, for example, tells us that sparse tensor should be a true tensor extension, and not just a Python object that contains an indices and values tensor: when doing optimization on networks involving embeddings, we want the gradient generated by the embedding to be sparse.
Our philosophy on extensions also has an impact of the data layout of tensor itself. One thing we really want out of our tensor struct is for it to have a fixed layout: we don't want fundamental (and very frequently called) operations like "What's the size of a tensor?" to require virtual dispatches. So when you look at the actual layout of a Tensor (defined in the TensorImpl struct), what we see is a common prefix of all fields that we consider all "tensor"like things to universally have, plus a few fields that are only really applicable for strided tensors, but are so important that we've kept them in the main struct, and then a suffix of custom fields that can be done on a perTensor basis. Sparse tensors, for example, store their indices and values in this suffix.
I told you all about tensors, but if that was the only thing PyTorch provided, we'd basically just be a Numpy clone. The distinguishing characteristic of PyTorch when it was originally released was that it provided automatic differentiation on tensors (these days, we have other cool features like TorchScript; but back then, this was it!)
What does automatic differentiation do? It's the machinery that's responsible for taking a neural network:
...and fill in the missing code that actually computes the gradients of your network:
Take a moment to study this diagram. There's a lot to unpack; here's what to look at:
The whole point of autograd is to do the computation that is described by this diagram, but without actually ever generating this source. PyTorch autograd doesn't do a sourcetosource transformation (though PyTorch JIT does know how to do symbolic differentiation).
To do this, we need to store more metadata when we carry out operations on tensors. Let's adjust our picture of the tensor data structure: now instead of just a tensor which points to a storage, we now have a variable which wraps this tensor, and also stores more information (AutogradMeta), which is needed for performing autograd when a user calls loss.backward() in their PyTorch script.
This is yet another slide which will hopefully be out of date in the near future. Will Feng is working on a VariableTensor merge in C++, following a simple merge which happened to PyTorch's frontend interface.
We also have to update our picture about dispatch:
Before we dispatch to CPU or CUDA implementations, there is another dispatch on variables, which is responsible for unwrapping variables, calling the underlying implementation (in green), and then rewrapping the results into variables and recording the necessary autograd metadata for backwards.
Some implementations don't unwrap; they just call into other variable implementations. So you might spend a while in the Variable universe. However, once you unwrap and go into the nonVariable Tensor universe, that's it; you never go back to Variable (except by returning from your function.)
In my NY meetup talk, I skipped the following seven slides. I'm also going to delay writeup for them; you'll have to wait for the sequel for some text.
Enough about concepts, let's look at some code.
PyTorch has a lot of folders, and there is a very detailed description of what they are in the CONTRIBUTING document, but really, there are only four directories you really need to know about:
That's a lot of places to look for code; we should probably simplify the directory structure, but that's how it is. If you're trying to work on operators, you'll spend most of your time in aten.
Let's see how this separation of code breaks down in practice:
When you call a function like torch.add, what actually happens? If you remember the discussion we had about dispatching, you already have the basic picture in your head:
Each of these steps corresponds concretely to some code. Let's cut our way through the jungle.
Our initial landing point in the C++ code is the C implementation of a Python function, which we've exposed to the Python side as something like torch._C.VariableFunctions.add. THPVariable_add is the implementation of one such implementation.
One important thing to know about this code is that it is autogenerated. If you search in the GitHub repository, you won't find it, because you have to actually build PyTorch to see it. Another important thing is, you don't have to really deeply understand what this code is doing; the idea is to skim over it and get a sense for what it is doing. Above, I've annotated some of the most important bits in blue: you can see that there is a use of a class PythonArgParser to actually pull out C++ objects out of the Python args and kwargs; we then call a dispatch_add function (which I've inlined in red); this releases the global interpreter lock and then calls a plain old method on the C++ Tensor self. On its way back, we rewrap the returned Tensor back into a PyObject.
(At this point, there's an error in the slides: I'm supposed to tell you about the Variable dispatch code. I haven't fixed it here yet. Some magic happens, then...)
When we call the add method on the Tensor class, no virtual dispatch happens yet. Instead, we have an inline method which calls a virtual method on a "Type" object. This method is the actual virtual method (this is why I say Type is just a "gadget" that gets you dynamic dispatch.) In the particular case of this example, this virtual call dispatches to an implementation of add on a class named TypeDefault. This happens to be because we have an implementation of add that is the same for every device type (both CPU and CUDA); if we had happened to have different implementations, we might have instead landed on something like CPUFloatType::add. It is this implementation of the virtual method that finally gets us to the actual kernel code.
Hopefully, this slide will be outofdate very soon too; Roy Li is working on replacing Type dispatch with another mechanism which will help us better support PyTorch on mobile.
It's worth reemphasizing that all of the code, until we got to the kernel, is automatically generated.
It's a bit twisty and turny, so once you have some basic orientation about what's going on, I recommend just jumping straight to the kernels.
PyTorch offers a lot of useful tools for prospective kernel writers. In this section, we'll walk through a few of them. But first of all, what do you need to write a kernel?
We generally think of a kernel in PyTorch consisting of the following parts:
In the subsequent slides, we'll walk through some of the tools PyTorch has for helping you implementing these steps.
To take advantage of all of the code generation which PyTorch brings, you need to write a schema for your operator. The schema gives a mypyesque type of your function, and also controls whether or not we generate bindings for methods or functions on Tensor. You also tell the schema what implementations of your operator should be called for given devicelayout combinations. Check out the README in native is for more information about this format.
You also may need to define a derivative for your operation in derivatives.yaml.
Error checking can be done by way of either a low level or a high level API. The low level API is just a macro, TORCH_CHECK, which takes a boolean, and then any number of arguments to make up the error string to render if the boolean is not true. One nice thing about this macro is that you can intermix strings with nonstring data; everything is formatted using their implementation of operator<<, and most important data types in PyTorch have operator<< implementations.
The high level API saves you from having to write up repetitive error messages over and over again. The way it works is you first wrap each Tensor into a TensorArg, which contains information about where the tensor came from (e.g., its argument name). It then provides a number of precanned functions for checking various properties; e.g., checkDim() tests if the tensor's dimensionality is a fixed number. If it's not, the function provides a userfriendly error message based on the TensorArg metadata.
One important thing to be aware about when writing operators in PyTorch, is that you are often signing up to write three operators: abs_out, which operates on a preallocated output (this implements the out= keyword argument), abs_, which operates inplace, and abs, which is the plain old functional version of an operator.
Most of the time, abs_out is the real workhorse, and abs and abs_ are just thin wrappers around abs_out; but sometimes writing specialized implementations for each case are warranted.
To do dtype dispatch, you should use the AT_DISPATCH_ALL_TYPES macro. This takes in the dtype of the tensor you want to dispatch over, and a lambda which will be specialized for each dtype that is dispatchable from the macro. Usually, this lambda just calls a templated helper function.
This macro doesn't just "do dispatch", it also decides what dtypes your kernel will support. As such, there are actually quite a few versions of this macro, which let you pick different subsets of dtypes to generate specializations for. Most of the time, you'll just want AT_DISPATCH_ALL_TYPES, but keep an eye out for situations when you might want to dispatch to some more types. There's guidance in Dispatch.h for how to select the correct one for your usecase.
On CPU, you frequently want to parallelize your code. In the past, this was usually done by directly sprinkling OpenMP pragmas in your code.
At some point, we have to actually access the data. PyTorch offers quite a few options for doing this.
A lot of kernels in PyTorch are still written in the legacy TH style. (By the way, TH stands for TorcH. It's a pretty nice acronym, but unfortunately it is a bit poisoned; if you see TH in the name, assume that it's legacy.) What do I mean by the legacy TH style?
This code is pretty crazy, and we hate reviewing it, so please don't add to it. One of the more useful tasks that you can do, if you like to code but don't know too much about kernel writing, is to port some of these TH functions to ATen.
To wrap up, I want to talk a little bit about working efficiently on PyTorch. If the largeness of PyTorch's C++ codebase is the first gatekeeper that stops people from contributing to PyTorch, the efficiency of your workflow is the second gatekeeper. If you try to work on C++ with Python habits, you will have a bad time: it will take forever to recompile PyTorch, and it will take you forever to tell if your changes worked or not.
How to work efficiently could probably be a talk in and of itself, but this slide calls out some of the most common antipatterns I've seen when someone complains: "It's hard to work on PyTorch."
So that's it for a whirlwind tour of PyTorch's internals! Many, many things have been omitted; but hopefully the descriptions and explanations here can help you get a grip on at least a substantial portion of the codebase.
Where should you go from here? What kinds of contributions can you make? A good place to start is our issue tracker. Starting earlier this year, we have been triaging issues; issues labeled triaged mean that at least one PyTorch developer has looked at it and made an initial assessment about the issue. You can use these labels to find out what issues we think are high priority or look up issues specific to some module, e.g., autograd or find issues which we think are small (word of warning: we're sometimes wrong!)
Even if you don't want to get started with coding right away, there are many other useful activities like improving documentation (I love merging documentation PRs, they are so great), helping us reproduce bug reports from other users, and also just helping us discuss RFCs on the issue tracker. PyTorch would not be where it is today without our open source contributors; we hope you can join us too!
Some notes collected from a close read of Conal Elliot's Compiling to Categories and The Simple Essence of Automatic Differentiation.
A colleague of mine was trying to define a "tree structure" of tensors, with the hope of thereby generalizing the concept to also work with tensors that have "ragged dimensions." Let's take a look:
Suppose we have a (2, 3) matrix:
tensor([[1, 2, 3], [4, 5, 6]])
One way to think about this is that we have a "tree" of some sort, where the root of the tree branches to two subnodes, and then each subnode branches to three nodes:
/ ROOT \ ROW 1 ROW 2 /  \ /  \ 1 2 3 4 5 6
Suppose you wanted to define this data structure in Haskell. One obvious way of going about doing this is to just say that a matrix is just a bunch of nested lists, [[Float]]. This works, true, but it isn't very illuminating, and it is certainly not type safe. Type safety could be achieved with sized vectors, but we are still left wondering, "what does it mean?"
Often, inductive definitions fall out of how we compose things together, in the same way that the inductive data structure for a programming language tells us how we take smaller programs and put them together to form a larger program. With matrices, we can think of a pictorial way of composing them, by either attaching matrices together vertically or horizontally. That gives us this vocabulary for putting together matrices, which would let us (nonuniquely) represent every matrix (Compiling to Categories, Section 8):
data Matrix = Scalar Float  Horizontal Matrix Matrix  Vertical Matrix Matrix
But what does it mean? Well, every matrix represents a linear map (if A : (n, m) is your matrix, the linear map is the function R^m > R^n, defined to be f(x) = A x. We'll call a linear map from a to b, Linear a b). So the question we ask now is, what does it mean to "paste" two matrices together? It's a way of composing two linear maps together into a new linear map:
 A function definition does not a category make! You have to  prove that the resulting functions are linear. horizontal :: Linear a c > Linear b c > Linear (a, b) c horizontal f g = \(a, b) > f a + g b  In matrix form:   [ a ]  [ F  G ] [  ] = [ F a + G b ]  [ b ] vertical :: Linear a c > Linear a d > Linear a (c, d) vertical f g = \a > (f a, g a)  In matrix form:   [ F ] [ F a ]  [  ] [ a ] = [  ]  [ G ] [ G a ]
Now we're cooking! Notice that the pasting shows up in the type of the linear map: if we paste horizontally, that just means that the vectors this linear map takes in have to be pasted together (with the tuple constructor); similarly, if we paste vertically, we'll produce output vectors that are the pasted results.
Cool, so we can add some type indexes, and write Linear as a GADT to refine the indices when you apply the constructor:
data Linear a b where Scalar :: Float > Linear Float Float Horizontal :: Linear a c > Linear b c > Linear (a, b) c Vertical :: Linear a c > Linear a d > Linear a (c, d)
Is this the end of the story? Not quite. There are many ways you can go about combining linear maps; for example, you could (literally) compose two linear maps together (in the same sense of function composition). It's true that you can paste together any matrix you like with the data type above; how do we decide what should and shouldn't go in our language of linear maps?
To this end, Conal Elliot calls on the language of category theory to adjudicate. A category should define identity and function composition:
identity :: Linear a a identity a = a  In matrix form: the identity matrix compose :: Linear b c > Linear a b > Linear a c compose g f = \a > g (f a)  In matrix form: matrix multiply
We find that Horizontal and Vertical are the elimination and introduction operations of cocartesian and cartesian categories (respectively).
But this should we just slap Identity and Compose constructors to our data type? Linear map composition is a computationally interesting operation: if we just keep it around as syntax (rather than doing what is, morally, a matrix multiply), then it will be quite expensive to do operations on the final linear map. Where do representable functors come in? I'm not exactly sure how to explain this, and I've run out of time for this post; stay tuned for a follow up.
Summary: Shake now does that Applicative trick from Haxl.
In Shake 0.17.9 and below, need xs >> need ys
builds xs
in parallel, then afterwards builds ys
in parallel. The same is true of need xs *> need ys
, where *>
is the applicative equivalent of >>
. From Shake 0.18 onwards both versions run everything in parallel. Hopefully that makes some Shakebased build systems go faster.
What change is being made?
If you make two calls to apply
without any IO
, monadicbind or state operations in between then they will be executed as though you had made a single call to apply
. As examples, need
, askOracle
and getDirectoryFiles
are all calls to apply
under the hood, so can be merged. However, note that the invariants are somewhat subtle. Something as simple as:
myNeed xs = do putNormal "Needing here"; need xs
Will not be merged with a preceeding need
 the function putNormal
queries the state (what is the verbosity level), does IO and contains a monadic bind.
Why are you making this change?
I am making the change for two reasons: 1) people have kept asking for it since Haxl does it; 2) the Hadrian build probably benefits from it. The downsides are relatively low (more complexity inside Shake, slightly slower Action
operations) but the benfits are potentially large.
Why didn't you make this change sooner?
My previous reasoning for not making the change was:
Shake could follow the Haxl approach, but does not, mainly because they are targeting different problems. In Haxl, the operations are typically readonly, and any single step is likely to involve lots of operations. In contrast, with Shake the operations definitely change the file system, and there are typically only one or two per rule. Consequently, Shake opts for an explicit approach, rather than allow users to use
*>
(and then inevitably add a comment because its an unusual thing to do).
I stand by that comment  explicit grouping of need
or explicit use of parallel
is often better  all it takes is a sneaky >>=
and the parallelism disappears. But if this change improves some build times, it's hard to argue strongly against.
Will it break any build systems?
Potentially, but unlikely, and those it will break were already on thin ice. As some examples:
a
depends on some state change from b
(e.g. creating a directory), but doesn't have a dependency on it, then need [a] >> need [b]
might have worked, while need [a,b]
might not. The correct solution is for a
to depend on b
, if it does in fact depend on b
, or at the very least use orderOnly
.getDirectoryFiles
on generated files (something the documentation says is a bad idea) then if merged with the thing that generates the files you will get incoherent results. The solution is to avoid using getDirectoryFiles
on generated files.Thanks to Pepe Iborra for encouraging, testing and troubleshooting this change.
What’s wrong with the following code?
module Acos (acos) where
import Prelude hiding (acos)
import Foreign.C.Types (CDouble(..))
foreign import ccall "math.h acos" c_acos :: CDouble > CDouble
acos :: Double > Double
acos = realToFrac . c_acos . realToFrac
If you use QuickCheck to test the equivalence of Acos.acos
and Prelude.acos
, you’ll quickly find a counterexample:
You might think this is a difference in the semantics of Haskell acos vs C acos, but the acos(3) manpage disproves that:
If x is outside the range [1, 1], a domain error occurs, and a NaN is returned.
Moreover, you’ll notice the discrepancy only when compiling the Haskell program with O0
. If you compile with O1
or higher, both versions will result in NaN
. So what’s going on here?
What turns the NaN
turned into the Infinity
is realToFrac
. It is defined as follows:
Unlike Double
, Rational
, which is defined as a ratio of two Integers, has no way to represent special values such as NaN
. Instead, toRational (acos 1.1)
results in a fraction with some ridiculously large numerator, which turns into Infinity
when converted back to Double
.
When you compile with O1
or higher, the following rewrite rules fire and avoid the round trip through Rational
:
"realToFrac/a>CDouble" realToFrac = \x > CDouble (realToFrac x)
"realToFrac/CDouble>a" realToFrac = \(CDouble x) > realToFrac x
"realToFrac/Double>Double" realToFrac = id :: Double > Double
Unfortunately, the Haskell 2010 Report doesn’t give you any reliable way to convert between Double
and CDouble
. According to the Report, CDouble
is an abstract newtype, about which all you know is the list of instances, including Real
and Fractional
. So if you want to stay portable, realToFrac
seems to be the only solution available.
However, if you only care about GHC and its base library (which pretty much everyone is using nowadays), then you can take advantage of the fact that the constructor of the CDouble
newtype is exported. You can use coerce
from Data.Coerce
or apply the data constructor CDouble
directly.
So here’s a reliable, but not portable, version of the Acos
module above:
For another project I’m working on, I needed a way to enumerate and randomly sample values from various potentially infinite collections. There are plenty of packages in this space, but none of them quite fit my needs:
universe
(and related packages) is very nice, but it’s focused on enumerating values of Haskell data types, not arbitrary sets: since it uses type classes, you have to make a new Haskell type for each thing you want to enumerate. It also uses actual Haskell lists of values, which doesn’t play nicely with sampling.enumerable
has not been updated in a long time and seems to be superseded by universe
.enumerate
is likewise focused on generating values of Haskell data types, with accompanying generic deriving machinery.sizebased
is used as the basis for the venerable testingfeat
library, but these are again focused on generating values of Haskell data types. I’m also not sure I need the added complexity of sizeindexed enumerations.enumeration
looks super interesting, and I might be able to use it for what I want, but (a) I’m not sure whether it’s maintained anymore, and (b) it seems rather more complex than I need.I really want something like Racket’s nice data/enumerate
package, but nothing like that seems to exist in Haskell. So, of course, I made my own! For now you can find it on GitHub.^{1} Here’s the package in a nutshell:
Enumeration
, which is an instance of Functor
, Applicative
, and Alternative
(but not Monad
).I wrote about something similar a few years ago. The main difference is that in that post I limited myself to only finite enumerations. There’s a lot more I could say but for now I think I will just show some examples:
>>> enumerate empty
[]
>>> enumerate unit
[()]
>>> enumerate $ empty <> unit <> unit
[(),()]
>>> enumerate $ finite 4 >< finiteList [27,84,17]
[(0,27),(0,84),(0,17),(1,27),(1,84),(1,17),(2,27),(2,84),(2,17),(3,27),(3,84),(3,17)]
>>> select (finite 4000000000000 >< finite 123456789) 0
(0,0)
>>> select (finite 4000000000000 >< finite 123456789) 196598723084073
(1592449,82897812)
>>> card (finite 4000000000000 >< finite 123456789)
Finite 493827156000000000000
>>> :set XTypeApplications
>>> enumerate $ takeE 26 . dropE 65 $ boundedEnum @Char
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
>>> take 10 . enumerate $ nat >< nat
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0)]
>>> take 10 . enumerate $ cw
[1 % 1,1 % 2,2 % 1,1 % 3,3 % 2,2 % 3,3 % 1,1 % 4,4 % 3,3 % 5]
>>> take 15 . enumerate $ listOf nat
[[],[0],[0,0],[1],[0,0,0],[1,0],[2],[0,1],[1,0,0],[2,0],[3],[0,0,0,0],[1,1],[2,0,0],[3,0]]
data Tree = L  B Tree Tree
deriving (Eq, Show)
trees :: Enumeration Tree
trees = infinite $ singleton L <> B <$> trees <*> trees
>>> take 3 . enumerate $ trees
[L,B L L,B L (B L L)]
>>> select trees 87239862967296
B (B (B (B (B L L) (B (B (B L L) L) L)) (B L (B L (B L L)))) (B (B (B L (B L (B L L))) (B (B L L) (B L L))) (B (B L (B L (B L L))) L))) (B (B L (B (B (B L (B L L)) (B L L)) L)) (B (B (B L (B L L)) L) L))
treesOfDepthUpTo :: Int > Enumeration Tree
treesOfDepthUpTo 0 = singleton L
treesOfDepthUpTo n = singleton L <> B <$> t' <*> t'
where t' = treesOfDepthUpTo (n1)
>>> card (treesOfDepthUpTo 0)
Finite 1
>>> card (treesOfDepthUpTo 1)
Finite 2
>>> card (treesOfDepthUpTo 3)
Finite 26
>>> card (treesOfDepthUpTo 10)
Finite
14378219780015246281818710879551167697596193767663736497089725524386087657390556152293078723153293423353330879856663164406809615688082297859526620035327291442156498380795040822304677
>>> select (treesOfDepthUpTo 10) (2^50)
B L (B L (B L (B (B L (B (B L (B (B L L) L)) (B (B (B (B L L) (B L L)) (B L (B L L))) (B (B (B L L) L) (B (B L L) L))))) (B (B (B (B (B (B L L) L) (B (B L L) L)) (B L L)) (B (B (B (B L L) L) (B L (B L L))) (B (B (B L L) (B L L)) L))) (B (B (B (B L L) (B L L)) (B (B (B L L) L) L)) (B (B L L) (B (B (B L L) L) (B (B L L) L))))))))
Comments, questions, suggestions for additional features, etc. are all very welcome!
This post summarizes the virtues of cutting frequent releases for software projects. You might find this post useful if you are trying to convince others to release more frequently (such as your company or an open source project you contribute to).
Frequent releases provide a smoother migration path for endusers of your software.
For example, suppose that your software is currently version “1.0” and you have two breaking changes (“A” and “B”) that you plan to make. Now consider the following two release strategies
Release strategy #0  More frequent releases
* Version 1.0
* Initial release
* Version 2.0
* BREAKING CHANGE: A
* Version 3.0
* BREAKING CHANGE: B
Release strategy #1  Less frequent releases
* Version 1.0
* Initial release
* Version 2.0
* BREAKING CHANGE: A
* BREAKING CHANGE: B
The first release strategy is better from the enduser’s point of view because they have the option to upgrade in two smaller steps. In other words, they can upgrade from version 1.0 to version 2.0 and then upgrade from version 2.0 to version 3.0 at a later date.
Under both release strategies users can elect to skip straight to the latest release if they are willing to pay down the full upgrade cost up front, but releasing more frequently provides users the option to pay down the upgrade cost in smaller installments. To make an analogy: walking up a staircase is easier than scaling a sheer cliff of the same height.
In particular, you want to avoid the catastrophic scenario where a large number of users refuse to upgrade if one release bundles too many breaking changes. The textbook example of this is the Python 2 to 3 upgrade where a large fraction of the community refused to upgrade because too many breaking changes were bundled into a single release instead of spread out over several releases.
You don’t need to delay a release to wait for a particular feature if you release frequently. Just postpone the change for the next release if it’s not ready. After all, if you release frequently then the next release is right around the corner.
Conversely, if you release infrequently, you will frequently run into the following vicious cycle:
Important feature X is close to completion but perhaps not quite ready to merge
Perhaps the feature has insufficient tests or there are unresolved concerns during code review
A new release is about to be cut
Should you wait to merge feature X? It might be a long time (3 months?) before the next release, even though X could be ready with just 1 more week of work.
You choose to delay the release to wait for important feature X
Now another important feature Y requests to also slip in before the release
… further delaying the release
3 months have passed and you still haven’t cut the release
New features keep (justifiably) slipping in out of fear that they will have to otherwise wait for the next release
Eventually you do cut a release, but each iteration of this process decreases the release frequency and compounds the problem. The less frequently you release software the more incentive to slip in lastminute changes before the release cutoff, further delaying the release. Even worse, the longer you wait to cut each release the greater the pressure to compromise on quality to get the release out the door.
Sticking to a strict and frequent release schedule staves off this vicious cycle because then you can always safely postpone incomplete features to the next release.
Infrequent “big bang” releases create pressure for developers to work excessive hours in the lead up to a release cutoff. This can happen even when developers are unpaid, such as on open source projects: the peer pressure of holding up the release for others can induce people to work unhealthy schedules they wouldn’t work otherwise.
I won’t claim that frequent release schedules will prevent paid developers from working late nights and weekends, but at least management can’t hide behind a looming release deadline to justify the overtime.
Releases are opportunities to correct course because you don’t know how users will react to a feature until you put the feature into their hands. If you implement a feature and the next release is 3 month away, that’s 3 months where you don’t know if the feature is what the user actually needs.
Even worse: suppose that the first implementation of the feature does not do what the user wants: now you have to wait another 3 months to get the next iteration of the feature into their hands. That slow feedback loop is a recipe for a poorlydesigned product.
Fast release cycles force you to automate and accelerate releaserelated processes that you would otherwise do manually (i.e. continuous integration), including:
That automation in turn means that you spend more time in the long run developing features and less time delivering them to end users.
Releasing more frequently isn’t free: as the previous section suggests, you need to invest in automation to be able to make frequent releases a reality.
However, I do hope that people reading this post will recognize when symptoms of infrequent releases creep up on them so that they can get ahead of them and make the case to others to invest in improving release frequency.
I was looking again at one of my implementations of breadthfirst traversals:
bfe :: Tree a > [a]
bfe r = f r b []
where
f (Node x xs) fw bw = x : fw (xs : bw)
b [] = []
b qs = foldl (foldr f) b qs []
And I was wondering if I could fuse away the intermediate list. On the following line:
The xs : bw
is a little annoying, because we know it’s going to be consumed eventually by a fold. When that happens, it’s often a good idea to remove the list, and just inline the fold. In other words, if you see the following:
You should replace it with this:
If you try and do that with the above definition, you get something like the following:
bfenum :: Tree a > [a]
bfenum t = f t b b
where
f (Node x xs) fw bw = x : fw (bw . flip (foldr f) xs)
b x = x b
The trouble is that the above comes with type errors:
Cannot construct the infinite type: b ~ (b > c) > [a]
This error shows up occasionally when you try and do heavy churchencoding in Haskell. You get a similar error when trying to encode the Y combinator:
• Occurs check: cannot construct the infinite type: t0 ~ t0 > t
The solution for the y combinator is to use a newtype, where we can catch the recursion at a certain point to help the typechecker.
The trick for our queue is similar:
newtype Q a = Q { q :: (Q a > [a]) > [a] }
bfenum :: Tree a > [a]
bfenum t = q (f t b) e
where
f (Node x xs) fw = Q (\bw > x : q fw (bw . flip (foldr f) xs))
b = fix (Q . flip id)
e = fix (flip q)
This is actually equivalent to the continuation monad:
newtype Fix f = Fix { unFix :: f (Fix f) }
type Q a = Fix (ContT a [])
q = runContT . unFix
bfenum :: Tree a > [a]
bfenum t = q (f t b) e
where
f (Node x xs) fw = Fix (mapContT (x:) (flip (foldr f) xs <$> unFix fw))
b = fix (Fix . pure)
e = fix (flip q)
There’s a problem though: this algorithm never checks for an end. That’s ok if there isn’t one, mind you. For instance, with the following “unfold” function:
infixr 9 #.
(#.) :: Coercible b c => (b > c) > (a > b) > a > c
(#.) _ = coerce
{# INLINE (#.) #}
bfUnfold :: (a > (b,[a])) > a > [b]
bfUnfold f t = g t (fix (Q #. flip id)) (fix (flip q))
where
g b fw bw = x : q fw (bw . flip (foldr ((Q .) #. g)) xs)
where
(x,xs) = f b
We can write a decent enumeration of the rationals.
 SternBrocot
rats1 :: [Rational]
rats1 = bfUnfold step ((0,1),(1,0))
where
step (lb,rb) = (n % d,[(lb , m),(m , rb)])
where
m@(n,d) = adj lb rb
adj (w,x) (y,z) = (w+y,x+z)
 CalkinWilf
rats2 :: [Rational]
rats2 = bfUnfold step (1,1)
where
step (m,n) = (m % n,[(m,m+n),(n+m,n)])
However, if we do want to stop at some point, we need a slight change to the queue type.
newtype Q a = Q { q :: Maybe (Q a > [a]) > [a] }
bfenum :: Tree a > [a]
bfenum t = q (f t b) e
where
f (Node x xs) fw = Q (\bw > x : q fw (Just (m bw . flip (foldr f) xs)))
b = fix (Q . maybe [] . flip ($))
e = Nothing
m = fromMaybe (flip q e)
We can actually add in a monad to the above unfold without much difficulty.
newtype Q m a = Q { q :: Maybe (Q m a > m [a]) > m [a] }
bfUnfold :: Monad m => (a > m (b,[a])) > a > m [b]
bfUnfold f t = g t b e
where
g s fw bw = f s >>=
\ ~(x,xs) > (x :) <$> q fw (Just (m bw . flip (foldr ((Q .) #. g)) xs))
b = fix (Q #. maybe (pure []) . flip ($))
e = Nothing
m = fromMaybe (flip q e)
And it passes the torture tests for a lineartime breadthfirst unfold from Feuer (2015). It breaks when you try and use it to build a tree, though.
Finally, we can try and make the above code a little more modular, by actually packaging up the queue type as a queue.
newtype Q a = Q { q :: Maybe (Q a > [a]) > [a] }
newtype Queue a = Queue { runQueue :: Q a > Q a }
now :: a > Queue a
now x = Queue (\fw > Q (\bw > x : q fw bw))
delay :: Queue a > Queue a
delay xs = Queue (\fw > Q (\bw > q fw (Just (m bw . runQueue xs))))
where
m = fromMaybe (flip q Nothing)
instance Monoid (Queue a) where
mempty = Queue id
mappend (Queue xs) (Queue ys) = Queue (xs . ys)
run :: Queue a > [a]
run (Queue xs) = q (xs b) Nothing
where
b = fix (Q . maybe [] . flip ($))
bfenum :: Tree a > [a]
bfenum t = run (f t)
where
f (Node x xs) = now x <> delay (foldMap f xs)
At this point, our type is starting to look a lot like the Phases
type from Noah Easterly’s treetraversals package. This is exciting: the Phases
type has the ideal interface for levelwise traversals. Unfortunately, it has the wrong time complexity for <*>
and so on: my suspicion is that the queue type above here is to Phases
as the continuation monad is to the free monad. In other words, we’ll get efficient construction at the expense of no inspection. Unfortunately, I can’t figure out how to turn the above type into an applicative. Maybe in a future post!
Finally, a lot of this is working towards finally understanding Smith (2009) and Allison (2006).
Allison, Lloyd. 2006. “Circular Programs and SelfReferential Structures.” Software: Practice and Experience 19 (2) (October 30): 99–109. doi:10.1002/spe.4380190202. http://users.monash.edu/~lloyd/tildeFP/1989SPE/.
Feuer, David. 2015. “Is a lazy, breadthfirst monadic rose tree unfold possible?” Question. Stack Overflow. https://stackoverflow.com/q/27748526.
Smith, Leon P. 2009. “Lloyd Allison’s Corecursive Queues: Why Continuations Matter.” The Monad.Reader, July 29. https://meldingmonads.files.wordpress.com/2009/06/corecqueues.pdf.
Last week we referenced the ST
monad and went into a little bit of depth with how it enables mutable arrays. It provides an alternative to the IO
monad that gives us mutable data without side effects. This week, we're going to take a little bit of a break from adding features to our Maze game. We'll look at a specific example where mutable data can allow different algorithms.
Let's consider the quicksort algorithm. We can do this "in place", mutating an input array. But immutable data in Haskell makes it difficult to implement this approach. We'll examine one approach using normal, immutable lists. Then we'll see how we can use a more common quicksort algorithm using ST
. At the end of the day, there are still difficulties with making this work the way we'd like. But it's a useful experiment to try nonetheless.
Still new to monads in Haskell? You should read our series on Monads and Functional Structures! It'll help you learn monads from the ground up, starting with simpler concepts like functors!
Before we dive back into using arrays, let's take a quick second to grasp the purpose of the ST
monad. My first attempt at using mutable arrays in the Maze game involved using an IOArray
. This worked, but it caused generateRandomMaze
to use the IO
monad. You should be very wary of any action that changes your code from pure to using IO
. The old version of the function couldn't have weird side effects like file system access! The new version could have any number of weird bugs present! Among other things, it makes it much harder to use and test this code.
In my specific case, there was a more pressing issue. It became impossible to run random generation from within the eventHandler
. This meant I couldn't restart the game how I wanted. The handler is a pure function and can't use IO
.
The ST
monad provides precisely what we need. It allows us to run code that can mutate values in place without allowing arbitrary side effects, as IO
does. We can use the generic runST
function to convert a computation in the ST
monad to it's pure result. This is similar to how we can use runState
to run a State
computation from a pure one.
runST :: (forall. s ST a) > a
The s
parameter is a little bit magic. We generally don't have to specify what it is. But the parameter prevents the outside world from having extra side effects on the data. Don't worry about it too much.
There's another function runSTArray
. This does the same thing, except it works with mutable arrays:
runSTArray :: (forall. s ST s (STArray s i e)) > Array i e
This allows us to use STArray
instead of IOArray
as our mutable data type. Later in this article, we'll use this type to make our "inplace" quicksort algorithm. But first, let's look at a simpler version of this algorithm.
Learn You a Haskell For Great Good presents a short take on the quicksort algorithm. It demonstrates the elegance with which we can express recursive solutions.
quicksort1 :: (Ord a) => [a] > [a]
quicksort1 [] = []
quicksort1 (x:xs) =
let smallerSorted = quicksort1 [a  a < xs, a <= x]
biggerSorted = quicksort1 [a  a < xs, a > x]
in smallerSorted ++ [x] ++ biggerSorted
This looks very nice! It captures the general idea of quicksort. We take the first element as our pivot. We divide the remaining list into the elements greater than the pivot and less than the pivot. Then we recursively sort each of these sublists, and combine them with the pivot in the middle.
However, each new list we make takes extra memory. So we are copying part of the list at each recursive step. This means we will definitely use at least O(n)
memory for this algorithm.
We can also note the way this algorithm chooses its pivot. It always selects the first element. This is quite inefficient on certain inputs (sorted or reverse sorted arrays). To get our expected performance to a good point, we want to choose the pivot index at random. But then we would need an extra argument of type StdGen
, so we'll ignore it for this article.
It's possible of course, to do quicksort "in place", without making any copies of any part of the array! But this requires mutable memory. To get an idea of what this algorithm looks like, we'll implement it in Java first. Mutable data is more natural in Java, so this code will be easier to follow.
The quicksort algorithm is recursive, but we're going to handle the recursion in a helper. The helper will take two add extra arguments: the int values for the "start" and "end" of this quicksort section. The goal of quicksortHelper
will be to ensure that we've sorted only this section. As a stylistic matter, I use "end" to mean one index past the point we're sorting to. So our main quicksort
function will call the helper with 0
and arr.length
.
public static void quicksort(int[] arr) {
quicksortHelper(arr, 0, arr.length);
}
public static void quicksortHelper(int[] arr, int start, int end) {
...
}
Before we dive into the rest of that function though, let's design two smaller helpers. The first is very simple. It will swap two elements within the array:
public static void swap(int[] arr, int i, int j) {
int temp = arr[i];
arr[i] = arr[j];
arr[j] = temp;
}
The next helper will contain the core of the algorithm. This will be our partition
function. It's responsible for choosing a pivot (again, we'll use the first element for simplicity). Then it divides the array so that everything smaller than the pivot is in the first part of the array. After, we insert the pivot, and then we get the larger elements. It returns the index of partition:
public static int partition(int[] arr, int start, int end) {
int pivotElement = arr[start];
int pivotIndex = start + 1;
for (int i = start + 1; i < end; ++i) {
if (arr[i] <= pivotElement) {
swap(arr, i, pivotIndex);
++pivotIndex;
}
}
swap(arr, start, pivotIndex  1);
return pivotIndex  1;
}
Now our quicksort helper is easy! It will partition the array, and then make recursive calls on the subparts! Notice as well the base case:
public static void quicksortHelper(int[] arr, int start, int end) {
if (start + 1 >= end) {
return;
}
int pivotIndex = partition(arr, start, end);
quicksortHelper(arr, start, pivotIndex);
quicksortHelper(arr, pivotIndex + 1, end);
}
Since we did everything in place, we didn't allocate any new arrays! So our function definitions only add O(1)
extra memory for the temporary values. Since the stack depth is, on average, O(log n)
, that is the asymptotic memory usage for this algorithm.
Now that we're familiar with the inplace algorithm, let's see what it looks like in Haskell. We want to do this with STArray
. But we'll still write a function with pure input and output. Unfortunately, this means we'll end up using O(n)
memory anyway. The thaw
function must copy the array to make a mutable version of it. However, the rest of our operations will work inplace on the mutable array. We'll follow the same patterns as our Java code! Let's start simple and write our swap
function!
swap :: ST s Int a > Int > Int > ST s ()
swap arr i j = do
elem1 < readArray arr i
elem2 < readArray arr j
writeArray arr i elem2
writeArray arr j elem1
Now let's write out our partition
function. We're going to make it look as much like our Java version as possible. But it's a little tricky because we're don't have forloops! Let's deal with this problem head on by first designing a function to handle the loop.
The loop produces our value for the final pivot index. But we have to keep track of its current value. This sounds like a job for the State
monad! Our state function will take the pivotElement
and the array itself as a parameter. Then it will take a final parameter for the i
value we have in our partition loop in the Java version.
partitionLoop :: (Ord a)
=> STArray s Int a
> a
> Int
> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
...
We fill this with comparable code to Java. We read the current pivot and the element for the current i
index. Then, if it's smaller, we swap them in our array, and increment the pivot:
partitionLoop :: (Ord a)
=> STArray s Int a
> a
> Int
> StateT Int (ST s) ()
partitionLoop arr pivotElement i = do
pivotIndex < get
thisElement < lift $ readArray arr i
when (thisElement <= pivotElement) $ do
lift $ swap arr i pivotIndex
put (pivotIndex + 1)
Now we incorporate this loop into our primary partition
function after getting the pivot element. We'll use mapM
to sequence the state actions together and pass that to execStateT
. Then we'll return the final pivot (subtracting 1). Don't forget to swap the pivot into the middle of the array though!
partition :: (Ord a)
=> STArray s Int a
> Int
> Int
> ST s Int
partition arr start end = do
pivotElement < readArray arr start
let pivotIndex_0 = start + 1
finalPivotIndex < execStateT
(mapM (partitionLoop arr pivotElement) [(start+1)..(end1)])
pivotIndex_0
swap arr start (finalPivotIndex  1)
return $ finalPivotIndex  1
Now it's super easy to incorporate these into our final function!
quicksort2 :: (Ord a) => Array Int a > Array Int a
quicksort2 inputArr = runSTArray $ do
stArr < thaw inputArr
let (minIndex, maxIndex) = bounds inputArr
quicksort2Helper minIndex (maxIndex + 1) stArr
return stArr
quicksort2Helper :: (Ord a)
=> Int
> Int
> STArray s Int a
> ST s ()
quicksort2Helper start end stArr = when (start + 1 < end) $ do
pivotIndex < partition stArr start end
quicksort2Helper start pivotIndex stArr
quicksort2Helper (pivotIndex + 1) end stArr
This completes our algorithm! Notice again though, that we use thaw
and freeze
. This means our main quicksort2
function can have pure inputs and outputs. But it comes at the price of extra memory. It's still cool though that we can use mutable data from inside a pure function!
Since we have to copy the list, this particular example doesn't result in much improvement. In fact, when we benchmark these functions, we see that the first one actually performs quite a bit faster! But it's still a useful trick to understand how we can manipulate data "inplace" in Haskell. The ST
monad allows us to do this in a "pure" way. If we're willing to accept impure code, the IO
monad is also possible.
Next week we'll get back to game development! We'll add enemies to our game that will go around and try to destroy our player! As we add more and more features, we'll continue to see cool ways to learn about algorithms in Haskell. We'll also see new ways to architect the game code.
There are many other advanced Haskell programs you can write! Check out our Production Checklist for ideas!
TL;DR: Even with integrated shrinking, you still have to think about shrinking. There is no free lunch. Also, important new Hedgehog release!
Propertybased testing is an approach to software testing where instead of writing tests we generate tests, based on properties that the software should have. To make this work, we need to be able to generate test data and, when we find a counter example, we need to shrink that test data to attempt to construct a minimal test case.
In Haskell, the library QuickCheck
has long been the library of choice for property based testing, but recently another library called Hedgehog
has been gaining popularity. One of the key differences between these two libraries is that in QuickCheck
one writes explicit generation and shrinking functions, whereas in Hedgehog
shrinking is integrated in generation. In this blog post we will explain what that means by developing a miniQuickCheck
and miniHedgehog
and compare the two. We will consider some examples where integrated shrinking gives us benefits over manual shrinking, but we we will also see that the belief that integrated shrinking basically means that we can forget about shrinking altogether is not justified. There is no such thing as a free shrinker.
The release of this blog post coincides with release 1.0 of Hedgehog. This is an important update which, amongst lots of other goodies, includes many bug fixes and improvements to shrinking based on earlier drafts of this blog post. Upgrading is strongly recommended.
This blog post is not intended as an introduction to propertybased testing. We will assume the reader has at least a superficial familiarity with setting up property based tests (in QuickCheck
, Hedgehog
, or otherwise). If you want to follow along, the code we present here is available from GitHub.
MiniQuickCheck
In this section we will develop a miniQuickCheck
interface which will enable us to study how shrinking works in QuickCheck'
s manual approach. Although many readers will be more familiar with this than they might be with the integrated shrinking approach, understanding how shrinking works exactly can be quite subtle and so we will spend a bit of time here to set up our running examples. We will then come back to these examples when we look at integrated shrinking in the next section.
When we want to test a property requiring input data of type a
, we have to write a generator that produces random elements of type a
. In order to be able to do that we need access to some kind of pseudorandom number generator, and so we define the type of generators for type a
as
newtype Gen a = Gen (R.StdGen > a)
deriving (Functor)
runGen :: R.StdGen > Gen a > a
runGen prng (Gen g) = g prng
where R
is some module providing PRNGs; in this blog post will we use System.Random
for simplicity’s sake^{1}. Gen
forms a monad; in return
we simply ignore the PRNG, and in (>>=)
we split the PRNG into two:
instance Monad Gen where
return x = Gen $ \_prng > x
x >>= f = Gen $ \ prng >
let (prngX, prngF) = R.split prng
in runGen prngF (f (runGen prngX x))
(the Applicative
instance is then the implied one). Technically speaking this breaks the monad laws since
but we can argue that this satisfies the monad laws “up to choice of PRNG”, which is modelling randomness anyway and should not be observable^{2}.
Generating random test data is not sufficient. For example, consider testing the property that “for any pair (x, y)
, the sum x + y
must be zero”. Clearly this property does not hold, and a good generator will easily find a counterexample. However, the counterexample we find might not be minimal; for instance, we might find the counterexample (28,89)
. It is therefore important that we can shrink counterexamples to construct minimal test cases, just like one might do when testing something by hand.^{3} In this example, a minimal test case might be (0, 1)
or (1, 0)
.
In QuickCheck
’s manual approach to shrinking, shrinking is modelled by a function that produces possible smaller values from a given value; we package up the generator and the shrinking together^{4}
As a very simple first example, consider generating boolean values, shrinking True
to False
:
mBool :: Manual Bool
mBool = Manual {
gen = Gen (fst . R.random)
, shrink = shrinkBool
}
shrinkBool :: Bool > [Bool]
shrinkBool True = [False]
shrinkBool False = []
It is important that values don’t shrink to themselves; when we are trying to find a counterexample, we will shrink the test case until we can’t shrink any more; if a value would shrink to itself, this process would loop indefinitely.
As a slightly more involved example, consider writing a generator for a positive integer in the range (0, hi)
:
mWord :: Word > Manual Word
mWord hi = Manual {
gen = Gen (fst . R.randomR (0, hi))
, shrink = shrinkWord
}
shrinkWord :: Word > [Word]
shrinkWord x = concat [
[ x `div` 2  x > 2 ]
, [ x  1  x > 0 ]
]
In the generator we simply pick a random value^{5}, and in the shrinker we return half the value and one less than the value. Consider testing the property that “all numbers are less than 12
”. If we start with the counter example 72
, this will quickly shrink to 38
, then 18
, and then shrink more slowly to 17
, 16
, 15
, 14
, 13
and finally 12
, which is indeed the minimal counterexample. (Note that a more realistic version of shrinkWord
will try numbers in a different order for improved efficiency^{6}.)
Although Gen
is a monad, Manual
is not (indeed, it’s not even a functor). When we compose Manual
instances together we must manually compose the generator (easy, since we have a Monad
interface available) and the shrinker (harder). For example, here is a generator for pairs:
mPair :: Manual a > Manual b > Manual (a, b)
mPair genA genB = Manual {
gen = (,) <$> gen genA <*> gen genB
, shrink = \(x, y) > concat [
 Shrink the left element
[ (x', y)  x' < shrink genA x ]
 Shrink the right element
, [ (x, y')  y' < shrink genB y ]
]
}
First attempting to shrink the left element introduces a slight bias. For example, consider again the example “for all pairs (x, y)
, the sum x + y
is zero”. Starting from a counterexample (9, 11)
, due to this bias shrinking will shrink the first component
(9,11) ⇝ (4,11) ⇝ (2, 11) ⇝ (1, 11) ⇝ (0, 11)
and then the second component
(0, 11) ⇝ (0, 5) ⇝ (0, 2) ⇝ (0, 1)
Thus, no matter what counterexample we start with, we will always reduce that counterexample to (0, 1)
, not (1, 0)
(unless the original counterexample happens to have a zero in the second component, of course).
In practice however this bias is not usually a concern, however, since we can shrink either the left or the right at every step in the shrinking process.^{7} For example, consider the property “for all pairs (x, y)
, x < y
”. Starting with the counter example (8, 6)
, we will first shrink the first component
(8, 6) ⇝ (7, 6) ⇝ (6, 6)
At this point we cannot shrink the left component any further, and so we shrink the right component instead
(6, 6) ⇝ (6, 3)
Now we can shrink the left component again, and shrinking continues in this “interleaved” fashion
(6, 3) ⇝ (3, 3) ⇝ (3, 1) ⇝ (1, 1) ⇝ (1, 0) ⇝ (0, 0)
We’re putting so much emphasis on this ordering because this will become a concern once we start looking at integrated shrinking.
As a simple example of generating recursive data types, we will consider how to generate lists of an arbitrary length:
mList :: Manual Word > Manual a > Manual [a]
mList genLen genA = Manual {
gen = do n < gen genLen
replicateM (fromIntegral n) (gen genA)
, shrink = shrinkList (shrink genA)
}
shrinkList :: (a > [a]) > [a] > [[a]]
shrinkList shrinkA xs = concat [
 Drop an element
[ as ++ cs
 (as, _b, cs) < pickOne xs
]
 Shrink an element
, [ as ++ [b'] ++ cs
 (as, b, cs) < pickOne xs
, b' < shrinkA b
]
]
The generator is straightforward: we generate an arbitrary length n
, and then use the standard monadic replicateM
combinator to generate n
elements.
The shrinker is more interesting: not only can we shrink any of the elements of the list, like we did for pairs, but now we can also drop elements from the list altogether. At every step it eithers drops an element or shrinks an element, using the function pickOne
to choose an element:
pickOne :: [a] > [([a], a, [a])]
pickOne [] = []
pickOne [x] = [([], x, [])]
pickOne (x:xs) = ([], x, xs)
: map (\(as, b, cs) > (x:as, b, cs)) (pickOne xs)
Consider how this shrinker works for the property “all elements of a list are greater than or equal to the length of the list”. Suppose the original counterexample we find is [5,2,65]
; this list will shrink as follows:
[5,2,65] ⇝ [2,2,65] ⇝ [1,2,65] ⇝ [1,65] ⇝ [0,65] ⇝ [0]
The length of this list is 3
, and so the element that violates the property is 2
. However, if we were to drop any element from this list, the length would be become 2
, and so no matter which element we would drop, we would not have a counterexample to the properly anymore. We must therefore shrink one of the elements first; mList
tries them in order, and so we shrink the first one to 2
and then to 1
. At this point we can drop the 2
from the list because the resulting list [1, 65]
has length 2
and so the element 1
still violates the property. This process repeats one more time, interleaving dropping elements with shrinking elements, until we reach the minimal counter example [0]
.
The final example we will consider is how to generate elements satisfying a given predicate. We will first define a simple helper function that runs a monadic action as often as needed^{8} to generate a value satisfying a predicate:
repeatUntil :: forall m a. Monad m => (a > Bool) > m a > m a
repeatUntil p ma = search
where
search :: m a
search = ma >>= \a > if p a then return a else search
This in hand, we can write a filter combinator as follows:
mSuchThat_ :: forall a. Manual a > (a > Bool) > Manual a
mSuchThat_ genA p = Manual {
gen = repeatUntil p $ gen genA
, shrink = filter p . shrink genA
}
For the generator we repeat the generator until we hit on an element that satisfies the predicate, and for the shrinker we filter out any shrunk elements that don’t satisfy the predicate.
Although this combinator is not wrong, and occasionally useful, it is not always optimal. Consider using this filter to generate even numbers:
Suppose we are testing the property that “all even numbers are less than 5”, and we start with the counter example 88
; this will now shrink as follows:
88 ⇝ 44 ⇝ 22
and then shrink no further. The problem is that 22
can only shrink to either 11
or 21
, neither of which are even, and so mSuchThat_
filters both of them out, leaving us with no further shrink steps.
There are two solutions to this problem. One is to define a variant on mSuchThat_
that instead of removing a shrunk value that doesn’t satisfy the predicate, instead shrinks it again, in the hope of finding even smaller values that do satisfy the predicate:
mSuchThat :: forall a. Manual a > (a > Bool) > Manual a
mSuchThat genA p = Manual {
gen = repeatUntil p $ gen genA
, shrink = shrink'
}
where
shrink' :: a > [a]
shrink' x = concatMap (\x' > if p x' then [x']
else shrink' x')
(shrink genA x)
If we use this combinator instead, the same counter example now shrinks
88 ⇝ 44 ⇝ 22 ⇝ 10 ⇝ 8 ⇝ 6
because 22
shrinks to 11
(which is not even) which in turn shrink to 5
(not even) and 10
(even), and we end up with 6
, which is indeed the smallest even number which is not less than 5.
The alternative solution is not to use filter at all. Instead of generatethentest, we can write a generator that produces even numbers by construction by generating any number and then multiplying it by two:
mEven' :: Word > Manual Word
mEven' hi = Manual {
gen = (*2) <$> gen (mWord (hi `div` 2))
, shrink = \x > concat [
[ x `div` 2  even (x `div` 2) ]
, [ x `div` 2  1  odd (x `div` 2) ]
, [ x  2  x > 1 ]
]
}
While the generator is simple, the shrinker is not, and we have logic for “evenness” both in the generator and in the shrinker. As we will see later, this is an example where integrated shrinking has clear benefits.
It is now time to turn our attention to integrated shrinking. The key idea is straightforward enough: instead of having the generator producing a single value, it will instead produce a tree of values. The root of the tree will correspond to the original value produced, the immediate children of the root correspond to the immediate shrink steps from the root, and so on.
where Tree
here means “rose tree”: trees with an arbitrary number of children at every step:
For example, here is the tree that corresponds to the shrinker that we defined in mWord
, shrinking a value x
to half x
or x  1
:
5
├─ 2
│ └─ 1
│ └─ 0
└─ 4
├─ 2
│ └─ 1
│ └─ 0
└─ 3
├─ 1
│ └─ 0
└─ 2
└─ 1
└─ 0
The easiest way to write primitive generators (generators not defined in terms of other generators) is to translate from a manual generator to an integrated one, constructing the tree by repeatedly applying the shrink
function:
integrated :: Manual a > Integrated a
integrated Manual{..} = Integrated $ \prng >
unfoldTree shrink $ runGen prng gen
where unfoldTree
builds a tree from a root and a function to construct the immediate children of that root:
unfoldTree :: forall a. (a > [a]) > a > Tree a
unfoldTree f = go
where
go :: a > Tree a
go x = Node x $ map go (f x)
For example, we can write integrated shrinkers for Bool
and Word
using
iBool :: Integrated Bool
iBool = integrated $ mBool
iWord :: Word > Integrated Word
iWord = integrated . mWord
For primitive generators integrated shrinking provides little benefit, but once we start composing generators things get more interesting. We can equip Integrated
with an Applicative
instance:
instance Applicative Integrated where
pure x = Integrated $ \_prng > singleton x
Integrated f <*> Integrated x = Integrated $ \prng >
let (prngF, prngX) = R.split prng
in interleave (f prngF) (x prngX)
For pure
we just return a singleton tree, but the case for (<*>)
is more complicated. After we split the PRNG into two and use it, we end up with a Tree (a > b)
of functions and a Tree a
of arguments, and need to construct a tree Tree b
of results.
How might we combine these two trees? Remember that these trees are shrink trees: the roots are the unshrunk values, and the subtrees are different ways in which we can shrink those values. Thus, to combine the “left” tree of functions and the “right” tree of arguments, the root of the new tree will combine the unshrunk root of both trees, and then shrink either the function in the left tree or an argument from the right tree, much like we did for pairs above in mPair
:
interleave :: Tree (a > b) > Tree a > Tree b
interleave l@(Node f ls) r@(Node x rs) =
Node (f x) $ concat [
[ interleave l' r  l' < ls ]
, [ interleave l r'  r' < rs ]
]
Just like in mPair
this has a slight bias because it shrinks the left argument first but, like in mPair
, in practice this bias does not matter too much.
Laws. We should verify that this definition of
interleave
is correct; that is, satisfies the laws forApplicative
. This boils down to showing thatIn the repository there is a Coq file that verifies these laws. Note that these laws are true whether we shrink the left tree first or the right one.f <$> pure x == pure (f x) pure f <*> x == f <$> x f <*> pure x == ($ x) <$> f g <*> (f <*> x) == ((.) <$> g <*> f) <*> x
The above description of the Applicative
instance is rather abstract, so let’s consider a concrete example. We can write a combinator for generating pairs using
(Indeed, such combinators are so simple that there is no need to provide them explicitly; the Applicative
interface suffices.) Let’s consider what happens when we use this to generate a pair of a boolean and a number. Suppose the boolean we pick is True
, which has shrink tree
True
└─ False
and the number we pick is 2
, with shrink tree
2
└─ 1
└─ 0
We first fmap
the function (,
) over that first tree to end up with the tree
(True,_)
└─ (False,_)
When we then interleave these two trees, the final result is
(True,2)
├─ (False,2)
│ └─ (False,1)
│ └─ (False,0)
└─ (True,1)
├─ (False,1)
│ └─ (False,0)
└─ (True,0)
└─ (False,0)
Note how this tree matches our intuition precisely: we start with the unshrunk value (True, 2)
; this has two immediate children, one first shrinking the bool (False, 2)
and one first shrinking the number (True, 1)
. If we do first shrink the number, we again have the choice to shrink the bool or the number first.
The advantage of the applicative interface is that this is not restricted to pairs, but can be used for any number of elements. For example, we can write a generator for triples using
If we start with the shrink trees
True
└─ False
1
└─ 0
'b'
└─ 'a'
then the final interleaved tree will be
(True,1,'b')
├─ (False,1,'b')
│ ├─ (False,0,'b')
│ │ └─ (False,0,'a')
│ └─ (False,1,'a')
│ └─ (False,0,'a')
├─ (True,0,'b')
│ ├─ (False,0,'b')
│ │ └─ (False,0,'a')
│ └─ (True,0,'a')
│ └─ (False,0,'a')
└─ (True,1,'a')
├─ (False,1,'a')
│ └─ (False,0,'a')
└─ (True,0,'a')
└─ (False,0,'a')
Notice how this models that we can pick any element in the triple to reduce at any given moment.
Using the applicative interface to generate lists of a fixed length is easy. Indeed, we can use a standard combinator on Applicative
:^{9}
replicateA :: Applicative f => Word > f a > f [a]
replicateA 0 _ = pure []
replicateA n f = (:) <$> f <*> replicateA (n  1) f
to define
However, there is no way to use the Applicative
interface to write a generator for lists of an arbitrary size. The problem is that in order to do that, we first need to generate the length, and then depending on the value n
of the length that we pick, run the generator for the elements n
times. This kind of dependency between generators is impossible using only an Applicative
interface; instead, we need a Monad
interface. This is however where trouble starts.
Suppose we have shrink tree corresponding to the length of the list
and a function
for some a
that produces a shrink tree for the list itself given a length. The natural thing to try is to apply function f
at every length
This gives us a tree of trees: for every value n
in len
, the corresponding shrink tree for lists of length n
. The only thing left to do is to collapse this treeoftrees into a tree. This is a standard combinator on monads called join
. For trees, we can implement it as follows:
Laws. As for the
The Coq file in the repo contains proofs of these properties.Applicative
interface,join
should satisfy a number of laws:
However, we will not equip Integrated
with a monad instance. In order to understand why, let’s suppose that it did have a monad instance. We could then write this alternative definition of iPair
:
iPairWRONG :: Integrated a > Integrated b > Integrated (a, b)
iPairWRONG genA genB = ((,) <$> genA) `ap` genB
This looks deceptively simple, and almost identical to iPair
, but iPair
and iPairWRONG
have very different behaviour. Starting from the tree ((,) <$> genA)
we get the tree
(True,2) ⇝ (True,1) ⇝ (True,0)
└─ (False,2) ⇝ (False,1) ⇝ (False,0)
which after join
looks like
Monad Applicative

(True,2) (True,2)
├─ (False,2) ├─ (False,2)
│ └─ (False,1) │ └─ (False,1)
│ └─ (False,0) │ └─ (False,0)
└─ (True,1) └─ (True,1)
└─ (True,0) ├─ (False,1)
│ └─ (False,0)
└─ (True,0)
└─ (False,0)
where for comparison we have reproduced the shrink tree we got using the Applicative
interface on the right. Notice the difference between the two trees: after we shrink the number, we do not go back to shrink the boolean anymore. This is important to remember: in a generator of the form
x >>= f
as soon as we start shrinking f
we will not go back to shrink x
. We can’t; since f
is a function, we must first decide on a value of x
before we can do anything with f x
.
This has real consequences for testing. For example, consider the property that “for all pairs (x, y)
, x < y
”. If we start with a counter example (80, 57)
, this will shrink as follows:
(80, 57) ⇝ (79, 57) ⇝ .. ⇝ (57, 57) ⇝ (57, 28) ⇝ .. ⇝ (57, 0)
When we reach (57, 57)
, we cannot shrink the first component anymore, since (56, 57)
isn’t a counterexample to the property. However, as soon as we start strinking the second component, we will not go back to the first component anymore, and so we end up with (57, 0)
as our rather poor “minimal” counterexample.
We have a choice in
join
in the order of the subtrees; we could have defined it likeFor our example tree from above, this results in the tree
Although this version of(True,2) ├─ (True,1) │ └─ (True,0) └─ (False,2) └─ (False,1) └─ (False,0)
join
still satisfies the monad laws, it is strictly worse. As before, when shrinkingx >>= f
, as soon as we start shrinkingf
, we will not go back anymore to shrinkx
. But worse, rather than trying to shrinkx
first, we will now first try to shrinkf
! This means that for the same property above, if we started with the counter example(80, 57)
, we would end up with the counterexample(80, 0)
. Even less “minimal” than before.
Let’s go back to writing a generator for lists of an arbitrary length. Let’s suppose we did have a Monad
instance available for Integrated
. Writing a generator for lists is then easy:
iListWRONG :: Integrated Word > Integrated a > Integrated [a]
iListWRONG genLen genA = do
n < genLen
replicateM (fromIntegral n) genA
If the belief that integrated shrinking means that we can mostly just forget about shrinking, this definition should be fine. However, it isn’t. Just like for iPairWRONG
above, this shrinker shrinks very poorly. Part of the problem is actually very similar as for iPairWRONG
. Consider checking the property that “all lists are sorted”, and suppose the initial counterexample we find is [81,27]
; this will shrink as follows:
When we reach [28,27]
we cannot shrink the first element any further, and so we start shrinking the next, never returning to the first element anymore. This problem is easily fixed though; the elements of the list are clearly independent from each other, and so we can use our iListOfSize
function from above instead; this uses the Applicative
interface and does not introduce this unwanted ordering between shrinking the elements of the list:
iListWRONG' :: Integrated Word > Integrated a > Integrated [a]
iListWRONG' genLen genA = do
n < genLen
iListOfSize n genA
The dependency on the length however is a real dependency, and so cannot be removed. Although iListWRONG'
shrinks a bit better than iListWRONG
, it can still result in nonminimal counterexamples. For example, if for the same property (all lists are sorted) the initial counter example we find is [28,66,13]
, we cannot first shrink the length because the shorter list [28,66]
is sorted. However, after we then start shrinking the elements of the list we never go back to try to shrink the length again, ending up with the nonminimal counter example [0,1,0]
.
So how do we fix it? If the implied shrinker for dependent generators is not good, we need a way to override it and define our own. In order to do that, we need to be able to manipulate the shrink trees explicitly. We therefore introduce a useful function called freeze
:
This changes an integrated shrinker into a simple (“manual”) shrinker for trees; this is the key step that makes it possible to manipulate shrink trees explicitly. We will also find it useful to define a variant on freeze
which just throws away any subtrees, leaving only the unshrunk root:
We can use these two combinators to define a explicit generator for lists of trees:
iListAux :: Integrated Word > Integrated a > Gen [Tree a]
iListAux genLen genA = do
n < dontShrink genLen
replicateM (fromIntegral n) (freeze genA)
This is almost identical to our naive first attempt iListWRONG
, but produces a list of shrink trees instead of a list of elements. In order to turn this into a proper shrink tree for lists of elements, we need to turn a list of trees into a tree of lists, and this operation corresponds precisely to the shrinker for lists that we defined back when we considered generating lists in the manual approach (mList
, above):
interleaveList :: [Tree a] > Tree [a]
interleaveList ts =
Node (map root ts) $ concat [
 Drop one of the elements altogether
[ interleaveList (as ++ cs)
 (as, _b, cs) < pickOne ts
]
 Shrink one of the elements
, [ interleaveList (as ++ [b'] ++ cs)
 (as, b, cs) < pickOne ts
, b' < subtrees b
]
]
All that’s left now is to turn a dependent generator that explicitly manipulates shrink trees back into a regular integrated generator:
leaving us with the following generator for lists:
iList :: Integrated Word > Integrated a > Integrated [a]
iList genLen genA =
dependent $
interleaveList <$> iListAux genLen genA
At this point you might be wondering whether all of this is worth it; the combination of Integrated
and freeze
seems like a roundabout way to introduce manual shrinking; all that just to get back to where we were in miniQuickCheck
. That is however overly pessimistic.
Suppose we have some applicationspecific datatype that counts elements:
and suppose we want to write a generator for this. One approach is to apply the same set of steps that we did in the previous section. We can write a function
and specialized shrinking function for Count
and finally
iGenCount :: forall a. Integrated a > Integrated (Count a)
iGenCount genA =
dependent $
interleaveCount <$> iGenCountAux genA
This is however a fair bit of work, interleaveCount
in particular is nontrivial (see repo). However, if we have a function
we can avoid all this work and piggyback on the generator for lists:
and we’re done with a oneline generator. This is much more difficult to do in QuickCheck
. Although it is easy to generate a list and then generate the Count
from that, when it comes to shrinking we don’t have the list available anymore and so we can’t piggyback on the shrinker for lists there. We can introduce what’s known as a “shrink wrapper”
data WrapCount a = WrapCount [a] (Count a)
wrapCount :: [a] > WrapCount a
wrapCount xs = WrapCount xs (countList xs)
which pairs a Count
value with the list that generated it; if we do that, then we can piggyback on the generator and shrinker for lists:
mGenCount' :: forall a. Manual a > Manual (WrapCount a)
mGenCount' genA = Manual {
gen = wrapCount <$> gen genAs
, shrink = \(WrapCount xs _) > map wrapCount (shrink genAs xs)
}
where
genAs :: Manual [a]
genAs = mList (mWord 2) genA
However, this approach does not compose: if we have some other datatype that expects a Count
as a subterm, we cannot use a WrapCount
term there. This limits the applicability of this pattern rather severely. In integrated shrinking, however, this is really easy to do; a clear win.
Caution. Defining the generator forCount
in terms of the one for lists is really only a valid approach if allCount
values can be generated by some list. If this is not the case, your tests don’t cover all cases. This should be stated and tested separately.
What if we don’t care about shrinking, or feel that the implied shrinker is okay, even for dependent generators? Just to support this use case we can introduce Dependent
alias which does have the Monad
instance available^{10}:
newtype Dependent a = Dependent (R.StdGen > Tree a)
deriving (Functor)
runDependent :: R.StdGen > Dependent a > Tree a
runDependent prng (Dependent f) = f prng
instance Monad Dependent where
return x = Dependent $ \_prng > singleton x
Dependent x >>= f = Dependent $ \prng >
let (prngX, prngF) = R.split prng
in join $ fmap (runDependent prngF . f) (x prngX)
where the corresponding Applicative
instance is the implied one.
When we define dependent generators we often want to use integrated ones, and so it is useful to “lift” an integrated shrinker to a dependent one:
Going in the other direction however is unsafe, as we have seen; unless we take special precautions, the implied shrinker behaviour of dependent shrinkers is very poor:
As our final example, we will reconsider filtering in the context of integrated shrinking. Like generating lists, filtering requires a Monad
interface. After all, the effects we need (how often we generate a value) depends on the value that we generated previously. If we did have a Monad
instance for Integrated
available, we could simply define
iSuchThatWRONG :: Integrated a > (a > Bool) > Integrated a
iSuchThatWRONG genA p = repeatUntil p $ genA
As for iListWRONG
, this function looks simple, but as for iListWRONG
, it is wrong; and in fact, this one is unuseably wrong. Remember what the monad interface does: it applies a function at every level in the shrink tree. In iSuchThatWRONG
, the function we apply is a function that checks the predicate and if it fails, reruns the generator. This means that as soon as we shrink a value to something that does not satisfy the predicate anymore, we start over from scratch, pick an entirely new value (possibly even larger than what we started with), and repeat ad nauseam.
What we want to do, of course, is first generate the shrink tree, and then filter out the elements from that tree that don’t satisfy the predicate. When we discussed this in the context of manual shrinking, we mentioned that we had two possibilities: either stop as soon as we find an element that doesn’t satisfy the predicate, or else recursively apply shrinking in the hope of finding a even smaller element that does satisfy the predicate. Translated to trees, the former corresponds to
filterTree_ :: forall a. (a > Bool) > Tree a > Maybe (Tree a)
filterTree_ p = go
where
go :: Tree a > Maybe (Tree a)
go (Node x xs)
 p x = Just $ Node x (mapMaybe go xs)
 otherwise = Nothing
and the latter to
filterTree :: forall a. (a > Bool) > Tree a > [Tree a]
filterTree p = go
where
go :: Tree a > [Tree a]
go (Node x xs)
 p x = [Node x (concatMap go xs)]
 otherwise = concatMap go xs
Defining filtering is now easy; since we want to explicitly manipulate the shrink tree, freeze
comes in handy again:^{11}
iSuchThat :: forall a. Integrated a > (a > Bool) > Integrated a
iSuchThat genA p =
dependent $ fmap (head . filterTree p) $
repeatUntil (p . root) $ freeze genA
iSuchThat_ :: forall a. Integrated a > (a > Bool) > Integrated a
iSuchThat_ genA p =
dependent $ fmap (fromJust . filterTree_ p) $
repeatUntil (p . root) $ freeze genA
As an example use case, consider once more generating even numbers. As for manual shrinking, we have two options: generatethentest or generateevenbyconstruction. For the former, we can do
where we must use iSuchThat
instead of iSuchThat_
(for the same reason that mEvenWRONG
was wrong). For the latter, we can do
If we compare this to mEven'
, we can see that integrated shrinking here again gives us a clear advantage. In the manual case we had to reason about “evenness” in both the shrinker and the generator; no such duplication of logic happens here.
In this blog post we have compared the manual approach to shrinking from QuickCheck
with the integrated approach from Hedgehog
. There are many other differences between these two libraries that we have completely ignored here, and I can strongly recommend watching Jacob Stanley’s excellent Lambda Jam talk Gens N’ Roses: Appetite for Reduction. Even if you have no intention of switching from QuickCheck
to Hedgehog
, many of the gotchas of QuickCheck
that Jacob mentions in that talk are well worth thinking about.
One of the problems that Jacob mentions in his talk is a social one: most QuickCheck
users simply don’t write shrinkers. Indeed, this is true. Part of the problem comes from the fact that the QuickCheck
type class Arbitary
has a default implementation of shrink
that returns the empty list. This means that by default the values you generate don’t shrink at all. This is clearly not good.
Unfortunately, it is not obvious that integrated shrinking solves this social problem. As we have seen, the implicitly defined shrinkers for dependent generators (generators that require the monad interface) are very poor (iListWRONG
), and in some cases even unuseable (iSuchThatWRONG
). It simply isn’t the case that we don’t have to think about shrinking, no matter which approach we use. Perhaps it can be argued that a default shrinker that shrinks a bit is better than one that doesn’t shrink at all; but not by much. Admittedly for generators that depend on the Applicative
interface only the implied shrinker is fine, but this case is easy in QuickCheck
also (it corresponds precisely with the behaviour of genericShrink
).
Perhaps we can construct integrated generators with good shrinkers by writing them in clever ways. It is however not obvious how to do this, even for the relatively simple case of lists. This is an interesting topic of future work.
In reality System.Random
is a poor choice, and we should choose something different such as splitmix
.↩
A more obvious type for the generator might have been
which would allow us to thread the PRNG through. We don’t do this because we would lose laziness; for example, when generating a pair of values; we would not be able to generate the second value until we finished generating the first. This can make testing much slower, and makes it impossible to generate infinite values.↩
To some degree we can reduce the need for shrinking by trying small counter examples first; both QuickCheck
and Hedgehog
do this, though Hedgehog
’s approach using firstclass “ranges” is arguably nicer here. However, this is not sufficient. It is often the case that the probability that a larger test case hits a given bug is disproportionally larger than the probability that a small test case does, and we are therefore more likely to find bugs in larger test cases than smaller ones.↩
QuickCheck
uses typeclasses instead of explicit records; for simplicity and to keep the comparison with Hedgehog
as focussed as possible, we will not do that in this blog post.↩
Picking a random value uniformly in the range (0, hi)
might not be the best choice; we may wish to generate “edge cases” such as 0
with a higher probability. Moreover, if we want to generate smaller test cases first, we’d also do that here.↩
This shrinker is suboptimal; it will use binary search if the minimum test case happens to be near zero, but linear search if the value happens to be be near the upper end of the range. The shrinkers in this blog post are intended to illustrate how QuickCheck
and Hedgehog
work under the hood, not as examples of how to write good shrinkers.↩
Sometimes the bias is a problem. For example, consider the property “for all pairs (x, y)
, x /= y
”. If we start with a counterexample, say, (46, 46)
, we could only shrink this if we shrink both components at the same time. We can write shrinkers like this, but in general there are O(2^n)
possible combinations of values to choose to shrink together when given n
values, which makes shrinking much too costly.↩
In reality we will want to impose a maximum number of iterations here and give up if we cannot find an element satisfying the predicate within that bound.↩
In recent versions of base
the function replicateM
has this signature; we define this custom combinator for the sake of this blog post because the difference between the Monad
and Applicative
interface to the integrated shrinkers is crucial.↩
In Hegdehog
no distinction is made at the type level between generators satisfying the Applicative
instance and the Monad
instance, and so it is up to the programmer to make sure not to use the Monad
instance where the Applicative
instance would suffice, or overwrite the shrinker when the Monad
instance is required. This can result in poor shrinkers, a problem which might materialize only much later if a bug is found and suddenly a test case does not shrink properly.↩
The use of head
and fromJust
in these definitions is justified by the fact that we know that the very root of the tree must satisfy the predicate.↩
Friends of mine took part in a competition where they had to present an art project of theirs using a video. At some point we had the plan of creating a time lapse video of a drawing being created, and for that mounted a camera above the drawing desk.
In the end we did not actually use the video, but it turns out that the still from the beginning (with blank paper) and the end of the video (no paper) are pretty nice, too. So I am sharing them here, in case anyone wants to use them as a desktop background or what not.
Feel free to reuse these photos under the terms of the Creative Commons Attribution 4.0 International License.
This post demonstrates a simple encoding of a (typed) concatenative language in Haskell.
Pointfree style is one of the distinctive markers of functional programming languages. Want to sum a list? That’s as easy as:
Now I want to sum every number after adding one to it.
One more step to make this function truly abstract™ and general™: we’ll allow the user to supply their own number to add
And here the trouble begins. The above expression won’t actually type check. In fact, it’ll give a pretty terrible error message:
• Non typevariable argument in the constraint: Num [a]
(Use FlexibleContexts to permit this)
• When checking the inferred type
sumThoseThat :: forall a.
(Num [a], Foldable ((>) [a])) =>
a > [a]
I remember as a beginner being confused by similar messages. What’s FlexibleContexts
? I had thought that the “pointfree style” just meant removing the last variable from an expression if it’s also the last argument:
Why doesn’t it work here?
Well, it doesn’t work because the types don’t line up, but I’m going to try and explain a slightly different perspective on the problem, which is associativity.
To make it a little clearer, let’s see what happens when we pointfill the expression:
sumAdded n xs = (foldr(+) 0 . (map . (+))) n xs
=> foldr(+) 0 ((map . (+)) n) xs
=> foldr(+) 0 (map ((+) n)) xs
Indeed, the problem is the placement of the parentheses. What we want at the end is:
But, no matter. We have to jiggle the arguments around, or we could use something terrible like this:
Is there something, though, that could do this automatically?
We run into a similar problem in Agda. We’re forever having to prove statements like:
There are a couple of ways to get around the issue, and for monoids there’s a rich theory of techniques. I’ll just show one for now, which relies on the endomorphism monoid. This monoid is created by partially applying the monoid’s binary operator:
And you can get back to the underlying monoid by applying it to the neutral element:
Here’s the important parts: first, we can lift the underlying operation into the endomorphism:
_⊕_ : Endo → Endo → Endo
xs ⊕ ys = λ x → xs (ys x)
⊕homo : ∀ n m → ⟦ ⟦ n ⇑⟧ ⊕ ⟦ m ⇑⟧ ⇓⟧ ≡ n + m
⊕homo n m = cong (n +_) (+identityʳ m)
And second, it’s definitionally associative.
These are all clues as to how to solve the composition problem in the Haskell code above. We need definitional associativity, somehow. Maybe we can get it from the endomorphism monoid?
You’re probably familiar with Haskell’s state monad:
It can help a lot when you’re threading around fiddly accumulators and so on.
nub :: Ord a => [a] > [a]
nub = go Set.empty
where
go seen [] = []
go seen (x:xs)
 x `Set.member` seen = go seen xs
 otherwise = x : go (Set.insert x seen) xs
nub :: Ord a => [a] > [a]
nub = flip evalState Set.empty . go
where
go [] = pure []
go (x:xs) = do
seen < gets (Set.member x)
if seen
then go xs
else do
modify (Set.insert x)
(x:) <$> go xs
Of course, these days state is a transformer:
This lets us stack multiple effects on top of each other: error handling, IO, randomness, even another state monad. In fact, if you do stack another state monad on top, you might be surprised by the efficiency of the code it generates:
type DoubleState s1 s2 a = StateT s1 (State s2) a
=> s1 > State s2 (a, s1)
=> s1 > s2 > ((a, s1), s2)
It’s nothing earth shattering, but it inlines and optimises well. That output is effectively a leftnested list, also.
If we can do one, and we can do two, why not more? Can we generalise the state pattern to an arbitrary number of variables? First we’ll need a generic tuple:
infixr 5 :
data Stack (xs :: [Type]) :: Type where
Nil :: Stack '[]
(:) :: x > Stack xs > Stack (x : xs)
Then, the state type.
We can actually clean the definition up a little: instead of a tuple at the other end, why not push it onto the stack.
In fact, let’s make this as polymorphic as possible. We should be able to change the state is we so desire.
And suddenly, our endomorphism type from above shows up again.
We can, of course, get back our original types.
And it comes with all of the instances you might expect:
instance Functor (State xs) where
fmap f xs = State (\s > case runState xs s of
(x : ys) > f x : ys)
instance Applicative (State xs) where
pure x = State (x :)
fs <*> xs = State (\s > case runState fs s of
(f : s') > case runState xs s' of
(x : s'') > f x : s'')
instance Monad (State xs) where
xs >>= f = State (\s > case runState xs s of
y : ys > runState (f y) ys)
But what’s the point? So far we’ve basically just encoded an unnecessarily complicated state transformer. Think back to the stacking of states. Written in the mtl style, the main advantage of stacking monads like that is you can write code like the following:
pop :: (MonadState [a] m, MonadError String m) => m a
pop = get >>= \case
[] > throwError "pop: empty list"
x:xs > do
put xs
pure x
In other words, we don’t care about the rest of m
, we just care that it has, somewhere, state for an [a]
.
This logic should apply to our stack transformer, as well. If it only cares about the top two variables, it shouldn’t care what the rest of the list is. In types:
And straight away we can write some of the standard combinators:
dup :: '[a] :> '[a,a]
dup (x : xs) = (x : x : xs)
swap :: '[x,y] :> '[y,x]
swap (x : y : xs) = y : x : xs
drop :: '[x,y] :> '[y]
drop (_ : xs) = xs
infixl 9 !
(f ! g) x = g (f x)
You’ll immediately run into trouble if you try to work with some of the more involved combinators, though. Quote should have the following type, for instance:
But GHC complains again:
• Illegal polymorphic type: xs :> ys
GHC doesn't yet support impredicative polymorphism
• In the type signature:
quote :: (xs :> ys) > '[] :> '[xs :> ys]
I won’t go into the detail of this particular error: if you’ve been around the block with Haskell you know that it means “wrap it in a newtype”. If we do that, though, we get yet more errors:
• Couldn't match type ‘ys ++ zs0’ with ‘ys ++ zs’
Expected type: Stack (xs ++ zs) > Stack (ys ++ zs)
Actual type: Stack (xs ++ zs0) > Stack (ys ++ zs0)
NB: ‘++’ is a type function, and may not be injective
This injectivity error comes up often. It means that GHC needs to prove that the input to two functions is equal, but it only knows that their outputs are. This is a doubly serious problem for us, as we can’t do type family injectivity on two type variables (in current Haskell). To solve the problem, we need to rely on a weird mishmash of type families and functional dependencies:
type family (++) xs ys where
'[] ++ ys = ys
(x : xs) ++ ys = x : (xs ++ ys)
class (xs ++ ys ~ zs) => Conc xs ys zs  xs zs > ys where
conc :: Stack xs > Stack ys > Stack zs
instance Conc '[] ys ys where
conc _ ys = ys
instance Conc xs ys zs => Conc (x : xs) ys (x : zs) where
conc (x : xs) ys = x : conc xs ys
infixr 0 :>
type (:>) xs ys = forall zs yszs. Conc ys zs yszs => Stack (xs ++ zs) > Stack yszs
And it does indeed work:
pure :: a > '[] :> '[a]
pure = (:)
newtype (:~>) xs ys = Q { d :: xs :> ys }
quote :: (xs :> ys) > '[] :> '[ xs :~> ys ]
quote x = pure (Q x)
dot :: forall xs ys. ((xs :~> ys) : xs) :> ys
dot (x : xs) = d x xs
true :: (xs :~> ys) : (xs :~> ys) : xs :> ys
true = swap ! drop ! dot
false :: (xs :~> ys) : (xs :~> ys) : xs :> ys
false = drop ! dot
test :: '[] :> '[ '[a] :~> '[a,a] ]
test = quote dup
Interestingly, these combinators represent the monadic operations on state (dot
= join
, pure
= pure
, etc.)
And can we get the nicer composition of the function from the intro? Kind of:
Here are some references for concatenative languages: Okasaki (2002), Purdy (2012), Kerby (2007), Okasaki (2003).
Kerby, Brent. 2007. “The Theory of Concatenative Combinators.” http://tunes.org/\%7Eiepos/joy.html.
Okasaki, Chris. 2002. “Techniques for embedding postfix languages in Haskell.” In Proceedings of the ACM SIGPLAN workshop on Haskell  Haskell ’02, 105–113. Pittsburgh, Pennsylvania: ACM Press. doi:10.1145/581690.581699. http://portal.acm.org/citation.cfm?doid=581690.581699.
———. 2003. “THEORETICAL PEARLS: Flattening combinators: Surviving without parentheses.” Journal of Functional Programming 13 (4) (July): 815–822. doi:10.1017/S0956796802004483. https://www.cambridge.org/core/journals/journaloffunctionalprogramming/article/theoreticalpearls/3E99993FE5464986AD94D292FF5EA275.
Purdy, Jon. 2012. “The Big Mud Puddle: Why Concatenative Programming Matters.” The Big Mud Puddle. https://evincarofautumn.blogspot.com/2012/02/whyconcatenativeprogrammingmatters.html.
We consider a situation in which an internet site anticipates that it might disappear from its current address, perhaps because of censorship. In preparation for potentially moving to a yet undecided location, we propose a method of preemptively publishing "digital breadcrumbs" (referencing Hansel and Gretel) on its current site as a way for users to find the next location if or when the site moves. The site encourages users to save a local copy of the breadcrumbs.
The published digital breadcrumbs consist of two parts: a public key and the specification of a deterministic pseudorandom word generator including its random seed.
As an example, we'll specify digital breadcrumbs for this blog.
Here is the public key for this blog, with fingerprint 2C95 B41D A4CE 7C5F 0110 C27A 561D DCBA 1BDA E2F7
:
BEGIN PGP PUBLIC KEY BLOCK Version: GnuPG v1 mQENBFUrkNQBCADRc2ia1qpiS8wwrsqnPQpUoGY8DC1+tyRs6xGTqkkdxADLkS6f VPuSkMktr0D/NmUmyCVSPkITYMeDlZ09eG2DIl33zS5ZpxTLgbHau8o8QB2cXw4f ldwDrt5UmQwc8jF6vwKqoXyxPxJIb59fxCQ5s6llurnUI9MdlhDMyRQ0rFHkXu8G JX+49zisWep7ZLZRT7/zdlKNlw2mriMTavOajCXtfR4WnFbQ8oYBkYLJPZFk4bi6 p4pyX9/nwcKCF2yIs7d3GqkYuuYSpp3gBdK+rAmYAj52cWEm08dtgurkDbh9rD/t ykiDqHxh2oCou63Tnjt9qrCdjy7f0AstS7qZABEBAAG0PEtlbiAoaHR0cDovL2tl bnRhLmJsb2dzcG90LmNvbSkgPGRldm51bGxAa2VudGEuYmxvZ3Nwb3QuY29tPokB OAQTAQIAIgUCVSuQ1AIbAwYLCQgHAwIGFQgCCQoLBBYCAwECHgECF4AACgkQVh3c uhva4vddMQgAuDcuimghGXzhazv/S86oCfZ3vtwqh5aZzW8N3rz/0tB0o+hZjgCv imu/N0m1Hv8IdFOexeHa6SgCuDg8xmRCSiFYgumDi6cQy9XCH4+mCfn5oiu1mmrg leBnV4gRF0u5m7i4pzoBsdbRU0mmKUnRUV4KKkVEsOpZla48AOdkX4SaRGq8sPft BRbUUoJf4/HVbZKLvJGqau270NbtHoM+AOe+Pk8X6AaPBl5vA6vep7zxRJayFiBm mlxN6vU8FoH5sBYTdCrN84h0kQDtFszVoYXl1QEF0ek3LjlrEVJvXBJRGy4ZLnv5 juR7vPk1LhLcq28078ucnHo6Hh3uslFnHrkBDQRVK5DUAQgApksDkc2/iTCaFXbm o1Ojb9VyOITquEzBjMMY/K58MuSKqw6X3PkzsIWVoUO1binlIWtoBHc8ooeWm2Ve uhardx1SmpGE17UJZRwe+bPI6AXzGM2vFpa7JZTbFY90rgqIWOVrPbBL2+bZds54 ySX6xuVl70H5+NsJIqcqFH5bHoLQtzLfoqLQrIK4Azmv/2NP/nAVySECznyyQT0n i25RNgiOjUwfKx2M4ICavQ/T1Of9YhnVSP3Cpz9+kDFV7VKiGCBKSSsahQbLOL3u 4dkG9QKY5vjU+dkjziZehHdNQrI9tMthCSopeLsUZ/ooQTj5IozdRTxVryxSbZKR Tp0TDQARAQABiQEfBBgBAgAJBQJVK5DUAhsMAAoJEFYd3Lob2uL35CQH/RzXJVor znGnWE/YPtb3qAFMit0APhOT0WWXCASJYjjzOJDMghjN70kqgPvmdjAL182wBVVz pjEbZBtPDcEx9YYfKiRC3qCygiSjdKRLfSwHmzFeYzGM6DI4GIsJW+1q8+iA2DUs lXLuyw8TJjH7jvY/cMhM6IzzdZQNnsaSZ9whCKM0t4yWDSxZ/cLk+ezPwEBJQmNR +dOCvmLy3PbUlLOxN18gVezyFpHy0Bj6UGQ+hyTj2fp4tKiD9LF4iHsOYJdNcHrH +CJJajhOKYmAB3RexlHunlLqAiLoGrcJUehi9hO4QnC52VvKa+2AryUKhQPPOZwa iMz2Xdl91SRrAb8= =mOe7 END PGP PUBLIC KEY BLOCK
Messages signed with a site's public key should contain the text Serial: NNN
where NNN
is a string in the format of a Debian software package version number, roughly epoch:version
, where the epoch:
is optional and version
is a dotted number string. (Inspired by the serial number of DNS zone records. Some sites use serial numbers like 20190228 to ensure the serial number monotonically increases. This would be nicer if dots were allowed: 2019.02.28.) These serial numbers can be compared as version numbers as specified by Debian. Having comparable serial numbers establishes a total ordering on messages, useful if later messages need to invalidate older messages.
Here is the first message signed with our public key, giving an example serial number. This message is otherwise uselessly empty.
BEGIN PGP SIGNED MESSAGE Hash: SHA1 Serial: 0.2015.6 BEGIN PGP SIGNATURE Version: GnuPG v1 iQEVAwUBVeD8B1Yd3Lob2uL3AQI1kwgAmUIKTr6rfffyceIsOL2UJ/Zw+bcdsdHt xlzRVAQUocCZVEMhnloRN6bj2PsEMWtO9PxN4y46EBmVImjPYRTPa3FRdVoB7tL9 Lo/ExpoQ93tkz/zMrhC3siq2dwe2FxehqIU1diqEORT3FKs3D7Zbvb3qunifzihH QoXOgEg6sQQzjKmUzMpwbt3SV86cpYLNE5GK9aaJLaYKf9yC7FQ9YnA8Dd/pVqBb OCk4PHW/iRhzbPJhBHTLmL4hBH1rVIqZvXPq4msa13tHxQce+2owzoyCQD9PXPyx TUFzDCJzoz7eDM12oyBbXRHvyWroT6khavrn/meaWofiKvB9ytAwpQ== =ZyLY END PGP SIGNATURE
We leave unsolved the standard hard problems of Public Key Infrastructure: what to do if your private key is compromised, what to do if you lose access to your private key.
We now turn our attention to the random word generator.
To combat yet unknown countermeasures an adversarial censor might deploy, the digital breadcrumbs provide only hints toward the many possibilities where the next site might be. Exactly how generated random words specify the site's next location is deliberately left unstated in order to flexibly route around the yet unknown censorship: perhaps DNS, perhaps it should be used as a web search term, perhaps a key into some censorshipresistant medium. It is the responsibility of the user, the recipient of the breadcrumbs, to try things and figure it out. The infinite stream of random words provides many choices in case some of the earlier words are not available (perhaps due to censorship). The public key allows the user to verify, perhaps even in an automated fashion, that he or she has found the right new site.
(Previous vaguely related idea: search the entire internet for the latest "message" signed by a public key.)
(Unfortunately, the random words won't directly be usable as addresses for things like Onion hidden services or Freenet CHK because for those, you don't have the ability to choose your own address. Freenet KSK might be usable, at least until spammers overwrite it.)
A cryptographically secure pseudorandom number generator (PRNG) is not strictly necessary; however, we use one in the sample implementation below because cryptographic primitives are standardized so widely available and easily portable.
Two unrelated entities (perhaps even adversaries) can use exactly the same random word generator, perhaps because they chose the same seed. We expect this is only to be a slight inconvenience because their different public keys can be used to distinguish them. They can also choose different words in the same random stream.
Here is the random word generator for this blog, suggesting a template for others. The random word generator is implemented in Haskell, similar to this stream cipher example.
BEGIN PGP SIGNED MESSAGE Hash: SHA1 { This code is public domain. } { Serial: 0.2019.1 } {# LANGUAGE PackageImports #} module Main where { import "cipheraes" Crypto.Cipher.AES as AES; import qualified Data.ByteString as ByteString; import Data.Word (Word8); import Data.Maybe (catMaybes); import qualified Crypto.Hash.SHA256 as SHA256; import Data.Text.Encoding (encodeUtf8); import qualified Data.Text as Text; import qualified Data.List as List; url :: String; url = "http://kenta.blogspot.com"; main :: IO(); main = putStr $ catMaybes $ map filt27 $ to_bytes $ aes_stream $ AES.initAES $ SHA256.hash $ encodeUtf8 $ Text.pack url; aes_stream :: AES.AES > [ByteString.ByteString]; aes_stream key = List.unfoldr (Just . (next_block key)) zero; next_block :: AES.AES > AES.AESIV > (ByteString.ByteString, AES.AESIV); next_block key iv = AES.genCounter key iv 1; { Although we ask for just 1 byte, genCounter will return a full 16byte block. } { Initial counter value } zero :: AES.AESIV; zero = AES.aesIV_ $ ByteString.replicate 16 0; to_bytes :: [ByteString.ByteString] > [Word8]; to_bytes = concat . map ByteString.unpack; filt27 :: Word8 > Maybe Char; filt27 z = case mod z 32 of { 0 > Just ' '; x  x<=26 > Just $ toEnum $ fromIntegral x + fromEnum 'a'  1; _ > Nothing; }; } BEGIN PGP SIGNATURE Version: GnuPG v1 iQEVAwUBXDtUc1Yd3Lob2uL3AQLb1QgAzeb/UebCk4cb0nSXdMSaSWwItxSbOvXK qzBqE8EwCsg/uz3ry5MB24nFUd0puO9LqEy0okebCdZqj5qWdPK/PnLZj5Zx+ZG2 sUHNSe7pn6gfJfL9+JDoVLRJaJt2Cn/c4KUT2uC7Xsig6RAhKcIKMytCnU8jDG2P S60Qdp3rk/GqgK6gHViTrLjckUAuV5nID+pxWzqE3Rx753w0W3wK/5f+giovWizk CTuPkYGv7eFzO9zPN9tLo4na+MfaKskFpJ3PsAQFpJbcIM+RH80HNhJ06i0jjHuX Rf2IcPnaBwtLYqjHK8WJ1dnhK2wHVLq2wD0/zNmCs1QPcm1Rbv9E6g== =DL7c END PGP SIGNATURE
Prose description of what the code does: The seed string http://kenta.blogspot.com
is hashed with SHA256, (yielding f78183140c842e8f4a550c3a5eb5663a33706fc07eeacc9687e70823d44511c4), which is then used (unsalted) as a key for AES256 in counter mode (CTR) to generate a stream of bytes. The counter starts at the zero block and increments as a 128bit bigendian integer. We read each AES output block as bytes in bigendian order. Each byte is truncated to its least significant five bits (i.e., modulo 32), then encoded into letters by the following substitution: 0=space, 1=A, 2=B,... 26=Z. Values 27 through 31 are ignored, encoding to nothing. (They might be useful for future extensions.) Occasionally there may be two or more consecutive spaces, a rare occurrence which currently has no special meaning but may be useful for future extensions. For reference, our random word stream begins: d efkabuai yqwrmhspliasmvokhvwhvz fdvhdwhoxkcqfujilomqjubxfzjtug ...
This idea is similar to and kind of an elaboration of the Document ReFinding Key also deployed on this blog which helps in finding, via a search engine, new addresses of individual posts (for which you have an old URL) should this blog move. Rather than associating just a single random word with an internet resource, we now associate an infinite stream of random words. The template above can easily be extended to arbitrary URLs, such as those of individual posts.
The technical details were inspired by a mechanism used by some computer virus to call home and update itself, using a deterministic pseudorandom word generator to generate internet domains, one of which the virus author would anonymously purchase and post update code.
We consider a situation in which an internet site anticipates that it might disappear from its current address, perhaps because of censorship. In preparation for potentially moving to a yet undecided location, we propose a method of preemptively publishing "digital breadcrumbs" (referencing Hansel and Gretel) on its current site as a way for users to find the next location if or when the site moves. The site encourages users to save a local copy of the breadcrumbs.
The published digital breadcrumbs consist of two parts: a public key and the specification of a deterministic pseudorandom word generator including its random seed.
As an example, we'll specify digital breadcrumbs for this blog.
Here is the public key for this blog, with fingerprint 2C95 B41D A4CE 7C5F 0110 C27A 561D DCBA 1BDA E2F7
:
BEGIN PGP PUBLIC KEY BLOCK Version: GnuPG v1 mQENBFUrkNQBCADRc2ia1qpiS8wwrsqnPQpUoGY8DC1+tyRs6xGTqkkdxADLkS6f VPuSkMktr0D/NmUmyCVSPkITYMeDlZ09eG2DIl33zS5ZpxTLgbHau8o8QB2cXw4f ldwDrt5UmQwc8jF6vwKqoXyxPxJIb59fxCQ5s6llurnUI9MdlhDMyRQ0rFHkXu8G JX+49zisWep7ZLZRT7/zdlKNlw2mriMTavOajCXtfR4WnFbQ8oYBkYLJPZFk4bi6 p4pyX9/nwcKCF2yIs7d3GqkYuuYSpp3gBdK+rAmYAj52cWEm08dtgurkDbh9rD/t ykiDqHxh2oCou63Tnjt9qrCdjy7f0AstS7qZABEBAAG0PEtlbiAoaHR0cDovL2tl bnRhLmJsb2dzcG90LmNvbSkgPGRldm51bGxAa2VudGEuYmxvZ3Nwb3QuY29tPokB OAQTAQIAIgUCVSuQ1AIbAwYLCQgHAwIGFQgCCQoLBBYCAwECHgECF4AACgkQVh3c uhva4vddMQgAuDcuimghGXzhazv/S86oCfZ3vtwqh5aZzW8N3rz/0tB0o+hZjgCv imu/N0m1Hv8IdFOexeHa6SgCuDg8xmRCSiFYgumDi6cQy9XCH4+mCfn5oiu1mmrg leBnV4gRF0u5m7i4pzoBsdbRU0mmKUnRUV4KKkVEsOpZla48AOdkX4SaRGq8sPft BRbUUoJf4/HVbZKLvJGqau270NbtHoM+AOe+Pk8X6AaPBl5vA6vep7zxRJayFiBm mlxN6vU8FoH5sBYTdCrN84h0kQDtFszVoYXl1QEF0ek3LjlrEVJvXBJRGy4ZLnv5 juR7vPk1LhLcq28078ucnHo6Hh3uslFnHrkBDQRVK5DUAQgApksDkc2/iTCaFXbm o1Ojb9VyOITquEzBjMMY/K58MuSKqw6X3PkzsIWVoUO1binlIWtoBHc8ooeWm2Ve uhardx1SmpGE17UJZRwe+bPI6AXzGM2vFpa7JZTbFY90rgqIWOVrPbBL2+bZds54 ySX6xuVl70H5+NsJIqcqFH5bHoLQtzLfoqLQrIK4Azmv/2NP/nAVySECznyyQT0n i25RNgiOjUwfKx2M4ICavQ/T1Of9YhnVSP3Cpz9+kDFV7VKiGCBKSSsahQbLOL3u 4dkG9QKY5vjU+dkjziZehHdNQrI9tMthCSopeLsUZ/ooQTj5IozdRTxVryxSbZKR Tp0TDQARAQABiQEfBBgBAgAJBQJVK5DUAhsMAAoJEFYd3Lob2uL35CQH/RzXJVor znGnWE/YPtb3qAFMit0APhOT0WWXCASJYjjzOJDMghjN70kqgPvmdjAL182wBVVz pjEbZBtPDcEx9YYfKiRC3qCygiSjdKRLfSwHmzFeYzGM6DI4GIsJW+1q8+iA2DUs lXLuyw8TJjH7jvY/cMhM6IzzdZQNnsaSZ9whCKM0t4yWDSxZ/cLk+ezPwEBJQmNR +dOCvmLy3PbUlLOxN18gVezyFpHy0Bj6UGQ+hyTj2fp4tKiD9LF4iHsOYJdNcHrH +CJJajhOKYmAB3RexlHunlLqAiLoGrcJUehi9hO4QnC52VvKa+2AryUKhQPPOZwa iMz2Xdl91SRrAb8= =mOe7 END PGP PUBLIC KEY BLOCK
Messages signed with a site's public key should contain the text Serial: NNN
where NNN
is a string in the format of a Debian software package version number, roughly epoch:version
, where the epoch:
is optional and version
is a dotted number string. (Inspired by the serial number of DNS zone records. Some sites use serial numbers like 20190228 to ensure the serial number monotonically increases. This would be nicer if dots were allowed: 2019.02.28.) These serial numbers can be compared as version numbers as specified by Debian. Having comparable serial numbers establishes a total ordering on messages, useful if later messages need to invalidate older messages.
Here is the first message signed with our public key, giving an example serial number. This message is otherwise uselessly empty.
BEGIN PGP SIGNED MESSAGE Hash: SHA1 Serial: 0.2015.6 BEGIN PGP SIGNATURE Version: GnuPG v1 iQEVAwUBVeD8B1Yd3Lob2uL3AQI1kwgAmUIKTr6rfffyceIsOL2UJ/Zw+bcdsdHt xlzRVAQUocCZVEMhnloRN6bj2PsEMWtO9PxN4y46EBmVImjPYRTPa3FRdVoB7tL9 Lo/ExpoQ93tkz/zMrhC3siq2dwe2FxehqIU1diqEORT3FKs3D7Zbvb3qunifzihH QoXOgEg6sQQzjKmUzMpwbt3SV86cpYLNE5GK9aaJLaYKf9yC7FQ9YnA8Dd/pVqBb OCk4PHW/iRhzbPJhBHTLmL4hBH1rVIqZvXPq4msa13tHxQce+2owzoyCQD9PXPyx TUFzDCJzoz7eDM12oyBbXRHvyWroT6khavrn/meaWofiKvB9ytAwpQ== =ZyLY END PGP SIGNATURE
We leave unsolved the standard hard problems of Public Key Infrastructure: what to do if your private key is compromised, what to do if you lose access to your private key.
We now turn our attention to the random word generator.
To combat yet unknown countermeasures an adversarial censor might deploy, the digital breadcrumbs provide only hints toward the many possibilities where the next site might be. Exactly how generated random words specify the site's next location is deliberately left unstated in order to flexibly route around the yet unknown censorship: perhaps DNS, perhaps it should be used as a web search term, perhaps a key into some censorshipresistant medium. It is the responsibility of the user, the recipient of the breadcrumbs, to try things and figure it out. The infinite stream of random words provides many choices in case some of the earlier words are not available (perhaps due to censorship). The public key allows the user to verify, perhaps even in an automated fashion, that he or she has found the right new site.
(Previous vaguely related idea: search the entire internet for the latest "message" signed by a public key.)
(Unfortunately, the random words won't directly be usable as addresses for things like Onion hidden services or Freenet CHK because for those, you don't have the ability to choose your own address. Freenet KSK might be usable, at least until spammers overwrite it.)
A cryptographically secure pseudorandom number generator (PRNG) is not strictly necessary; however, we use one in the sample implementation below because cryptographic primitives are standardized so widely available and easily portable.
Two unrelated entities (perhaps even adversaries) can use exactly the same random word generator, perhaps because they chose the same seed. We expect this is only to be a slight inconvenience because their different public keys can be used to distinguish them. They can also choose different words in the same random stream.
Here is the random word generator for this blog, suggesting a template for others. The random word generator is implemented in Haskell, similar to this stream cipher example.
BEGIN PGP SIGNED MESSAGE Hash: SHA1 { This code is public domain. } { Serial: 0.2019.1 } {# LANGUAGE PackageImports #} module Main where { import "cipheraes" Crypto.Cipher.AES as AES; import qualified Data.ByteString as ByteString; import Data.Word (Word8); import Data.Maybe (catMaybes); import qualified Crypto.Hash.SHA256 as SHA256; import Data.Text.Encoding (encodeUtf8); import qualified Data.Text as Text; import qualified Data.List as List; url :: String; url = "http://kenta.blogspot.com"; main :: IO(); main = putStr $ catMaybes $ map filt27 $ to_bytes $ aes_stream $ AES.initAES $ SHA256.hash $ encodeUtf8 $ Text.pack url; aes_stream :: AES.AES > [ByteString.ByteString]; aes_stream key = List.unfoldr (Just . (next_block key)) zero; next_block :: AES.AES > AES.AESIV > (ByteString.ByteString, AES.AESIV); next_block key iv = AES.genCounter key iv 1; { Although we ask for just 1 byte, genCounter will return a full 16byte block. } { Initial counter value } zero :: AES.AESIV; zero = AES.aesIV_ $ ByteString.replicate 16 0; to_bytes :: [ByteString.ByteString] > [Word8]; to_bytes = concat . map ByteString.unpack; filt27 :: Word8 > Maybe Char; filt27 z = case mod z 32 of { 0 > Just ' '; x  x<=26 > Just $ toEnum $ fromIntegral x + fromEnum 'a'  1; _ > Nothing; }; } BEGIN PGP SIGNATURE Version: GnuPG v1 iQEVAwUBXDtUc1Yd3Lob2uL3AQLb1QgAzeb/UebCk4cb0nSXdMSaSWwItxSbOvXK qzBqE8EwCsg/uz3ry5MB24nFUd0puO9LqEy0okebCdZqj5qWdPK/PnLZj5Zx+ZG2 sUHNSe7pn6gfJfL9+JDoVLRJaJt2Cn/c4KUT2uC7Xsig6RAhKcIKMytCnU8jDG2P S60Qdp3rk/GqgK6gHViTrLjckUAuV5nID+pxWzqE3Rx753w0W3wK/5f+giovWizk CTuPkYGv7eFzO9zPN9tLo4na+MfaKskFpJ3PsAQFpJbcIM+RH80HNhJ06i0jjHuX Rf2IcPnaBwtLYqjHK8WJ1dnhK2wHVLq2wD0/zNmCs1QPcm1Rbv9E6g== =DL7c END PGP SIGNATURE
Prose description of what the code does: The seed string http://kenta.blogspot.com
is hashed with SHA256, (yielding f78183140c842e8f4a550c3a5eb5663a33706fc07eeacc9687e70823d44511c4), which is then used (unsalted) as a key for AES256 in counter mode (CTR) to generate a stream of bytes. The counter starts at the zero block and increments as a 128bit bigendian integer. We read each AES output block as bytes in bigendian order. Each byte is truncated to its least significant five bits (i.e., modulo 32), then encoded into letters by the following substitution: 0=space, 1=A, 2=B,... 26=Z. Values 27 through 31 are ignored, encoding to nothing. (They might be useful for future extensions.) Occasionally there may be two or more consecutive spaces, a rare occurrence which currently has no special meaning but may be useful for future extensions. For reference, our random word stream begins: d efkabuai yqwrmhspliasmvokhvwhvz fdvhdwhoxkcqfujilomqjubxfzjtug ...
This idea is similar to and kind of an elaboration of the Document ReFinding Key also deployed on this blog which helps in finding, via a search engine, new addresses of individual posts (for which you have an old URL) should this blog move. Rather than associating just a single random word with an internet resource, we now associate an infinite stream of random words. The template above can easily be extended to arbitrary URLs, such as those of individual posts.
The technical details were inspired by a mechanism used by some computer virus to call home and update itself, using a deterministic pseudorandom word generator to generate internet domains, one of which the virus author would anonymously purchase and post update code.
Tweag.io has a bit of a history with language interop. By this point, we created or collaborated with others in the community on HaskellR, inlinec, inlinejava, and now inlinejs. The original idea for this style of interop was realized in languagecinline by Manuel Chakravarty a few years before joining, concurrently to HaskellR. Manuel wrote a blog post about the design principles that underpin all these different libraries. Others in the community have since created similar libraries such as clrinline, inlinerust and more. In this post, we'll present our latest contribution to the family: inlinejs.
The tagline for inlinejs: program Node.js from Haskell.
inlinejs
Here is a quick demo of calling the Node.js DNS Promises API to resolve a domain:
import Data.Aeson
import GHC.Generics
import Language.JavaScript.Inline
data DNSRecord = DNSRecord
{ address :: String
, family :: Int
} deriving (FromJSON, Generic, Show)
dnsLookup :: String > IO [DNSRecord]
dnsLookup hostname =
withJSSession
defJSSessionOpts
[block
const dns = (await import("dns")).promises;
return dns.lookup($hostname, {all: true});
]
To run it in ghci
:
*Blog> dnsLookup "tweag.io"
[DNSRecord {address = "104.31.68.163", family = 4},DNSRecord {address = "104.31.69.163", family = 4},DNSRecord {address = "2606:4700:30::681f:44a3", family = 6},DNSRecord {address = "2606:4700:30::681f:45a3", family = 6}]
We can see that the A/AAAA records of tweag.io
are returned as Haskell values.
This demo is relatively small, yet already enough to present some important features described below.
In the example above, we used block
to embed a JavaScript snippet. Naturally, two
questions arise: what content can be quoted, and what's the generated
expression's type?
block
quotes a series of JavaScript statements, and inscope Haskell
variables can be referred to by prefixing their names with $
. Before
evaluation, we wrap the code in a JavaScript async function, and this clearly
has advantages against evaluating unmodified code:
When different block
s of code share a JSSession
, the local bindings in one
block
don't pollute the scope of another block
. And it's still possible
to add global bindings by explicitly operating on global
; these global
bindings will persist within the same JSSession
.
We can return
the result back to Haskell any time we want; otherwise we'll
need to ensure the last executed statement happens to be the result value
itself, which can be tricky to get right.
Since it's an async function, we have await
at our disposal, so working with
async APIs becomes much more pleasant.
When we call dnsLookup "tweag.io"
, the constructed JavaScript code looks like
this:
(async ($hostname) => {
const dns = (await import("dns")).promises;
return dns.lookup($hostname, {all: true});
})("tweag.io").then(r => JSON.stringify(r))
As we can see, the Haskell variables are serialized and put into the argument
list of the async function. Since we're relying on FromJSON
to parse the
result in this case, the result of the async function is further mapped with
JSON.stringify
.
We also provide an expr
QuasiQuoter when the quoted code is expected to be a
single expression. Under the hood it adds return
and reuse the implementation
of block
, to save a few keystrokes for the user.
The type of block
's generated expression is JSSession > IO r
, with hidden
constraints placed on r
. In our example, we're returning [DNSRecord]
which
has a FromJSON
instance, so that instance is picked up, and on the JavaScript
side, JSON.stringify()
is called automatically before returning the result
back to Haskell. Likewise, since hostname
is a String
which supports
ToJSON
, upon calling dnsLookup
, hostname
is serialized to a JSON to be
embedded in the JavaScript code.
For marshaling userdefined types, ToJSON
/FromJSON
is sufficient. This
is quite convenient when binding a JavaScript function, since the
ToJSON
/FromJSON
instances are often free due to Haskell's amazing generics
mechanism. However, there are also a few other useful nonJSON types which are
supported here. These nonJSON types are:
The ByteString
types in the bytestring
package, including
strict/lazy/short versions. It's possible to pass a Haskell ByteString
to
JavaScript, which shows up as a Buffer
. Going in the other
direction works too.
The JSVal
type which is an opaque reference to a JavaScript value, described
in later sections of this post.
The ()
type (only as a return value), meaning that the JavaScript return
value is discarded.
Ensuring the expr
/block
QuasiQuoters work with both JSON/nonJSON types
involves quite a bit of type hackery, so we hide the relevant internal classes
and it's currently not possible for inlinejs
users to add new such nonJSON
types.
When prototyping inlinejs
, we felt the need to support the importing of
modules, either builtin or usersupplied ones. Currently, there are two
different import mechanisms coexisting in Node.js: the old CommonJSstyle
require()
and the new ECMAScript native import
. It's quite nontrivial to
support both, and we eventually chose to support ECMAScript dynamic import()
since it works outofthebox on both web and Node, making it more futureproof.
Importing a builtin module is straightforward: import(module_name)
returns a
Promise
which resolves to that module's namespace object. When we need to
import npm
installed modules, we need to specify their location in the
settings to initialize JSSession
:
import Data.ByteString (ByteString)
import Data.Foldable
import Language.JavaScript.Inline
import System.Directory
import System.IO.Temp
import System.Process
getMagnet :: String > FilePath > IO ByteString
getMagnet magnet filename =
withSystemTempDirectory "" $ \tmpdir > do
withCurrentDirectory tmpdir $
traverse_
callCommand
["npm init yes", "npm install save saveexact webtorrent@0.103.1"]
withJSSession
defJSSessionOpts {nodeWorkDir = Just tmpdir}
[block
const WebTorrent = (await import("webtorrent")).default,
client = new WebTorrent();
return new Promise((resolve, reject) =>
client.add($magnet, torrent =>
torrent.files
.find(file => file.name === $filename)
.getBuffer((err, buf) => (err ? reject(err) : resolve(buf)))
)
);
]
Here, we rely on the webtorrent
npm package to implement a
simple BitTorrent client function getMagnet
, which fetches the file content
based on a magnet
URI and a filename. First, we allocate a temporary directory
and run npm install
in it; then we supply the directory path in the
nodeWorkDir
field of session config, so inlinejs
knows where node_modules
is. And finally, we use the webtorrent
API to perform downloading, returning
the result as a Haskell ByteString
.
Naturally, running npm install
for every single getMagnet
call doesn't sound
like a good idea. In a real world Haskell application which calls npminstalled
modules with inlinejs
, the required modules shall be installed by the package
build process, e.g. by using Cabal hooks to install to the package's data
directory, and getMagnet
can use the data directory as the working directory
of Node.
Now, it's clear that all code created by the QuasiQuoters in inlinejs
requires a JSSession
state, which can be created by newJSSession
or
withJSSession
. There are a couple of config fields available, which allows one
to specify the working directory of Node, pass extra arguments or redirect
back the Node process standard error output.
There are multiple possible methods to interact with Node in other applications, including in particular:
Whenever we evaluate some code, start a Node process to run it, and fetch the result either via standard output or a temporary file; persistent Node state can be serialized via structural cloning. This is the easiest way but also has the highest overhead.
Use pipes/sockets for IPC, with inlinejs
starting a script to get the code,
perform evaluation and return results, reusing the same Node process
throughout the session. This requires more work and has less overhead than
calling Node for each call.
Use the Node.js NAPI to build a native addon, and whatever
Haskell application relying on inlinejs
gets linked with the addon, moving
the program entry point to the Node side. We have ABI stability with NAPI,
and building a native addon is surely less troublesome than building the whole
Node stack. Although the IPC overhead is spared, this complicates the
Haskell build process.
Try to link with Node either as a static or dynamic library, then directly call internal functions. Given that the build system of Node and V8 is a large beast, we thought it would take a considerable amount of effort; even if it's known to work for a specific revision of Node, there's no guarantee later revisions won't break it.
The current implementation uses the second method listed above.
inlinejs
starts an "eval server" which passes binary messages
between Node and the host Haskell process via a pair of pipes. At the
cost of a bit of IPCrelated overhead, we make inlinejs
capable of
working with multiple installations of Node without recompiling. The
schema of binary messages and implementation of "eval server" is
hidden from users and thus can evolve without breaking the exposed API
of inlinejs
.
The JavaScript specification provides the eval()
function, allowing a
dynamically constructed code string to be run anywhere. However, it's better to
use the builtin vm module of Node.js, since it's possible to supply
a custom global
object where JavaScript evaluation happens, so we can prevent
the eval server's declarations leaking into the global scope of the evaluated
code, while still being able to add custom classes or useful functions to the eval server.
Once started, the eval server accepts binary requests from the host Haskell
process and returns responses. Upon an "eval request" containing a piece of
UTF8 encoded JavaScript code, it first evaluates the code, expecting a
Promise
to be returned. When the Promise
resolves with a final result, the
result is serialized and returned. Given the asynchronous nature of this
pipeline, it's perfectly possible for the Haskell process to dispatch a batch of
eval requests, and the eval server to process them concurrently, therefore we
also export a set of "async" APIs in Language.JavaScript.Inline
which
decouples sending requests and fetching responses.
On the Haskell side, we use STM to implement send/receive queues, and they are
accompanied by threads which perform the actual sending/receiving. All userfacing
interfaces either enqueues a request or tries to fetch the corresponding
response from a TVar
, blocked if the response is not ready yet. In this way,
we make almost all exposed interfaces of inlinejs
threadsafe.
Typically, the JavaScript code sent to the eval server is generated by the QuasiQuoter's returned code, potentially including some serialized Haskell variables in the code, and the raw binary data included in the eval response is deserialized into a Haskell value. So how are the Haskell variables recognized in quoted code, and how does the Haskell/JavaScript marshaling take place?
To recognize Haskell variables, it's possible to simply use a simple regex to
parse whatever token starting with $
and assume it's a captured Haskell
variables, yet this introduces a lot of false positives, e.g. "$not_var"
,
where $not_var
is actually in a string. So in the QuasiQuoters of inlinejs
,
we perform JavaScript lexical analysis on quoted code, borrowing the lexer in
languagejavascript
. After the Haskell variables are found, the QuasiQuoters
generate a Haskell expression including them as free variables, and at runtime,
they can be serialized as parts of the quoted JavaScript code.
To perform typebased marshaling between Haskell and JavaScript data, the
simplest thing to do is solely relying on aeson
's FromJSON
/ToJSON
classes.
All captured variables should have a ToJSON
instance, serialized to JSON which
is also a valid piece of ECMAScript, and whatever returned value should also have
a FromJSON
instance. However, there are annoying exceptions which aren't
appropriate to recover from FromJSON
/ToJSON
instances.
One such types is ByteString
. It's very important to be able to support
Haskell ByteString
variables and expect them to convert to Buffer
on the
Node side (or vice versa). Unfortunately, the JSON spec doesn't have a special
variant for raw binary data. While there are other crosslanguage serialization
schemes (e.g. CBOR) that support it, they introduce heavy npm dependencies to
the eval server. Therefore, a reasonable choice is: expect inlinejs
users to
solely rely on FromJSON
/ToJSON
for their custom types, while also supporting
a few special types which have different serialization logic.
Therefore, we have a pair of internal classes for this purpose: ToJSCode
and
FromEvalResult
. All ToJSON
instances are also ToJSCode
instances, while
for ByteString
, we encode it with base64 and generate an expression which
recovers a Buffer
and is safe to embed in any JavaScript code. The
FromEvalResult
class contains two functions: one to generate a
"postprocessing" JavaScript function that encodes the result to binary on the
Node side, another to deserialize from binary on the Haskell side. For the
instances derived from FromJSON
, the "postprocessing" code is r => JSON.stringify(r)
,
and for ByteString
it's simply r => r
.
To keep the public API simple, ToJSCode
/FromEvalResult
is not exposed, and
although type inference is quite fragile for QuasiQuoter output, everything
works well as long as the relevant variables and return values have explicit
type annotations.
It's also possible to pass opaque references to arbitrary JavaScript values
between Haskell and Node. On the Haskell side, we have a JSVal
type to
represent such references, and when the returned value's type is annotated to be
a JSVal
, on the Node side, we allocate a JSVal
table slot for the result
and pass the table index back. JSVal
can also be included in quoted JavaScript
code, and they convert to JavaScript expressions which fetch the indexed value.
Finally, here's another important feature worth noting: inlinejs
supports a
limited form of exporting Haskell functions to the JavaScript world! For
functions of type [ByteString] > IO ByteString
, we can use exportHSFunc
to
get the JSVal
corresponding to a JavaScript wrapper function which calls this
Haskell function. When the wrapper function is called, it expects all parameters
to be convertible to Buffer
, then sends a request back to the Haskell process.
The regular responseprocessor Haskell thread has special logic to handle them;
it fetches the indexed Haskell function, calls it with the serialized JavaScript
parameters in a forked thread, then the result is sent back to the Node side.
The wrapper function is async and returns a Promise
which resolves once the
expected response is received from the Haskell side. Due to the async nature of
message processing on both the Node and Haskell side, it's even possible for
an exported Haskell function to call into Node again, and it also works the
other way.
Normally, the JavaScript wrapper function is async, and async functions work
nicely for most cases. There are corner cases where we need the JavaScript
function to be synchronous, blocking when the Haskell response is not ready and
returning the result without firing a callback. One such example is WebAssembly
imports: the JavaScript embedding spec of WebAssembly doesn't allow async
functions to be used as imports since this involves the "suspending" and
"resuming" of WebAssembly instance state, which might be not economical to
implement in today's JavaScript engines. Therefore, we also provide
exportSyncHSFunc
which makes a synchronous wrapper function to be used in such
scenarios. Since it involves completely locking up the main thread in Node
with Atomics
, this is an extremely heavy hammer and should be used with much
caution. We also lose reentrancy with this "sync mode"; when the exported
Haskell function calls back into Node, the relevant request will be forever
stuck in the message queue, freezing both the Haskell/Node process.
We've presented how inlinejs
allows JavaScript code to be used
directly from Haskell, and explained several key aspects of
inlinejs
internals. The core ideas are quite simple, and the
potential use cases are potentially endless, given the enormous
ecosystem the Node.js community has accumulated over the past few
years. Even for development tasks that are not specifically tied to
Node.js, it is still nice to have the ability to easily call relevant
JavaScript libraries, to accelerate prototyping in Haskell and to
compare correctness/performance of Haskell/JavaScript implementations.
There are still potential improvements to make, e.g. implementing
typebased exporting of Haskell functions. But we decided that now is
a good timing to announce the framework and collect some firsthand
use experience, spot more bugs and hear user opinions on how it can be
improved. When we get enough confidence from the feedback of seed
users, we can prepare an initial Hackage release. Please spread the
word, make actual stuff with inlinejs
and tell us what you think :)
About the Webinar
Topics covered:During the webinar we tried to answer these questions:

Interested InLearning more from FP Complete's 
We decided to include the chat log for this webinar, and it can be seen at the end of this blog post. We have a winner!Haskell Success Program Winning Draw is...Congratulations Lauri Lättilä of Helsinki, Finland's SimAnalytics! Lauri & SimAnalytics have won FP Complete's $1 Haskell Success Program Drawing. FP Complete looks forward to working together with Lauri and his SimAnalytics' Haskell team. 
NEW! 2 Success Programs!Following the great feedback and success of its new Haskell Success Program, FP Complete would like to take this opportunity to introduce and welcome its 2 new Success Programs! 

BlockChain Success ProgramBringing worldclass engineering to your rapid blockchain projects. 
Be The FirstLearn more about this exciting new opportunity available for the success of your team! 
DevOps Success ProgramAccelerate your team's expertise in cloud tools & automation Mentoring, teaching, and collaboration customized to your team's needs. 
Engineer To EngineerFixing broken processes with DevOps. Engineer to engineer mentoring that pays for itself! 
Do You Know FP Complete?At FP Complete, we do so many things to help companies it's hard to encapsulate our impact in a few words. They say a picture is worth a thousand words, so a video has to be worth 10,000 words (at least). Therefore, to tell all we can in as little time as possible, check out our explainer video. It's only 108 seconds to get the full story of FP Complete. We want your feedback for webinar topicsWe would like to hear your suggestions for future webinar topics. The simplest way to accomplish this is to add a comment to this blog post with your suggestion. Alternatively, send your suggestion via email to socialmedia@fpcomplete.com. Webinar Chat LogWe find it useful to share what was chatted about during the webinar. You can see the chat flow below. 00:06:56 Yanik Koval: hey 
About the Webinar
Topics covered:During the webinar we tried to answer these questions:

Interested InLearning more from FP Complete's 
We decided to include the chat log for this webinar, and it can be seen at the end of this blog post. We have a winner!Haskell Success Program Winning Draw is...Congratulations Lauri Lättilä of Helsinki, Finland's SimAnalytics! Lauri & SimAnalytics have won FP Complete's $1 Haskell Success Program Drawing. FP Complete looks forward to working together with Lauri and his SimAnalytics' Haskell team. 
NEW! 2 Success Programs!Following the great feedback and success of its new Haskell Success Program, FP Complete would like to take this opportunity to introduce and welcome its 2 new Success Programs! 

BlockChain Success ProgramBringing worldclass engineering to your rapid blockchain projects. 
Be The FirstLearn more about this exciting new opportunity available for the success of your team! 
DevOps Success ProgramAccelerate your team's expertise in cloud tools & automation Mentoring, teaching, and collaboration customized to your team's needs. 
Engineer To EngineerFixing broken processes with DevOps. Engineer to engineer mentoring that pays for itself! 
Do You Know FP Complete?At FP Complete, we do so many things to help companies it's hard to encapsulate our impact in a few words. They say a picture is worth a thousand words, so a video has to be worth 10,000 words (at least). Therefore, to tell all we can in as little time as possible, check out our explainer video. It's only 108 seconds to get the full story of FP Complete. We want your feedback for webinar topicsWe would like to hear your suggestions for future webinar topics. The simplest way to accomplish this is to add a comment to this blog post with your suggestion. Alternatively, send your suggestion via email to socialmedia@fpcomplete.com. Webinar Chat LogWe find it useful to share what was chatted about during the webinar. You can see the chat flow below. 00:06:56 Yanik Koval: hey 
This post is a collection of some of the tricks Iâ€™ve learned for manipulating lists in Haskell. Each one starts with a puzzle: you should try the puzzle yourself before seeing the solution!
How can you split a list in half, in one pass, without taking its length?
This first one is a relatively wellknown trick, but it occasionally comes in handy, so I thought Iâ€™d mention it. The naive way is as follows:
But itâ€™s unsatisfying: we have to traverse the list twice, and weâ€™re taking its length (which is almost always a bad idea). Instead, we use the following function:
splitHalf :: [a] > ([a],[a])
splitHalf xs = go xs xs
where
go (y:ys) (_:_:zs) = first (y:) (go ys zs)
go ys _ = ([],ys)
The â€œtortoise and the hareâ€� is the two arguments to go
: it traverses the second one twice as fast, so when it hits the end, we know that the first list must be halfway done.
Given two lists,
xs
andys
, write a function which zipsxs
with the reverse ofys
(in one pass).
Thereâ€™s a lovely paper (Danvy and Goldberg 2005) which goes though a number of tricks for how to do certain list manipulations â€œin reverseâ€�. Their technique is known as â€œthere and back againâ€�. However, Iâ€™d like to describe a different way to get to the same technique, using folds.
Whenever I need to do some list manipulation in reverse (i.e., I need the input list to be reversed), I first see if I can rewrite the function as a fold, and then just switch out foldr
for foldl
.
For our puzzle here, we need to first write zip
as a fold:
zip :: [a] > [b] > [(a,b)]
zip = foldr f b
where
f x k (y:ys) = (x,y) : k ys
f x k [] = []
b _ = []
If that looks complex, or difficult to write, donâ€™t worry! Thereâ€™s a systematic way to get to the above definition from the normal version of zip
. First, letâ€™s start with a normal zip
:
Then, we need to turn it into a casetree, where the first branch is on the list we want to fold over. In other words, we want the function to look like this:
To figure out the cases, we factor out the cases in the original function. Since the second clause (zip xs [] = []
) is only reachable when xs /= []
, itâ€™s effectively a case for the x:xs
branch.
zip :: [a] > [b] > [(a,b)]
zip xs = case xs of
[] > \_ > []
x:xs > \case
[] > []
y:ys > (x,y) : zip xs ys
Now, we rewrite the different cases to be auxiliary functions:
zip :: [a] > [b] > [(a,b)]
zip xs = case xs of
[] > b
x:xs > f x xs
where
b = \_ > []
f = \x xs > \case
[] > []
y:ys > (x,y) : zip xs ys
And finally, we refactor the recursive call to the first case expression.
zip :: [a] > [b] > [(a,b)]
zip xs = case xs of
[] > b
x:xs > f x (zip xs)
where
b = \_ > []
f = \x xs > \case
[] > []
y:ys > (x,y) : xs ys
Then those two auxiliary functions are what you pass to foldr
!
So, to reverse it, we simply take wherever we wrote foldr f b
, and replace it with foldl (flip f) b
:
zipRev :: [a] > [b] > [(a,b)]
zipRev = foldl (flip f) b
where
f x k (y:ys) = (x,y) : k ys
f x k [] = []
b _ = []
Of course, weâ€™re reversing the wrong list here. Fixing that is simple:
zipRev :: [a] > [b] > [(a,b)]
zipRev = flip (foldl (flip f) b)
where
f y k (x:xs) = (x,y) : k xs
f y k [] = []
b _ = []
Rewrite the above function without using continuations.
zipRev
, as written above, actually uses continuationpassing style. In most languages (including standard ML, which was the one used in Danvy and Goldberg (2005)), this is pretty much equivalent to a directstyle implementation (modulo some performance weirdness). In a lazy language like Haskell, though, continuationpassing style often makes things unnecessarily strict.
Consider the churchencoded pairs:
newtype Pair a b
= Pair
{ runPair :: forall c. (a > b > c) > c
}
firstC :: (a > a') > Pair a b > Pair a' b
firstC f p = Pair (\k > runPair p (k . f))
firstD :: (a > a') > (a, b) > (a', b)
firstD f ~(x,y) = (f x, y)
fstD :: (a, b) > a
fstD ~(x,y) = x
fstC :: Pair a b > a
fstC p = runPair p const
>>> fstC (firstC (const ()) undefined)
undefined
>>> fstD (firstD (const ()) undefined)
()
So itâ€™s sometimes worth trying to avoid continuations if there is a fast directstyle solution. (alternatively, continuations can give you extra strictness when you do want it)
First, Iâ€™m going to write a different version of zipRev
, which folds on the first list, not the second.
Then, we inline the definition of foldl
:
Then, as a hint, we tuple up the two accumulating parameters:
What we can see here is that we have two continuations stacked on top of each other. When this happens, they can often â€œcancel outâ€�, like so:
And we have our directstyle implementation!
Note 14/05/2019: the â€œcanceloutâ€� explanation there is a little handwavy, as Iâ€™m sure youâ€™ll notice. However, there are a number of excellent explanations on this stackoverflow thread which explain it much better than I ever could. Thanks to Anders Kaseorg, Will Ness, user11228628, and to Joseph Sible (2019) for asking the question.
Detect that a list is a palindrome, in one pass.
We now know a good way to split a list in two, and a good way to zip a list with its reverse. We can combine the two to get a program that checks if a list is a palindrome. Hereâ€™s a first attempt:
But this is doing three passes!
To get around it, we can manually do some fusion. Fusion is a technique where we can spot scenarios like the following:
And translate them into a version without a list:
The trick is making sure that the consumer is written as a fold, and then we just put its f
and b
in place of the :
and []
in the producer.
So, when we inline the definition of splitHalf
into zipRev
, we get the following:
zipRevHalf :: [a] > [(a,a)]
zipRevHalf xs = snd (go xs xs)
where
go (y:ys) (_:_:zs) = f y (go ys zs)
go (_:ys) [_] = (ys,[])
go ys [] = (ys,[])
f x (y:ys,r) = (ys,(x,y):r)
isPal xs = all (uncurry (==)) (zipRevHalf xs)
(adding a special case for oddlength lists)
Finally, the all (uncurry (==))
is implemented as a fold also. So we can fuse it with the rest of the definitions:
isPal :: Eq a => [a] > Bool
isPal xs = snd (go xs xs)
where
go (y:ys) (_:_:zs) = f y (go ys zs)
go (_:ys) [_] = (ys,True)
go ys [] = (ys,True)
f x (y:ys,r) = (ys,(x == y) && r)
You may have spotted the writer monad over All
there. Indeed, we can rewrite it to use the monadic bind:
isPal :: Eq a => [a] > Bool
isPal xs = getAll (fst (go xs xs)) where
go (y:ys) (_:_:zs) = f y =<< go ys zs
go (_:ys) [_] = pure ys
go ys [] = pure ys
f y (z:zs) = (All (y == z), zs)
Construct a Braun tree from a list in linear time.
This is also a very wellknown trick (Bird 1984), but today Iâ€™m going to use it to write a function for constructing Braun trees.
A Braun tree is a peculiar structure. Itâ€™s a binary tree, where adjacent branches can differ in size by only 1. When used as an array, it has $<semantics>\mathrm{\u011f\ufffd\u2019\xaa}(logn)<annotation\; encoding="application/xtex">\backslash mathcal\{O\}(\backslash log\; n)</annotation></semantics>$ lookup times. Itâ€™s enumerated like so:
â”Œâ”€7
â”Œ3â”¤
â”‚ â””11
â”Œ1â”¤
â”‚ â”‚ â”Œâ”€9
â”‚ â””5â”¤
â”‚ â””13
0â”¤
â”‚ â”Œâ”€8
â”‚ â”Œ4â”¤
â”‚ â”‚ â””12
â””2â”¤
â”‚ â”Œ10
â””6â”¤
â””14
The objective is to construct a tree from a list in linear time, in the order defined above. Okasaki (1997) observed that, from the list:
Each level in the tree is constructed from chucks of powers of two. In other words:
From this, we can write the following function:
rows k [] = []
rows k xs = (k , take k xs) : rows (2*k) (drop k xs)
build (k,xs) ts = zipWith3 Node xs ts1 ts2
where
(ts1,ts2) = splitAt k (ts ++ repeat Leaf)
fromList = head . foldr build [Leaf] . rows 1
The first place weâ€™ll look to eliminate a pass is the build
function. It combines two rows by splitting the second in half, and zipping it with the first.
We donâ€™t need to store the length of the first list, though, as we are only using it to split the second, and we can do that at the same time as the zipping.
zipUntil :: (a > b > c) > [a] > [b] > ([c],[b])
zipUntil _ [] ys = ([],ys)
zipUntil f (x:xs) (y:ys) = first (f x y:) (zipUntil f xs ys)
>>> zipUntil (,) [1,2] "abc"
([(1,'a'),(2,'b')],"c")
Using this function in build
looks like the following:
That toplevel zipWith
is also unnecessary, though. If we make the program circular, we can produce ts2
as we consume it, making the whole thing singlepass.
build xs ts = ys
where
(ys,ts2) = zip3Node xs (ts ++ repeat Leaf) ts2
zip3Node (x:xs) (y:ys) ~(z:zs) = first (Node x y z:) (zip3Node xs ys zs)
zip3Node [] ys _ = ([], ys)
That zip3Node
is a good candidate for rewriting as a fold, also, making the whole thing look like this:
rows k [] = []
rows k xs = take k xs : rows (2*k) (drop k xs)
build xs ts = ys
where
(ys,zs) = foldr f b xs ts zs
f x xs (y:ys) ~(z:zs) = first (Node x y z:) (xs ys zs)
b ys _ = ([],ys)
fromList = head . foldr build (repeat Leaf) . rows 1
To fuse all of those definitions, we first will need to rewrite rows
as a fold:
rows xs = uncurry (:) (foldr f b xs 1 2)
where
b _ _ = ([],[])
f x k 0 j = ([], uncurry (:) (f x k j (j*2)))
f x k i j = first (x:) (k (i1) j)
Once we have everything as a fold, the rest of the transformation is pretty mechanical. At the end of it all, we get the following lineartime function for constructing a Braun tree from a list:
fromList :: [a] > Tree a
fromList xs = head (l (foldr f b xs 1 2))
where
b _ _ ys zs = (repeat Leaf, (repeat Leaf, ys))
l k = let (xs, ys) = uncurry k ys in xs
f x k 0 j ys zs = ([], (l (f x k j (j*2)), ys))
f x k i j ~(y:ys) ~(z:zs) = first (Node x y z:) (k (i1) j ys zs)
Bird, R. S. 1984. â€œUsing Circular Programs to Eliminate Multiple Traversals of Data.â€� Acta Inf. 21 (3) (October): 239â€“250. doi:10.1007/BF00264249. http://dx.doi.org/10.1007/BF00264249.
Danvy, Olivier, and Mayer Goldberg. 2005. â€œThere and Back Again.â€� BRICS Report Series 12 (3). doi:10.7146/brics.v12i3.21869. https://tidsskrift.dk/brics/article/view/21869.
Okasaki, Chris. 1997. â€œThree Algorithms on Braun Trees.â€� Journal of Functional Programming 7 (6) (November): 661â€“666. doi:10.1017/S0956796897002876. https://www.eecs.northwestern.edu/~robby/courses/3954952013fall/threealgorithmsonbrauntrees.pdf.
Sible, Joseph. 2019. â€œHow can two continuations cancel each other out?â€� Stack Overflow. https://stackoverflow.com/questions/56122022/howcantwocontinuationscanceleachotherout.
I wrote a little tool to graph the finegrained timing logs produced by ghc
when the v
(verbose) flag is given. These logs to STDERR look like, e.g.
!!! Liberate case [Data.Binary.Class]: finished in 32.06 milliseconds, allocated 14.879 megabytes
!!! Simplifier [Data.Binary.Class]: finished in 873.97 milliseconds, allocated 563.867 megabytes
The project is on GitHub at jberryman/ghctimingtreemap, along with a screenshot.
Navigating within the graph is pretty slow at least in firefox, and there are some other improvements that could be made, for instance some of the phases are run multiple times on the same module and it would be nice to see these grouped, where the module name is logged.
The last few days I’ve watched Rainer König’s OrgMode videos. It’s resulted in a few new settings that makes Org a little more useful.
Variable  Value  Description 

calendarweekstartday 
1 
Weeks start of Monday! 
orgmodules (list) 
orghabit 
Support for tracking habits 
orgmodules (list) 
orgid 
Improved support for ID property 
orgagendastartonweekday 
1 
Weeks start on Monday, again! 
orglogintodrawer 
t 
Put notes (logs) into a drawer 
orgenforcetodocheckboxdependencies 
t 
Checkboxes must be checked before a TODO can become DONE 
orgidlinktoorguseid 
t 
Prefer use of ID property for links 
Last week we walked through the process of refactoring our code to use Data.Array
instead of Data.Map
. But in the process, we introduced a big inefficiency! When we use the Array.//
function to "update" our array, it has to create a completely new copy of the array! For various reasons, Map
doesn't have to do this.
So how can we fix this problem? The answer is to use the MArray
interface, for mutable arrays. With mutable arrays, we can modify them inplace, without a copy. This results in code that is much more efficient. This week, we'll explore the modifications we can make to our code to allow this. You can see a quick summary of all the changes in this Git Commit.
Refactoring code can seem like an hard process, but it's actually quite easy with Haskell! In this article, we'll use the idea of "Compile Driven Development". With this process, we update our types and then let compiler errors show us all the changes we need. To learn more about this, and other Haskell paradigms, read our Haskell Brain series!
To start with, let's address the seeming contradiction of having mutable data in an immutable language. We'll be working with the IOArray
type in this article. An item of type IOArray
acts like a pointer, similar to an IORef
. And this pointer is, in fact, immutable! We can't make it point to a different spot in memory. But we can change the underlying data at this memory. But to do so, we'll need a monad that allows such side effects.
In our case, with IOArray
, we'll use the IO
monad. This is also possible with the ST
monad. But the specific interface functions we'll use (which are possible with either option) live in the MArray
library. There are four in particular we're concerned with:
freeze :: (Ix i, MArray a e m, IArray b e) => a i e > m (b i e)
thaw :: (Ix i, IArray a e, MArray b e m) => a i e > m (b i e)
readArray :: (MArray a e m, Ix i) => a i e > i > m e
writeArray :: (MArray a e m, Ix i) => a i e > i > e > m ()
The first two are conversion functions between normal, immutable arrays and mutable arrays. Freezing turns the array immutable, thawing makes it mutable. The second two are our replacements for Array.!
and Array.//
when reading and updating the array. There are a lot of typeclass constraints in these. So let's simplify them by substituting in the types we'll use:
freeze
:: IOArray Location CellBoundaries
> IO (Array Location CellBoundaries)
thaw
:: Array Location CellBoundaries
> IO (IOArray Location CellBoundaries)
readArray
:: IOArray Location CellBoundaries
> Location
> IO CellBoundaries
writeArray
:: IOArray Location CellBoundaries
> Location
> CellBoundaries
> IO ()
Obviously, we'll need to add the IO
monad into our code at some point. Let's see how this works.
We won't need to change how the main World
type uses the array. We'll only be changing how the SearchState
stores it. So let's go ahead and change that type:
type MMaze = IA.IOArray Location CellBoundaries
data SearchState = SearchState
{ randomGen :: StdGen
, locationStack :: [Location]
, currentBoundaries :: MMaze
, visitedCells :: Set.Set Location
}
The first issue is that we should now pass a mutable array to our initial search state. We'll use the same initialBounds
item, except we'll thaw
it first to get a mutable version. Then we'll construct the state and pass it along to our search function. At the end, we'll freeze
the resulting state. All this involves making our generation function live in the IO
monad:
 This did not have IO before!
generateRandomMaze :: StdGen > (Int, Int) > IO Maze
generateRandomMaze gen (numRows, numColumns) = do
initialMutableBounds < IA.thaw initialBounds
let initialState = SearchState
g2
[(startX, startY)]
initialMutableBounds
Set.empty
let finalBounds = currentBoundaries
(execState dfsSearch initialState)
IA.freeze finalBounds
where
(startX, g1) = …
(startY, g2) = …
initialBounds :: Maze
initialBounds = …
This seems to "solve" our issues in this function and push all our errors into dfsSearch
. But it should be obvious that we need a fundamental change there. We'll need the IO
monad to make array updates. So the type signatures of all our search functions need to change. In particular, we want to combine monads with StateT SearchState IO
. Then we'll make any "pure" functions use IO
instead.
dfsSearch :: StateT SearchState IO ()
findCandidates :: Location > Maze > Set.Set Location
> IO [(Location, CellBoundaries, Location, CellBoundaries)]
chooseCandidate
:: [(Location, CellBoundaries, Location, CellBoundaries)]
> StateT SearchState IO ()
This will lead us to update our generation function.
generateRandomMaze :: StdGen > (Int, Int) > IO Maze
generateRandomMaze gen (numRows, numColumns) = do
initialMutableBounds < IA.thaw initialBounds
let initialState = SearchState
g2
[(startX, startY)]
initialMutableBounds
Set.empty
finalBounds < currentBoundaries <$>
(execStateT dfsSearch initialState)
IA.freeze finalBounds
where
…
The original dfsSearch
definition is almost fine. But findCandidates
is now a monadic function. So we'll have to extract its result instead of using let
:
 Previously
let candidateLocs = findCandidates currentLoc bounds visited
 Now
candidateLocs < lift $ findCandidates currentLoc bounds visited
The findCandidates
function though will need a bit more retooling. The main this is that we need readArray
instead of Array.!
. The first swap is easy:
findCandidates currentLocation@(x, y) bounds visited = do
currentLocBounds < IA.readArray bounds currentLocation
...
It's tempting to go ahead and read all the other values for upLoc
, rightLoc
, etc. right now:
findCandidates currentLocation@(x, y) bounds visited = do
currentLocBounds < IA.readArray bounds currentLocation
let upLoc = (x, y + 1)
upBounds < IA.readArray bounds upLoc
...
We can't do that though, because this will access them in a strict way. We don't want to access upLoc
until we know the location is valid. So we need to do this within the case statement:
findCandidates currentLocation@(x, y) bounds visited = do
currentLocBounds < IA.readArray bounds currentLocation
let upLoc = (x, y + 1)
maybeUpCell < case (upBoundary currentLocBounds,
Set.member upLoc visited) of
(Wall, False) > do
upBounds < IA.readArray bounds upLoc
return $ Just
( upLoc
, upBounds {downBoundary = AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {upBoundary = AdjacentCell upLoc}
)
_ > return Nothing
And then we'll do the same for the other directions and that's all for this function!
We don't have to change too much about our chooseCandidates
function! The primary change is to eliminate the line where we use Array.//
to update the array. We'll replace this with two monadic lines using writeArray
instead. Here's all that happens!
chooseCandidate candidates = do
(SearchState gen currentLocs boundsMap visited) < get
...
lift $ IA.writeArray boundsMap chosenLocation newChosenBounds
lift $ IA.writeArray boundsMap prevLocation newPrevBounds
put (SearchState newGen (chosenLocation : currentLocs) boundsMap newVisited)
Aside from that, there's one small change in our runner to use the IO
monad for generateRandomMaze
. But after that, we're done!
As mentioned above, you can see all these changes in this commit on our github repository. The last two articles have illustrated how it's not hard to refactor our Haskell code much of the time. As long as we are methodical, we can pick the one thing that needs to change. Then we let the compiler errors direct us to everything we need to update as a result. I find refactoring other languages (particularly Python/Javascript) to be much more stressful. I'm often left wondering...have I actually covered everything? But in Haskell, there's a much better chance of getting everything right the first time!
To learn more about Compile Driven Development, read our Haskell Brain Series. If you're new to Haskell you can also read our Liftoff Series and download our Beginners Checklist!
This is a video interview, where I am talking about what I see as the value proposition of functional programming, functional programming in industry, and how the YOW! Lambda Jam conference helps developers to get the most out of functional programming.
Higher Kinded Data Types (HKDTs) have piqued my interest lately. They seem to have a lot of potential applications, however the ergonomics still aren't so great in most of these cases. Today we'll look at one case where I think the end result ends up quite nice! Let's parse some options!
First the problem; if you've worked on a nontrivial production app you've probably come across what I'll call the Configuration Conundrum. Specifically, this is when an app collects configuration values from many sources. Maybe it parses some options from CLI flags, some from Environment Variables, yet more come from a configuration file in JSON or YAML or TOML or or even worse it may pull from SEVERAL files. Working with these is a mess, option priority gets tricky, providing useful error messages gets even harder, and the code for managing all these sources is confusing, complicated, and spread out. Though we may not solve ALL these problems today, we'll build an approach that's modular and extensible enough that you can mix and match bits and pieces to get whatever you need.
Here's an example of some messy code which pulls options from the environment or from a JSON value file:
getOptions :: IO Options
getOptions = do
configJson < readConfigFile
mServerHostEnv < readServerHostEnv
mNumThreadsEnv < readNumThreadsEnv
let mServerHostJson = configJson ^? key "server_host" . _String . unpacked
let mNumThreadsJson = configJson ^? key "num_threads" . _Number . to round
return $ Options <$> fromMaybe serverHostDef (mServerHostEnv <> mServerHostJson)
<*> fromMaybe numThreadsDef (mNumThreadsEnv <> mNumThreadsJson)
Here's a peek at how our configuration parsing code will end up:
getOptions :: IO Options
getOptions =
withDefaults defaultOpts <$> fold [envOpts, jsonOptsCustom <$> readConfigFile]
This is slightly disingenuous as some of the logic is abstracted away behind the scenes in the second example; but the point here is that the logic CAN be abstracted, whereas it's very difficult to abstract over the steps in the first example without creating a bunch of intermediate types.
If you're unfamiliar with HKDTs (higher kinded data types); it's a very simple idea with some mind bending implications. Many data types are parameterized by a value type (e.g.Â [a]
is a list is parameterized by the types of values it contains); however HKDTs are parameterized by some wrapper type (typically a functor, but not always) around the data of the record. Easiest to just show an example and see it in practice. Let's define a very simple type to contain all the options our app needs:
Notice that each field is wrapped in f
. I use a _
suffix as a convention to denote that it's a HKDT. f
could be anything at all of the kind Type > Type
; e.g.Â Maybe
, IO
, Either String
, or even strange constructions like Compose Maybe (Join (Biff (,) IO Reader))
! You'll discover the implications as we go along, so don't worry if you don't get it yet. For our first example we'll describe how to get options from Environment Variables!
Applications will often set configuration values using Environment Variables; it's an easy way to implicitly pass information into programs and is nice for sensitive data like secrets. We can describe the options in our HKDT in terms of Environment Variables which may or may not exist. First we'll need a way to lookup an option for a given key, and a way to convert it into the type we expect. You may want to use something more sophisticated in your app; but for the blog post I'll just lean on the Read
typeclass to make a small helper.
import System.Environment (lookupEnv, setEnv)
import Text.Read (readMaybe)
readEnv :: Read a => String > IO (Maybe a)
readEnv envKey = do
lookupEnv envKey >>= pure . \case
Just x > readMaybe x
Nothing > Nothing
This function looks up the given key in the environment, returning a Nothing
if it doesn't exist or fails to parse. We'll talk about more civilized error handling later on, don't worry ;)
Now we can describe how to get each option in our type using this construct:
 This doesn't work!
envOpts :: Options_ ??
envOpts =
OptionsF
{ serverHost = readEnv "SERVER_HOST"
, numThreads = readEnv "NUM_THREADS"
, verbosity = pure Nothing  Don't read verbosity from environment
}
Close; but if you'll note earlier, each field should contain field's underlying type wrapped in some f
. Here we've got IO (Maybe a)
, we can't assign f
to IO (Maybe _)
so we need to compose the two Functors somehow. We can employ Compose
here to collect both IO
and Maybe
into a single Higher Kinded Type to serve as our f
. Try the following instead:
import Data.Functor.Compose (Compose(..))
 Add a Compose to our helper
readEnv :: Read a => String > (IO `Compose` Maybe) a
readEnv envKey = Compose $ do
...
envOpts :: Options_ (IO `Compose` Maybe)
envOpts =
OptionsF
{ serverHost = readEnv "SERVER_HOST"
, numThreads = readEnv "NUM_THREADS"
, verbosity = Compose $ pure Nothing  Don't read verbosity from environment
}
I personally find it more readable to write Compose
as infix like this, but some disagree. Very cool; we've got a version of our record where each field contains an action which gets and parses the right value from the environment! It's clear at a glance that we haven't forgotten to check any fields (if you have Wall
enabled you'd get a warning about missing fields)! We've effectively turned the traditional Options <$> ... <*> ...
design inside out. It's much more declarative this way, and now that it's all collected as structured data it'll be easier for us to work with from now on too!
Let's build another one!
JSON and YAML configuration files are pretty common these days. I won't bother to dive into where to store them or how we'll parse them, let's assume you've done that already and just pretend we've got ourselves an Aeson Value
object from some config file and we want to dump the values into our options object.
We have two options here and I'll show both! The simplest is just to derive FromJSON
and cast the value directly into our type!
Unfortunately it's not quite so easy as just tacking on a deriving FromJSON
; Since GHC doesn't know what type f
is it has a tough time figuring out what you want it to do. If you try you'll get an error like:
â€¢ No instance for (FromJSON (f String))
We need to help out GHC a bit. No worries though; someone thought of that! Time to pull in the barbies
library. An incredibly useful tool for working with HKDT in general. Add the barbies
library to your project, then we'll derive a few handy instances:
{# LANGUAGE DeriveGeneric #}
{# LANGUAGE DeriveAnyClass #}
{# LANGUAGE StandaloneDeriving #}
 ...
import GHC.Generics (Generic)
import qualified Data.Aeson as A
import Data.Barbie
 ...
 Go back and add the deriving clause:
data Options_ f =
Options_ {...}
deriving (Generic, FunctorB, TraversableB, ProductB, ConstraintsB, ProductBC)
deriving instance (AllBF Show f Options_) => Show (Options_ f)
deriving instance (AllBF Eq f Options_) => Eq (Options_ f)
deriving instance (AllBF A.FromJSON f Options_) => A.FromJSON (Options_ f)
Okay! Let's step through some of that. First we derive Generic
, it's used by both aeson
and barbies
for most of their type classes. We derive a bunch of handy *B
helpers (B for Barbies) which also come from the barbies
lib, we'll explain them as we use them. The important part right now is the deriving instance
clauses. AllBF
from barbies
asserts that all the wrapped fields of the typeclass adhere to some type class. For example, AllBF Show f Options_
says that f a
is Showable for every field in our product. More concretely, in our case AllBF Show f Options
expands into something equivalent to (Show (f String), Show (f Int))
since we have fields of type String
and Int
. Nifty! So we can now derive type classes with behaviour dependent on the wrapping type. In most cases this works as expected, and can sometimes be really handy!
One example where this ends up being useful is FromJSON
. The behaviour of our FromJSON
instance will depend on the wrapper type; if we choose f ~ Maybe
then all of our fields become optional! Let's use this behaviour to say that we want to parse our JSON file into an Options
object, but it's okay if fields are missing.
import Control.Lens
jsonOptsDerived :: A.Value > Options_ Maybe
jsonOptsDerived = fromResult . A.fromJSON
where
fromResult :: A.Result (Options_ Maybe) > Options_ Maybe
fromResult (A.Success a) = a
fromResult (A.Error _) = buniq Nothing
A few things to point out here; we call fromJson :: FromJSON a => Value > Result a
here, but we don't really need the outer Result
type; we'd prefer if the failure was localized at the individual field level; simply using Nothing
for fields which are missing. So we use fromResult
to unpack the result if successful, or to construct an Options_ Maybe
filled completely with Nothing
if the parsing fails for some reason (you'll probably want to come back an improve this error handling behaviour later). You'll notice that nothing we do really has much to do with Options_
; so let's generalize this into a combinator we can reuse in the future:
jsonOptsDerived :: (A.FromJSON (b Maybe), ProductB b) => A.Value > b Maybe
jsonOptsDerived = fromResult . A.fromJSON
where
fromResult :: ProductB b => A.Result (b Maybe) > b Maybe
fromResult (A.Success a) = a
fromResult (A.Error _) = buniq Nothing
buniq
requires a ProductB
constraint which asserts that the type we're constructing is a Record type or some other Product. This is required because buniq
wouldn't know which constructor to instantiate if it were a Sumtype.
Okay, we've seen the generic version; here's a different approach where we can choose HOW to deserialize each option from the provided Value
.
import Data.Text.Lens
import Data.Aeson.Lens
import Control.Lens
jsonOptsCustom :: A.Value > Options_ Maybe
jsonOptsCustom = bsequence
Options_
{ serverHost = findField $ key "host" . _String . unpacked
, numThreads = findField $ key "num_threads" . _Number . to round
, verbosity = findField $ key "verbosity" . _Number . to round
}
where
findField :: Fold A.Value a > Compose ((>) A.Value) Maybe a
findField p = Compose (preview p)
Some of these types get a bit funky; but IMHO they wouldn't be too terrible if this were all bundled up in some lib for readability. As I said earlier, some of the ergonomics still have room for improvement.
Let's talk about what this thing does! First we import a bunch of lensy stuff; then in each field of our options type we build a getter function from Value > Maybe a
which tries to extract the field from the JSON Value. preview
mixed with Data.Aeson.Lens
happens to be a handy way to do this. I pulled out the findField
helper mainly to draw attention to the rather cryptic Compose ((>) A.Value) Maybe a
type signature. This is just Compose
wrapped around a function A.Value > Maybe a
; why do we need the Compose
here? What we REALLY want is A.Value > Option_ Maybe
; but remember that every field MUST contain something that matches f a
for some f
. A function signature like A.Value > Maybe a
doesn't match this form, but Compose ((>) A.Value) Maybe a
does (where f ~ Compose ((>) A.Value) Maybe
)! Ideally we'd then like to pull the function bits to the outside since we'll be calling each field with the same argument. Conveniently; barbies
provides us with bsequence
; whose type looks like this:
Or if we specialize it to this particular case:
We use the >
applicative (also known as Reader
) to extract the function Functor to the outside of the structure! This of course requires that the individual fields can be traversed; implying the TraversableB
constraint. Hopefully this demonstrates the flexibility of this technique, we can provide an arbitrary lens chain to extract the value for each setting, maybe it's overkill in this case, but I can think of a few situations where it would be pretty handy.
While we're at it, let's bsequence
our earlier Environment Variable object to get the IO on the outside!
envOpts :: IO (Options_ Maybe)
envOpts = bsequence
Options_
 serverHost is already a string so we don't need to 'read' it.
{ serverHost = Compose . lookupEnv $ "SERVER_HOST"
, numThreads = readEnv "NUM_THREADS"
 We can 'ignore' a field by simply returning Nothing.
, verbosity = Compose . pure $ Nothing
}
This is dragging on a bit; let's see how we can actually use these things!
Now that we've got two different ways to collect options for our program let's see how we can combine them. Let's write a simple action in IO for getting and combining our options parsers.
import Control.Applicative
 Fake config file for convenience
readConfigFile :: IO A.Value
readConfigFile =
pure $ A.object [ "host" A..= A.String "example.com"
, "verbosity" A..= A.Number 42
]
getOptions :: IO (Options_ Maybe)
getOptions = do
configJson < readConfigFile
envOpts' < envOpts
return $ bzipWith (<>) envOpts' (jsonOptsCustom configJson)
Let's try it out, then I'll explain it.
Î»> getOptions
Options_ {serverHost = Just "example.com", numThreads = Nothing, verbosity = Just 42}
Î»> setEnv "NUM_THREADS" "1337"
Î»> getOptions
Options_ {serverHost = Just "example.com", numThreads = Just 1337, verbosity = Just 42}
 We've set things up so that environment variables override our JSON config.
Î»> setEnv "SERVER_HOST" "chrispenner.ca"
Î»> getOptions
Options_ {serverHost = Just "chrispenner.ca", numThreads = Just 1337, verbosity = Just 42}
Now that we're combining sets of config values we need to decide what semantics we want when values overlap! I've decided to use <>
from Alternative
to combine our Maybe
values. This basically means "take the first nonNothing value and ignore the rest". That means in our case that the first setting to be "set" wins out. bzipWith
performs elementwise zipping of each element within our Options_
record, with the caveat that the function you give it must work over any possible a
contained inside. In our case the type is specialized to:
bzipWith :: (forall a. Maybe a > Maybe a > Maybe a)
> Options_ Maybe > Options_ Maybe > Options_ Maybe
Which does what we want. This end bit is going to get messy if we add any more sources though, let's see if we can't clean it up! My first thought is that I'd love to use <>
without any lifting/zipping, but the kinds don't line up; Options_
is kind (Type > Type) > Type
whereas Type > Type
is required by Alternative
. How do we lift Alternative to Higher Kinds? Well we could try something clever, OR we could go the opposite direction and use Alternative
to build a Monoid
instance for our type; then use that to combine our values!
instance (Alternative f) => Semigroup (Options_ f) where
(<>) = bzipWith (<>)
instance (Alternative f) => Monoid (Options_ f) where
mempty = buniq empty
Now we have a Monoid for Options_
whenever f
is an Alternative
such as Maybe
! There are many possible Monoid
instance for HKDTs, but in our case it works great! Alternative
is actually just a Monoid in the category of Applicative Functors, so it makes sense that it makes a suitable Monoid if we apply it to values within an HKDT.
Let's see how we can refactor things.
Wait a minute; what about the IO
? Here I'm actually employing IO
s little known Monoid instance! IO
is a Monoid whenever the result of the IO
is a Monoid; it simply runs both IO
actions then mappends
the results (e.g.Â liftA2 (<>)
). In this case it's perfect! As we get even more possible option parsers we could even just put them in a list and fold
them together: fold [envOpts, jsonOptsCustom <$> readConfigFile, ...]
But wait! There's more!
We've seen how we can specify multiple partial configuration sources, but at the end of the day we're still left with an Options_ Maybe
! What if we want to guarantee that we have a value for all required config values? Let's write a new helper.
withDefaults :: ProductB b => b Identity > b Maybe > b Identity
withDefaults = bzipWith fromMaybeI
where
fromMaybeI :: Identity a > Maybe a > Identity a
fromMaybeI (Identity a) Nothing = Identity a
fromMaybeI _ (Just a) = Identity a
This new helper uses our old friend bzipWith
to lift a slightly altered fromMaybe
to run over HKDTs! We have to do a little bit of annoying wrapping/unwrapping of Identity, but it's not too bad. This function will take the config value from any Just
's in our Options_ Maybe
and will choose the default for the Nothing
s!
import Data.Foldable

type Options = Options_ Identity
getOptions :: IO Options
getOptions =
withDefaults defaultOpts <$> fold [envOpts, jsonOptsCustom <$> readConfigFile]
We introduce the alias type Options = Options_ Identity
as a convenience.
So far our system silently fails in a lot of places. Let's see how HKDTs can give us more expressive error handling!
The first cool thing is that we can store error messages directly alongside fields they pertain to!
{# LANGUAGE OverloadedStrings #}

optErrors :: Options_ (Const String)
optErrors =
Options_
{ serverHost = "server host required but not provided"
, numThreads = "num threads required but not provided"
, verbosity = "verbosity required but not provided"
}
If we use Const String
in our HKDT we are saying that we actually don't care about the type of the field itself, we just want to store a string no matter what! If we turn on OverloadedStrings
we can even leave out the Const
constructor if we like! But I'll leave that choice up to you.
Now that we've got errors which relate to each field we can construct a helpful error message if we're missing required fields:
import Data.Either.Validation

validateOptions :: (TraversableB b, ProductB b)
=> b (Const String)
> b Maybe
> Validation [String] (b Identity)
validateOptions errMsgs mOpts = bsequence' $ bzipWith validate mOpts errMsgs
where
validate :: Maybe a > Const String a > Validation [String] a
validate (Just x) _ = Success x
validate Nothing (Const err) = Failure [err]
validateOptions
takes any traversable product HKDT with Maybe
fields and an HKDT filled with error messages inside Const
and will return a Validation
object containing either a summary of errors or a validated Identity
HKDT. Just as before we use bzipWith
with a function which operates at the level of functors as a Natural Transformation; i.e.Â it cares only about the containers, not the values. Note that Validation is very similar to the Either
type, but accumulates all available errors rather than failing fast. We use bsequence'
here, which is just like bsequence
; but saves us the trouble of explicitly threading an Identity
into our structure. Check the docs in barbies
if you'd like to learn more.
getOptions :: IO (Validation [String] Options)
getOptions =
validateOptions optErrors <$> fold [envOpts, jsonOptsCustom <$> readConfigFile]
Now if we end up with values missing we get a list of errors!
You can trust me that if we had more than one thing missing it would collect them all. That's a lot of content all at once, so I'll leave some other experiments for next time. Once you start to experiment a world of opportunities opens up; you can describe validation, forms, documentations, schemas, and a bunch of other stuff I haven't even though of yet!! A challenge for the reader: try writing a proper validator using HKDTs which validates that each field fulfills specific properties. For example, check that the number of threads is > 0; check that the host is nonempty, etc. You may find the following newtype helpful ;) newtype Checker a = Checker (a > Maybe String)
Just for fun here's a bonus config source for getting options from the Command Line using Optparse Applicative
import Options.Applicative hiding (Failure, Success)

cliOptsParser :: Options_ Parser
cliOptsParser =
Options_
{ serverHost =
strOption (long "serverHost" <> metavar "HOST" <> help "host for API interactions")
, numThreads =
option auto
(long "threads" <> short 't' <> help "number of threads" <> metavar "INT")
, verbosity = option auto
(long "verbosity"
<> short 'v'
<> help "Level of verbosity"
<> metavar "VERBOSITY")
}
mkOptional :: FunctorB b => b Parser > b (Parser `Compose` Maybe)
mkOptional = bmap (Compose . optional)
toParserInfo :: (TraversableB b) => b (Parser `Compose` Maybe) > ParserInfo (b Maybe)
toParserInfo b = info (bsequence b) briefDesc
cliOpts :: IO (Options_ Maybe)
cliOpts = execParser $ toParserInfo (mkOptional cliOptsParser)
getOptions :: IO (Validation [String] Options)
getOptions =
validateOptions optErrors <$> fold [cliOpts, envOpts, jsonOptsCustom <$> readConfigFile]
Hopefully you learned something ðŸ¤ž; If so, consider supporting more posts like this 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?
A while back I wrote an article about confusing and misleading technical jargon, drawing special attention to botanists’ indefensible misuse of the word “berry” and then to the word “henge”, which archaeologists use to describe a class of Stonehengelike structures of which Stonehenge itself is not a member.
I included a discussion of mathematical jargon and generally gave it a good grade, saying:
Nobody hearing the term “cobordism” … will think for an instant that they have any idea what it means … they will be perfectly correct.
But conversely:
The nonmathematician's idea of “line”, “ball”, and “cube” is not in any way inconsistent with what the mathematician has in mind …
Today I find myself wondering if I gave mathematics too much credit. Some mathematical jargon is pretty bad. Often brought up as an example are the topological notions of “open” and “closed” sets. It sounds as if they should be exclusive and exhaustive — surely a set that is open is not closed, and vice versa? — but no, there are sets that are neither open nor closed and other sets that are both. Really the problem here is entirely with “open”. The use of “closed” is completely in line with other mathematical uses of “closed” and “closure”. A “closed” object is one that is a fixed point of a closure operator. Topological closure is an example of a closure operator, and topologically closed sets are its fixed points.
(Last month someone asked on Stack Exchange if there was a connection between topological closure and binary operation closure and I was astounded to see a consensus in the comments that there was no relation between them. But given a binary operation , we can define an associated closure operator as follows: is the smallest set that contains and for which implies . Then the binary operation is said to be “closed on the set ” precisely if is closed with respect to ; that is if . But I digress.)
Another example of poor nomenclature is “even” and “odd” functions. This is another case where it sounds like the terms ought to form a partition, as they do in the integers, but that is wrong; most functions are neither even nor odd, and there is one function that is both. I think what happened here is that first an “even” polynomial was defined to be a polynomial whose terms all have even exponents (such as ) and similarly an “odd” polynomial. This already wasn't great, because most polynomials are neither even nor odd. But it was not too terrible. And at least the meaning is simple and easy to remember. (Also you might like the product of an even and an odd polynomial to be even, as it is for even and odd integers, but it isn't, it's always odd. As far as evenandoddness is concerned the multiplication of the polynomials is analogous to addition of integers, and to get anything like multiplication you have to compose the polynomials instead.)
And once that step had been taken it was natural to extend the idea from polynomials to functions generally: odd polynomials have the property that , so let's say that an odd function is one with that property. If an odd function is analytic, you can expand it as a Taylor series and the series will have only odddegree terms even though it isn't a polynomial.
There were two parts to that journey, and each one made some sense by itself, but by the time we got to the end it wasn't so easy to see where we started from. Unfortunate.
I tried a web search for bad mathematics terminology and the top hit was this old blog article by my old friend Walt. (Not you, Walt, another Walt.) Walt suggests that
the worst terminology in all of mathematics may be that of and sets…
I can certainly get behind that nomination. I have always hated those terms. Not only does it partake of the dubious openclosed terminology I complained of earlier (you'll see why in a moment), but all four letters are abbreviations for words in other languages, and not the same language. A set is one that is a countable intersection of open sets. The is short for Gebiet, which is German for an open neighborhood, and the is for durchschnitt, which is German for set intersection. And on the other side of the Ruhr Valley, an set, which is a countable union of closed sets, is from French fermé (“closed”) and for somme (set union). And the terms themselves are completely opaque if you don't keep track of the ingredients of this unwholesome GermanFrenchGreek stew.
This put me in mind of a similarly obscure pair that I always mix up, the type I and type II errors. One if them is when you fail to ignore something insignificant, and the other is when you fail to notice something significant, but I don't remember which is which and I doubt I ever will.
But the one I was thinking about today that kicked all this off is, I think, worse than any of these. It's really shameful, worthy to rank with cucumbers being berries and with Stonhenge not being a henge.
These are all examples of elliptic curves:
These are not:
That's right, ellipses are not elliptic curves, and elliptic curves are not elliptical. I don't know who was responsible for this idiocy, but if I ever meet them I'm going to kick them in the ass.
Often, someone wants to exhaling the difference between a leftfold and a rightfold, i.e. foldl
and foldr
in Haskell, you see a picture like the following
This is taken from the recently published and very nice “foldilocks” tutorial by Ayman Nadeem, but I have seen similar pictures before.
I always thought that something is not quite right about them, in particular the foldr
. I mean, they are correct, and while the foldl
one clearly conveys the right intuition, the foldr
doesn’t quite: it looks as if the computer would fast forward to the end of the list, and then start processing it. But that does not capture the essence of foldr
, which also starts at the beginning of the list, by applying its argument lazily.
And therefore, this is how I would draw this graph:
This way (at least to people from a lefttoright toptobottom culture), it becomes more intuitive that with foldr
, you are first looking at an application of the combinator to the first element, and then possibly more.
In my previous post about my basic setup for solving competitive programming problems with Haskell, I (somewhat provocatively) used lists to represent pairs, and wrote a partial function to process them. Commenter Yom responded with a proposed alternative that was (less) partial. I was glad for the comment, because it gave me a good opportunity to think more about why I wrote the code in the way I did, and how it fits into larger issues of good coding practices and the reasons behind them.
What is good code style? You probably have some opinions about this. In fact, I’m willing to bet you might even have some very strong opinions about this; I know I do. Whether consciously or not, we tend to frame good coding practices as a moral issue. Following good coding practices makes us feel virtuous; ignoring them makes us feel guilty. I can guess that this is why Yom said “I don’t think I could bring myself to be satisfied with partial functions” [emphasis added]. And this is why we say “good code style”, not “optimal” or “rational” or “best practice” code style.
Why is this? Partly, it is just human: we like to have right and wrong ways to do everything (load the dishwasher, enforce grammar “rules”, use a text editor, etc.), and we naturally create and enforce community standards via subtle and notsosubtle social cues. In the case of coding practices, I think we also sometimes do it consciously and explicitly, because the benefits can be unintuitive or only manifest in the long term. So the only way to get our students—or ourselves—to follow practices that are in our rational selfinterest is by framing them in moral terms; rational arguments do not work in and of themselves. For example, I cannot get my students to write good comments by explaining to them how it will be beneficial to them in the future. It seems obvious to them that they will remember perfectly how their code works in the future, so any argument claiming the opposite falls on deaf ears. The only way to get them to write comments is to make it a moral issue: they should feel bad (i.e. lose points, lose respect, feel like they are “taking shortcuts”) if they don’t. Of course I do this “for their own good”: I trust that in the future they will come to appreciate this ingrained behavior on its own merits.
The problem is that things framed in moral terms become absolutes, and it is then difficult for us to assess them rationally. My students will never be able to write a [function without comments, partial function, goto
statement, …] without feeling bad about it, and they probably won’t stop to think about why.
I ask again: what is good code style—and why? I have identified a few reasons for various “good” coding practices. Ultimately, we want our code to have properties such as:
String
vs Text
or ByteString
).Even in scenarios where one might initially think these properties are not needed (e.g. writing a oneoff script for some sysadmin or data processing task), they often end up being important anyway (e.g. that oneoff script gets copied and mutated until it becomes a key piece of some production system). And this is exactly one of the reasons for framing good coding style in moral terms! I won’t write comments or use good function decomposition in my oneoff script just because I know, rationally, that it might end up in a production system someday. (I “know” that this particular script really is just a oneoff script!) But I just might follow good coding practices anyway if I feel bad about not doing it (e.g. I would feel ashamed if other people saw it).
It seems to me that most things we would typically think of as good code style are geared towards producing code with some or all of the above properties (and perhaps some other properties as well), and most scenarios in which code is being written really do benefit from these properties.
But what if there was a scenario where these properties are actually, concretely of no benefit? As you can probably guess, I would argue that competitive programming is one such scenario:
So what do we care about?
The combination of optimizing for speed and not caring about things like robustness, maintainability, and efficiency leads to a number of “best practices” for competitive programming that fly in the face of typical standards. For example:
read
, head
, tail
, fromJust
, and so on, even though I would almost never use these functions in other contexts. This is also why I used a partial function that was only defined on lists of length two in my previous post (though as I argue in a comment, perhaps it’s not so much that the function is partial as that its type is too big).String
for text processing, even though something like Text
or ByteString
(depending on the scenario) would be faster or more robust. (The exception is problems with a large amount of I/O, when the overhead of String
really does become a problem; more on this in a future post.)foldr
, foldl'
, and scanl
, I don’t bother with generic recursion schemes; I tend to just write lots of explicit recursion, which I find quicker to write and easier to debug.There are similar things I do in Java as well. It has taken me quite a while to become comfortable with these things and stop feeling bad about them, and I think I finally understand why.
I’m not sure I really have a main point, other than to encourage you to consider your coding practices, and why you consider certain practices to be good or bad (and whether it depends on the context!).
Next time, back to your regularly scheduled competitive programming tips!
In the last couple weeks, we've been slowly building up our maze game. For instance, last week, we added the ability to serialize our mazes. But software development is never a perfect process! So it's not uncommon to revisit some past decisions and come up with better approaches. This week we're going to address a particular code wart in the random maze generation code.
Right now, we store our Maze
as a mapping from Locations
to CellBoundaries
items. We do this using Data.Map
. The Map.lookup
function returns a Maybe
result, since it might not exist. But most of the time we accessed a location, we had good reason to believe that it would exist in the map. This led to several instances of the following idiom:
fromJust $ Map.lookup location boundsMap
Using a function like fromJust
is a code smell, a sign that we could be doing something better. This week, we're going to change this structure so that it uses the Array
type instead from Data.Array
. It captures our idiomatic definitions better. We'll use "Compile Driven Development" to make this change. We won't need to hunt around our code to figure out what's wrong. We'll just make type changes and follow the compiler errors!
To learn more about compile driven development and the mental part of Haskell, read our Haskell Brain series. It will help you think about the language in a different way. So it's a great tool for beginners!
Another good resource for this article is to look at the Github repository for this project. The complete code for this part is on the part3
branch. You can consult this commit to see all the changes we make in migrating to arrays.
To start with, we should make sure our code uses the following type synonym for our maze type:
type Maze = Map.Map Location CellBoundaries
Now we can observe the power of type synonyms! We'll make a change in this one type, and that'll update all the instances in our code!
import qualified Data.Array as Array
type Maze = Array.Array Location CellBoundaries
Of course, this will cause a host of compiler issues! But most of these will be pretty simple to fix. But we should be methodical and start at the top. The errors begin in our parsing code. In our mazeParser
, we use Map.fromList
to construct the final map. This requires the pairs of Location
and CellBoundaries
.
mazeParser :: (Int, Int) > Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
…
return $ Map.fromList (cellSpecToBounds <$> (concat rows))
The Array
library has a similar function, Array.array
. However, it also requires us to provides the bounds for the Array
. That is, we need the "min" and "max" locations in a tuple. But these are easy, since we have the dimensions as an input!
mazeParser :: (Int, Int) > Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
…
return $ Array.array
((0,0), (numColumns  1, numRows  1))
(cellSpecToBounds <$> (concat rows))
Our next issue comes up in the dumpMaze
function. We use Map.mapKeys
to transpose the keys of our map. Then we use Map.toList
to get the association list back out. Again, all we need to do is find the comparable functions for arrays to update these.
To change the keys, we want the ixmap
function. It does the same thing as mapKeys
. As with Array.array
, we need to provide an extra argument for the min and max bounds. We'll provide the bounds of our original maze.
transposedMap = Array.ixmap (Array.bounds maze) (\(x, y) > (y, x)) maze
A few lines below, we can see the usage of Map.toList
when grouping our pairs. All we need instead is Array.assocs
cellsByRow :: [[(Location, CellBoundaries)]]
cellsByRow = groupBy
(\((r1, _), _) ((r2, _), _) > r1 == r2)
(Array.assocs transposedMap)
That's all the changes for the basic parsing code. Now let's move on to the random generation code. This is where we have a lot of those yucky fromJust $ Map.lookup
calls. We can now instead use the "bang" operator, Array.!
to access those elements!
findCandidates currentLocation@(x, y) bounds visited =
let currentLocBounds = bounds Array.! currentLocation
...
Of course, it's possible for an "index out of bounds" error to occur if we aren't careful! But our code should reflect the fact that we expect all these calls to work. After fixing the initial call, we need to change each directional component. Here's what the first update looks like:
findCandidates currentLocation@(x, y) bounds visited =
let currentLocBounds = bounds Array.! currentLocation
upLoc = (x, y + 1)
maybeUpCell = case (upBoundary currentLocBounds,
Set.member upLoc visited) of
(Wall, False) > Just
( upLoc
, (bounds Array.! upLoc) {downBoundary =
AdjacentCell currentLocation}
, currentLocation
, currentLocBounds {upBoundary =
AdjacentCell upLoc}
)
_ > Nothing
We've replaced Map.lookup
with Array.!
in the second part of the resulting tuple. The other three directions need the same fix.
Then there's one last change in the random generation section! When we choose a new candidate, we currently need two calls to Map.insert
. But arrays let us do this with one function call. The function is Array.//
, and it takes a list of association updates. Here's what it looks like:
chooseCandidate candidates = do
(SearchState gen currentLocs boundsMap visited) < get
...
 Previously used Map.insert twice!!!
let newBounds = boundsMap Array.//
[(chosenLocation, newChosenBounds),
(prevLocation, newPrevBounds)]
let newVisited = Set.insert chosenLocation visited
put (SearchState
newGen
(chosenLocation : currentLocs)
newBounds
newVisited)
Now our final remaining issues are within the Runner
code. But they're all similar fixes to what we saw in the parsing code.
In our sample boundariesMap
, we once again replace Map.fromList
with Array.array
. Again, we add a parameter with the bounds of the array. Then, when drawing the pictures for our cells, we need to use Array.assocs
instead of Map.toList
.
For the final change, we need to update our input handler so that it accesses the array properly. This is our final instance of fromJust $ Map.lookup
! We can replace it like so:
inputHandler :: Event > World > World
inputHandler event w = case event of
...
where
cellBounds = (worldBoundaries w) Array.! (playerLocation w)
And that's it! Now our code will compile and work as it did before!
There's a pretty big inefficiency with our new approach. Whereas Map.insert
can give us an updated map in log(n)
time, the Array.//
function isn't so nice. It has to create a complete copy of the array, and we run that function many times! How can we fix this? Next week, we'll find out! We'll use the Mutable Array interface to make it so that we can update our array inplace! This is super efficient, but it requires our code to be more monadic!
For some more ideas of cool projects you can do in Haskell, download our Production Checklist! It goes through a whole bunch of libraries on topics from database management to web servers!
Summary: The foldr
function seems simple, but is actually very complex, with lots of layers. This post dives through the layers.
The foldr
function takes a list and replaces all :
(cons) and []
(nil) values with functions and a final value. It's available in the Haskell Prelude
and described on Wikipedia. As some examples:
sum = foldr (+) 0
map f = foldr (\x xs > f x : xs) []
But the simple foldr
described on Wikipedia is many steps away from the one in the Haskell Prelude
. In this post we'll peel back the layers, learning why foldr
is a lot more complicated under the hood.
Layer 1: Wikipedia definition
The definition on Wikipedia is:
foldr :: (a > b > b) > b > [a] > b
foldr f z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
This recursive definition directly describes what foldr
does. Given a list [1,2,3]
we get f 1 (f 2 (f 3 z))
.
Layer 2: Static argument transformation
The problem with this definition is that it is recursive, and GHC doesn't like to inline recursive functions, which prevents a lot of optimisation. Taking a look at sum
, it's a real shame that operations like (+)
are passed as opaque higherorder functions, rather than specialised to the machine instruction ADD
. To solve that problem, GHC defines foldr
as:
foldr f z = go
where go [] = z
go (x:xs) = f x (go xs)
The arguments f
and z
are constant in all sucessive calls, so they are lifted out with a manually applied static argument transformation.
Now the function foldr
is no longer recursive (it merely has a where
that is recursive), so foldr
can be inlined, and now +
can meet up with go
and everything can be nicely optimised.
Layer 3: Inline later
We now have foldr
that can be inlined. However, inlining foldr
is not always a good idea. In particular, GHC has an optimisation called list fusion based on the idea that combinations of foldr
and build
can be merged, sometimes known as shortcut deforestation. The basic idea is that if we see foldr
applied to build
we can get rid of both (see this post for details). We remove foldr
using the GHC rewrite rule:
{# RULES "my foldr/build" forall g k z. foldr k z (build g) = g k z #}
The most interesting thing about this rule (for this post at least!) is that it matches foldr
by name. Once we've inlined foldr
we have thrown away the name, and the rule can't fire anymore. Since this rule gives significant speedups, we really want it to fire, so GHC adds an extra pragma to foldr
:
{# INLINE [0] foldr #}
This INLINE
pragma says don't try and inline foldr
until the final stage of the compiler, but in that final stage, be very keen to inline it.
Layer 4: More polymorphism
However, the foldr
function in the Prelude
is not the one from GHC.List
, but actually a more general one that works for anything Foldable
. Why limit yourself to folding over lists, when you can fold over other types like Set
. So now foldr
is generailsed from []
to t
with:
foldr :: Foldable t => (a > b > b) > b > t a > b
Where foldr
on []
is GHC.List.foldr
.
Layer 5: A default implementation
But foldr
is actually in the type class Foldable
, not just defined on the outside. Users defining Foldable
can define only foldr
and have all the other methods defined for them. But they can equally define only foldMap
, and have an implicit version of foldr
defined as:
foldr :: (a > b > b) > b > t a > b
foldr f z t = appEndo (foldMap (Endo . f) t) z
Where Endo
is defined as:
newtype Endo = Endo {appEndo :: a > a}
instance Monoid (Endo a) where
mempty = Endo id
Endo a <> Endo b = Endo (a . b)
The function foldMap f
is equivalent to mconcat . map f
, so given a list [1,2,3]
the steps are:
map (Endo . f)
to each element to get [Endo (f 1), Endo (f 2), Endo (f 3)]
.mconcat
to the list to get Endo (f 1) <> Endo (f 2) <> Endo (f 3)
.<>
definitions to get Endo (f 1 . f 2 . f 3)
.appEndo
at the beginning and z
at the end for (f 1 . f 2 . f 3) z
..
to give f 1 (f 2 (f 3 z))
, which is what we had at layer 1.Layer 6: Optimising the default implementation
The real default implementation of foldr
is:
foldr f z t = appEndo (foldMap (Endo #. f) t) z
Note that the .
after Endo
has become #.
. Let's first explain why it's correct, then why it might be beneficial. The definition of #.
is:
(#.) :: Coercible b c => (b > c) > (a > b) > (a > c)
(#.) _ = coerce
Note that it has the same type as .
(plus a Coercible
constraint), but ignores it's first argument entirely. The coerce
function transforms a value of type a
into a value of type b
with zero runtime cost, provided they have the same underlying representation. Since Endo
is a newtype
, that means Endo (f 1)
and f 1
are implemented identically in the runtime, so coerce
switches representation "for free". Note that the first argument to #.
only serves to pin down the types, so if we'd passed an interesting function as the first argument it would have been ignored.
Of course, in normal circumstances, a newtype
is free anyway, with no runtime cost. However, in this case we don't have a newtype
, but a function application with a newtype
. You can see the gory details in GHC ticket 7542, but at one point this impeeded other optimisations.
I tried a simulated version of foldr
and found that if GHC can't tell that []
is the Foldable
the code looks pretty bad, but if it can, at O1
and above, the two implementations are 100% equialent (to the point that common subexpression elimination makes them actually the same). It's possible this final layer is a vestigial optimisation, or perhaps it's still important in some circumstances.
Up until a few days ago I sort of mixed my private and work web browsing, e.g. I connected my private LastPass account to my work account. Then I heard about BitWarden and wanted to try it out. A quick export from LastPass and import to BitWarden later I realised that I really ought to try to split my private browsing from my work browsing too – Firefox for the former and Chromium for the latter.
After about a day of this I found that having a single default browser was a bit of a limitation. Inspired by behaviour on my Android phone I started looking for a browser choosing. Unfortunately I didn’t find anything for Linux/Gnome. With the help from a Reddit post I ended putting together a package for Arch Linux.
I gave it the name browserchooser.
Hello all,
It looks like my old cl.indiana.edu/~wren is dead. I'm not sure why exactly (glancing through emails I couldn't find anything relevant); but it looks like all the nonfaculty accounts on that machine have gone away, so I won't take it personally.
But fear not, for at long last I have decided to get my own domain: wrengr.org! I've corrected the links on the columbicubiculomania posts, so you should be able to get the pdfs again. If you notice any other broken links, please do drop me a line.
As part of the move I've also decided to finalize the switch from Darcs to GitHub for all my Hackage projects. The impedence cost of merging github pullrequests back to darcs has been a bit much, and I've been using git at work, so, much as I love darcs and hate git, I think it's finally time. I've pushed out a few package updates already, and will try to get the rest out as soon as I can.
Ever since community.haskell.org has died, I've defaulted back to using my cpan email for Haskell stuff. This is clearly suboptimal, but I'm one of those old curmudgeons who hates giving out the direct address for their personal email, and cpan seems like the only one still providing forwarding addresses these days. The webhost for my new domainname, alas, doesn't offer a forwardingonly plan so the only way to use them would be to spring for a fullblown smtp plan, which is a bit pricy for a single forwarding address. I'll prolly end up doing it eventually, but it'll take a while to justify to myself. Until then, please bear with the holding pattern of using the cpan address.
What is the shed in “watershed”? Is it a garden shed? No.
I guessed that it meant a piece of land that sheds water into some stream or river. Wrong!
The Big Dictionary says that this shed is:
The parting made in the hair by combing along the top of the head.
This meaning of “shed” fell out of use after the end of the 17th century.
The slides are at http://bit.ly/2KYpqig.
I am the coach of my school’s competitive programming team and enjoy solving problems on Open Kattis. Since Kattis accepts submissions in a wide variety of languages (including Haskell, OCaml, Rust, Common Lisp, and even Prolog), I often enjoy submitting solutions in Haskell. Of the 946 problems I have solved on Kattis^{1}, I used Haskell for 607 of them (I used Java for the rest, except for one in C++).
After solving so many problems in Haskell, by now I’ve figured out some patterns that work well, identified some common pitfalls, developed some nice little libraries, and so forth. I thought it would be fun to write a series of blog posts sharing my experience for the benefit of others—and because I expect I will also learn things from the ensuing discussion!
As a basic running example I’ll use the same example problem that Kattis uses in its help section, namely, A Different Problem. In this problem, we are told that the input will consist of a number of pairs of integers between and , one pair per line, and we should output the absolute value of the difference between each pair. The given example is that if the input looks like this:
10 12
71293781758123 72784
1 12345677654321
then our program should produce output that looks like this:
2
71293781685339
12345677654320
Kattis problems are always set up this way, with input of a specified format provided on standard input, and output to be written to standard output. To do this in Haskell, one might think we will need to use things like getLine
and putStrLn
to read and write the input. But wait! There is a much better way. Haskell’s standard Prelude
has a function
interact :: (String > String) > IO ()
It takes a pure String > String
function, and creates an IO
action which reads from standard input, feeds the input to the function, and then writes the function’s output to standard output. It uses lazy IO, so the reading and writing can be interleaved with computation of the function—a bit controversial and dangerous in general, but absolutely perfect for our use case! Every single Kattis problem I have ever solved begins with
main = interact $ ...
(or the equivalent for ByteString
, more on that in a future post) and that is the only bit of IO
in the entire program. Yay!
So now we need to write a pure function which transforms the input into the output. Of course, in true Haskell fashion, we will do this by constructing a chained pipeline of functions to do the job incrementally. The general plan of attack (for any Kattis problem) is as follows:
String
input into some more semantically meaningful representation—typically using a combination of functions like lines
, words
, read
, map
, and so on (or more sophisticated tools—see a later post).show
, unwords
, unlines
, and so on.Idiomatic Haskell uses the composition operator (.)
to combine functions. However, when solving competitive programming problems, I much prefer to use the reverse composition operator, (>>>)
from Control.Arrow
(that is, (>>>) = flip (.)
). The reason is that since I often end up constructing long function pipelines, I want to be able to think about the process of transforming input to output and type from left to right at the same time; having to add functions from right to left would be tedious.
So here’s my solution to A Different Problem:
main = interact $
lines >>> map (words >>> map read >>> solve >>> show) >>> unlines
solve :: [Integer] > Integer
solve [a,b] = abs (a  b)
A few notes:
map
.solve
function in this case, but I prefer to split it out explicitly in order to specify its type, which both prevents problems with read
/show
ambiguity and also serves as a sanity check on the parsing and formatting code.Int
instead of Integer
(maxBound :: Int64
is a bit more than , plenty big enough for inputs up to ), but there would be no benefit to doing so. If we use Integer
we don’t even have to consider potential problems with overflow.And one last thing: I said we were going to parse the input into a “semantically meaningful representation”, but I lied a teensy bit: the problem says we are going to get a pair of integers but I wrote my solve
function as though it takes a list of integers. And even worse, my solve
function is partial! Why did I do that?
The fact is that I almost never use actual Haskell tuples in my solutions, because they are too awkward and inconvenient. Representing homogeneous tuples as Haskell lists of a certain known length allows us to read and process “tuples” using standard functions like words
and map
, to combine them using zipWith
, and so on. And since we get to assume that the input always precisely follows the specification—which will never change—this is one of the few situations where, in my opinion, we are fully justified in writing partial functions like this if it makes the code easier to write. So I always represent homogeneous tuples as lists and just pattern match on lists of the appropriate (known) length. (If I need heterogeneous tuples, on the other hand, I create an appropriate data
type.)
Of course I’ve only scratched the surface here—I’ll have a lot more to say in future posts—but this should be enough to get you started! I’ll leave you with a few very easy problems, which can each be done with just a few lines of Haskell:
Of course you can also try solving any of the other problems (as of this writing, over 2400 of them!) on Kattis as well.
We’re ramping up for the Stack 2 release, which contains a number of changes. (If you want more information, check out the changelog.) I’m not going to be covering all of those changes in this blog post. Instead, today, I want to talk about what the release process will look like, both for Stack itself and Stackage.
Check Out Our Haskell Success Program!
We’re ramping up for the Stack 2 release, which contains a number of changes. (If you want more information, check out the changelog.) I’m not going to be covering all of those changes in this blog post. Instead, today, I want to talk about what the release process will look like, both for Stack itself and Stackage.
Check Out Our Haskell Success Program!
Last week we improved our game so that we could solve additional random mazes after the first. This week, we'll step away from the randomness and look at how we can serialize our mazes. This will allow us to have a consistent and repeatable game. It will also enable us to save the game state later.
We'll be using the Megaparsec library as part of this article. If you aren't familiar with that (or parsing in Haskell more generally), check out our Parsing Series!
The serialized representation of our maze doesn't need to be human readable. We aren't trying to create an ASCII art style representation. That said, it would be nice if it bore some semblance to the actual layout. There are a couple properties we'll aim for.
First, it would be good to have one character represent one cell in our maze. This dramatically simplifies any logic we'll use for serializing back and forth. Second, we should layout the cell characters in a way that matches the maze's appearance. So for instance, the top left cell should be the first character in the first row of our string. Then, each row should appear on a separate line. This will make it easier to avoid silly errors when coming up with test cases.
So how can we serialize a single cell? We could observe that for each cell, we have sixteen possible states. There are 4 sides, and each side is either a wall or it is open. This suggests a hexadecimal representation.
Let's think of the four directions as being 4 bits, where if there is a wall, the bit is set to 1, and if it is open, the bit is set to 0. We'll order the bits as uprightdownleft, as we have in a couple other areas of our code. So we have the following example configurations:
0
.1111 = F
.1010 = A
.0101 = 5
.With that in mind, we can create a small 5x5 test maze with the following representation:
98CDF
1041C
34775
90AA4
32EB6
And this ought to look like so:
This serialization pattern lends itself to a couple helper functions we'll use later. The first, charToBoundsSet
, will take a character and give us four booleans. These represent the presence of a wall in each direction. First, we convert the character to the hex integer. Then we use patterns about hex numbers and where the bits lie. For instance, the first bit is only set if the number is at least 8. The last bit is only set for odd numbers. This gives us the following:
charToBoundsSet :: Char > (Bool, Bool, Bool, Bool)
charToBoundsSet c =
( num > 7,
, num `mod` 8 > 3
, num `mod` 4 > 1
, num `mod` 2 > 0
)
Then, we also want to go backwards. We want to take a CellBoundaries
item and convert it to the proper character. We'll look at each direction. If it's an AdjacentCell
, it contributes nothing to the final Int
value. But otherwise, it contributes the hex digit value for its place. We add these up and convert to a char with intToDigit
:
cellToChar :: CellBoundaries > Char
cellToChar bounds =
let top = case upBoundary bounds of
(AdjacentCell _) > 0
_ > 8
let right = case rightBoundary bounds of
(AdjacentCell _) > 0
_ > 4
let down = case downBoundary bounds of
(AdjacentCell _) > 0
_ > 2
let left = case leftBoundary bounds of
(AdjacentCell _) > 0
_ > 1
in toUpper $ intToDigit (top + right + down + bottom)
We'll use both of these functions in the next couple parts.
Let's move on now to determining how we can take a maze and represent it as Text
. For this part, let's first apply a type synonym on our maze type:
type Maze = Map.Map Location CellBoundaries
dumpMaze :: Maze > Text
dumpMaze = ...
First, let's imagine we have a single row worth of locations. We can convert that row to a string easily using our helper function from above:
dumpMaze = …
where
rowToString :: [(Location, CellBoundaries)] > String
rowToString = map (cellToChar . snd)
Now we'd like to take our maze map and group it into the different rows. The groupBy
function seems appropriate. It groups elements of a list based on some predicate. We'd like to take a predicate that checks if the rows of two elements match. Then we'll apply that against the toList
representation of our map:
rowsMatch :: (Location, CellBoundaries) > (Location, CellBoundaries) > Bool
rowsMatch ((_, y1), _) ((_, y2), _) = y1 == y2
We have a problem though because groupBy
only works when the elements are next to each other in the list. The Map.toList
function will give us a columnmajor ordering. We can fix this by first creating a transposed version of our map:
dumpMaze maze = …
where
transposedMap :: Maze
transposedMap = Map.mapKeys (\(x, y) > (y, x)) maze
Now we can go ahead and group our cells by row:
dumpMaze maze = …
where
transposedMap = …
cellsByRow :: [[(Location, CellBoundaries)]]
cellsByRow = groupBy (\((r1, _), _) ((r2, _), _) > r1 == r2)
(Map.toList transposedMap)
And now we can complete our serialization function! We get the string for each row, and combine them with unlines
and then pack
into a Text
.
dumpMaze maze = pack $ (unlines . reverse) (rowToString <$> cellsByRow)
where
transposedMap = …
cellsByRow = …
rowToString = ...
As a last trick, note we reverse
the order of the rows. This way, we get that the top row appears first, rather than the row corresponding to y = 0
.
Now that we can dump our maze into a string, we also want to be able to go backwards. We should be able to take a properly formatted string and turn it into our Maze
type. We'll do this using the Megaparsec
library, as we discussed in part 4 of our series on parsing in Haskell. So we'll create a function in the Parsec
monad that will take the dimensions of the maze as an input:
import qualified Text.Megaparsec as M
mazeParser :: (Int, Int) > M.Parsec Void Text Maze
mazeParser (numRows, numColumns) = ...
We want to parse the input into a format that will match each character up with its location in the (x,y)
coordinate space of the grid. This means parsing one row at a time, and passing in a counter argument. To make the counter match with the desired row, we'll use a descending list comprehension like so:
mazeParser (numRows, numColumns = do
rows < forM [(numRows  1), (numRows  2)..0] $ \i > do
...
For each row, we'll parse the individual characters using M.hexDigit
and match them up with a column index:
mazeParser (numRows, numColumns = do
rows < forM [0..(numRows  1)] $ \i > do
(columns :: [(Int, Char)]) <
forM [0..(numColumns  1)] $ \j > do
c < M.hexDigitChar
return (j, c)
...
We conclude the parsing of a row by reading the newline character. Then we make the indices match the coordinates in discrete (x,y) space. Remember, the "column" should be the first item in our location.
mazeParser (numRows, numColumns = do
(rows :: [[(Location, Char)]]) <
forM [0..(numRows  1)] $ \i > do
columns < forM [0..(numColumns  1)] $ \j > do
c < M.hexDigitChar
return (j, c)
M.newline
return $ map (\(col, char) > ((col, i), char)) columns
...
Now we'll need a function to convert one of these Location, Char
pairs into CellBoundaries
. For the most part, we just want to apply our charToBoundsSet
function and get the boolean values. Remember these tell us if walls are present or not:
mazeParser (numRows, numColumns = do
rows < …
where
cellSpecToBounds :: (Location, Char) > (Location, CellBoundaries)
cellSpecToBounds (loc@(x, y), c) =
let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) =
charToBoundsSet c
...
Now it's a matter of applying a case by case basis in each direction. We just need a little logic to determine, in the True
case, if it should be a Wall
or a WorldBoundary
. Here's the implementation:
cellSpecToBounds :: (Location, Char) > (Location, CellBoundaries)
cellSpecToBounds (loc@(x, y), c) =
let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) =
charToBoundsSet c
topCell = if topIsWall
then if y + 1 == numRows
then WorldBoundary
else Wall
else (AdjacentCell (x, y + 1))
rightCell = if rightIsWall
then if x + 1 == numColumns
then WorldBoundary
else Wall
else (AdjacentCell (x + 1, y))
bottomCell = if bottomIsWall
then if y == 0
then WorldBoundary
else Wall
else (AdjacentCell (x, y  1))
leftCell = if leftIsWall
then if x == 0
then WorldBoundary
else Wall
else (AdjacentCell (x  1, y))
in (loc, CellBoundaries topCell rightCell bottomCell leftCell)
And now we can complete our parsing function by applying this helper over all our rows!
mazeParser (numRows, numColumns = do
(rows :: [[(Location, Char)]]) <
forM [0..(numRows  1)] $ \i > do
columns < forM [0..(numColumns  1)] $ \j > do
c < M.hexDigitChar
return (j, c)
M.newline
return $ map (\(col, char) > ((col, i), char)) columns
return $ Map.fromList (cellSpecToBounds <$> (concat rows))
where
cellSpecToBounds = ...
This wraps up our latest part on serializing maze definitions. The next couple parts will still be more codefocused. We'll look at ways to improve our data structures and an alternate way of generating random mazes. But after those, we'll get back to adding some new game features, such as wandering enemies and combat!
To learn more about serialization, you should read our series on parsing. You can also download our Production Checklist for more ideas!
When reading about Comonadic builders the other day I reacted to this comment:
The
comonad
package has the Tracednewtype
wrapper around the function(>)
. TheComonad
instance for thisnewtype
gives us the desired behaviour. However, dealing with thenewtype
wrapping and unwrapping makes our code noisy and truly harder to understand, so let’s use theComonad
instance for the arrow(>)
itself
So, just for fun I thought I work out the “noisy and truly harder” bits.
To begin with I needed two language extensions and two imports
{# LANGUAGE OverloadedStrings#}
{# LANGUAGE RecordWildCards #}
import Control.Comonad.Traced
import Data.Text
After that I could copy quite a bit of stuff directly from the other post
Settings
definitionSemigroup
instance for Settings
Monoid
instance for Settings
Project
definitionAfter this everything had only minor changes. First off the ProjectBuilder
type had to be changed to
With that done the types of all the functions can actually be left as they are, but of course the definitions have to modified. However, it turned out that the necessary modifications were rather smaller than I had expected. First out buildProject
which I decided to call buildProjectW
to make it possible to keep the original code and the new code in the same file without causing name clashes:
buildProjectW :: Text > ProjectBuilder
buildProjectW = traced . buildProject
where
buildProject projectName Settings{..} = Project
{ projectHasLibrary = getAny settingsHasLibrary
, projectGitHub = getAny settingsGitHub
, projectTravis = getAny settingsTravis
, ..
}
The only difference is the addition of traced .
to wrap it up in the newtype
, the rest is copied straight from the original article.
The two simple project combinator functions, which I call hasLibraryBW
and gitHubBW
, needed a bit of tweaking. In the original version combinators take a builder
which is an ordinary function, so it can just be called. Now however, the function is wrapped in a newtype
so a bit of unwrapping is necessary:
hasLibraryBW :: ProjectBuilder > Project
hasLibraryBW builder = runTraced builder $ mempty { settingsHasLibrary = Any True }
gitHubBW :: ProjectBuilder > Project
gitHubBW builder = runTraced builder $ mempty { settingsGitHub = Any True }
Once again it’s rather small differences from the code in the article.
As for the final combinator, which I call travisBW
, actually needed no changes at all. I only rewrote it using a when
clause, because I prefer that style over let
:
travisBW :: ProjectBuilder > Project
travisBW builder = project { projectTravis = projectGitHub project }
where
project = extract builder
Finally, to show that this implementation hasn’t really changed the behaviour
λ extract $ buildProjectW "travis" =>> travisBW
Project { projectName = "travis"
, projectHasLibrary = False
, projectGitHub = False
, projectTravis = False
}
λ extract $ buildProjectW "githubtravis" =>> gitHubBW =>> travisBW
Project { projectName = "githubtravis"
, projectHasLibrary = False
, projectGitHub = True
, projectTravis = True
}
λ extract $ buildProjectW "travisgithub" =>> travisBW =>> gitHubBW
Project { projectName = "travisgithub"
, projectHasLibrary = False
, projectGitHub = True
, projectTravis = True
}
Blog post on my new site.
In Haskell, one can assert the type of an identifier in an expression by attaching a type annotation with "::". For infix operators, one can attach such a type annotation by rewriting it in function notation: surround the operator with parentheses and move it from infix to prefix position:
three :: Int;
three = ((+)::Int > Int > Int) 1 2;
It seems impossible to attach a type annotation to an operator while keeping it in infix notation. This is a bit problematic because a common use of an infix operator is to use many of them in series, e.g., 1 + 2 + 3 + 4, but it is awkward to rewrite a long series of uses of an infix operator into prefix notation.
ten = (+) ((+) ((+) 1 2) 3) 4
Tangentially, for addition, we could do foldl' (+) 0 [1, 2, 3, 4], but fold won't work with operators like (.), ($), or (>>=) which take operands of many different types within a series expression. Previously: syntactic fold and fold (.) via Data.Dynamic.
The motivation was, if one is using a polymorphic function or operator, it may be pedagogically helpful to attach a type annotation at the point of use so the reader knows what "version" of a polymorphic function is being invoked. The annotation gives the concrete types at the point of use, rather than the polymorphic type with type variables that library documentation will give you.
Cubical Agda has just come out, and Iâ€™ve been playing around with it for a bit. Thereâ€™s a bunch of info out there on the theory of cubical types, and Homotopy Type Theory more generally (cubical type theory is kind of like an â€œimplementationâ€� of Homotopy type theory), but I wanted to make a post demonstrating cubical Agda in practice, and one of its cool uses from a programming perspective.
I donâ€™t really know! Cubical type theory is quite complex (even for a type theory), and Iâ€™m not nearly qualified to properly explain it. In lieu of a proper firstprinciples explanation, then, Iâ€™ll try and give a few examples of how it differs from normal Agda, before moving on to the main example of this post.
{# OPTIONS cubical #} open import ProbabilityModule.Semirings module ProbabilityModule.Monad {s} (rng : Semiring s) where open import Cubical.Core.Everything open import Cubical.Relation.Everything open import Cubical.Foundations.Prelude hiding (_â‰¡âŸ¨_âŸ©_) renaming (_âˆ™_ to _Í¾_) open import Cubical.HITs.SetTruncation open import ProbabilityModule.Utils
extensionality : âˆ€ {f g : A â†’ B} â†’ (âˆ€ x â†’ f x â‰¡ g x) â†’ f â‰¡ gItâ€™s emblematic of a wider problem in Agda: we canâ€™t say â€œtwo things are equal if they always behave the sameâ€�. Infinite types, for instance (like streams) are often only equal via bisimulation: we canâ€™t translate this into normal equality in standard Agda. Cubical type theory, though, has a different notion of â€œequalityâ€�, which allow a wide variety of things (including bisimulations and extensional proofs) to be translated into a proper equality
extensionality = funExt
So those are two useful examples, but the most interesting use Iâ€™ve seen so far is the following:
module NormalList where data List {a} (A : Set a) : Set a where [] : List A _âˆ·_ : A â†’ List A â†’ List A
They allow us to add new equations to a type, as well as constructors. To demonstrate what this means, as well as why youâ€™d want it, Iâ€™m going to talk about free objects.
Very informally, a free object on some algebra is the minimal type which satisfies the laws of the algebra. Lists, for instance, are the free monoid. They satisfy all of the monoid laws ($<semantics>\xe2\u20ac\xa2<annotation\; encoding="application/xtex">\backslash bullet</annotation></semantics>$ is ++
and $<semantics>\mathrm{\xcf\mu}<annotation\; encoding="application/xtex">\backslash epsilon</annotation></semantics>$ is []
):
$$<semantics>(x\xe2\u20ac\xa2y)\xe2\u20ac\xa2z=x\xe2\u20ac\xa2(y\xe2\u20ac\xa2z)<annotation\; encoding="application/xtex">(x\; \backslash bullet\; y)\; \backslash bullet\; z\; =\; x\; \backslash bullet\; (y\; \backslash bullet\; z)</annotation></semantics>$$ $$<semantics>x\xe2\u20ac\xa2\mathrm{\xcf\mu}=x<annotation\; encoding="application/xtex">x\; \backslash bullet\; \backslash epsilon\; =\; x</annotation></semantics>$$ $$<semantics>\mathrm{\xcf\mu}\xe2\u20ac\xa2x=x<annotation\; encoding="application/xtex">\backslash epsilon\; \backslash bullet\; x\; =\; x</annotation></semantics>$$
But nothing else. That means they donâ€™t satisfy any extra laws (like, for example, commutativity), and they donâ€™t have any extra structure they donâ€™t need.
How did we get to the definition of lists from the monoid laws, though? It doesnâ€™t look anything like them. It would be nice if there was some systematic way to construct the corresponding free object given the laws of an algebra. Unfortunately, in normal Agda, this isnâ€™t possible. Consider, for instance, if we added the commutativity law to the algebra: $$<semantics>x\xe2\u20ac\xa2y=y\xe2\u20ac\xa2x<annotation\; encoding="application/xtex">x\; \backslash bullet\; y\; =\; y\; \backslash bullet\; x</annotation></semantics>$$ Not only is it not obvious how weâ€™d write the corresponding free object, itâ€™s actually not possible in normal Agda!
This kind of problem comes up a lot: we have a type, and we want it to obey just one more equation, but there is no inductive type which does so. Higher Inductive Types solve the problem in quite a straightforward way. So we want lists to satisfy another equation? Well, just add it to the definition!
module OddList where mutual data List {a} (A : Set a) : Set a where [] : List A _âˆ·_ : A â†’ List A â†’ List A comm : âˆ€ xs ys â†’ xs ++ ys â‰¡ ys ++ xs postulate _++_ : List A â†’ List A â†’ List ANow, when we write a function that processes lists, Agda will check that the function behaves the same on
xs ++ ys
and ys ++ xs
. As an example, hereâ€™s how you might define the free monoid as a HIT:
data FreeMonoid {a} (A : Set a) : Set a where [_] : A â†’ FreeMonoid A _âˆ™_ : FreeMonoid A â†’ FreeMonoid A â†’ FreeMonoid A Îµ : FreeMonoid A âˆ™Îµ : âˆ€ x â†’ x âˆ™ Îµ â‰¡ x Îµâˆ™ : âˆ€ x â†’ Îµ âˆ™ x â‰¡ x assoc : âˆ€ x y z â†’ (x âˆ™ y) âˆ™ z â‰¡ x âˆ™ (y âˆ™ z)
Itâ€™s quite a satisfying definition, and very easy to see how we got to it from the monoid laws.
Now, when we write functions, we have to prove that those functions themselves also obey the monoid laws. For instance, hereâ€™s how we would take the length:module Length where open import ProbabilityModule.Semirings.Nat open Semiring +*ğ�•Š length : FreeMonoid A â†’ â„• length [ x ] = 1 length (xs âˆ™ ys) = length xs + length ys length Îµ = 0 length (âˆ™Îµ xs i) = +0 (length xs) i length (Îµâˆ™ xs i) = 0+ (length xs) i length (assoc xs ys zs i) = +assoc (length xs) (length ys) (length zs) i
The first three clauses are the actual function: they deal with the three normal constructors of the type. The next three clauses prove that those previous clauses obey the equalities defined on the type.
With the preliminary stuff out of the way, letâ€™s get on to the type I wanted to talk about:
First things first, letâ€™s remember the classic definition of the probability monad:
Definitionally speaking, this doesnâ€™t really represent what weâ€™re talking about. For instance, the following two things express the same distribution, but have different representations:
So itâ€™s the perfect candidate for an extra equality clause like we had above.
Second, in an effort to generalise, we wonâ€™t deal specifically with Rational
, and instead weâ€™ll use any semiring. After all of that, we get the following definition:
open Semiring rng module Initial where infixr 5 _&_âˆ·_ data ğ�’« (A : Set a) : Set (a âŠ” s) where [] : ğ�’« A _&_âˆ·_ : (p : R) â†’ (x : A) â†’ ğ�’« A â†’ ğ�’« A dup : âˆ€ p q x xs â†’ p & x âˆ· q & x âˆ· xs â‰¡ p + q & x âˆ· xs com : âˆ€ p x q y xs â†’ p & x âˆ· q & y âˆ· xs â‰¡ q & y âˆ· p & x âˆ· xs del : âˆ€ x xs â†’ 0# & x âˆ· xs â‰¡ xs
The three extra conditions are pretty sensible: the first removes duplicates, the second makes things commutative, and the third removes impossible events.
Letâ€™s get to writing some functions, then:
âˆ« : (A â†’ R) â†’ ğ�’« A â†’ R âˆ« f [] = 0# âˆ« f (p & x âˆ· xs) = p * f x + âˆ« f xs âˆ« f (dup p q x xs i) = begin[ i ] p * f x + (q * f x + âˆ« f xs) â‰¡Ë˜âŸ¨ +assoc (p * f x) (q * f x) (âˆ« f xs) âŸ© (p * f x + q * f x) + âˆ« f xs â‰¡Ë˜âŸ¨ cong (_+ âˆ« f xs) (âŸ¨+âŸ©* p q (f x)) âŸ© (p + q) * f x + âˆ« f xs âˆ� âˆ« f (com p x q y xs i) = begin[ i ] p * f x + (q * f y + âˆ« f xs) â‰¡Ë˜âŸ¨ +assoc (p * f x) (q * f y) (âˆ« f xs) âŸ© p * f x + q * f y + âˆ« f xs â‰¡âŸ¨ cong (_+ âˆ« f xs) (+comm (p * f x) (q * f y)) âŸ© q * f y + p * f x + âˆ« f xs â‰¡âŸ¨ +assoc (q * f y) (p * f x) (âˆ« f xs) âŸ© q * f y + (p * f x + âˆ« f xs) âˆ� âˆ« f (del x xs i) = begin[ i ] 0# * f x + âˆ« f xs â‰¡âŸ¨ cong (_+ âˆ« f xs) (0* (f x)) âŸ© 0# + âˆ« f xs â‰¡âŸ¨ 0+ (âˆ« f xs) âŸ© âˆ« f xs âˆ�
This is much more involved than the free monoid function, but the principle is the same: we first write the actual function (on the first three lines), and then we show that the function doesnâ€™t care about the â€œrewrite rulesâ€� we have in the next three clauses.
Before going any further, we will have to amend the definition a little. The problem is that if we tried to prove something about any function on our ğ�’«
type, weâ€™d have to prove equalities between equalities as well. Iâ€™m sure that this is possible, but itâ€™s very annoying, so Iâ€™m going to use a technique I saw in this repository. We add another rule to our type, stating that all equalities on the type are themselves equal. The new definition looks like this:
infixr 5 _&_âˆ·_ data ğ�’« (A : Set a) : Set (a âŠ” s) where [] : ğ�’« A _&_âˆ·_ : (p : R) â†’ (x : A) â†’ ğ�’« A â†’ ğ�’« A dup : âˆ€ p q x xs â†’ p & x âˆ· q & x âˆ· xs â‰¡ p + q & x âˆ· xs com : âˆ€ p x q y xs â†’ p & x âˆ· q & y âˆ· xs â‰¡ q & y âˆ· p & x âˆ· xs del : âˆ€ x xs â†’ 0# & x âˆ· xs â‰¡ xs trunc : isSet (ğ�’« A)
Unfortunately, after adding that case we have to deal with it explicitly in every patternmatch on ğ�’«
. We can get around it by writing an eliminator for the type which deals with it itself. Eliminators are often irritating to work with, though: we give up the nice patternmatching syntax we get when we program directly. Itâ€™s a bit like having to rely on church encoding everywhere.
However, we can get back some patternlike syntax if we use copatterns. Hereâ€™s an example of what I mean, for folds on lists:
module ListElim where open NormalList open import ProbabilityModule.Semirings.Nat open Semiring +*ğ�•Š renaming (_+_ to _â„•+_) record [_â†¦_] (A : Set a) (B : Set b) : Set (a âŠ” b) where field [_][] : B [_]_âˆ·_ : A â†’ B â†’ B [_]â†“ : List A â†’ B [ [] ]â†“ = [_][] [ x âˆ· xs ]â†“ = [_]_âˆ·_ x [ xs ]â†“ open [_â†¦_] sumalg : [ â„• â†¦ â„• ] [ sumalg ][] = 0 [ sumalg ] x âˆ· xs = x â„•+ xs sum : List â„• â†’ â„• sum = [ sumalg ]â†“
For the probability monad, thereâ€™s an eliminator for the whole thing, and eliminator for propositional proofs, and a normal eliminator for folding. Their definitions are quite long, but mechanical.
record âŸ…_â†�_âŸ† {a â„“} (A : Set a) (P : ğ�’« A â†’ Set â„“) : Set (a âŠ” â„“ âŠ” s) where constructor elim field âŸ…_âŸ†set : âˆ€ {xs} â†’ isSet (P xs) âŸ…_âŸ†[] : P [] âŸ…_âŸ†_&_âˆ·_ : âˆ€ p x xs â†’ P xs â†’ P (p & x âˆ· xs) private z = âŸ…_âŸ†[]; f = âŸ…_âŸ†_&_âˆ·_ field âŸ…_âŸ†dup : (âˆ€ p q x xs pxs â†’ PathP (Î» i â†’ P (dup p q x xs i)) (f p x (q & x âˆ· xs) (f q x xs pxs)) (f (p + q) x xs pxs)) âŸ…_âŸ†com : (âˆ€ p x q y xs pxs â†’ PathP (Î» i â†’ P (com p x q y xs i)) (f p x (q & y âˆ· xs) (f q y xs pxs)) (f q y (p & x âˆ· xs) (f p x xs pxs))) âŸ…_âŸ†del : (âˆ€ x xs pxs â†’ PathP (Î» i â†’ P (del x xs i)) (f 0# x xs pxs) pxs) âŸ…_âŸ†â‡“ : (xs : ğ�’« A) â†’ P xs âŸ… [] âŸ†â‡“ = z âŸ… p & x âˆ· xs âŸ†â‡“ = f p x xs âŸ… xs âŸ†â‡“ âŸ… dup p q x xs i âŸ†â‡“ = âŸ…_âŸ†dup p q x xs âŸ… xs âŸ†â‡“ i âŸ… com p x q y xs i âŸ†â‡“ = âŸ…_âŸ†com p x q y xs âŸ… xs âŸ†â‡“ i âŸ… del x xs i âŸ†â‡“ = âŸ…_âŸ†del x xs âŸ… xs âŸ†â‡“ i âŸ… trunc xs ys p q i j âŸ†â‡“ = elimSquashâ‚€ (Î» xs â†’ âŸ…_âŸ†set {xs}) (trunc xs ys p q) âŸ… xs âŸ†â‡“ âŸ… ys âŸ†â‡“ (cong âŸ…_âŸ†â‡“ p) (cong âŸ…_âŸ†â‡“ q) i j open âŸ…_â†�_âŸ† public elimsyntax : âˆ€ {a â„“} â†’ (A : Set a) â†’ (ğ�’« A â†’ Set â„“) â†’ Set (a âŠ” â„“ âŠ” s) elimsyntax = âŸ…_â†�_âŸ† syntax elimsyntax A (Î» xs â†’ Pxs) = [ xs âˆˆğ�’« A â†� Pxs ] record âŸ¦_â‡’_âŸ§ {a â„“} (A : Set a) (P : ğ�’« A â†’ Set â„“) : Set (a âŠ” â„“ âŠ” s) where constructor elimprop field âŸ¦_âŸ§prop : âˆ€ {xs} â†’ isProp (P xs) âŸ¦_âŸ§[] : P [] âŸ¦_âŸ§_&_âˆ·_âŸ¨_âŸ© : âˆ€ p x xs â†’ P xs â†’ P (p & x âˆ· xs) private z = âŸ¦_âŸ§[]; f = âŸ¦_âŸ§_&_âˆ·_âŸ¨_âŸ© âŸ¦_âŸ§â‡‘ = elim (isPropâ†’isSet âŸ¦_âŸ§prop) z f (Î» p q x xs pxs â†’ toPathP (âŸ¦_âŸ§prop (transp (Î» i â†’ P (dup p q x xs i)) i0 (f p x (q & x âˆ· xs) (f q x xs pxs))) (f (p + q) x xs pxs) )) (Î» p x q y xs pxs â†’ toPathP (âŸ¦_âŸ§prop (transp (Î» i â†’ P (com p x q y xs i)) i0 (f p x (q & y âˆ· xs) (f q y xs pxs))) (f q y (p & x âˆ· xs) (f p x xs pxs)))) Î» x xs pxs â†’ toPathP (âŸ¦_âŸ§prop (transp (Î» i â†’ P (del x xs i)) i0 ((f 0# x xs pxs))) pxs) âŸ¦_âŸ§â‡“ = âŸ… âŸ¦_âŸ§â‡‘ âŸ†â‡“ open âŸ¦_â‡’_âŸ§ public elimpropsyntax : âˆ€ {a â„“} â†’ (A : Set a) â†’ (ğ�’« A â†’ Set â„“) â†’ Set (a âŠ” â„“ âŠ” s) elimpropsyntax = âŸ¦_â‡’_âŸ§ syntax elimpropsyntax A (Î» xs â†’ Pxs) = âŸ¦ xs âˆˆğ�’« A â‡’ Pxs âŸ§ record [_â†¦_] {a b} (A : Set a) (B : Set b) : Set (a âŠ” b âŠ” s) where constructor rec field [_]set : isSet B [_]_&_âˆ·_ : R â†’ A â†’ B â†’ B [_][] : B private f = [_]_&_âˆ·_; z = [_][] field [_]dup : âˆ€ p q x xs â†’ f p x (f q x xs) â‰¡ f (p + q) x xs [_]com : âˆ€ p x q y xs â†’ f p x (f q y xs) â‰¡ f q y (f p x xs) [_]del : âˆ€ x xs â†’ f 0# x xs â‰¡ xs [_]â‡‘ = elim [_]set z (Î» p x _ xs â†’ f p x xs) (Î» p q x xs â†’ [_]dup p q x) (Î» p x q y xs â†’ [_]com p x q y) (Î» x xs â†’ [_]del x) [_]â†“ = âŸ… [_]â‡‘ âŸ†â‡“ open [_â†¦_] public
Hereâ€™s one in action, to define map
:
map : (A â†’ B) â†’ ğ�’« A â†’ ğ�’« B map = Î» f â†’ [ mapâ€² f ]â†“ module Map where mapâ€² : (A â†’ B) â†’ [ A â†¦ ğ�’« B ] [ mapâ€² f ] p & x âˆ· xs = p & f x âˆ· xs [ mapâ€² f ][] = [] [ mapâ€² f ]set = trunc [ mapâ€² f ]dup p q x xs = dup p q (f x) xs [ mapâ€² f ]com p x q y xs = com p (f x) q (f y) xs [ mapâ€² f ]del x xs = del (f x) xs
And hereâ€™s how weâ€™d define union, and then prove that itâ€™s associative:
infixr 5 _âˆª_ _âˆª_ : ğ�’« A â†’ ğ�’« A â†’ ğ�’« A _âˆª_ = Î» xs ys â†’ [ union ys ]â†“ xs module Union where union : ğ�’« A â†’ [ A â†¦ ğ�’« A ] [ union ys ]set = trunc [ union ys ] p & x âˆ· xs = p & x âˆ· xs [ union ys ][] = ys [ union ys ]dup = dup [ union ys ]com = com [ union ys ]del = del âˆªassoc : (xs ys zs : ğ�’« A) â†’ xs âˆª (ys âˆª zs) â‰¡ (xs âˆª ys) âˆª zs âˆªassoc = Î» xs ys zs â†’ âŸ¦ âˆªassocâ€² ys zs âŸ§â‡“ xs module UAssoc where âˆªassocâ€² : âˆ€ ys zs â†’ âŸ¦ xs âˆˆğ�’« A â‡’ xs âˆª (ys âˆª zs) â‰¡ (xs âˆª ys) âˆª zs âŸ§ âŸ¦ âˆªassocâ€² ys zs âŸ§prop = trunc _ _ âŸ¦ âˆªassocâ€² ys zs âŸ§[] = refl âŸ¦ âˆªassocâ€² ys zs âŸ§ p & x âˆ· xs âŸ¨ P âŸ© = cong (p & x âˆ·_) P
Thereâ€™s a lot more stuff here that I wonâ€™t bore you with.
infixl 7 _â‹Š_ _â‹Š_ : R â†’ ğ�’« A â†’ ğ�’« A _â‹Š_ = Î» p â†’ [ p â‹Šâ€² ]â†“ module Cond where _â‹Šâ€² : R â†’ [ A â†¦ ğ�’« A ] [ p â‹Šâ€² ]set = trunc [ p â‹Šâ€² ][] = [] [ p â‹Šâ€² ] q & x âˆ· xs = p * q & x âˆ· xs [ p â‹Šâ€² ]com q x r y xs = com (p * q) x (p * r) y xs [ p â‹Šâ€² ]dup q r x xs = p * q & x âˆ· p * r & x âˆ· xs â‰¡âŸ¨ dup (p * q) (p * r) x xs âŸ© p * q + p * r & x âˆ· xs â‰¡Ë˜âŸ¨ cong (_& x âˆ· xs) (*âŸ¨+âŸ© p q r) âŸ© p * (q + r) & x âˆ· xs âˆ� [ p â‹Šâ€² ]del x xs = p * 0# & x âˆ· xs â‰¡âŸ¨ cong (_& x âˆ· xs) (*0 p) âŸ© 0# & x âˆ· xs â‰¡âŸ¨ del x xs âŸ© xs âˆ� âˆ« : (A â†’ R) â†’ ğ�’« A â†’ R âˆ« = Î» f â†’ [ âˆ«â€² f ]â†“ module Expect where âˆ«â€² : (A â†’ R) â†’ [ A â†¦ R ] [ âˆ«â€² f ]set = sIsSet [ âˆ«â€² f ] p & x âˆ· xs = p * f x + xs [ âˆ«â€² f ][] = 0# [ âˆ«â€² f ]dup p q x xs = p * f x + (q * f x + xs) â‰¡Ë˜âŸ¨ +assoc (p * f x) (q * f x) xs âŸ© (p * f x + q * f x) + xs â‰¡Ë˜âŸ¨ cong (_+ xs) (âŸ¨+âŸ©* p q (f x)) âŸ© (p + q) * f x + xs âˆ� [ âˆ«â€² f ]com p x q y xs = p * f x + (q * f y + xs) â‰¡Ë˜âŸ¨ +assoc (p * f x) (q * f y) (xs) âŸ© p * f x + q * f y + xs â‰¡âŸ¨ cong (_+ xs) (+comm (p * f x) (q * f y)) âŸ© q * f y + p * f x + xs â‰¡âŸ¨ +assoc (q * f y) (p * f x) (xs) âŸ© q * f y + (p * f x + xs) âˆ� [ âˆ«â€² f ]del x xs = 0# * f x + xs â‰¡âŸ¨ cong (_+ xs) (0* (f x)) âŸ© 0# + xs â‰¡âŸ¨ 0+ (xs) âŸ© xs âˆ� syntax âˆ« (Î» x â†’ e) = âˆ« e ğ�‘‘ x pure : A â†’ ğ�’« A pure x = 1# & x âˆ· [] âˆªcons : âˆ€ p (x : A) xs ys â†’ xs âˆª p & x âˆ· ys â‰¡ p & x âˆ· xs âˆª ys âˆªcons = Î» p x xs ys â†’ âŸ¦ âˆªconsâ€² p x ys âŸ§â‡“ xs module UCons where âˆªconsâ€² : âˆ€ p x ys â†’ âŸ¦ xs âˆˆğ�’« A â‡’ xs âˆª p & x âˆ· ys â‰¡ p & x âˆ· xs âˆª ys âŸ§ âŸ¦ âˆªconsâ€² p x ys âŸ§prop = trunc _ _ âŸ¦ âˆªconsâ€² p x ys âŸ§[] = refl âŸ¦ âˆªconsâ€² p x ys âŸ§ r & y âˆ· xs âŸ¨ P âŸ© = cong (r & y âˆ·_) P Í¾ com r y p x (xs âˆª ys) â‹ŠdistribÊ³ : âˆ€ p q â†’ (xs : ğ�’« A) â†’ p â‹Š xs âˆª q â‹Š xs â‰¡ (p + q) â‹Š xs â‹ŠdistribÊ³ = Î» p q â†’ âŸ¦ â‹ŠdistribÊ³â€² p q âŸ§â‡“ module JDistrib where â‹ŠdistribÊ³â€² : âˆ€ p q â†’ âŸ¦ xs âˆˆğ�’« A â‡’ p â‹Š xs âˆª q â‹Š xs â‰¡ (p + q) â‹Š xs âŸ§ âŸ¦ â‹ŠdistribÊ³â€² p q âŸ§prop = trunc _ _ âŸ¦ â‹ŠdistribÊ³â€² p q âŸ§[] = refl âŸ¦ â‹ŠdistribÊ³â€² p q âŸ§ r & x âˆ· xs âŸ¨ P âŸ© = p â‹Š (r & x âˆ· xs) âˆª q â‹Š (r & x âˆ· xs) â‰¡âŸ¨ âˆªcons (q * r) x (p â‹Š (r & x âˆ· xs)) (q â‹Š xs) âŸ© q * r & x âˆ· p â‹Š (r & x âˆ· xs) âˆª q â‹Š xs â‰¡âŸ¨ cong (_âˆª q â‹Š xs) (dup (q * r) (p * r) x (p â‹Š xs)) âŸ© q * r + p * r & x âˆ· p â‹Š xs âˆª q â‹Š xs â‰¡Ë˜âŸ¨ cong (_& x âˆ· (p â‹Š xs âˆª q â‹Š xs)) (âŸ¨+âŸ©* q p r) âŸ© (q + p) * r & x âˆ· p â‹Š xs âˆª q â‹Š xs â‰¡âŸ¨ cong ((q + p) * r & x âˆ·_) P âŸ© (q + p) * r & x âˆ· (p + q) â‹Š xs â‰¡âŸ¨ cong (Î» pq â†’ pq * r & x âˆ· (p + q) â‹Š xs) (+comm q p) âŸ© (p + q) * r & x âˆ· (p + q) â‹Š xs â‰¡âŸ¨âŸ© _â‹Š_ (p + q) (r & x âˆ· xs) âˆ� â‹ŠdistribË¡ : âˆ€ p â†’ (xs ys : ğ�’« A) â†’ p â‹Š xs âˆª p â‹Š ys â‰¡ p â‹Š (xs âˆª ys) â‹ŠdistribË¡ = Î» p xs ys â†’ âŸ¦ â‹ŠdistribË¡â€² p ys âŸ§â‡“ xs module JDistribL where â‹ŠdistribË¡â€² : âˆ€ p ys â†’ âŸ¦ xs âˆˆğ�’« A â‡’ p â‹Š xs âˆª p â‹Š ys â‰¡ p â‹Š (xs âˆª ys) âŸ§ âŸ¦ â‹ŠdistribË¡â€² p ys âŸ§prop = trunc _ _ âŸ¦ â‹ŠdistribË¡â€² p ys âŸ§[] = refl âŸ¦ â‹ŠdistribË¡â€² p ys âŸ§ q & x âˆ· xs âŸ¨ P âŸ© = p â‹Š (q & x âˆ· xs) âˆª p â‹Š ys â‰¡âŸ¨âŸ© p * q & x âˆ· p â‹Š xs âˆª p â‹Š ys â‰¡âŸ¨ cong (p * q & x âˆ·_) P âŸ© p * q & x âˆ· p â‹Š (xs âˆª ys) â‰¡âŸ¨âŸ© p â‹Š ((q & x âˆ· xs) âˆª ys) âˆ� âˆªidÊ³ : (xs : ğ�’« A) â†’ xs âˆª [] â‰¡ xs âˆªidÊ³ = âŸ¦ âˆªidÊ³â€² âŸ§â‡“ module UIdR where âˆªidÊ³â€² : âŸ¦ xs âˆˆğ�’« A â‡’ xs âˆª [] â‰¡ xs âŸ§ âŸ¦ âˆªidÊ³â€² âŸ§prop = trunc _ _ âŸ¦ âˆªidÊ³â€² âŸ§[] = refl âŸ¦ âˆªidÊ³â€² âŸ§ p & x âˆ· xs âŸ¨ P âŸ© = cong (p & x âˆ·_) P âˆªcomm : (xs ys : ğ�’« A) â†’ xs âˆª ys â‰¡ ys âˆª xs âˆªcomm = Î» xs ys â†’ âŸ¦ âˆªcommâ€² ys âŸ§â‡“ xs module UComm where âˆªcommâ€² : âˆ€ ys â†’ âŸ¦ xs âˆˆğ�’« A â‡’ xs âˆª ys â‰¡ ys âˆª xs âŸ§ âŸ¦ âˆªcommâ€² ys âŸ§prop = trunc _ _ âŸ¦ âˆªcommâ€² ys âŸ§[] = sym (âˆªidÊ³ ys) âŸ¦ âˆªcommâ€² ys âŸ§ p & x âˆ· xs âŸ¨ P âŸ© = cong (p & x âˆ·_) P Í¾ sym (âˆªcons p x ys xs) 0â‹Š : (xs : ğ�’« A) â†’ 0# â‹Š xs â‰¡ []