A Toy SECD Machine

In 1964, Peter Landin wrote a paper called “The Mechanical Evaluation of Expressions”(pdf) in which he outlines a notion of “Applicative Expressions” which, in the tradition of McCarthy's original Lisp, translate a more complex functional programming language into a smaller kernel.

Now, this sort of thing isn't new to me, you see the smaller kernel language approach all over in Functional Programming, partly due to the work of McCarthy and Landin. More interesting was the second part of the paper, in which he outlines what I've been told was the first virtual machine, namely the SECD machine.

This machine is a procedure and takes its name from the four arguments it takes: the Stack, Environment, Control, and Dump.

The Stack is your bog-standard stack from computing, and is used for keeping temporary results, passing arguments to functions, and returning the result value.

The Environment is a traditional alist structure of names and their values.

The Control is the list of Applicative Expressions still to be evaluated.

Finally, the Dump is a structure holding a previous state for these four registers.

You can read Landin's paper, and you will get a much better description than I've managed, but I have provided a toy Haskell implementation of the SECD machine for you to play with. The code is also available as a gist, and there is a second, slightly more complicated version, that allows you to augment the machine with additional primitives.

-- An implementation of Peter Landin's SECD machine, as described in
-- "The Mechanical Evaluate of Expressions"
import Prelude hiding (lookup)

type Name = String

data Expr = ID Name
          | Fun Name Expr
          | Apply Expr Expr
          deriving (Eq, Show)
            
data Value = S Name
           | Closure Name Expr Environment
           deriving (Eq, Show)
             
type Stack = [Value]

type Environment = [(Name, Value)]

data Controllee = AP
                | AE Expr
                deriving (Show)

type Control = [Controllee]

data Dump = Dump Stack Environment Control Dump
          | InitState
          deriving (Show)

lookup :: Name -> Environment -> Value
lookup n [] = S n
lookup n ((k,v):kvs)
  | n == k    = v -- The wrong thing (tm), but it makes things slightly easier to test
  | otherwise = lookup n kvs

transform :: Stack -> Environment -> Control -> Dump -> Value
transform (s:_) e [] InitState           = s
transform (s:ss) e [] (Dump s' e' c' d') = transform (s:s') e' c' d'
transform s e (AE (ID i):cs) d           = transform (lookup i e : s) e cs d
transform s e (AE (Fun n b) : cs) d      = transform (Closure n b e : s) e cs d
transform s e (AE (Apply op arg) : cs) d = transform s e (AE arg : AE op : AP : cs) d
transform (Closure n b e' : s2 : ss) e (AP : cs) d = transform [] e'' [AE b] d'
  where e'' = (n, s2) : e'
        d'  = Dump ss e cs d
transform (s1:s2:ss) e (AP : cs) d = transform (basicApply s1 s2:ss) e cs d
transform _ _ _ _ = error "crash"

-- Implement this to be handle primitive functions in the machine
basicApply :: Value -> Value -> Value
basicApply fun arg = error "not implemented yet"

runSECD :: [Expr] -> Value
runSECD es = transform [] initEnv initControl InitState
  where initEnv = []
        initControl = map AE es

test1 = runSECD [Apply (Fun "x" (ID "x")) (ID "y")] == S "y"
test2 = runSECD [Apply (Fun "x" (ID "x")) $ Apply (Fun "x" (ID "x")) (ID "y")] == S "y"
test3 = runSECD [Apply (Apply (Fun "x" (ID "x")) (Fun "x" (ID "x")))  (ID "y")]  == S "y"

runTests = and [test1,test2,test3]

As a brief aside, agumonkey on the Freenode #emacs irc channel mentioned that there should be a programming language named after him. I wholeheartedly agree.