This posting on the Java core library mailing list proposes to replace the current quicksort with a new, 2-pivot quicksort.

Ordinary quicksort in Haskell looks something like this:

quicksort [] = []
quicksort (pivot:rest) =
   quicksort [x| x ← rest, x ≤ pivot] ++
   [pivot] ++
   quicksort [x| x ← rest, x > pivot]

Note the similarity of this to the notation for ‘invariants’ used in the email:

[ <= p | >= p ]

Similarly, for the 2-pivot invariants (I have corrected a typo in this):

[ < P1 | P1 <= & <= P2 | > P2 ]

We can derive the code:

quicksort2 [] = []
quicksort2 (only:[]) = [only]
quicksort2 (first:second:rest) =
   quicksort2 [x|x ← rest, x < p1] ++
   [p1] ++
   quicksort2 [x|x ← rest, p1 ≤ x && x ≤ p2] ++
   [p2] ++
   quicksort2 [x|x ← rest, p2 < x]
  where (p1,p2) = if first ≤ second then (first,second) else (second,first)

Which does, in fact, run faster than the ordinary 1-pivot quicksort.

n-pivot quicksort

Of course, this being Haskell we want to take things to their logical conclusions, and allow any number of pivots to be used. My formulation follows:

quicksortN _ [] = []
quicksortN _ (x:[]) = [x]
quicksortN n xs
    | n > length xs = quicksortN ((n `div` 2) `max` 1) xs
    | otherwise = part True pivots
    where
      (takexs,dropxs) = splitAt n xs
      pivots = quicksortN 1 takexs
      part False (p2:[])      = quicksortN n [x|x ← dropxs, p2 < x]
      part False (p1:p2:rest) = quicksortN n [x|x ← dropxs, p1 < x && x ≤ p2] ++ [p2] ++ part False (p2:rest)
      part True  (p1:[])      = quicksortN n [x|x ← dropxs, x ≤ p1] ++ [p1] ++ quicksortN n [x|x ← dropxs, p1 < x] -- remember me? :)
      part True  (p1:p2:rest) = quicksortN n [x|x ← dropxs, x ≤ p1] ++ [p1] ++ part False (p1:p2:rest)

Now there are only 3 things that I can see that are left ‘tweakable’;

• how to reduce ‘n’ when it is greater than length of the list
  • dividing by 2 here
• how to sort the pivots
  • using a recursive call to the 1-pivot version of itself here
• whether or not to reduce the number of pivots as sorting continues
  • ‘no’ chosen here

I have no idea whether these are sensible defaults

Which n should I choose?

Finally, some code for the timings. You’ll need timeit to run it.

main = do
 gen ← getStdGen
 let n = 10^6
 let r = take n $ randoms gen :: [Int]
 print $ sum r -- force list
 timeIt . putStrLn . ("quicksort = "++) . show . sum $ quicksort r
 timeIt . putStrLn . ("quicksort2 = "++) . show . sum $ quicksort2 r
 mapM_ (\x → timeIt . putStrLn . (("quicksortN "++ show x++" = ")++) . show . sum $ quicksortN x r)
    [1..20]

Sample output:

$ ./sort
858124546
quicksort = 858124546
CPU time:   4.60s
quicksort2 = 858124546
CPU time:   3.66s
quicksortN 1 = 858124546
CPU time:   5.19s
quicksortN 2 = 858124546
CPU time:   3.77s
quicksortN 3 = 858124546
CPU time:   3.28s
quicksortN 4 = 858124546
CPU time:   3.27s
quicksortN 5 = 858124546
CPU time:   3.06s
quicksortN 6 = 858124546
CPU time:   3.04s
quicksortN 7 = 858124546
CPU time:   3.04s
quicksortN 8 = 858124546
CPU time:   3.07s
quicksortN 9 = 858124546
CPU time:   3.10s
quicksortN 10 = 858124546
CPU time:   3.14s
quicksortN 11 = 858124546
CPU time:   3.22s
quicksortN 12 = 858124546
CPU time:   3.31s
quicksortN 13 = 858124546
CPU time:   3.30s
quicksortN 14 = 858124546
CPU time:   3.37s
quicksortN 15 = 858124546
CPU time:   3.54s
quicksortN 16 = 858124546
CPU time:   3.41s
quicksortN 17 = 858124546
CPU time:   3.52s
quicksortN 18 = 858124546
CPU time:   3.65s
quicksortN 19 = 858124546
CPU time:   3.63s
quicksortN 20 = 858124546
CPU time:   3.77s

As expected, generalized quicksort performs slower than the equivalent hard-coded quicksorts for specific values of n, but higher values of n than 1 or 2 can perform better.

Preamble; choice of implementation

I decided to go with the latest and greatest version of Scheme: R⁶RS. There are currently two implementations available under Ubuntu Linux: Ikarus and Ypsilon. I installed both so I wouldn’t be swayed by any tempting extensions to the standard. Despite this, I ended up using Ikarus for most testing, as it ran quite a lot faster, although Ypsilon gave much better stack traces.

I also used the streams library for dealing with infinite lists (SRFI 41), which is included with both implementations.

Note: I’ll be providing all the code so that you should be able to copy-paste it into a new file and run it.

(import (rnrs)
    (rnrs r5rs (6)) ; provides 'delay' & 'force'
    (streams))

The Machine

Turing sought to capture the essence of computation. For this purpose he constructed an idealized machine, which can read and write symbols to an infinitely long piece of tape. We are going to model these idealized machines and see what they can do.

First, we want some types to represent the a-machines (the a is for automatic). Each machine has a set of states (m-configurations) it can be in, each of which contains a mapping from a set of symbols to a list of actions and a new m-configuration. I decided that the state would be my basic unit of construction, but twiddled the meaning of m-configuration a tiny bit so that instead of having each configuration contain a mapping from symbols, I would instead have a list of configurations, each one with a list of which symbols activate it. I ended up with the following:

; type for a configuration
(define-record-type m-cfg
            (fields symbols operations next))

This defines a new record type called m-cfg with the fields symbols, operations and next. The define-record-type form defines a constructor (make-m-cfg) and accessors for each field (m-cfg-*). Rather than have a ‘machine’ type, I decided that this would just be left implicit; if we know what the current state is then we can follow the links to next whenever we want to.

The Tape

Now, each machine operates upon an infinitely long ‘tape’. To model this, I use two streams, which are infinite lists. One is the infinite length of the tape to the left of the machine, and the other is the infinite length of the tape to the right of the machine. I decided that the first item in the right list would be the current item that the machine is reading.

; type for a tape (modeled as two stacks)
(define-record-type tape
            (fields left right min max index))

You will note that there are also the fields min, max, and index. These are solely used to track how much of the tape the machine has “visited”. Without this information, we would not know how much of the tape to show when we want to look at it; and since it is infinitely long, this could be a problem!

Representing operations

The operations that a machine can perform consist of:

• Move right
• Move left
• Print symbol
• Erase symbol
• Halt

I implemented these as an enumeration, just in case, but I didn’t actually end up utilizing any of the enumeration features.

; the operations available
(define-enumeration op
  (right left erase print halt)
  op-set)

There is a small difficulty with this representation: the ‘print’ operation needs to be able to take an argument. I decided that operations would always be passed around as lists, and that only ‘print’ would have a second element in the list: its argument. Here is a little shorthand to make this representation easier:

; these need to be lists, because print takes an argument
(define L (list (op left)))
(define R (list (op right)))
(define P (lambda (c) (list (op print) c)))
(define E (list (op erase)))
(define H (list (op halt)))

Thus, we can represent a list of operations like this: (list R R (P #\A) L E H)—that’s right, right, print ‘A’ (Scheme’s syntax for characters is a little weird), left, erase, halt.

Moving around on the tape

Here is a simple tape; it is completely empty. Note that I use the symbol 'empty to represent empty places on the tape. stream-constant makes an infinite stream of the value(s) supplied.

(define empty-tape
  (make-tape (stream-constant 'empty) (stream-constant 'empty) 0 0 0))

Next we need code to actually implement the operations described above. It is fairly straightforward, but we also have to keep track of the index and max/min points on the tape:

; Tape manipulation:
(define (current-symbol tape)
  (stream-car (tape-right tape)))
 
(define (move-item from to)
  (values (stream-cdr from)
      (stream-cons (stream-car from) to)))
 
(define (move-right tape)
  (let-values (
      [(right left) (move-item (tape-right tape) (tape-left tape))]
      [(min max) (update-min-max (tape-min tape) (tape-max tape) (+ 1 (tape-index tape)))])
    (make-tape left right min max (+ 1 (tape-index tape)))))
 
(define (move-left tape)
  (let-values (
      [(left right) (move-item (tape-left tape) (tape-right tape))]
      [(min max) (update-min-max (tape-min tape) (tape-max tape) (- (tape-index tape) 1))])
    (make-tape left right min max (- (tape-index tape) 1))))
 
(define (print tape symbol)
  (make-tape
    (tape-left tape)
    (stream-cons symbol (stream-cdr (tape-right tape)))
    (tape-min tape)
    (tape-max tape)
    (tape-index tape)))
 
(define (erase tape)
  (print tape 'empty))
 
(define (update-min-max min max i)
  (cond 
    [(< i min) (values i max)]
    [(> i max) (values min i)]
    [else      (values min max)]))

Notice that erase is actually redundant because we can just print 'empty. We also want a “dispatcher” of sorts that takes a value representing an operation and performs that operation. This is where passing the argument around with the ‘print’ came in useful:

; performs an operation on a tape, returns new tape
(define (perform-op tape oper)
  (case (car oper)
    [(op left) (move-left tape)]
    [(op right) (move-right tape)]
    [(op print) (print tape (cadr oper))]
    [(op erase) (erase tape)]
    [(op halt) #f])) ; ungraceful halt!

Running the machine

Now that we have the operations implemented, we can almost run a state against a tape. First we need to figure out just which of the configurations of the state to run. This procedure receives a list of configurations (but they are all part of the same ‘state’) and a symbol, and picks the first configuration that has a matching symbol. Note that the configurations can also have the symbol 'any, which matches anything.

; finds the correct rule to follow for this symbol
(define (find-cfg machine symbol)
  (find (lambda (cfg) (or
                (find [lambda (s) (eqv? symbol s)]
                  (m-cfg-symbols cfg))
                (find [lambda (s) (eqv? 'any s)]
                  (m-cfg-symbols cfg))))
        machine))

Now that we have a way to find out which rule to perform, and how to perform it, we can run it against a tape. This procedure advances the machine to the next state, performing all the operations needed. It returns the new state and a new tape.

; runs a machine forward one step
(define (run-machine tape machine)
  (let ([cfg (find-cfg (force machine) (current-symbol tape))])
    (list (fold-left perform-op tape (m-cfg-operations cfg))
          (m-cfg-next cfg))))

Displaying the tape

Being able to run the machine against a tape isn’t much good if we can’t see the result, so here’s a procedure to print out what it looks like. This is where we need the indexes we kept track of on the tape, so we know when to stop printing.

(define (print-tape tape)
  ; move as far left as possible
  (let ([leftTape (go-far-left tape)])
    ; now go right
    (do ([t leftTape])
      ((> (tape-index t) (tape-max tape)) t)
      (when (eqv? (tape-index tape) (tape-index t))
              (display "["))
      (cond
          [(eqv? (current-symbol t) 'empty) (display ".")]
          [else (display (current-symbol t))])
      (when (eqv? (tape-index tape) (tape-index t))
              (display "]"))
      (set! t (move-right t)))))
 
; moves to the far left of the tape (as far as has been travelled)
(define (go-far-left tape)
  (do ([t tape])
    ((= (tape-index t) (tape-min tape)) t)
     (set! t (move-left t))))

I print out a ‘.’ for each blank, and surround the current symbol with square brackets (actually I’ve changed that to be underlining in this blog post).

Turing Machines!

Now we can test it! Here is my definition of Turing’s first published machine:

; Turing's first published machine!
(define m1 (letrec 
  ([b (delay (list
       (make-m-cfg (list 'any) (list (P #\0) R) c)))]
   [c (delay (list
       (make-m-cfg (list 'any) (list R) e)))]
   [e (delay (list
       (make-m-cfg (list 'any) (list (P #\1) R) f)))]
   [f (delay (list
       (make-m-cfg (list 'any) (list R) b)))])
  b))

Now you see why we needed to import ‘delay’… since Scheme is a strictly-evaluated language, we can’t just letrec each state in terms of the others, so I wrap each one up in delay, then force it in one place; just before we use it in the run-machine procedure.

Other than that it is fairly straightforward, each state has a list of m-configurations, each of which has a list of what symbols it accepts, the actions to take, and the next state to move to. After we letrec, we have the initial state defined as the ‘machine’—in this case, b.

We can run this machine like so:

(define (go t m)
 (do ([tm (list t m)])
  ((eqv? tm #f) (car tm))
  (print-tape (car tm))
  (newline)
  (set! tm (run-machine (car tm) (cadr tm)))))
 
(go empty-tape m1)

This gives us the following output:

.
0.
0..
0.1.
0.1..
0.1.0.
0.1.0..
0.1.0.1.
0.1.0.1..
0.1.0.1.0.
...

This looks correct: P0, R, R, P1, R, R, etc.

Machine redux

The next machine Turing gives is the same as the first one, only in a different form:

; the same machine, only smaller
(define m2 (letrec
         ([b (delay (list
           (make-m-cfg (list 'empty) (list (P #\0)) b)
           (make-m-cfg (list #\0) (list R R (P #\1)) b)
           (make-m-cfg (list #\1) (list R R (P #\0)) b)))])
         b))

It has only one state, but changes depending on what the current symbol is. This produces the same output as the first machine, but in fewer steps:

.
0
0.1
0.1.0
0.1.0.1
0.1.0.1.0
0.1.0.1.0.1
0.1.0.1.0.1.0
0.1.0.1.0.1.0.1
0.1.0.1.0.1.0.1.0
...

You may be wondering why Turing leaves blanks between each printed symbol. He used the convention that only the ‘even’ squares (termed F-squares) would be the output. The ‘odd’ squares (termed E-squares) would be used as a scratch-pad.

Machine-à-trois

The third machine is a little more interesting. Whereas the first two printed out 01010101..., this prints 01011011101111011111...:

; Turing's third machine
(define m3 (letrec
         ([b (delay (list
                   (make-m-cfg (list 'any) (list (P #\ǝ) R (P #\ǝ) R (P #\0) R R (P #\0) L L) o)))]
          [o (delay (list
                  (make-m-cfg (list #\1) (list R (P #\x) L L L) o)
                  (make-m-cfg (list #\0) (list) q)))]
          [q (delay (list
                  (make-m-cfg (list #\0 #\1) (list R R) q)
                  (make-m-cfg (list 'empty) (list (P #\1) L) p)))]
          [p (delay (list
                  (make-m-cfg (list #\x) (list E R) q)
                  (make-m-cfg (list #\ǝ) (list R) f)
                  (make-m-cfg (list 'empty) (list L L) p)))]
          [f (delay (list
                  (make-m-cfg (list 'empty) (list (P #\0) L L) o)
                  (make-m-cfg (list 'any) (list R R) f)))])
         b))

With the output:

.
ǝǝ0.0
ǝǝ0.0
ǝǝ0.0
ǝǝ0.0..
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1..
ǝǝ0.0.1.0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0..
ǝǝ0.0.1x0.1
ǝǝ0.0.1x0.1
ǝǝ0.0.1.0.1
ǝǝ0.0.1.0.1
ǝǝ0.0.1.0.1..
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1..
ǝǝ0.0.1.0.1.1.0
ǝǝ0.0.1.0.1.1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0..
ǝǝ0.0.1.0.1x1x0.1
ǝǝ0.0.1.0.1x1x0.1
ǝǝ0.0.1.0.1x1.0.1
ǝǝ0.0.1.0.1x1.0.1
ǝǝ0.0.1.0.1x1.0.1..
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1.0
ǝǝ0.0.1.0.1.1.0.1.1.1x0
ǝǝ0.0.1.0.1.1.0.1.1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0..
ǝǝ0.0.1.0.1.1.0.1x1x1x0.1
ǝǝ0.0.1.0.1.1.0.1x1x1x0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1..
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1..
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1

Here we can see the scratch-pad being used. We can also see the beginnings of a pattern of execution; notice how the machine returns to the beginning of the tape after completing each set of 1s.

Opus Magnum

Next up was my main challenge. One of the major contributions of Turing’s paper was to display a machine which could emulate any other machine you wanted. In essence, you don’t actually need lots of different machines. You can just build one, and it can do anything any of the other machines can do! This is the principle behind modern general-purpose computers.

This is a very big, and complex machine. Some of the intricacies not involved in the other machines are:

• m-functions; that is, configurations which accept parameters—luckily, this was surprisingly easy to implement using Scheme; I simply wrap the delayed code inside another lambda
• m-configurations which are parametrized over all symbols on the machine—this is solved by just mapping a lambda over the list of symbols
• variadic m-functions—solved by the magic of case-lambda
• poorly-scanned journal document containing Fraktur and Greek letters

But not only was this by far the biggest and most complex machine supplied by Turing, I had read texts mentioning unspecified bugs in the program.

… and sure enough, I ran into a ‘bug’. There were some configurations used in the machine which weren’t defined in the paper! At first I thought this was due to the low resolution of the PDF, but even enhancing the image didn’t help.

After much supplication and burnt offerings to the God of the Internet, I managed to find that:

Someone else did the work already

Yay!

More specifically, I found a paper entitled Understanding Turing’s Universal Machine — Personal Style in Program Description (which is unfortunately not available to the public), a marvelous paper that not only explains the errors made in detail, but also provides a nice, corrected version of Turing’s exposition of his machine.

After painstakingly re-checking all the states again, I arrived at this:

; need this to generate a couple of cfgs
(define u-symbols (list
		   #\A #\C #\D #\0 #\1
		   #\u #\v #\w #\x #\y #\z
		   #\; #\L #\R #\N
		   #\∷ #\:
		   ))
 
; yo dawg
(define u (letrec
        (
         [f (lambda (C B a) (delay (list
                (make-m-cfg (list #\ǝ) (list L) (f1 C B a))
                (make-m-cfg (list 'any) (list L) (f C B a)))))]
         [f1 (lambda (C B a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'empty) (list R) (f2 C B a))
                (make-m-cfg (list 'any) (list R) (f1 C B a)))))]
         [f2 (lambda (C B a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'empty) (list R) B)
                (make-m-cfg (list 'any) (list R) (f1 C B a)))))]
         [fdash (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (f (l C) B a)))))]
         [fdashdash (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (f (r C) B a)))))]
         [r (lambda (C) (delay (list
                (make-m-cfg (list 'any) (list R) C))))]
         [l (lambda (C) (delay (list
                (make-m-cfg (list 'any) (list L) C))))]
         [q (case-lambda
              [(C) (delay (list
                (make-m-cfg (list 'empty) (list R) (q1 C))
                (make-m-cfg (list 'any) (list R) (q C))))]
         [(C a) (delay (list
                (make-m-cfg (list 'any) (list) (q (q1 C a)))))])]
         [q1 (case-lambda
               [(C) (delay (list
                (make-m-cfg (list 'empty) (list) C)
                (make-m-cfg (list 'any) (list R) (q C))))]
               [(C a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'any) (list L) (q1 C a))))])]
         [pe (lambda (C b) (delay (list
                (make-m-cfg (list 'any) (list) (f (pe1 C b) c #\ǝ)))))]
         [pe1 (lambda (C b) (delay (list
                (make-m-cfg (list 'empty) (list (P b)) C)
                (make-m-cfg (list 'any) (list R R) (pe1 C b)))))]
         [pe2 (lambda (C a b) (delay (list
                (make-m-cfg (list 'any) (list) (pe (pe C b) a)))))]
         [c (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (fdash (c1 C) B a)))))]
         [c1 (lambda (C) (delay (map
                    (lambda (b) (make-m-cfg (list b) (list) (pe C b)))
                      u-symbols)))]
         [ce (case-lambda
               [(C B a) (delay (list
                (make-m-cfg (list 'any) (list) (c (e C B a) B a))))]
               [(B a) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce B a) B a))))])]
         [ce2 (lambda (B a b) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce B b) a)))))]
         [ce3 (lambda (B a b g) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce2 B b g) a)))))]
         [ce5 (lambda (B a b g d e) (delay (list
                (make-m-cfg (list 'any) (list) (ce3 (ce2 B d e) a b g)))))] ; added
         [cp (lambda (C U F a b) (delay (list
                (make-m-cfg (list 'any) (list) (fdash (cp1 C U b) (f U F b) a)))))]
         [cp1 (lambda (C U b) (delay (map
                   (lambda (g) (make-m-cfg (list g) (list) (fdash (cp2 C U g) U b)))
                     u-symbols)))]
         [cp2 (lambda (C U g) (delay (list
                (make-m-cfg (list g) (list) C)
                (make-m-cfg (list 'any) (list) U))))]
         [cpe (case-lambda 
                [(C U F a b) (delay (list
                 (make-m-cfg (list 'any) (list) (cp (e (e C C b) C a) U F a b))))]
                [(U F a b) (delay (list
                 (make-m-cfg (list 'any) (list) (cpe (cpe U F a b) U F a b))))])]
         [e (case-lambda
               [(C) (delay (list
                (make-m-cfg (list #\ǝ) (list R) (e1 C))
                (make-m-cfg (list 'any) (list L) (e C))))]
               [(B a) (delay (list 
                (make-m-cfg (list 'any) (list) (e (e B a) B a))))]
               [(C B a) (delay (list 
                (make-m-cfg (list 'any) (list) (f (e1 C B a) B a))))])]
         [e1 (case-lambda
               [(C) (delay (list
                (make-m-cfg (list 'empty) (list) C) 
                (make-m-cfg (list 'any) (list R E R) (e1 C))))]
               [(C B a) (delay (list
                (make-m-cfg (list 'any) (list E) C)))])]
         [con (lambda (C a) (delay (list
                (make-m-cfg (list #\A) (list L (P a) R) (con1 C a))
                (make-m-cfg (list 'any) (list R R) (con C a)))))]
         [con1 (lambda (C a) (delay (list
                (make-m-cfg (list #\A) (list R (P a) R) (con1 C a))
                (make-m-cfg (list #\D) (list R (P a) R) (con2 C a)))))]
         [con2 (lambda (C a) (delay (list
                (make-m-cfg (list #\C) (list R (P a) R) (con2 C a))
                (make-m-cfg (list 'any) (list R R) C))))]
         [b (delay (list
                (make-m-cfg (list 'any) (list) (f b1 b1 #\∷))))]
         [b1 (delay (list
                (make-m-cfg (list 'any) (list R R (P #\:) R R (P #\D) R R (P #\A) R R (P #\D)) anf)))] ; added "R R PD"
         [anf (delay (list
                (make-m-cfg (list 'any) (list) (q anf1 #\:))))] ; corrected from "(g ..."
         [anf1 (delay (list
                (make-m-cfg (list 'any) (list) (con fom #\y))))]
         [fom (lambda () (list
                (make-m-cfg (list #\;) (list R (P #\z) L) (con fmp #\x))
                (make-m-cfg (list #\z) (list L L) fom)
                (make-m-cfg (list #\ǝ) (list H) fom)
                (make-m-cfg (list 'any) (list L) fom)))]
         [fmp (delay (list
                (make-m-cfg (list 'any) (list) (cpe (e (e anf #\x) #\y) sim #\x #\y))))] ; corrected
         [sim (delay (list
                (make-m-cfg (list 'any) (list) (fdash sim1 sim1 #\z))))]
         [sim1 (delay (list
                (make-m-cfg (list 'any) (list) (con sim2 'empty))))]
         [sim2 (delay (list
                (make-m-cfg (list #\A) (list) sim3)
                (make-m-cfg (list 'any) (list L (P #\u) R R R) sim2)))] ; corrected from "R ..."
         [sim3 (delay (list
                (make-m-cfg (list #\A) (list L (P #\y) R R R) sim3)
                (make-m-cfg (list 'any) (list L (P #\y)) (e mf #\z))))]
         [mf (delay (list
                (make-m-cfg (list 'any) (list) (q mf1 #\:))))] ; corrected from "(g mf ..."
         [mf1 (delay (list
                (make-m-cfg (list #\A) (list L L L L) mf2)
                (make-m-cfg (list 'any) (list R R) mf1)))]
         [mf2 (delay (list
                (make-m-cfg (list #\C) (list R (P #\x) L L L) mf2)
                (make-m-cfg (list #\:) (list) mf4)
                (make-m-cfg (list #\D) (list R (P #\x) L L L) mf3)))]
         [mf3 (delay (list
                (make-m-cfg (list #\:) (list) mf4)
                (make-m-cfg (list 'any) (list R (P #\v) L L L) mf3)))]
         [mf4 (delay (list
                (make-m-cfg (list 'any) (list) (con (l (l mf5)) 'empty))))]
         [mf5 (delay (list
                (make-m-cfg (list 'empty) (list (P #\:)) sh)
                (make-m-cfg (list 'any) (list R (P #\w) R) mf5)))]
         [sh (delay (list
                (make-m-cfg (list 'any) (list) (f sh1 inst #\u))))]
         [sh1 (delay (list
                (make-m-cfg (list 'any) (list L L L) sh2)))]
         [sh2 (delay (list
                (make-m-cfg (list #\D) (list R R R R) sh3) ; corrected from "sh2"
                (make-m-cfg (list 'any) (list) inst)))]
         [sh3 (delay (list
                (make-m-cfg (list #\C) (list R R) sh4)
                (make-m-cfg (list 'any) (list) inst)))]
         [sh4 (delay (list
                (make-m-cfg (list #\C) (list R R) sh5)
                (make-m-cfg (list 'any) (list) (pe2 inst #\0 #\:))))]
         [sh5 (delay (list
                (make-m-cfg (list #\C) (list) inst)
                (make-m-cfg (list 'any) (list) (pe2 inst #\1 #\:))))]
         [inst (delay (list                                 ; note that inst1 is forced here!
                                                            ; this is because it is a zero-arity varargs
                (make-m-cfg (list 'any) (list) (q (l (inst1)) #\u))))] ; corrected from "(g ..." 
         [inst1 (case-lambda
                 [() (delay (map
                       (lambda (a) (make-m-cfg (list a) (list R E) (inst1 a)))
                       u-symbols))]
                 [(x) (case x
                      [(#\L) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\y #\x #\u #\w))))]
                      [(#\R) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\x #\u #\y #\w))))]
                      [(#\N) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\x #\y #\u #\w))))])])]
         [ov (delay (list
               (make-m-cfg (list 'any) (list) (q (r (r ov1)) #\A))))] ; changed from original
         [ov1 (delay (list
               (make-m-cfg (list #\D) (list) (e anf))
               (make-m-cfg (list 'empty) (list (P #\D)) (e anf))))]
         ) b)) ;; start in state 'b'

I don’t think I can blame Turing much for the errors in the paper. It seems as though some arose through printing typos, and attempting to debug this baroque machine by hand, on paper, would have been a difficult task. (I don’t think he even had Visual Studio!)

A machine in a machine

Of course, the final test of this is to see whether this machine can actually emulate another like it is supposed to. I defined a short procedure to set up a machine on a tape according to Turing’s ingenious encoding.

(define (setup-tape tape inits) 
  (let ([t (move-right (print (move-right (print tape #\ǝ)) #\ǝ))]
  	[inits (append inits (list #\∷))])
   (go-far-left (fold-left (lambda (tape init)
  	       (move-right (move-right (print tape init)))) 
	     t inits))))

A quick explanation of Turing’s encoding

The idea is to first simplify, then encode the states. Turing noted that many of the m-configurations’ operations could be considered redundant:

• as mentioned above, instead of having “erase” we can simply print the ‘blank’ symbol
• instead of not modifying the symbol, we simply print the symbol already present

There are then only three types of operation each state needs to perform:

1. print something and go left
2. print something and go right
3. print something and stay put

States which have a sequence of operations can be split into a series of states, each of which transfers control to the next one.

Now, if we encode all the symbols and configurations as numbers, we can write them out. Turing chose to encode them via this scheme:

• configurations’ numbers are the symbol ‘D’ followed by n ‘A’s, where n is the number of the state
• symbols’ numbers are similar, with ‘D’ followed by n ‘C’s. (Turing set ‘blank’ to always be symbol 0, represented as simply “D”)

So to encode each configuration, we write down its number, the symbol it accepts, the symbol it outputs, which direction to move, and which state to go to next. We prefix each configuration with ‘;’. (When we input it into the machine we also sandwich the whole thing between ‘ǝǝ’ and ‘∷’.)

Here is the example which Turing gives in his paper. I have formatted it to make it easier to read. Can you tell what it does?

(define example (setup-tape empty-tape (list 
			     #\; #\D #\A             #\D #\D #\C     #\R #\D #\A #\A
			     #\; #\D #\A #\A         #\D #\D         #\R #\D #\A #\A #\A
			     #\; #\D #\A #\A #\A     #\D #\D #\C #\C #\R #\D #\A #\A #\A #\A
			     #\; #\D #\A #\A #\A #\A #\D #\D         #\R #\D #\A)))

If we translate the symbols to get numbers we have the following:

; 1 0 0 R 2
; 2 0 . R 3
; 3 0 1 R 4
; 4 0 . R 1

This machine prints alternately 0.1.0.1.. In fact, when I first typed it up, I left off an ‘A’ on the 3rd state and couldn’t figure out why the machine was printing 0.11111...!

Just to show it works

Here is some output of the universal machine running the ’0101′ machine. I have only included a snippet as the machine takes a while to get to this stage. You’ll also notice the output format is different from the other machines; this one outputs some state information and the output of the emulated machine (in this case, 0 and 1), separated by colons. So far, after a minute or so, the machine has output 010

.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C

And that’s enough for today! Feel free to post corrections, additions, your own Turing machines, and so on

f x y z = ...

… and you want:

f x y z w = ...

First of all you should check the contexts where f is used. For example, if f is quite often used as an argument to map (fmap, <$>):

elsewhere xs = map (f a b) xs

If you naïvely add w to the end of the argument list you’ll end up with this instead:

elsewhere xs = map (\x-> f a b x c) xs

On the other hand, if you take a look at the usage of f you can decide that because f is often used to map over things, you can insert the additional parameter before the last, and end up with nicer code:

elsewhere xs = map (f a b c) xs

You may even discover that the existing f is used in a lot of lambdas that could be avoided by rearranging its arguments!

public static IEnumerable<T> Map<F,T>(Func<F,T> func, IEnumerable<F> source)
{
    return
        from it in source
        select func(it);
}

Actually, it’s trivial to implement without the new syntax (although I’ve left in Func because it’s nicer than defining a separate delegate):

public static IEnumerable<T> Map<F,T>(Func<F,T> func, IEnumerable<F> from)
{
    foreach (F it in from)
        yield return func(it);
}

But why stop at map? We can also define a fold:

public static T FoldL<F, T>(Func<T, F, T> func, IEnumerable<F> source, T init)
{
    T last = init;
    foreach (F it in source)
        last = func(last, it);
    return last;
}

Or the non-empty-list variant. This is made easier through the query operator Skip:

public static T FoldL1<T>(Func<T, T, T> func, IEnumerable<T> source)
{
    T last = source.First();
    foreach (T it in source.Skip(1))
        last = func(last, it);
    return last;
}

Finally, a simple compose operator for sticking two functions together, again using the nicer syntax to make this simple:

public static Func<X,Z> Compose<X,Y,Z>(this Func<Y,Z> second, Func<X,Y> first) {
    return x => second(first(x));
}

Example

A simple example including functionality from each part above (I put everything into an FFC utility class):

int[] numbers = { 1, 2, 3, 4, 5 };
Func<int, int> addOne = n => n + 1;
 
foreach (var k in FFC.Map(addOne, numbers))
    Console.Write(k + " ");
Console.ReadLine();
 
Func<int,int> addTwo = addOne.Compose(addOne);
 
foreach (var k in FFC.Map(addTwo, numbers))
    Console.Write(k + " ");
Console.ReadLine();
 
var sum = FFC.FoldL((x, y) => x + y, numbers, 0);
Console.Write(sum + " ");
Console.ReadLine();

A first attempt

The first thing I thought of was to implement them using an IEnumerable with yield statements, so I began with a construction borrowed from Haskell: the iterate function.

static class FakeLazyList
{
    public static IEnumerable<T> Iterate<T>(Func<T, T> f, T x)
    {
        while (true)
        {
            yield return x;
            x = f(x);
        }
    }
}

While this works (try FakeLazyList.Iterate(i => i + 1, 0)), it is obviously a poor solution; it is not flexible as it requires a seperate function to be written for every incarnation.

Lazy data in general

My next approach was to begin with creating a generic type for lazy data. All it has to do is act as a wrapper for a piece of data. However, since in C# arguments must be evaluated before they are used, the data must in turn be wrapped inside a delegate so that the delegate’s execution can be postponed. This resulted in:

public class Lazy<T> 
{
    public Lazy(Func<T> del)
    {
        Del = del;
    }
    private Func<T> Del;
    private T PValue;
    private bool HasValue = false;
    public static implicit operator T(Lazy<T> f)
    {
        if (!f.HasValue)
        {
            f.PValue = f.Del.Invoke();
            f.HasValue = true;
        }
        return f.PValue;
    }
}

As you can see, execution of the data-bearing delegate is delayed until the lazy data is forced to become normal data.

Implementing the list

For the list implementation itself, I chose to go with the traditional cons list structure, so that each list item has an object of data, and a pointer to the next item in the list. In order to make the list lazy, the next item of the list should be generated only on-access, so it is wrapped in the above Lazy<T> class.

public class LazyList<T> : IEnumerable<T>, IEnumerable
{
    private T _First;
    private Lazy<LazyList<T>> _Rest;
 
    public T First { get { return _First; } }
    public LazyList<T> Rest { get { return _Rest; } }
 
    public LazyList(T first, Lazy<LazyList<T>> rest)
    {
        _First = first; _Rest = rest;
    }

Next comes some boilerplate so that the class can be used as an enumerable structure:

    public IEnumerator<T> GetEnumerator() {
        return new Enumerator(this);
    }
    IEnumerator IEnumerable.GetEnumerator()
    {
        return new Enumerator(this);
    }
 
    private class Enumerator : IEnumerator<T>, IEnumerator
    {
        private LazyList<T> curr = null;
        private LazyList<T> next;
        public Enumerator(LazyList<T> parent)
        {
            next = parent;
        }
        /* must implement both interfaces */
        object IEnumerator.Current { get { return this.Current; } }
        public T Current {
                get {
                    if (curr == null)
                        throw new InvalidOperationException();
                    else
                        return curr._First;
                }
        }
 
        public bool MoveNext() { curr = next; next = next._Rest; return curr != null; }
        public void Reset() { throw new NotSupportedException(); }
        public void Dispose() { return; }
    }

Last of all comes a couple of utility functions for constructing lists, both of which I took from Haskell. The first, iterate, generates a list of items by taking a function f and a datum x and generating the list like this [x,f(x),f(f(x)),f(f(f(x))),...].

    public static LazyList<X> Iterate<X>(Func<X, X> f, X x)
    {
        return new LazyList<X>(x, new Lazy<LazyList<X>>(delegate { return Iterate(f, f(x)); }));
    }

The next takes a datum and generates the infinite list of just that datum:

    public static LazyList<X> Repeat<X>(X x)
    {
        return new LazyList<X>(x, new Lazy<LazyList<X>>(delegate { return Repeat(x); }));
    }
}

As you can see, the usage of the LazyList constructor isn’t the most elegant. I had hoped that I would be able to use an implicit operator on the Lazy class, such as:

public static implicit operator Lazy<T>(Func<T> f)
{
    return new Lazy<T>(f);
}

… and then use it like this …

new LazyList<X>(x, () => Repeat(x));

Unfortunately, this doesn’t work, giving error CS1660. Apparently the C# compiler cannot use the fact that an implicit cast has been defined. Still, this implementation works well.

Usage

The usage of the LazyList in normal code is very simple, and as shown in this example, you can also use the new C# 3.0-defined list operators Take, Drop, Where etc:

IEnumerable<int> ys;
 
// Lazy list of all positive integers
ys = LazyList<int>.Iterate(i => i + 1, 0).Take(20);
foreach (var y in ys) Console.WriteLine(y);
 
//Lazy list of [89, 89, 89, 89, ...]
ys = LazyList<int>.Repeat(89).Take(20);
foreach (var y in ys) Console.WriteLine(y);
 
Console.ReadLine();

First of all we have to have an idea of what the numbers look like. We want to simulate this in XSL:

data Nat = Zero | Succ Nat

Using XSD we can have something like this:

<complexType name="Nat">
    <choice>
        <element name="Zero"/>
        <element name="Succ" type="Nat"/>
    </choice>
</complexType>

(Note that this is not tested, and probably wrong!)

However, since I don’t have an XSLT processor on hand that can deal with XSD types, I had to drop this course of action (although I still used the introduced type for the data). The type gives data like this:

<Succ><Succ><Zero/></Succ></Succ>

…in this case standing for the number two. Now the idea of addition on these numbers is given by a function:

add Zero y = y
add (Succ x) y = Succ (add x y)

Since this function involves pattern-matching it is an ideal candidate for implementation in XSLT, and it looks something like this:

<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="2.0" 
xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
 
	<!-- apply the add function to two numbers -->
	<xsl:template name="add" match="add">
		<xsl:apply-templates mode="adder" select="*[1]">
			<xsl:with-param name="rest" select="*[2]"/>
		</xsl:apply-templates>
	</xsl:template>
 
	<!-- add Succ(x) y = Succ(add x y) -->
	<xsl:template name="addSucc" mode="adder" match="Succ">
		<xsl:param name="rest"/>
		<Succ>
			<xsl:apply-templates mode="adder">
				<xsl:with-param name="rest" select="$rest"/>
			</xsl:apply-templates>
		</Succ>
	</xsl:template>
 
	<!-- add Zero y = y -->
	<xsl:template name="addZero" mode="adder" match="Zero">
		<xsl:param name="rest"/>
		<xsl:copy-of select="$rest"/>
	</xsl:template>
 
</xsl:stylesheet>

The first template matches any occurances of <add/>, and calls the real ‘add’ function on them. It passes the second number as a parameter, while the first is what the function actually recurses on—exactly as in the Haskell example. The rest proceeds similarly.

You can test it yourself by using the W3C online XSLT processor, which uses my processor and some sample input data. It should work for any similar data that you can throw at it as well. In this case it is adding 2 + 2 and coming up with 4, as we expect

Now, a functor is—according to higher sources—something which takes any type to a type . Let’s see how we can accomplish that with our functor, using Haskell code:

data MyFunctor a = Construct a

This is quite simply a type constructor for our functor for any type . For example, we can use it on the Integer type as Construct Integer, which will give us the type MyFunctor Integer.

That’s half the definition of a functor. The other half is that it also converts any function to a function . This means for any function, it converts that function to work on stuff “inside” the functor.

In terms of our Haskell code, this means that we have a function that acts on another function to modify it. This function is usually called “fmap” (for “functor map” or something similar). This function has the type:

fmap :: (a -> b) -> (MyFunctor a -> MyFunctor b)

It takes any function to . Now we can define the function itself. This is the part which will be the most unique for our functor, and we can define it how we like. For our functor, this isn’t going to be very interesting:

fmap f (MyFunctor a) = MyFunctor (f a)

We unwrap the object from our MyFunctor, apply the function , then wrap it back up.

Now there are two laws that must satisfy in order for this to be a “real” functor. In Haskell these are:

(fmap f) . (fmap g) == fmap (f . g)
id . fmap == fmap . id == fmap

These can’t be enforced from “within” Haskell, but you must keep them in mind when writing your functor. If you’d like, you can check that these laws hold for our MyFunctor defined above.

Now we have our entire functor:

data MyFunctor a = Construct a
fmap f (MyFunctor a) = MyFunctor (f a)

…and in fact, Haskell has a built-in class for functors:

class Functor f where
  fmap :: (a -> b) -> (f a -> f b)

We can declare our MyFunctor to be a Functor like this:

instance Functor MyFunctor where
  fmap f (MyFunctor a) = MyFunctor (f a)

…which still doesn’t seem very interesting.

An interesting functor is . This is defined as:

data List a = Empty | Cons a (List a)
 
instance Functor List where
  fmap f (Cons first rest) = Cons (f first) (fmap f rest)
  fmap f Empty = Empty

…wherein the functor takes a type to a list of , and is the familiar map list function, only expressed in a functor context.

T[X] = Forall(n : N) Xn / Autn

This is a little much for me, since I don’t understand the symbolism and terminology used in the other 99% of the paper, either! However, as they note that it closely matches the Taylor-series expansion of e^x. I think that using the simple concepts I linked to in the previous post, I can approach a similar definition.

First of all, start with a simple (identity?) type:

F[X] = X

Now, since what we want is a type that when differentiated, gives itself, we should start by integrating:

F[X]  = X2 ÷ 2

As shown in the previous post, we can interpret the division operator as ‘missing information’. In this case, the missing information is a 2-enum stating where the new type element was to be inserted… thus we have a type consisting of two elements, only we don’t know in what order they should appear. If we repeat this process several times, we obtain:

F[X] = X3 ÷ (2×3)
F[X] = X4 ÷ (2×3×4)
F[X] = X5 ÷ (2×3×4×5)

Now we can begin to see a pattern emerging. Each time we integrate the function, we are adding an element to the type, without saying where it should be inserted—in other words, we are creating an unordered set of objects (note that these aren’t true sets, but merely bags: sets which can contain duplicates). Now if we take the literal Taylor expansion of e^x, we can see what it really is as a type:

E[X] = Σ (Xn ÷ n!)

It is either a bag with one element, or a bag with two elements, or a bag with three elements… it is in fact the union of all bag types! That is, the exponential function interpreted as a type, is the type of bags.

If we take integration to be the logical inverse of differentiation (which is defined in the article as ‘removal of an element from a type’, then we have integration as the addition of an element to a type.

For example, take the type of an array of 3 elements of the same type:

F[T] = T3

If we are to add an element to this array, we want to integrate it. This gives us:

F[T] = T4 ÷ 4

Clearly this is not what we expected. If we want to add an element to a 3-element array, we are expecting a 4-element array. However, if we look again at the above result, we can reinterpret it as telling us something: the mere integration of the type is not supplying the expected result; and if we interpret division as ‘without’ (just as addition is ‘or’ and multiplication is ‘and’, then we can understand the result obtained.

What this is in fact telling us is that we need to provide another parameter (an enum in this case), which will give us the required result. In other words (if we do it backwards…:

F[T] = T4 -- wanted
F'[T] = 4.T3 -- needed

In order to obtain a 4-element array, we need a 3-element array and a 4-enum. This makes sense, because if we have a 3-element array:

x y z

…and we wish to add an element ‘w’ to it, we need to know where to insert it. The number of insertion points is:

(1) x (2) y (3) z (4)

…and thus we need to supply a 4-enum to specify exactly where we want the insertion to take place. Once we have done this, we obtain our 4-element array with no ‘missing’ parameters.

comp [] _ = False
comp _ [] = True
comp (_s) (_:ys) = comp xs ys

foldr getCounts (0,0,0) $ map classify $ concat [[20..30], [490..500], [8120..8130]]

In order to understand what is happening here, one needs to start from the RHS of the expression and then work backwards—much the same as in this snippet of APL:

(∼R∈R∘.×R)/R←1↓⍳R

(See the Wikipedia article on APL for what is happening here.)

In both cases, the code is operating upon a common parameter which is modified by each function in turn. Similarly, there seems to be a rather high-level isomorphism between these kinds of functional code and the concept of Unix pipes:

sort file | uniq -c | sort -n

…with the difference being that in this case, the common parameter is being passed from the left instead of from the right.

Now, in Haskell I can define a new “pipe” operator (| is already taken):

(~>) :: a -> (a->b) -> b
(~>) x f = f x

Which just has the reverse signature to the $ operator, and:

foldr getCounts (0,0,0) $ map classify $ concat [[20..30], [490..500], [8120..8130]]

…becomes…

[[20..30], [490..500], [8120..8130]] ~> concat ~> map classify ~> foldr getCounts (0,0,0)

…which makes it a bit easier to read, at least in my (used-to-Linux) eyes.