Tom Moertel's Weblog: Category functional programming

Thinking algebraically: a functional-programming dividend that pays during your imperative-programming day job

Tom Moertel — Wed, 20 Aug 2008 21:50:00 -0400

Although at work I code mostly in Python – a language from which lambda and map were nearly removed – I still find that functional-programming experience has its benefits. One of the “functional-programming dividends” I notice most often is insight gained from considering problems from an algebraic perspective.

Recently, for example, I had a small parsing problem. I had to write code that, given a simple grammar specification as input, emits a regular expression that matches the language generated by the grammar.

Here’s a simplified version of the problem. A grammar specification is limited to a series of one or more atoms. For example, “a b c” represents the atom “a”, followed by the atom “b”, followed by the atom “c”. To generate the grammar, the series of atoms is interpreted such that each atom (except the last) generates a production rule of the following form:

atom_rule ::=
  <the literal atom> (SPACE <the next rule> | NOTHING)

(SPACE represents literal white space and NOTHING represents an empty string.) The grammar as a whole is rooted in the first atom’s rule.

Thus the specification “a b c” represents the following grammar:

grammar ::= a_rule
a_rule  ::= "a" (SPACE b_rule | NOTHING)
b_rule  ::= "b" (SPACE c_rule | NOTHING)
c_rule  ::= "c"

Note that the final atom’s production matches only the literal atom itself: it has no following rule on which to chain.

The grammar, in turn, generates the following language:

a
a b
a b c

Thus, given the grammar specification “a b c”, my code had to produce a regular expression that would match “a”, “a b”, or “a b c”.

At this point, please stop for a moment and think about this little programming exercise. Do any solutions leap to mind? How would you approach the problem? Form your opinions now, because I’m going to ask you about them later. (If you’re feeling especially caffeinated, try coding a solution before reading on.)

For me, the insight that made the exercise easy was seeing that the grammar is given by folding a (suitably defined) right-associative binary operator through the series of atoms. The relationship might be easier to see if you substitute away the intermediate production rules from the grammar above:

grammar ::= "a" (SPACE "b" (SPACE "c" | NOTHING) | NOTHING)

If you squint past the SPACE and NOTHING terms, you’ll see that the grammar has the form

(a + (b + (c)))

The + is a binary operator that generates the parts we squinted away. Once you see what’s going on structurally, the operator is easy to define:

x + y = x (SPACE y | NOTHING)

Compare the operator’s definition with that of the atom_rule I presented at the beginning of the article. They’re structurally the same: the operator’s x and y are the atom rule’s <the literal atom> and <the next rule>.

Now all that remains is to generalize the “a b c” formula into a general formula that works for arbitrary grammar specifications. Fortunately, this work has already been done for us. The generalized formula is nothing more than a right fold. In Haskell, the particular right-fold flavor we want is called foldr1.

Given a list of atoms, we can use foldr1 to construct its grammar as follows:

mk_grammar atoms = foldr1 (+) atoms

But Python, our implementation language, does not offer a foldr1 function. This wrinkle, however, is another thing we can iron out by thinking algebraically. Python doesn’t have foldr1, but it does have a reduce function, which represents a left fold, equivalent to Haskell’s foldl’ or foldl1’. Because our + operator is strict and our list of atoms is finite, we can take advantage of the following identity:

foldr1 (+) xs == foldl1 (flip (+)) (reverse xs)

That is, we can convert a right fold into a left fold by flipping the arguments of the operator and operating on the list in reverse. Thus we can implement the fold we want in terms of the fold we have:

# Python code

def foldr1(f, xs):
    return reduce(flip(f), reversed(xs))

def flip(f):
    def g(x, y):
        return f(y, x)
    return g

Now writing a Python-based solution is straightforward:

def grammar_spec_to_re(spec):
    atoms = grammar_spec_to_atoms(spec)
    atom_res = map(atom_to_re, atoms)
    grammar_re = r'\A%s\Z' % foldr1(op, atom_res)
    return grammar_re

def op(x, y):
    # x + y = x (SPACE y | NOTHING)
    return r'%s(\s+%s)?' % (x, y)

def grammar_spec_to_atoms(spec):
    return spec.split()

def atom_to_re(atom):
    return re.escape(atom)

Using our solution, let’s compile the “a b c” grammar specification into its corresponding regular expression:

>>> print grammar_spec_to_re('a b c')
\Aa(\s+b(\s+c)?)?\Z

And that’s basically how I solved the problem.

To play around with the solution, here’s a small helper class that compiles a grammar specification into a regular expression and then tests strings for matching the regexp:

class GrammarMatcher(object):
    def __init__(self, spec):
        self.re = re.compile(grammar_spec_to_re(spec))
    def __call__(self, s):
        return not not self.re.match(s)

Now, let’s try out the regular expression generated for the grammar specification “a b c” :

>>> matcher = GrammarMatcher('a b c')
>>> matcher('')
False
>>> matcher('a')
True
>>> matcher('ab')
False
>>> matcher('a b')
True
>>> matcher('a  b')
True
>>> matcher('a b c')
True
>>> matcher('a b c d')
False
>>> matcher('a c')
False
>>> matcher('b')
False

Now, those questions I promised. If you’re a functional programmer, did a fold-based solution leap out at you? (Did you think of the problem in terms of folds?) If you’re not a functional programmer, how did you see the problem? Did the solution above seem twisted, confusing, or overly clever?

(There are no right or wrong answers. I’m just curious about how people with different backgrounds view the problem.)

Update: Edited to clarify that the problem is to convert a grammar specification into a regular expression, not just test whether a string matches a specified grammar.

Oleg's great way of explaining delimited continuations

Tom Moertel — Mon, 05 May 2008 09:58:00 -0400

There’s a great way to explain delimited continuations in the notes of Oleg’s Continuation Fest talk on using delimited continuations for CGI programming. Just so it doesn’t get overlooked, here it is:

I’m obsessed in pointing out that every programmer already knows and understands the delimited continuations; they might not know that word though. Everyone knows that when a process executes a system call like read, it gets suspended. When the disk delivers the data, the process is resumed. That suspension of a process is its continuation. It is delimited: it is not the check-point of the whole OS, it is the check-point of a process only, from the invocation of main() up to the point main() returns. Normally these suspensions are resumed only once, but can be zero times (exit) or twice (fork).

I especially like the final part about exit and fork, which drives home the notion that something more subtle than returning from a typical function call is going on. If anybody is confused over what suspended means, that last part ought to clear things up.

The next time I need to explain delimited continuations, I know how I’m going to do it.

A simple directory-tree printer in Haskell

Tom Moertel — Thu, 22 Feb 2007 16:30:00 -0500

At a recent gathering, my friend Casey mentioned that he was learning a new programming language and, as a learning exercise, had written a directory-tree printer. That’s a program that recursively scans directory hierarchies and prints out a tree representation for each:

$ tlist cheating-hangman

cheating-hangman
|-- CVS
|   |-- Entries
|   |-- Repository
|   `-- Root
|-- Makefile
|-- cheating-hangman.lhs
`-- cheating-hangman.pl

I thought the problem sounded like fun, and so I wrote a small solution in Haskell. Let’s take a look.

First, some documentation by way of comments.

-- Tree list for directories
-- Tom Moertel <tom@moertel.com>
-- 2007-02-20
--
-- Compile:  ghc -O -o tlist --make tlist.hs
-- Usage:    ./tlist [dir...]

Next, we’ll start a new module and import a few libraries that will make our job easier.

module Main (main) where

import Control.Monad
import Data.List
import System.Directory
import System.Environment

Now we arrive at the first real code, the main function:

main = do
    args <- getArgs
    mapM_ tlist (if null args then ["."] else args)

The code gets the arguments from the command line, each representing a file or directory. Then it maps the tlist function over the list of arguments or, if the list is empty, over the default argument, which represents the current working directory. Because tlist has side effects (e.g., directory scanning and tree printing), it returns an IO action, and thus we must use a monadic flavor of map, mapM_, to sequence its effects.

Next, tlist visits the file-system path it receives as an argument, handing off to the visit function, to which it passes some sensible initial values. We’ll examine what these values mean in a moment.

tlist path =
    visit (if "/" `isPrefixOf` path then "" else ".") "" "" "" path

The visit function, in turn, “visits” a node, printing its little portion of the tree. Before we look at that function, however, let’s think about drawing a single node.

Say we’re visiting the “Repository” node in the hierarchy:

cheating-hangman
|-- CVS
|   |-- Entries
|   |-- Repository    <--- consider just this line

    ^   ^
    A   B

To connect the node to the tree, we need to draw three things:

the leader, which connects the tree structure way above the node;
the arm, which connects the node’s siblings; and
the tie, which connects the node to the arm.

In this particular case, the leader is everything to the left of point A. Here it is "| ", but it will get longer as we descend deeper into the hierarchy. The arm is the single character at point A. It’s usually a vertical bar, but for the final sibling it’s rounded off into an elbow (a backquote in ASCII art). Finally the tie, which connects the name of the current node to the arm, is everything between points A and B. It’s always "-- " except at the tree’s root, which needs no tie.

With the tree’s anatomy firmly in mind, we’re ready to visit a node and draw its contribution to the tree:

visit path leader tie arm node = do
    putStrLn (leader ++ arm ++ tie ++ node)
    visitChildren (path ++ "/" ++ node) (leader ++ extension)
  where
    extension = case arm of ""  -> ""; "`" -> "    "; _   -> "|   "

Let’s examine the arguments. Path is the path to the directory we’re listing, and node is the item we’re visiting within that directory. The remaining arguments are the tree-drawing parts necessary to connect this node to the tree.

The first line of the function’s body prints the node’s addition to the tree. The second line visits the node’s children, if any, updating the path and leader accordingly. The path is updated to point to the current node. The leader is extended to ensure that the current node’s unvisited siblings, if any, will be connected to the tree by the current node’s children, if any. In effect, the current node’s arm is projected into the children’s leader to make the connection.

Visiting the children is a little more complicated:

visitChildren path leader =
    whenM (doesDirectoryExist path) $ do
        contents <- getDirectoryContents path
            `catch` (\e -> return [show e])
        let visibles = sort . filter (`notElem` [".", ".."]) $ contents
            arms = replicate (length visibles - 1) "|" ++ ["`"]
        zipWithM_ (visit path leader "-- ") arms visibles

The whenM line tests to see if the path represents a directory. If it’s not, the remaining code is ignored. (Only directories have children to visit.)

The remaining code, if it does run, gets the directory’s contents (catching and reporting errors, if any), filters out the "." and ".." directory entries, and stores the sorted, remaining entries in visibles. Then it prepares a list of arms: straight arms for all but the last entry, which gets an elbow. Finally, zipWithM_ “zips” the prepared arms and visible entries into one big, effectful computation that calls (recursively) to the visit function to zip each arm with its corresponding entry. And that completes our algorithm.

One final tidbit: the handy whenM, which lamentably is not part of the Haskell standard libraries (yet), is defined like so:

whenM mtest ma = mtest >>= flip when ma

The complete code

Here’s the code, without the commentary:

module Main (main) where

import Control.Monad
import Data.List
import System.Directory
import System.Environment

main = do
    args <- getArgs
    mapM_ tlist (if null args then ["."] else args)

tlist path =
    visit (if "/" `isPrefixOf` path then "" else ".") "" "" "" path

visit path leader tie arm node = do
    putStrLn (leader ++ arm ++ tie ++ node)
    visitChildren (path ++ "/" ++ node) (leader ++ extension)
  where
    extension = case arm of ""  -> ""; "`" -> "    "; _   -> "|   "

visitChildren path leader =
    whenM (doesDirectoryExist path) $ do
        contents <- getDirectoryContents path
            `catch` (\e -> return [show e])
        let visibles = sort . filter (`notElem` [".", ".."]) $ contents
            arms = replicate (length visibles - 1) "|" ++ ["`"]
        zipWithM_ (visit path leader "-- ") arms visibles

whenM mtest ma = mtest >>= flip when ma

Next time: a refactoring

Our program does two things: it scans directory hierarchies and it prints trees. You may have noticed, however, that those two things are intertwined in the code. There are times when we might want to scan a directory hierarchy or print a tree, but our code can’t be reused for those purposes. It can only scan and print as one indivisible action.

Wouldn’t it be better to separate the directory-scanning code from the tree-printing code so that each formed a reusable module? Next time, we’ll do just that. Haskell’s lazy magic makes it easy and efficient.

See you then.

Update 2007-02-23: If you’re interested in coding up an implementation, please don’t forget to round off corners and prune unnecessary connecting lines. For example:

dir1
|-- file1
|-- subdir1
|   |-- file11
|   |-- file12
|   `-- subdir13
|       `-- file131
`-- zfile

Introductory Haskell: Solving the Sorting-It-Out Kata

Tom Moertel — Tue, 31 Oct 2006 14:44:00 -0500

Last Tuesday, my friend Casey and I were hanging out at Aldo Coffee. We planned on enjoying some espresso, doing some work, and then heading over to the Pittsburgh Coding Dojo, where we could hang out with other geekly folks. We ended up not having enough time to go to the meeting, but we decided to hack on the challenge problem anyway, using Aldo’s ever-handy free wireless to access the Internet.

The Dojo problem was PragDave’s Kata Eleven – Sorting it Out. (It’s short; read it now.) We decided to use Haskell for our implementation language.

In this post, I’ll walk through our coding session and explain how our solution evolved. To better fit the session into a blog post, I have removed a lot of back-and-forth micro iterations, and I have edited some of the code for clarity.

The first part of the problem

The first part of the problem was “Sorting Balls.” The story: You need to implement a “rack” to hold the balls drawn at random (without replacement) from a bin containing sixty balls, numbered 0 to 59. Regardless of the order in which the balls are added to the rack, you need to present them in sorted order whenever you’re asked for them.

Upon reading this part of the challenge, a couple of thoughts sprung to mind:

Because the range of balls is so small, the problem was begging for a solution based on a counting sort.
Because the balls are uniquely numbered and drawn without replacement, we could even use a bit vector to represent counts.

Nevertheless, we decided to ignore these thoughts and implement a more-general solution that would work for any (orderable) values, not just small ranges of integers.

Sketching the interface

The first step, then, was to sketch out an interface. Our interface mirrored the one from the problem statement but was tweaked for Haskell:

mkRack :: Rack a
add    :: Ord a => a -> Rack a -> Rack a
balls  :: Rack a -> [a]

The function mkRack makes a new rack to hold values (“balls”) of type a. It’s equivalent to Rack.new in Ruby.

The add function adds a ball to a rack. You give it a ball and a rack, and it returns a new rack that is the same as the original rack but also contains the ball. (If you’re accustomed to stateful programming, this may seem weird. Why return a new rack instead of modifying the original rack? Because, in Haskell, you can’t change values: you can only create new values. At first, this constraint may seem limiting, but after you get used to it, you’ll find it empowering.)

Note: the Ord a qualification on the type signature of add says that it will work for any type a whose values can be ordered. The qualification is necessary because values of some types, like IO actions, cannot be compared to see which are less than the others.

The balls function is an “observer”: it lets you observe the balls in a rack by returning them as an ordered list.

And that’s the interface.

With the interface sketched, we gave it meaning by defining its properties.

Giving our interface meaning: defining properties using QuickCheck

QuickCheck is a powerful, easy-to-use testing tool. Instead of checking test cases, it checks properties – statements about what your code ought to do in general.

The great thing about QuickCheck properties is that they are testable documentation. They tell the world what your code is supposed to do, and they do so in a concise, formal language that just happens to be easily readable by humans and automatically testable by computers.

To specify the desired properties of our Rack interface, we first had to import QuickCheck:

import Test.QuickCheck

Then, we defined our first property. It said, simply, that a new rack must be empty when observed:

prop_New =
    balls mkRack =~ []

Our second property said that, when you add a ball x to a rack, the resulting rack must contain the same balls as the original rack plus x:

prop_AddAddsElement rack x =
    balls (add x rack) =~ (x : balls rack)

Both of the properties above rely upon a special, order-insensitive equality test that we defined for lists of Int values:

(=~) :: [Int] -> [Int] -> Bool
xs =~ ys = sort xs == sort ys

Note that under this test, [1,2] “equals” both [1,2] and [2,1], but it does not “equal” any other values.

The reason we defined this operator was to help us specify the two essential properties of add separately: (1) it must insert a ball into a rack, and (2) the new ball’s position, when observed, must preserve the rack’s ordering invariant. The previous property definition used the =~ operator to specify the first of these two properties. The next property we defined specified the second:

prop_AddPreservesOrdering rack x =
    isOrdered (balls rack) ==> isOrdered (balls (add x rack))

This definition specifies that, for all racks rack and all balls x, if the balls in rack are ordered, the balls in the rack that results from adding x to rack must also be ordered. If you are familiar with proof by induction, you’ll know why we went this route. In short, if we can prove that this property holds (and, trivially, that an empty rack is ordered), we can prove that add preserves the ordering invariant.

To round out the property definition, we needed to define the isOrdered test:

isOrdered :: [Int] -> Bool
isOrdered xs = xs == sort xs

And those are the properties we needed to check the correctness of our implementation. Of course, we still needed to write our implementation, and we turned to that task next.

A simple, list-based Rack implementation

For our first implementation, we decided upon a drop-dead-simple list-based representation. We would keep the elements of the list in sorted order by inserting them into the correct positions when add was called.

Here, then, was our code:

-- Our list-based implementation of a Rack

type Rack a = [a]

mkRack   = []
add x xs = insertList x xs
balls    = id

insertList :: Ord a => a -> [a] -> [a]
insertList x []     = [x]
insertList x (y:ys)
    | x < y         = x : y : ys
    | otherwise     = y : insertList x ys

That’s it.

We took our new implementation for a spin in GHCi:

*Rack> balls mkRack
[]

*Rack> balls (add 3 mkRack)
[3]

*Rack> balls (add 4 (add 3 mkRack))
[3,4]

*Rack> balls (add 1 (add 4 (add 3 mkRack)))
[1,3,4]

*Rack> balls (foldr add mkRack [4,2,6,3,-9,0,33,9])
[-9,0,2,3,4,6,9,33]

To really test our implementation, we asked QuickCheck to check its properties:

*Rack> quickCheck prop_New
OK, passed 100 tests.

*Rack> quickCheck prop_AddAddsElement
OK, passed 100 tests.

*Rack> quickCheck prop_AddPreservesOrdering
OK, passed 100 tests.

I should point out that QuickCheck did not prove that our properties held. Rather, it gathered evidence that we could use to argue that our properties held. The evidence was that each of our properties’ claims was subjected to 100 randomly generated tests, and none of the tests was able to disprove a claim.

Was this evidence sufficient for us to rest satisfied that our implementation was correct? Given how simple our implementation was, I felt that the evidence was sufficient. Casey agreed, and we moved on.

With the first implementation done, we decided to try a more-sophisticated implementation.

Generalizing the interface

Since we were about to have multiple implementations, it made sense for us to define a generalized interface that any “Rack-like” implementation could use. For that, Haskell’s type classes were perfect:

-- Our interface for "Rack-like" data types

class Racklike a ra | ra -> a where
    mkRack :: ra
    add    :: Ord a => a -> ra -> ra
    balls  :: ra -> [a]

The interface was essentially the same as before, except that the data type behind the rack implementation was not given by a specific type Rack a but rather by the type variable ra, which represents some type of rack container for balls of type a.

Note that ra determines a. If, for example, you know that the container type ra equals “a list of Int values,” you know that a must equal Int. (To represent this relationship, we used functional dependencies, a popular extension to the Haskell 98 standard.)

With the Racklike type class in place, we moved our list-based implementation inside of the interface:

-- Our list-based implementation of a Rack

type ListRack a = [a]

instance Racklike a (ListRack a) where
    mkRack = []
    add    = insertList
    balls  = id

Next, we modified our QuickCheck property definitions. Where before it was fine to assume that we would be testing our single, list-based implementation, now we needed to allow for testing other implementation types. We did this by adding a rackType parameter to our property definitions. We used the type, not the value, of this parameter to determine the type of rack to test:

prop_New rackType =
    balls (mkRack `asTypeOf` rackType) =~ []

prop_AddAddsElement rackType ballList x =
    balls (add x rack) =~ (x : balls rack)
  where
    rack = rackFromList ballList `asTypeOf` rackType

prop_AddPreservesOrdering rackType ballList x =
    isOrdered (balls rack) ==> isOrdered (balls (add x rack))
  where
    rack = rackFromList ballList `asTypeOf` rackType

Because we could no longer assume the rack would be represented as a list of integers, we wrote rackFromList to convert such a list into a rack:

rackFromList xs = foldr add mkRack xs

With these modifications in place, we re-ran our tests, specifying (via type annotations) that we wanted to run them for the ListRack implementation:

*Rack> quickCheck $ prop_New (undefined :: ListRack Int)
OK, passed 100 tests.

*Rack> quickCheck $ prop_AddAddsElement (undefined :: ListRack Int)
OK, passed 100 tests.

*Rack> quickCheck $ prop_AddPreservesOrdering (undefined :: ListRack Int)
OK, passed 100 tests.

A tree-based Rack implementation

Now that we were free to add additional implementation types, we created one based on binary trees. We started by defining the tree data type:

data Tree a
    = Empty
    | Root (Tree a) a (Tree a)
    deriving (Ord, Eq, Show)

This definition says that a tree can be either empty or a root node. A root node has a single value and left and right sub-trees.

Further, root nodes must satisfy an ordering invariant: if a root node’s value is x, all of the values in its left subtree must be less than x, and all of the values in its right subtree must be greater than or equal to x. The data type doesn’t enforce this invariant, so we would need to enforce it in our implementation.

Next, we wrote the basic functions for creating, adding elements to, and observing our trees.

We needed to be able to create empty trees:

emptyTree =
    Empty

Inserting an element into a tree requires us to walk the tree and append the element as a new leaf node in the correct location, being mindful of our ordering invariant. Because our data structure is inherently recursive, a recursive implementation was straightforward to code:

insertTree x Empty  = Root Empty x Empty
insertTree x (Root left y right)
    | x < y         = Root (insertTree x left) y right
    | otherwise     = Root left y (insertTree x right)

Note that we don’t try to ensure that the tree is balanced. The problem statement says that the balls are randomly selected, and thus we can expect our trees, on average, to be balanced naturally.

Next, we wrote the code to observe the elements of a tree. We used a functional-programming idiom for efficiently flattening a tree into a list:

elemsTree rx =
    elemsTree' rx []

elemsTree' Empty               = id
elemsTree' (Root left x right) =
    elemsTree' left . (x :) . elemsTree' right

Finally, we defined a new tree-based rack type and declared it to be an instance of the Racklike type class:

type TreeRack a = Tree a

instance Racklike a (TreeRack a) where
    mkRack = emptyTree
    add    = insertTree
    balls  = elemsTree

With the implementation done, we took it for a test drive:

*Rack> add 1 mkRack :: TreeRack Int
Root Empty 1 Empty

*Rack> add 3 (add 1 mkRack) :: TreeRack Int
Root Empty 1 (Root Empty 3 Empty)

*Rack> balls (add 3 (add 1 mkRack) :: TreeRack Int)
[1,3]

Then, for the real test, we checked that our properties held for TreeRacks:

*Rack> quickCheck $ prop_New (undefined :: TreeRack Int)
OK, passed 100 tests.

*Rack> quickCheck $ prop_AddAddsElement (undefined :: TreeRack Int)
OK, passed 100 tests.

quickCheck $ prop_AddPreservesOrdering (undefined :: TreeRack Int)
OK, passed 100 tests.

Satisfied with these results, we moved on to part two of the problem.

The second part of the problem

The second part of the problem was about sorting the letters within a block of text, ignoring white space and punctuation, and converting upper case letters into lower case: “Are there any ways to perform this sort cheaply, and without using built-in libraries?”

Again, a counting sort seemed like an obvious ideal solution, but we decided to recycle our existing code since we had to leave soon. Because our Rack implementations were generic, they would work on letters just as well as on numbers or other kinds of balls:

*Rack> balls (rackFromList "this is a test" :: TreeRack Char)
"   aehiisssttt"

With our existing code already doing the hard work for us, it was trivial to code up the letter-sorting function:

sortLetters xs =
    balls (rackFromList letters :: TreeRack Char)
  where
    letters = [toLower x | x <- xs, isAlpha x]

(Note: Because of the nature of the problem, I interpreted the question’s “without using built-in libraries” to mean “without built-in sorting libraries.”)

We took the new function for a test drive, and it worked as expected:

*Rack> sortLetters "This is a test, pal." 
"aaehiilpsssttt"

And that ended our coding session.

Update: Tweaked the revised definition of the AddAddsElement property for greater parallelism with the original.

Update 2007-03-03: Minor edits for clarity.

My code is "so clever as to be stupid"

Tom Moertel — Fri, 16 Jun 2006 08:21:00 -0400

In Port Scanning Shootout, author “cavedave” provides a mini-review of my Concurrent port scanner in Haskell. The thing is, I am not sure what to make of it:

50 lines of indentation balancing monadic grappling goodness. Considering I started this quest after seeing this code and thinking it was good, in retrospect it seems very big and not very clever, or at least so clever as to be stupid.

I am struck by the last statement. It seems the author is channeling the timeless David St. Hubbins, who said, “It’s such a fine line between stupid, and clever.”

Words to live by, if you ask me. ;-)

Composing functions in Ruby

Tom Moertel — Fri, 07 Apr 2006 11:55:00 -0400

One of the things I miss when coding in Ruby is inexpensive function composition. In Haskell, for example, I can compose functions using the dot (.) operator:

inc        = (+1)
twice      = (*2)
twiceOfInc = twice . inc

Because of Ruby’s open classes, however, I can easily add the feature to the language. In the code below, I introduce Proc.compose and overload the star (*) operator for the purpose:

# func_composition.rb
class Proc
  def self.compose(f, g)
    lambda { |*args| f[g[*args]] }
  end
  def *(g)
    Proc.compose(self, g)
  end
end

And that’s all it takes:

$ irb --simple-prompt -r func_composition.rb

>> inc = lambda { |x| x + 1 }
=> #<Proc:0x00002aaaaaad7810@(irb):1>

>> twice = lambda { |x| x * 2 }
=> #<Proc:0x00002aaaaabd2d18@(irb):2>

>> inc[1]
=> 2

>> twice[2]
=> 4

>> twice_of_inc = twice * inc
=> #<Proc:0x00002aaaaab32458@./func_composition.rb:3>

>> twice_of_inc[1]
=> 4

>> twice_of_inc[2]
=> 6

Now, isn’t that refreshing?

Update: Vincent Foley pointed out on comp.lang.ruby that Ruby Facets has a nearly identical implementation that also uses the star operator for composition. (Its version of compose, however, is an instance method whereas my version is a class method.)

Wow! A Haskell-based first-person shooter!

Tom Moertel — Tue, 22 Nov 2005 17:26:00 -0500

As seen in Haskell Weekly News, Mon Hon Cheong announced Frag, a first-person shooter written in – wait for it – Haskell. It uses HOpenGL for its OpenGL binding and Yampa for reactive game elements.

Cool!

Scope herding with delimited continuations

Tom Moertel — Tue, 13 Sep 2005 10:24:00 -0400

Recently I took advantage of delimited continuations to create a more natural Haskell-based kernel for GIML. The amazing scope-herding abilities of reset and shift were the magic that made it possible.

Ready to get wild? Grab an espresso and read on.

Consider the GIML code below. A block, delimited by curly braces, establishes a new evaluation frame. Variable bindings (such as those for x below) shadow earlier bindings, and each remains in effect until its enclosing block goes out of scope.

# GIML code (ex. 1)
x <- 1
{
    x <- 2   # local binding shadows earlier binding
    x        # evaluates to 2
}            # local binding goes out of scope with block
x   # evaluates to 1

The Reader monad provides most of this block-scoping behavior for free, and so it makes a natural part of the monad underlying the GIML evaluator. Its job is to make an environment – in this case, a Haskell Data.Map containing our active bindings – available to the actions running within it. The Reader monad provides the ask and asks combinators, which we can use to get and work with our bindings. We can use asks, for example, to write a combinator evalVar that takes a variable name and returns an action that looks up the variable’s value in the active bindings:

-- Haskell code (ex. 2)
evalVar var = do
    val <- asks (Map.findWithDefault 0 var)
    return val

The Reader monad also supplies a combinator local that can be used to run actions within a locally modified environment. The semantics of local ensure that the modifications cannot escape: after the local actions have been executed, the local environment goes out of scope and the previous, containing environment is restored. And that’s the block-scoping behavior we want.

Let’s use local to represent the following GIML block:

# GIML code (ex. 3)
{
    x <- 2
    x
}

Here is a local-based Haskell representation of the GIML block:

-- Haskell code (ex. 4)
local (Map.insert "x" 2) $ do
    evalVar "x"

The Haskell code above says, roughly translated, “Create a local environment by binding x to 2 (on top of any bindings that may have been effective within the outer environment) and then run the evalVar action within the local environment.”

Any actions before or after the local action will run in the outer environment, which will be unaffected by the local action. For example, consider the following Haskell code:

do
evalVar "x"
local (Map.insert "x" 2) $ do
    evalVar "x"
evalVar "x"

In the code above, if the first evalVar action results in 1, so must the third evalVar action because both run in the exact same environment. (The definition of bind for the Reader monad guarantees this.) The second evalVar action, however, runs in a locally modified environment where x is bound to 2, and so it will result in 2.

Unfortunately, this translation scheme for blocks and bindings has a limitation. Once we enter a block, we can’t change its environment because the only way to make changes is via local, and those changes would be confined to a new, local environment and would not affect the environment of the block’s remaining actions. Thus the only way we can effect a mid-block binding is to introduce another block, nested within the first.

For example, consider the following GIML code:

# GIML code (ex. 5)
{
    x <- 2
    y <- x + 1
    x + y
}

How do we translate this into Haskell? Our earlier translation method doesn’t work on this code because we have a mid-block binding. If we rewrite the GIML code to make the scope of each binding explicit, however, we get an equivalent GIML expression that can be translated:

# GIML code (ex. 6)
{
    x <- 2
    {
        y <- x + 1
        x + y
    }
}

The Haskell translation of the above:

-- Haskell code (ex. 7)
local (Map.insert "x" 2) $ do
    x <- evalVar "x"
    local (Map.insert "y" (x + 1)) $ do
        x <- evalVar "x"
        y <- evalVar "y"
        return (x + y)

This is, ultimately, the translation we want, but deriving it is awkward. Who wants to scan the AST and insert scoping blocks? Not me.

Instead, why not break the chains between binding and block-scoping? We ought to be able to make a local binding anywhere, not just at the point where a block begins. Let’s aim for code like the following, which is a direct translation of the earlier GIML code and preserves the user-supplied blocking:

-- Haskell code (ex. 8)
enterBlock $ do
    bindLocal "x" 2
    x <- evalVar "x"
    bindLocal "y" (x + 1)
    x <- evalVar "x"
    y <- evalVar "y"
    return (x + y)

The key to this more pleasant translation is the magic pair of combinators enterBlock and bindLocal. The enterBlock combinator creates a new block, and bindLocal sets up a binding that goes out of scope when the block that contains it does. Note that bindLocal can be used anywhere, and not just at the beginning of a block.

How, then, do we implement these new combinators? This is where delimited continuations come in. Take a look at the combinators’ definitions:

-- Haskell code
enterBlock action = reset action
bindLocal var val = shift $ \c -> local (Map.insert var val) (c ())

Before going further, let’s review reset and shift, the dynamic duo of delimited continuations. The reset combinator brackets an action, drawing a boundary around it. The shift combinator is a bit trickier. (Quaff espresso now.) When we invoke shift within a bracketed action, something amazing happens. The bracketed action is abortively replaced by another action that is constructed by the template function that we supply to shift.

Now, here’s where it gets wild. Our template function constructs the replacement action from an internal template, which can pull in the shift action’s context. The context is a delimited continuation that represents the unexecuted portion of the reset-bracketed action – except for the shift action itself, which has been removed, leaving a hole in the context. Our template fills in the hole with a value by passing the value to the context, which is really just another function.

If it sounds confusing, the following example may help. Consider this code, which represents an action within a monad that supports delimited continuations and IO:

-- Haskell code (ex. 9)
reset $ do
    puts "before"
    msg <- shift $ \cxt -> do
        -- our "template"
        puts "template start"
        cxt "template cxt(first)"
        cxt "template cxt(second)"
        puts "template end" 
    puts msg
    puts "after"
  where
    puts = liftIO . putStrLn

Let’s break it down. First, reset brackets everything between it and the where clause.

Second, the initial puts action prints “before” to the screen.

Third, the shift action takes control. Blammo! The reset-delimited action is aborted. Its unexecuted portion is captured as the context, which we can approximate with an anonymous function that looks like this:

( \hole -> reset $ do
    msg <- return hole
    puts msg
    puts "after" )

(I used the variable hole above to represent the hole left by removing the shift action.) This context function is then passed by shift to our template function, which binds the context function to its cxt variable.

Then the template function builds the action that will replace the aborted action. Before “expansion,” the template looks like this:

do
puts "template start"
cxt "template cxt(first)"
cxt "template cxt(second)"
puts "template end"

Each call to the cxt function drops the captured context into the template and fills in the context’s hole with the supplied argument. Expanding these calls results in the final template:

do
puts "template start"
reset $ do
    msg <- return "template cxt(first)"
    puts msg
    puts "after"
reset $ do
    msg <- return "template cxt(second)"
    puts msg
    puts "after"
puts "template end"

Because the reset-delimited portions of the code above do not contain any shift actions, reset acts like an identity function, and the final expansion of our template is thus as follows:

do
puts "template start"
msg <- return "template cxt(first)"
puts msg
puts "after"
msg <- return "template cxt(second)"
puts msg
puts "after"
puts "template end"

As we would now expect, running the original action results in the following output:

before
template start
template cxt(first)
after
template cxt(second)
after
template end

(Recall that the first line of output was emitted before the shift action was invoked.)

The ability to grab the remainder of an action and stuff it into a template is what makes the magic of enterBlock and bindLocal possible. When they appear in our Haskellized GIML code from earlier:

-- Haskell code
enterBlock $ do
    bindLocal "x" 2
    x <- evalVar "x"
    bindLocal "y" (x + 1)
    x <- evalVar "x"
    y <- evalVar "y"
    return (x + y)

they expand into this:

reset $ do
    shift $ \c -> local (Map.insert "x" 2) (c ())
    x <- evalVar "x"
    shift $ \c -> local (Map.insert "y" (x + 1)) (c ())
    x <- evalVar "x"
    y <- evalVar "y"
    return (x + y)

And that, thanks to delimited continuations, is “re-scoped” into to this:

reset $ do
    reset $ local (Map.insert "x" 2) $ do
        x <- evalVar "x"
        shift $ \c -> local (Map.insert "y" (x + 1)) (c ())
        x <- evalVar "x"
        y <- evalVar "y"
        return (x + y)

and then into this:

reset $ do
    reset $ local (Map.insert "x" 2) $ do
        x <- evalVar "x"
        reset $ local (Map.insert "y" (x + 1)) $ do
            x <- evalVar "x"
            y <- evalVar "y"
            return (x + y)

Finally, because the remaining reset combinators contain no shift actions, we can treat them like identity functions to arrive at our final code, which is identical to the Haskell code we wrote by hand back in Example 7 to represent the GIML code that we added explicit blocking to (again, by hand) in Example 6:

local (Map.insert "x" 2) $ do
    x <- evalVar "x"
    local (Map.insert "y" (x + 1)) $ do
        x <- evalVar "x"
        y <- evalVar "y"
        return (x + y)

And that, my friends, is what we were after, all along. Only this time around, we didn’t have to do it by hand – our combinators did the hard work for us.

Update 2007-03-15: Fixed typo.