diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2009 Bernard James Pope 
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.txt b/README.txt
new file mode 100644
--- /dev/null
+++ b/README.txt
@@ -0,0 +1,13 @@
+Thank you for trying Ministg.
+
+For documentation on using Ministg please consult the web page:
+
+   http://www.haskell.org/haskellwiki/Ministg
+
+For building and installing please consult the web page:
+
+   http://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package
+
+Feedback, feature requests, bug reports:
+
+  Bernie Pope: http://www.cs.mu.oz.au/~bjpop/
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/ministg.cabal b/ministg.cabal
new file mode 100644
--- /dev/null
+++ b/ministg.cabal
@@ -0,0 +1,40 @@
+name:                ministg
+version:             0.1
+cabal-version:       >= 1.6
+synopsis:            an interpreter for an operational semantics for the STG machine. 
+description:         ministg is an interpreter for a simple high-level operational semantics for the STG machine. The
+                     semantics is taken from the research paper "Making a fast curry: push/enter vs. eval/apply
+                     for higher-order languages", by Simon Marlow and Simon Peyton Jones. It provides the option
+                     to trace the execution of the interpreter, rendering each step in a HTML file. This is useful
+                     for understanding the behaviour of the STG machine, and also useful for experimenting with 
+                     changes to the machine. It also supports an experimental call stack tracing facility.
+category:            Language
+license:             BSD3
+license-file:        LICENSE
+copyright:           (c) 2009 Bernard James Pope
+author:              Bernard James Pope 
+maintainer:          bjpop@csse.unimelb.edu.au
+homepage:            http://www.haskell.org/haskellwiki/Ministg 
+build-type:          Simple
+stability:           experimental
+tested-with:         GHC==6.10.4
+extra-source-files:  README.txt test/*.stg 
+
+Executable ministg 
+  main-is:         Main.hs
+  hs-source-dirs:  src
+  build-depends:   base >= 3 && < 5, monads-tf, transformers, containers, parsec >= 3, pretty, haskell98, xhtml, directory, filepath
+  other-modules:
+      Ministg.AST
+      Ministg.Lexer
+      Ministg.Parser
+      Ministg.Utils
+      Ministg.Eval
+      Ministg.Arity
+      Ministg.Pretty
+      Ministg.State
+      Ministg.TraceEval
+      Ministg.CallStack
+      Ministg.Options
+      Ministg.GC
+      Ministg.Annotate
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,80 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Main 
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- The main module of ministg. An interpreter for the operational semantics
+-- of the STG machine, as set out in the "How to make a fast curry" paper
+-- by Simon Marlow and Simon Peyton Jones.
+-----------------------------------------------------------------------------
+
+module Main where
+
+import System (exitFailure)
+import Ministg.AST (Program (Program))
+import Ministg.Parser (parser)
+import Ministg.Lexer (lexer, Token)
+import Control.Monad (when, unless)
+import System (getArgs, exitFailure)
+import System.Directory (doesDirectoryExist, createDirectory)
+import Ministg.Utils (safeReadFile)
+import Ministg.Arity (runArity)
+import Ministg.Eval (run)
+import Ministg.Pretty (prettyText)
+import Ministg.Options (processOptions, Flag (..), Dumped (..), existsFlag, getTraceDir)
+import Ministg.Annotate
+
+-- | The main driver of the program.
+main :: IO ()
+main = do
+   args <- getArgs
+   (flags, file) <- processOptions args
+   -- create trace directory if necessary
+   when (existsFlag flags Trace) $ do
+      let traceDir = getTraceDir flags
+      dirExist <- doesDirectoryExist traceDir
+      unless dirExist $ createDirectory traceDir 
+   -- parse the file
+   Program userProgram <- parseFile flags file
+   -- optionally include the Prelude
+   fullProgram 
+      <- if existsFlag flags NoPrelude
+            then return (Program userProgram)
+            else do Program preludeProgram <- parseFile flags "Prelude.stg"
+                    return $ Program (preludeProgram ++ userProgram)
+   -- possibly annotate the program with stack markers
+   let annotated = if existsFlag flags Annotate 
+                      then annotate fullProgram else fullProgram 
+   -- compute arities of known functions
+   let arityProgram = runArity annotated 
+   dump flags DumpArity (prettyText arityProgram) $
+      "The program after arity analysis:\n"
+   -- interpret the program
+   run flags arityProgram
+
+parseFile :: [Flag] -> FilePath -> IO Program
+parseFile flags file = do
+   tryContents <- safeReadFile file
+   case tryContents of
+      Left error -> putStrLn error >> exitFailure
+      Right contents -> do
+         -- parse the program
+         case parser file contents of
+            Left e -> (putStrLn $ "Parse error: " ++ show e) >> exitFailure
+            Right program -> do 
+               dump flags DumpAST (show program) $ "The AST of the program from " ++ file ++ ":\n"
+               dump flags DumpParsed (prettyText program) $
+                    "The parsed program from " ++ file ++ ":\n"
+               return program 
+
+dump :: [Flag] -> Dumped -> String -> String -> IO () 
+dump flags dumped str msg = 
+   when (existsFlag flags $ Dump dumped) $ do
+      putStrLn msg 
+      putStrLn str 
+      putStr "\n"
+
diff --git a/src/Ministg/AST.hs b/src/Ministg/AST.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/AST.hs
@@ -0,0 +1,222 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.AST 
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- The representation of the abstract syntax tree for ministg programs. 
+-----------------------------------------------------------------------------
+module Ministg.AST where
+
+import Prelude 
+import Ministg.CallStack (CallStack, prettyCallStack)
+import Ministg.Pretty
+import Data.Set as Set hiding (map)
+
+-- | Variables (also known as identifiers).
+type Var = String
+-- | Data constructor names.
+type Constructor = String
+
+class FreeVars t where
+   freeVars :: t -> Set Var
+
+instance FreeVars t => FreeVars [t] where
+   freeVars = Set.unions . map freeVars
+
+-- | Literal integers. These correspond to unboxed integers in the semantics.
+data Literal = Integer Integer 
+   deriving (Eq, Show)
+
+instance Pretty Literal where
+   pretty (Integer i) = pretty i
+
+-- | Atomic expressions.
+data Atom
+   = Literal Literal    -- ^ Literal values (unoboxed integers).
+   | Variable Var       -- ^ Variables.
+   deriving (Eq, Show)
+
+instance Pretty Atom where
+   pretty (Literal l) = pretty l
+   pretty (Variable v) = text v
+
+instance FreeVars Atom where
+   freeVars (Literal {}) = Set.empty
+   freeVars (Variable v) = Set.singleton v
+
+-- | Is an atom a literal?
+isLiteral :: Atom -> Bool
+isLiteral (Literal {}) = True
+isLiteral _other = False
+
+-- | The arity (number of parameters) of a function. It is only known when the function 
+-- being applied is statically known (not lambda bound).
+type FunArity = Maybe Int
+
+prettyArity :: FunArity -> Doc
+prettyArity Nothing = text "_?" 
+prettyArity (Just i) = text "_" <> int i
+
+-- | Expressions.
+data Exp 
+   = Atom Atom                  -- ^ Atomic expressions (literals, variables).
+   | FunApp FunArity Var [Atom] -- ^ Function application (f^k a_1 ... a_n, n >= 1).
+   | PrimApp Prim [Atom]        -- ^ Saturated primitive application (op a_1 ... a_n, n >= 1).
+   | Let Var Object Exp         -- ^ Let declaration. 
+   | Case Exp [Alt]             -- ^ Case expression.
+   | Stack String Exp           -- ^ Like SCC, but just for stacks. (stack str (exp))
+   deriving (Eq, Show)
+
+instance FreeVars Exp where
+   freeVars (Atom a) = freeVars a
+   freeVars (FunApp _arity var args) = Set.singleton var `Set.union` freeVars args
+   freeVars (PrimApp prim args) = freeVars args
+   -- Treat this as a letrec, which means that the var is bound (not free) in the object
+   freeVars (Let var object exp) 
+      = Set.delete var (freeVars exp `Set.union` freeVars object) 
+   freeVars (Case exp alts)
+      = freeVars exp `Set.union` freeVars alts
+   freeVars (Stack _str exp) = freeVars exp
+
+instance Pretty Exp where
+   pretty (Atom a) = pretty a
+   pretty (FunApp arity var atoms) = text var <> prettyArity arity <+> hsep (map pretty atoms)
+   pretty (PrimApp prim atoms) = pretty prim <+> hsep (map pretty atoms)
+   pretty letExp@(Let var obj exp) 
+      = maybeNest (text "let {") prettyDecls (rbrace <+> text "in" <+> pretty inExp)
+      where
+      (decls, inExp) = unflattenLet letExp
+      prettyDecls = vcat (punctuate semi (map pretty decls))
+      maybeNest letPart declPart inPart
+         | length decls < 2 = letPart <+> declPart <+> inPart
+         | otherwise = letPart $$ (nest 3 declPart) $$ inPart
+   pretty (Case exp alts) = 
+      text "case" <+> pretty exp <+> text "of {" $$ 
+      nest 3 (vcat (punctuate semi (map pretty alts))) $$
+      rbrace
+   pretty (Stack annotation exp) = 
+      maybeNest exp (text "stack" <+> doubleQuotes (text annotation)) (pretty exp)
+
+isNestedExp :: Exp -> Bool
+isNestedExp (Let {}) = True
+isNestedExp (Case {}) = True
+isNestedExp (Stack {}) = True
+isNestedExp other = False 
+
+unflattenLet :: Exp -> ([Decl], Exp)
+unflattenLet exp = unflattenLetAcc exp []
+   where
+   unflattenLetAcc :: Exp -> [Decl] -> ([Decl], Exp)
+   unflattenLetAcc (Let var obj exp) ds = unflattenLetAcc exp (Decl var obj : ds) 
+   unflattenLetAcc exp ds = (reverse ds, exp) 
+
+-- | Case alternatives (the right-hand-sides of case branches).
+data Alt
+   = PatAlt Constructor [Var] Exp  -- ^ Constructor pattern (C x_1 ... x_n -> e, n >= 0).
+   | DefaultAlt Var Exp            -- ^ Default pattern (matches anything) (x -> e).
+   deriving (Eq, Show)
+
+instance FreeVars Alt where
+   freeVars (PatAlt constructor args exp) = freeVars exp \\ Set.fromList args
+   freeVars (DefaultAlt var exp) = Set.delete var $ freeVars exp 
+
+instance Pretty Alt where
+   pretty (PatAlt con vars exp) = maybeNest exp (text con <+> hsep (map text vars) <+> rightArrow) (pretty exp)
+   pretty (DefaultAlt var exp) = text var <+> rightArrow <+> pretty exp
+
+rightArrow :: Doc
+rightArrow = text "->" 
+
+-- | Objects. These serve two roles in the language: 
+-- 
+-- (1) as part of the language syntax (except blackholes).
+-- (2) as things which are allocated on the heap during execution.
+
+data Object
+   = Fun [Var] Exp                 -- ^ Function values (FUN (x_1 ... x_n -> e).
+   | Pap Var [Atom]                -- ^ Partial applications (PAP (f a_1 ... a_n)).
+   | Con Constructor [Atom]        -- ^ Data constructor application (CON (C a_1 ... a_n)).
+   | Thunk Exp CallStack           -- ^ THUNK (e).
+   | BlackHole                     -- ^ BLACKHOLE (only during evaluation - not part of the language syntax).
+   | Error                         -- ^ Raise an exception.
+   deriving (Eq, Show)
+
+instance FreeVars Object where
+   freeVars (Fun vars exp) = freeVars exp \\ Set.fromList vars
+   freeVars (Pap var args) = Set.singleton var `Set.union` freeVars args
+   freeVars (Con constructor args) = freeVars args
+   freeVars (Thunk exp callStack) = freeVars exp 
+   freeVars BlackHole = Set.empty
+   freeVars Error = Set.empty
+
+maybeNest :: Exp -> Doc -> Doc -> Doc
+maybeNest exp d1 d2 = if isNestedExp exp then d1 $$ (nest 3 d2) else d1 <+> d2
+
+instance Pretty Object where
+   pretty (Fun vars exp) 
+      = text "FUN" <> parens (maybeNest exp (hsep (map text vars) <+> rightArrow) (pretty exp))
+   pretty (Pap var atoms) = text "PAP" <> parens (text var <+> hsep (map pretty atoms))
+   pretty (Con constructor atoms) = text "CON" <> parens (text constructor <+> hsep (map pretty atoms))
+   pretty (Thunk exp callStack) 
+      = text "THUNK" <> parens (pretty exp) $$ (nest 3 (prettyCallStack callStack))
+   pretty BlackHole = text "BLACKHOLE"
+   pretty Error = text "ERROR"
+
+-- | Test for "value" objects.
+isValue :: Object -> Bool
+isValue (Fun {}) = True
+isValue (Pap {}) = True
+isValue (Con {}) = True
+isValue _other = False
+
+-- | Test for FUN objects
+isFun :: Object -> Bool
+isFun (Fun {}) = True
+isFun other = False
+
+-- | Test for PAP objects
+isPap :: Object -> Bool
+isPap (Pap {}) = True
+isPap other = False
+
+-- | A top-level declaration (f = obj).
+data Decl = Decl Var Object
+   deriving Show
+
+instance Pretty Decl where
+   pretty (Decl var obj) = text var <+> equals <+> pretty obj
+
+-- | A whole program.
+newtype Program = Program [Decl]
+   deriving Show
+
+instance Pretty Program where
+   pretty (Program decls) = vcat (punctuate semi (map pretty decls))
+
+-- | Primitive operators.
+data Prim
+   = Add                        -- ^ Unboxed integer addition (x + y).
+   | Subtract                   -- ^ Unboxed integer subtraction (x - y).
+   | Multiply                   -- ^ Unboxed integer multiplication (x * y).
+   | Equality                   -- ^ Unboxed integer equality test (x == y).
+   | LessThan                   -- ^ Unboxed integer less-than comparison (x < y).
+   | GreaterThan                -- ^ Unboxed integer greater-than comparison ( x > y). 
+   | LessThanEquals             -- ^ Unboxed integer less-than-equals comparison ( x <= y).
+   | GreaterThanEquals          -- ^ Unboxed integer greater-than-equals comparison ( x >= y).
+   | IntToBool                  -- ^ Convert an unboxed integer to a (boxed) boolean ( 1 = True, 0 = False).
+   deriving (Eq, Show)
+
+instance Pretty Prim where
+   pretty Add = text "plus#"
+   pretty Subtract = text "sub#"
+   pretty Multiply = text "mult#"
+   pretty Equality = text "eq#"
+   pretty LessThan = text "lt#"
+   pretty GreaterThan = text "gt#"
+   pretty LessThanEquals = text "lte#"
+   pretty GreaterThanEquals = text "gte#" 
+   pretty IntToBool = text "intToBool#"
diff --git a/src/Ministg/Annotate.hs b/src/Ministg/Annotate.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Annotate.hs
@@ -0,0 +1,34 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Annotate
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Add stack annotations to top-level functions in ministg programs. 
+-----------------------------------------------------------------------------
+module Ministg.Annotate where
+
+import Ministg.AST
+
+class Annotate t where
+   annotate :: t -> t
+
+instance Annotate a => Annotate [a] where
+   annotate = map annotate
+
+instance Annotate Program where
+   annotate (Program decls) = Program $ annotate decls
+
+instance Annotate Decl where
+   -- don't annotate functions which are already annotated (by the user)
+   annotate decl@(Decl _ (Fun _ (Stack {}))) = decl
+   annotate (Decl var (Fun args body))
+      = Decl var (Fun args (Stack var body))
+   -- don't annotate thunks which are already annotated (by the user)
+   annotate decl@(Decl _ (Thunk (Stack {}) _)) = decl
+   annotate decl@(Decl var (Thunk body callStack)) 
+      = Decl var (Thunk (Stack var body) callStack) 
+   annotate other = other
diff --git a/src/Ministg/Arity.hs b/src/Ministg/Arity.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Arity.hs
@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -XTypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Arity
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Arity analysis of ministg programs: compute how many arguments each
+-- top-level and let-bound function has, and annotate the application sites
+-- of those functions.
+-----------------------------------------------------------------------------
+
+module Ministg.Arity (runArity, Arity) where
+
+import Data.Map as Map
+import Control.Monad.Reader
+import Control.Applicative
+import Ministg.AST
+import Data.List (foldl')
+
+-- | A mapping from variable names (names of functions) to their respective
+-- arities.
+type ArityMap = Map Var Int
+-- | A monad for pushing arity information down the AST, taking care of 
+-- variable scope. 
+type A a = Reader ArityMap a
+
+-- | Arity analysis of a program fragment.
+runArity :: Arity a => a -> a
+runArity x = runReader (arity x) Map.empty 
+
+-- | Overloaded arity function.
+class Arity a where
+   arity :: a -> A a 
+
+instance Arity Alt where
+   arity (PatAlt con args body) = 
+      PatAlt con args <$> local (clearVars args) (arity body)
+   arity (DefaultAlt var body) = 
+      DefaultAlt var <$> local (clearVars [var]) (arity body)
+
+instance Arity Object where
+   arity (Fun args body) = Fun args <$> local (clearVars args) (arity body)
+   arity (Thunk exp cs) = Thunk <$> arity exp <*> pure cs
+   arity other = return other
+
+instance Arity Program where
+   arity (Program decls) = Program <$> (local (Map.union as) $ mapM arity decls)
+      where
+      as :: ArityMap
+      as = Map.fromList [ (var, countArgs obj) | Decl var obj <- decls, isFun obj]
+
+-- | Count the number of arguments (really parameters) of a function object).
+countArgs :: Object -> Int
+countArgs (Fun args _) = length args
+countArgs other = error $ "countArgs called on non function: " ++ show other
+
+instance Arity Decl where
+   arity (Decl var object) = Decl var <$> arity object
+
+instance Arity Exp where
+   arity (FunApp _oldArity var args) = 
+      FunApp <$> asks (Map.lookup var) <*> pure var <*> pure args
+   arity (Let var object exp)
+      | isFun object = 
+           Let var <$> arity object <*> local (Map.insert var $ countArgs object) (arity exp)
+      | otherwise = Let var <$> arity object <*> local (clearVars [var]) (arity exp)
+   arity (Case exp alts) = Case <$> arity exp <*> mapM arity alts 
+   arity (Stack annotation exp) = Stack annotation <$> arity exp
+   arity exp@(Atom {}) = return exp
+   arity exp@(PrimApp {}) = return exp
+
+-- | Remove a list of variables from an ArityMap.
+clearVars :: [Var] -> ArityMap -> ArityMap
+clearVars vars map = foldl' (flip Map.delete) map vars
diff --git a/src/Ministg/CallStack.hs b/src/Ministg/CallStack.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/CallStack.hs
@@ -0,0 +1,27 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.CallStack
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Stack of program annotations. Simulate a call stack.
+-----------------------------------------------------------------------------
+
+module Ministg.CallStack (CallStack, push, showCallStack, prettyCallStack) where
+
+import Ministg.Pretty
+
+type CallStack = [String]
+
+push :: String -> CallStack -> CallStack
+push = (:)
+
+showCallStack :: CallStack -> String
+showCallStack = unlines
+
+prettyCallStack :: CallStack -> Doc
+prettyCallStack [] = empty
+prettyCallStack stack = char '<' <> hcat (punctuate (text "|") (map text stack)) <> char '>'
diff --git a/src/Ministg/Eval.hs b/src/Ministg/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Eval.hs
@@ -0,0 +1,321 @@
+{-# OPTIONS_GHC -XPatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Eval
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Evaluate a ministg program using the semantics described in the 
+-- "fast curry" paper by Simon Marlow and Simon Peyton Jones.
+-----------------------------------------------------------------------------
+
+module Ministg.Eval (run) where
+
+import Control.Monad.State (evalStateT, gets)
+import Control.Monad.Trans (liftIO)
+import Data.Map as Map hiding (map)
+import Data.List (foldl')
+import Ministg.AST
+import Ministg.CallStack (CallStack, push, showCallStack)
+import Ministg.Pretty
+import Ministg.State
+import Ministg.TraceEval (traceEval, traceEnd)
+import Ministg.Options as Opts 
+       (Flag (..), EvalStyle (..), defaultEvalStyle, probeFlagsFirst, getEvalStyle)
+import Ministg.GC (garbageCollect)
+
+-- | Evaluate a ministg program and cause its effects to happen.
+run :: [Flag] -> Program -> IO ()
+run flags decls = 
+   evalStateT (evalProgram style $ initHeap decls) (initState flags)
+   where
+   style = getEvalStyle flags
+
+evalProgram :: EvalStyle -> Heap -> Eval ()
+evalProgram style heap = do
+   (newExp, _newStack, newHeap) <- bigStep style (Atom (Variable "main")) initStack heap
+   traceEnd
+   str <- case newExp of
+             Atom (Literal lit) -> return $ prettyText lit 
+             Atom (Variable var) -> do
+                let object = lookupHeap var newHeap
+                case object of
+                   Error -> do
+                      cs <- gets state_callStack
+                      return $ "Exception raised!" ++ displayCallStack cs
+                   other -> return $ prettyHeapObject newHeap $ lookupHeap var newHeap
+             other -> return $ "Runtime error: result of bigStep is not an atom: " ++ show other 
+   liftIO $ putStrLn str
+   where
+   displayCallStack [] = []
+   displayCallStack cs = "\n\nCall stack:\n" ++ showCallStack cs
+        
+-- | Reduce an exression to WHNF (a big step reduction, which may be composed
+-- of one or more small step reductions).
+bigStep :: EvalStyle -> Exp -> Stack -> Heap -> Eval (Exp, Stack, Heap) 
+bigStep style exp stack heap = do
+   gcHeap <- garbageCollect exp stack heap
+   traceEval exp stack gcHeap 
+   result <- smallStep style exp stack gcHeap
+   incStepCount
+   case result of
+      -- Nothing more to do, we have reached a WHNF value (or perhaps some error).
+      Nothing -> return (exp, stack, gcHeap)
+      -- There might be more to do, keep trying.
+      Just (newExp, newStack, newHeap) -> bigStep style newExp newStack newHeap
+
+-- | Perform one step of reduction. These equations correspond to the
+-- rules in the operational semantics described in the "fast curry" paper.
+smallStep :: EvalStyle -> Exp -> Stack -> Heap -> Eval (Maybe (Exp, Stack, Heap))
+-- STACK ANNOTATION
+smallStep style (Stack annotation exp) stack heap = do
+   setRule "STACK"
+   pushCallStack annotation
+   return $ Just (exp, stack, heap)
+-- LET
+smallStep _anyStyle (Let var object exp) stack heap = do
+   setRule "LET"
+   newVar <- freshVar
+   callStack <- gets state_callStack
+   let annotatedObject = setThunkStack callStack object
+   let newHeap = updateHeap newVar annotatedObject heap
+   let newExp = subs (mkSub var (Variable newVar)) exp 
+   return $ Just (newExp, stack, newHeap)
+-- CASECON
+smallStep _anyStyle (Case (Atom (Variable v)) alts) stack heap
+   | Con constructor args <- lookupHeap v heap, 
+     Just (vars, exp) <- exactPatternMatch constructor alts = do
+        setRule "CASECON"
+        return $ Just (subs (mkSubList $ zip vars args) exp, stack, heap)
+-- CASEANY
+smallStep _anyStyle (Case (Atom v) alts) stack heap
+   | isLiteral v || isValue (lookupHeapAtom v heap), 
+     Just (x, exp) <- defaultPatternMatch alts = do
+        setRule "CASEANY"
+        return $ Just (subs (mkSub x v) exp, stack, heap)
+-- CASE
+smallStep _anyStyle (Case exp alts) stack heap = do
+   setRule "CASE"
+   callStack <- gets state_callStack
+   return $ Just (exp, CaseCont alts callStack : stack, heap)
+-- RET 
+smallStep _anyStyle exp@(Atom atom) (CaseCont alts oldCallStack : stackRest) heap
+   | isLiteral atom || isValue (lookupHeapAtom atom heap) = do
+        setRule "RET"
+        setCallStack oldCallStack
+        return $ Just (Case exp alts, stackRest, heap)
+-- THUNK 
+smallStep _anyStyle (Atom (Variable x)) stack heap
+   | Thunk exp thunkCallStack <- lookupHeap x heap = do
+        setRule "THUNK"
+        let newHeap = updateHeap x BlackHole heap
+        oldCallStack <- gets state_callStack
+        setCallStack thunkCallStack 
+        return $ Just (exp, UpdateCont x oldCallStack : stack, newHeap)
+-- UPDATE
+smallStep _anyStyle atom@(Atom (Variable y)) (UpdateCont x oldCallStack : stackRest) heap
+   | object <- lookupHeap y heap, isValue object = do
+        setRule "UPDATE"
+        setCallStack oldCallStack
+        return $ Just (atom, stackRest, updateHeap x object heap)
+-- KNOWNCALL
+smallStep _anyStyle (FunApp (Just arity) var args) stack heap
+   | arity == length args = 
+        case lookupHeap var heap of
+           Fun params body -> do
+              setRule "KNOWNCALL"
+              let newBody = subs (mkSubList $ zip params args) body
+              return $ Just (newBody, stack, heap) 
+           other -> fail $ "known function " ++ var ++ " bound to non function object: " ++ show other
+-- PRIMOP
+smallStep _anyStyle (PrimApp prim args) stack heap = do
+   setRule "PRIMOP"
+   (result, newStack, newHeap) <- evalPrim prim args stack heap
+   return $ Just (Atom result, newStack, newHeap)
+
+-- The push enter specific rules.
+
+-- PUSH
+smallStep PushEnter (FunApp _arity f args) stack heap = do
+   setRule "PUSH"
+   return $ Just (Atom (Variable f), map ArgCont args ++ stack, heap)
+-- FENTER
+smallStep PushEnter (Atom (Variable f)) stack heap
+   | Fun vars exp <- lookupHeap f heap,
+     (argConts, restStack) <- span isArgCont stack,
+     length vars <= length argConts = do
+        setRule "FENTER"
+        let (enoughArgs, restArgs) = splitAt (length vars) argConts
+        let argAtoms = [atom | ArgCont atom <- enoughArgs]
+        let newStack = restArgs ++ restStack 
+        return $ Just (subs (mkSubList $ zip vars argAtoms) exp, newStack, heap) 
+-- PAP1
+smallStep PushEnter (Atom (Variable f)) stack heap
+   | Fun vars exp <- lookupHeap f heap,
+     argConts <- takeWhile isArgCont stack,
+     length argConts >= 1,
+     length vars > length argConts = do
+        setRule "PAP1"
+        let argAtoms = [atom | ArgCont atom <- argConts]
+        p <- freshVar
+        return $ Just (Atom (Variable p), drop (length argConts) stack, updateHeap p (Pap f argAtoms) heap)
+-- PENTER
+smallStep PushEnter (Atom (Variable f)) stack@(ArgCont _ : stackRest) heap
+   | Pap g args <- lookupHeap f heap = do
+        setRule "PENTER"
+        return $ Just (Atom (Variable g), map ArgCont args ++ stack, heap) 
+
+-- The eval apply rules
+
+-- EXACT
+smallStep EvalApply (FunApp Nothing f args) stack heap
+   | Fun vars exp <- lookupHeap f heap, length args == length vars = do
+        setRule "EXACT"
+        let newExp = subs (mkSubList $ zip vars args) exp
+        return $ Just (newExp, stack, heap)
+-- CALLK
+smallStep EvalApply (FunApp _anyArity f args) stack heap
+   | Fun vars exp <- lookupHeap f heap, length args > length vars = do
+        setRule "CALLK"
+        let (enoughArgs, restArgs) = splitAt (length vars) args
+            newExp = subs (mkSubList $ zip vars enoughArgs) exp
+        return $ Just (newExp, (ApplyToArgs restArgs) : stack, heap)
+-- PAP2
+smallStep EvalApply (FunApp _anyArity f args) stack heap
+   | Fun vars exp <- lookupHeap f heap, length args < length vars = do
+        setRule "PAP2"
+        p <- freshVar
+        let newHeap = updateHeap p (Pap f args) heap
+        return $ Just (Atom (Variable p), stack, newHeap)
+-- TCALL
+-- XXX fix up call stack?
+smallStep EvalApply (FunApp Nothing f args) stack heap
+   | Thunk exp thunkCallStack <- lookupHeap f heap = do
+        setRule "TCALL"
+        return $ Just (Atom (Variable f), (ApplyToArgs args) : stack, heap)
+-- PCALL
+smallStep EvalApply (FunApp _anyArity f args) stack heap
+   | Pap g papArgs <- lookupHeap f heap = do
+        setRule "PCALL"
+        return $ Just (FunApp Nothing g (papArgs ++ args), stack, heap)
+-- RETFUN
+smallStep EvalApply (Atom (Variable f)) (ApplyToArgs args : stack) heap
+   | object <- lookupHeap f heap, isFun object || isPap object = do
+        setRule "RETFUN"
+        return $ Just (FunApp Nothing f args, stack, heap)
+
+-- NOTHING MORE TO DO
+smallStep _anyStyle _other _stack _heap = do
+   setRule "None"
+   return Nothing
+
+-- | Evaluate the application of a primitive function. It is assumed that the
+-- arguments of the primitive are already evaluated. Note: we allow primitives
+-- to manipulate the heap and stack, but the semantics in the "fast curry" paper
+-- do not.
+evalPrim :: Prim -> [Atom] -> Stack -> Heap -> Eval (Atom, Stack, Heap)
+evalPrim Add args stack heap = mkIntPrim (+) args stack heap
+evalPrim Subtract args stack heap = mkIntPrim (-) args stack heap
+evalPrim Multiply args stack heap = mkIntPrim (*) args stack heap
+evalPrim Equality args stack heap = mkIntComparePrim (==) args stack heap
+evalPrim LessThan args stack heap = mkIntComparePrim (<) args stack heap
+evalPrim LessThanEquals args stack heap = mkIntComparePrim (<=) args stack heap
+evalPrim GreaterThan args stack heap = mkIntComparePrim (>) args stack heap
+evalPrim GreaterThanEquals args stack heap = mkIntComparePrim (>=) args stack heap
+evalPrim IntToBool [Literal (Integer i)] stack heap = do
+   var <- freshVar
+   let newHeap = updateHeap var (Con (if i == 1 then "True" else "False") []) heap
+   return (Variable var, stack, newHeap)
+evalPrim prim args stack heap = error $ show (prim,args)
+
+-- | Check for an exact pattern match for a data constructor in a list of case alternatives.
+exactPatternMatch :: Constructor -> [Alt] -> Maybe ([Var], Exp)
+exactPatternMatch con1 (PatAlt con2 vars exp : alts)
+   | con1 == con2 = Just (vars, exp)
+   | otherwise = exactPatternMatch con1 alts
+exactPatternMatch con (DefaultAlt {} : _) = Nothing
+exactPatternMatch _con [] = Nothing
+
+-- | Check for a default pattern match (x -> e) in a list of case alternatives.
+defaultPatternMatch :: [Alt] -> Maybe (Var, Exp)
+defaultPatternMatch [] = Nothing
+defaultPatternMatch (PatAlt {} : alts) = defaultPatternMatch alts
+defaultPatternMatch (DefaultAlt var exp : _alts) = Just (var, exp) 
+
+-- | Convenience function for making integer primitives. 
+mkIntPrim :: (Integer -> Integer -> Integer) -> [Atom] -> Stack -> Heap -> Eval (Atom, Stack, Heap)
+mkIntPrim op [Literal (Integer i), Literal (Integer j)] stack heap
+   = return (Literal $ Integer (i `op` j), stack, heap)
+
+-- | Convenience function for making integer comparison primitives. 
+mkIntComparePrim :: (Integer -> Integer -> Bool) -> [Atom] -> Stack -> Heap -> Eval (Atom, Stack, Heap)
+mkIntComparePrim op args stack heap = mkIntPrim (\i j -> if i `op` j then 1 else 0) args stack heap
+
+setThunkStack :: CallStack -> Object -> Object
+setThunkStack cs (Thunk e _oldCS) = Thunk e cs
+setThunkStack cs other = other
+
+type Substitution = Map.Map Var Atom
+
+mkSub :: Var -> Atom -> Substitution 
+mkSub = Map.singleton
+
+mkSubList :: [(Var, Atom)] -> Substitution
+mkSubList = Map.fromList
+
+removeVars :: [Var] -> Substitution -> Substitution 
+removeVars vars sub = foldl' (flip Map.delete) sub vars
+
+class Substitute a where
+   subs :: Substitution -> a -> a 
+
+instance Substitute a => Substitute [a] where
+   subs s = map (subs s)
+
+subsVar :: Substitution -> Var -> Var 
+subsVar s var = 
+   case Map.lookup var s of
+      Nothing -> var
+      Just (Variable newVar) -> newVar
+      Just (Literal lit) -> error $ "attempt to substitute variable " ++ var ++ " with literal " ++ show lit
+
+instance Substitute Atom where
+   subs s v@(Variable var) = 
+      case Map.lookup var s of
+         Nothing -> v
+         Just atom -> atom 
+   subs _s l@(Literal {}) = l
+
+instance Substitute Exp where
+   subs s (Atom a) = Atom $ subs s a
+   subs s exp@(FunApp arity var atoms)
+      = FunApp arity (subsVar s var) (subs s atoms)
+   subs s (PrimApp prim args) = PrimApp prim $ subs s args
+   -- lets are not recursive so we don't really need to removeVars from s
+   -- in the subs of obj, but it is safe to do so, and we might use it
+   -- if lets become recursive.
+   subs s exp@(Let var obj body)
+      = Let var (subs newSub obj) (subs newSub body)
+      where
+      newSub = removeVars [var] s
+   subs s (Case exp alts) = Case (subs s exp) (subs s alts)
+   subs s (Stack str e) = Stack str $ subs s e
+
+instance Substitute Alt where
+   subs s p@(PatAlt cons vars exp)
+      = PatAlt cons vars $ subs (removeVars vars s) exp
+   subs s p@(DefaultAlt var exp)
+      = DefaultAlt var $ subs (removeVars [var] s) exp
+
+instance Substitute Object where
+   subs s f@(Fun args exp)
+      = Fun args $ subs (removeVars args s) exp
+   subs s (Pap var atoms)
+      = Pap (subsVar s var) (subs s atoms)
+   subs s (Con constructor atoms) = Con constructor $ subs s atoms
+   subs s (Thunk exp cs) = Thunk (subs s exp) cs
+   subs _s BlackHole = BlackHole
+   subs _s Error = Error
diff --git a/src/Ministg/GC.hs b/src/Ministg/GC.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/GC.hs
@@ -0,0 +1,47 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.GC
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Garbage collection for ministg.
+-----------------------------------------------------------------------------
+module Ministg.GC where
+
+import Data.Set as Set hiding (map)
+import Data.Map as Map hiding (map, fold)
+import Control.Monad.Trans (liftIO)
+import Control.Monad.State (gets)
+import Ministg.Pretty
+import Ministg.State
+import Ministg.AST
+
+garbageCollect :: Exp -> Stack -> Heap -> Eval Heap
+garbageCollect exp stack heap = do
+   wantGC <- gets state_gc 
+   if wantGC 
+      then return $ collect roots heap Map.empty 
+      else return heap
+   where
+   roots = freeVars exp `Set.union` freeVars stack
+
+collect :: Set Var -> Heap -> Heap -> Heap
+collect vars oldHeap newHeap
+   = collector vars newHeap
+   where
+   collector vars newHeap 
+      | Set.null vars = newHeap
+      | otherwise = collector newVars nextHeap 
+      where
+      (newVars, nextHeap) = fold collectVar (Set.empty, newHeap) vars 
+      collectVar :: Var -> (Set Var, Heap) -> (Set Var, Heap)
+      collectVar var (vars, heap)
+         | Map.member var heap = (vars, heap)
+         | otherwise = (newVars, newHeap)
+         where
+         object = lookupHeap var oldHeap 
+         newVars = freeVars object `Set.union` vars
+         newHeap = updateHeap var object heap
diff --git a/src/Ministg/Lexer.hs b/src/Ministg/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Lexer.hs
@@ -0,0 +1,173 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Lexer
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Lexical analysis for ministg programs.
+-----------------------------------------------------------------------------
+
+module Ministg.Lexer 
+   ( Token (..)
+   , Symbol (..)
+   , Ident
+   , lexer
+   )
+where
+
+import Data.Char 
+   ( isDigit
+   , isAlpha
+   , isPrint
+   , isLower
+   )
+
+import Text.ParserCombinators.Parsec hiding (token)
+import Control.Applicative hiding ((<|>), many)
+
+newtype Token = Token (SourcePos, Symbol)
+
+instance Show Token where
+   show (Token (pos, symbol)) = show symbol
+
+type Ident = String
+
+data Symbol
+   = Variable Ident 
+   | Constructor Ident
+   | Natural Integer
+   | QuotedString String
+   | Equals
+   | BackSlash 
+   | RightArrow
+   | Let
+   | In 
+   | Case
+   | Of
+   | LeftParen
+   | RightParen
+   | LeftBrace
+   | RightBrace
+   | SemiColon
+   | Fun
+   | Con
+   | Pap
+   | Thunk 
+   | Plus
+   | Minus
+   | Times
+   | Equality
+   | GreaterThan
+   | LessThan
+   | GreaterThanEquals
+   | LessThanEquals
+   | IntToBool
+   | Stack
+   | Error
+   deriving (Eq, Show)
+
+lexer :: String -> String -> Either ParseError [Token] 
+lexer = parse tokenise 
+
+tokenise :: Parser [Token]
+tokenise = skip *> sepEndBy token skip <* eof
+
+skip :: Parser ()
+skip = skipMany (comment <|> whiteSpace)
+
+whiteSpace :: Parser ()
+whiteSpace = space >> return ()
+
+comment :: Parser () 
+comment = singleLineComment
+
+singleLineComment :: Parser ()
+singleLineComment = string  "#" >> manyTill anyChar eol >> return ()
+
+eol :: Parser ()
+eol = newline >> return ()
+
+-- XXX Perhaps it is not sensible to divide the tokens based on their
+-- syntactic role. Sometimes tokens from different syntactic classes can have
+-- the same prefix.
+token :: Parser Token
+token = 
+   punctuation <|>
+   keyword     <|> 
+   variable    <|> 
+   constructor <|>
+   parenthesis <|> 
+   number <|>
+   quotedString
+
+number :: Parser Token
+number = tokenPos parseNum Natural
+   where
+   parseNum :: Parser Integer
+   parseNum = read <$> many1 digit
+
+quotedString :: Parser Token
+quotedString = tokenPos parseString QuotedString
+   where
+   parseString :: Parser String
+   parseString = char '"' *> manyTill anyChar (char '"')
+
+variable :: Parser Token
+variable = tokenPos (parseIdent lower) Variable 
+
+constructor :: Parser Token
+constructor = tokenPos (parseIdent upper) Constructor
+
+parseIdent :: Parser Char -> Parser String
+parseIdent firstChar = (:) <$> firstChar <*> many (char '_' <|> alphaNum) 
+
+keyword :: Parser Token
+keyword =
+   key "let"   Let   <|>
+   key "in"    In    <|>
+   key "case"  Case  <|>
+   key "of"    Of    <|>
+   key "FUN"   Fun   <|>
+   key "CON"   Con   <|>
+   key "PAP"   Pap   <|>
+   key "THUNK" Thunk <|>
+   key "plus#" Plus  <|>
+   key "sub#"  Minus <|>
+   key "mult#" Times <|>
+   key "eq#"   Equality <|>
+   key "lt#"   LessThan <|>
+   key "lte#"  LessThanEquals <|>
+   key "gt#"   GreaterThan <|>
+   key "gte#"  GreaterThanEquals <|>
+   key "intToBool#" IntToBool <|>
+   key "ERROR" Error <|>
+   key "stack" Stack
+   where
+   key :: String -> Symbol -> Parser Token
+   key str keyWord = tokenPos (try kwParser) (const keyWord)
+      where
+      kwParser = string str >> notFollowedBy alphaNum
+
+parenthesis :: Parser Token
+parenthesis = 
+   simpleTok "(" LeftParen  <|> 
+   simpleTok ")" RightParen <|>
+   simpleTok "{" LeftBrace  <|>
+   simpleTok "}" RightBrace  
+
+punctuation :: Parser Token
+punctuation = 
+   simpleTok "=" Equals 
+   <|> simpleTok ";" SemiColon 
+   <|> simpleTok "\\" BackSlash 
+   <|> simpleTok "->" RightArrow
+
+simpleTok :: String -> Symbol -> Parser Token
+simpleTok str token = tokenPos (string str) (const token) 
+
+tokenPos :: Parser a -> (a -> Symbol) -> Parser Token
+tokenPos parser mkToken = 
+  Token <$> ((,) <$> getPosition <*> (mkToken <$> parser))
diff --git a/src/Ministg/Options.hs b/src/Ministg/Options.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Options.hs
@@ -0,0 +1,173 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Options
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Command line option processing. 
+-----------------------------------------------------------------------------
+module Ministg.Options 
+   ( processOptions
+   , programName
+   , defaultMaxSteps
+   , defaultEvalStyle
+   , defaultTraceDir
+   , Flag (..)
+   , EvalStyle (..)
+   , Dumped (..)
+   , probeFlags
+   , probeFlagsFirst
+   , existsFlag
+   , getTraceDir
+   , getMaxTraceSteps
+   , getEvalStyle
+   )
+   where
+
+import System.Console.GetOpt 
+import Data.Maybe (fromMaybe)
+import Data.Char (toLower, isDigit)
+import Data.Maybe (catMaybes)
+import IO (stderr, hPutStrLn)
+import System
+
+programName :: String
+programName = "ministg"
+
+-- This should really come from the cabal file somehow.
+versionNumber :: String
+versionNumber = "0.1"
+
+versionInfo :: String
+versionInfo = unwords [programName, "version", versionNumber]
+
+processOptions :: [String] -> IO ([Flag], String)
+processOptions argv = 
+   case getOpt RequireOrder options argv of
+      (flags, nonOpts, []) 
+         | existsFlag flags Help -> do 
+              putStrLn $ usageInfo header options
+              exitWith ExitSuccess
+         | existsFlag flags Version -> do 
+              putStrLn versionInfo 
+              exitWith ExitSuccess
+         | length nonOpts /= 1 ->
+              raiseError ["You must specify a single input stg file.\n"]  
+         | otherwise -> return (flags, head nonOpts)
+      (_, _, errs) -> raiseError errs
+      where 
+      header = "Usage: " ++ programName ++ " [OPTION...] file"
+      failureMsg = programName ++ ": command line error.\n"
+      raiseError errs = do
+         hPutStrLn stderr $ failureMsg ++ concat errs ++ usageInfo header options
+         exitFailure
+
+probeFlags :: [Flag] -> (Flag -> Maybe a) -> [a]
+probeFlags flags probe = catMaybes (map probe flags)
+
+probeFlagsFirst :: [Flag] -> (Flag -> Maybe a) -> a -> a
+probeFlagsFirst flags probe defaultValue
+   | null probed = defaultValue 
+   | otherwise = head probed
+   where
+   probed = probeFlags flags probe
+
+existsFlag :: [Flag] -> Flag -> Bool
+existsFlag flags f
+   = probeFlagsFirst flags probe False 
+   where
+   probe someFlag = if f == someFlag then Just True else Nothing 
+    
+data Flag 
+  = Style EvalStyle        -- ^ Which evaluation rules to use (eval/apply or push enter)
+  | Trace                  -- ^ Turn tracing on.
+  | TraceDir String        -- ^ Directory to save trace file.
+  | MaxTraceSteps Integer  -- ^ Maximum trace steps to record.
+  | CallStack              -- ^ Include call stack in trace.
+  | Dump Dumped            -- ^ Dump something out to debug the interpreter.
+  | NoPrelude              -- ^ Do not automatically include the Prelude.
+  | NoGC                   -- ^ Disable garbage collection.
+  | Help                   -- ^ Print a help message and exit.
+  | Version                -- ^ Print the version number. 
+  | Annotate               -- ^ Auto annotate the program with stack markers.
+  deriving (Eq, Ord, Show)
+
+data EvalStyle
+   = EvalApply
+   | PushEnter
+   deriving (Eq, Ord, Show)
+
+data Dumped
+  = DumpAST
+  | DumpParsed
+  | DumpArity
+  | DumpNothing
+  deriving (Eq, Ord, Show)
+
+options :: [OptDescr Flag]
+options =
+ [ Option ['s']     ["style"]     (ReqArg mkStyle "STYLE")   "evaluation STYLE to use (EA = eval apply, PE = push enter)"
+ , Option ['t']     ["trace"]     (NoArg Trace)              "record a trace of program evaluation"
+ , Option []        ["tracedir"]  (ReqArg TraceDir "DIR")    "directory (DIR) to store trace files"
+ , Option ['m']     ["maxsteps"]  (ReqArg mkMaxSteps "STEPS")  "maximum number of evaluation STEPS to record in trace"
+ , Option ['c']     ["callstack"] (NoArg CallStack)          "enable call stack tracing"
+ , Option []        ["noprelude"] (NoArg NoPrelude)          "do not import the Prelude"
+ , Option []        ["nogc"]      (NoArg NoGC)               "disable garbage collector"
+ , Option ['d']     ["dump"]      (ReqArg mkDumped "DUMPED") "output DUMPED for debugging purposes (ast, parsed, arity)"
+ , Option ['v']     ["version"]   (NoArg Version)            "show version number"
+ , Option ['h']     ["help"]      (NoArg Help)               "get help about using this program"
+ , Option ['a']     ["annotate"]  (NoArg Annotate)           "automatically annotate the program with stack markers"
+ ]
+
+defaultTraceDir :: String
+defaultTraceDir = "trace"
+
+defaultEvalStyle :: EvalStyle 
+defaultEvalStyle = PushEnter
+
+mkStyle :: String -> Flag
+mkStyle = normalMkStyle . map toLower
+   where
+   normalMkStyle "ea" = Style EvalApply
+   normalMkStyle "pe" = Style PushEnter
+   normalMkStyle other = Style defaultEvalStyle
+
+mkDumped :: String -> Flag
+mkDumped = normalMkDumped . map toLower
+   where
+   normalMkDumped "ast"    = Dump DumpAST
+   normalMkDumped "parsed" = Dump DumpParsed
+   normalMkDumped "arity"  = Dump DumpArity
+   normalMkDumped other    = Dump DumpNothing
+
+defaultMaxSteps :: Integer 
+defaultMaxSteps = 1000
+
+mkMaxSteps :: String -> Flag 
+mkMaxSteps [] = MaxTraceSteps defaultMaxSteps 
+mkMaxSteps n
+   | all isDigit n = MaxTraceSteps $ read n
+   | otherwise = MaxTraceSteps defaultMaxSteps
+
+getMaxTraceSteps :: [Flag] -> Integer 
+getMaxTraceSteps flags =
+      probeFlagsFirst flags probe defaultMaxSteps
+      where probe (MaxTraceSteps i) = Just i
+            probe other = Nothing
+
+getTraceDir :: [Flag] -> String
+getTraceDir flags =
+   probeFlagsFirst flags probe defaultTraceDir
+      where probe (TraceDir d) = Just d
+            probe other = Nothing
+
+getEvalStyle :: [Flag] -> EvalStyle
+getEvalStyle flags =
+   probeFlagsFirst flags probe defaultEvalStyle
+   where
+   probe :: Flag -> Maybe EvalStyle
+   probe (Style style) = Just style
+   probe other = Nothing
diff --git a/src/Ministg/Parser.hs b/src/Ministg/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Parser.hs
@@ -0,0 +1,177 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Parser
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Parsing for ministg programs.
+-----------------------------------------------------------------------------
+module Ministg.Parser (parser) where
+
+import Prelude hiding (exp, subtract)
+import Text.ParserCombinators.Parsec hiding (Parser)
+import qualified Ministg.Lexer as Lex
+import Ministg.AST hiding (rightArrow)
+import Control.Applicative hiding ((<|>), many)
+
+type Parser a = GenParser Lex.Token () a
+
+tokenParser :: (Lex.Symbol -> Maybe a) -> Parser a
+tokenParser test
+   = token showToken posToken testToken
+   where
+   showToken (Lex.Token (pos,tok)) = show tok
+   posToken  (Lex.Token (pos,tok)) = pos
+   testToken (Lex.Token (pos,tok)) = test tok
+
+symbol :: Lex.Symbol -> Parser ()
+symbol tok
+   = tokenParser $ 
+        \next -> if next == tok then Just () else Nothing
+
+parser :: FilePath -> String -> Either ParseError Program 
+parser source input
+   = case Lex.lexer source input of
+        Left err -> Left err
+        Right toks -> parse program source toks 
+
+program :: Parser Program
+program = Program <$> sepEndBy decl semiColon <* eof
+
+decl :: Parser Decl
+decl = Decl <$> var <*> (equals *> object)
+
+exp :: Parser Exp
+exp = funCallOrVar <|> 
+      expAtomLiteral <|> 
+      primApp <|> 
+      letExp <|> 
+      caseExp <|>
+      stack
+
+stack :: Parser Exp
+stack = Stack <$> (symbol Lex.Stack *> quotedString) <*> exp
+
+quotedString :: Parser String 
+quotedString = tokenParser getString
+   where
+   getString (Lex.QuotedString s) = Just s
+   getString other = Nothing 
+
+funCallOrVar :: Parser Exp
+funCallOrVar = do
+   v <- var
+   args <- many atom
+   return $ if null args
+      then Atom $ Variable v
+      -- we don't know the arity of the function yet.
+      else FunApp Nothing v args 
+
+expAtomLiteral :: Parser Exp
+expAtomLiteral = Atom <$> atomLiteral 
+
+expAtom :: Parser Exp
+expAtom = Atom <$> atom
+
+primApp :: Parser Exp
+primApp = PrimApp <$> primOp <*> many1 atom 
+
+primOp, add, subtract, multiply, eq, lessThan, greaterThan, lessThanEquals, greaterThanEquals :: Parser Prim
+
+primOp = 
+   add <|> 
+   subtract <|> 
+   multiply <|> 
+   eq <|> 
+   lessThan <|> 
+   greaterThan <|> 
+   lessThanEquals <|> 
+   greaterThanEquals <|> 
+   intToBool
+
+add = const Add <$> symbol Lex.Plus
+subtract = const Subtract <$> symbol Lex.Minus
+multiply = const Multiply <$> symbol Lex.Times
+eq = const Equality <$> symbol Lex.Equality
+lessThan = const LessThan <$> symbol Lex.LessThan
+lessThanEquals = const LessThanEquals <$> symbol Lex.LessThanEquals
+greaterThan = const GreaterThan <$> symbol Lex.GreaterThan
+greaterThanEquals = const GreaterThanEquals <$> symbol Lex.GreaterThanEquals
+intToBool = const IntToBool <$> symbol Lex.IntToBool
+
+letExp :: Parser Exp
+letExp = flattenLet <$> (symbol Lex.Let *> leftBrace *> sepEndBy1 decl semiColon <* rightBrace) <*> (symbol Lex.In *> exp)
+
+flattenLet :: [Decl] -> Exp -> Exp
+flattenLet [Decl var obj] body = Let var obj body
+flattenLet (Decl var obj : decls) body = Let var obj $ flattenLet decls body 
+
+caseExp :: Parser Exp
+caseExp = Case <$> (symbol Lex.Case *> exp) <*> (symbol Lex.Of *> leftBrace *> sepEndBy1 alt semiColon <* rightBrace)
+
+atom, atomLiteral, atomVariable :: Parser Atom
+atom = atomLiteral <|> atomVariable
+atomLiteral = Literal <$> literal
+atomVariable = Variable <$> var
+
+literal :: Parser Literal
+literal = Integer <$> natural 
+
+alt :: Parser Alt
+alt = patAlt <|> defaultAlt
+
+patAlt :: Parser Alt
+patAlt = PatAlt <$> constructor <*> many var <*> (rightArrow *> exp)
+
+defaultAlt :: Parser Alt
+defaultAlt = DefaultAlt <$> var <*> (rightArrow *> exp)
+
+object :: Parser Object
+object = fun <|> pap <|> con <|> thunk <|> errorObj
+
+fun, pap, con, thunk, errorObj  :: Parser Object
+fun = Fun <$> (symbol Lex.Fun *> leftParen *> many1 var) <*> (rightArrow *> exp <* rightParen)
+pap = Pap <$> (symbol Lex.Pap *> leftParen *> var) <*> (many1 atom <* rightParen)
+con = Con <$> (symbol Lex.Con *> leftParen *> constructor) <*> (many atom <* rightParen)
+thunk = Thunk <$> (symbol Lex.Thunk *> leftParen *> exp <* rightParen) <*> pure []
+errorObj = const Error <$> symbol Lex.Error
+
+var :: Parser Var 
+var = tokenParser getIdent
+   where
+   getIdent (Lex.Variable s) = Just s
+   getIdent other = Nothing 
+
+constructor :: Parser Constructor 
+constructor = tokenParser getIdent
+   where
+   getIdent (Lex.Constructor s) = Just s
+   getIdent other = Nothing 
+
+equals :: Parser ()
+equals = symbol Lex.Equals 
+
+semiColon :: Parser ()
+semiColon = symbol Lex.SemiColon 
+
+rightArrow :: Parser ()
+rightArrow = symbol Lex.RightArrow
+
+leftParen, rightParen :: Parser ()
+leftParen = symbol Lex.LeftParen
+rightParen = symbol Lex.RightParen
+
+leftBrace, rightBrace :: Parser ()
+leftBrace = symbol Lex.LeftBrace
+rightBrace = symbol Lex.RightBrace
+
+natural :: Parser Integer 
+natural = 
+   tokenParser getNat
+   where
+   getNat :: Lex.Symbol -> Maybe Integer 
+   getNat (Lex.Natural n) = Just n 
+   getNat other = Nothing 
diff --git a/src/Ministg/Pretty.hs b/src/Ministg/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Pretty.hs
@@ -0,0 +1,47 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Pretty
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Convenient class wrapper for pretty printing. 
+-----------------------------------------------------------------------------
+
+module Ministg.Pretty (module Ministg.Pretty, module HPJ) where
+
+import Text.PrettyPrint.HughesPJ as HPJ
+
+class Pretty a where
+   pretty :: a -> Doc
+
+prettyText :: Pretty a => a -> String
+prettyText = render . pretty
+
+parensIf :: Pretty a => (a -> Bool) -> a -> Doc
+parensIf test x = if test x then parens $ pretty x else pretty x 
+
+tuple :: Pretty a => [a] -> Doc
+tuple = parens . hsep . punctuate comma . map pretty 
+
+instance Pretty Int where
+  pretty = int
+
+instance Pretty Integer where
+  pretty = integer
+
+instance Pretty Char where
+  pretty = char
+
+instance Pretty Double where
+   pretty = double
+
+instance Pretty Bool where
+  pretty True = text "True"
+  pretty False = text "False"
+
+instance Pretty a => Pretty (Maybe a) where
+   pretty Nothing = empty
+   pretty (Just x) = pretty x
diff --git a/src/Ministg/State.hs b/src/Ministg/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/State.hs
@@ -0,0 +1,183 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.State
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Representation of the state of the ministg evaluator.
+-----------------------------------------------------------------------------
+
+module Ministg.State 
+   ( Continuation (..)
+   , Stack
+   , prettyStack 
+   , Heap 
+   , EvalState (..)
+   , Eval
+   , initStack
+   , initHeap
+   , initState
+   , pushCallStack
+   , setCallStack
+   , lookupHeap
+   , lookupHeapAtom
+   , updateHeap
+   , freshVar
+   , incStepCount
+   , setRule
+   , prettyHeapObject
+   , isArgCont
+   )
+   where
+
+import Control.Monad.State 
+import Data.Map as Map hiding (map)
+import Data.Set as Set hiding (map)
+import Ministg.AST
+import Ministg.CallStack (CallStack, push, prettyCallStack)
+import Ministg.Pretty 
+import Ministg.Options 
+   ( Flag (..), defaultMaxSteps, defaultTraceDir
+   , probeFlagsFirst, existsFlag, getTraceDir, getMaxTraceSteps )
+
+-- | Stack continuations.
+data Continuation
+   = CaseCont [Alt] CallStack -- ^ The alternatives of a case expression.
+   | UpdateCont Var CallStack -- ^ A variable which points to a thunk to be updated.
+   | ArgCont Atom             -- ^ A pending argument (used only by the push-enter model).
+   | ApplyToArgs [Atom]       -- ^ Apply the returned function to these arguments (eval-apply only).
+   deriving (Eq, Show)
+
+instance FreeVars Continuation where
+   freeVars (CaseCont alts _cs) = freeVars alts
+   freeVars (UpdateCont var _cs) = Set.singleton var
+   freeVars (ArgCont arg) = freeVars arg
+   freeVars (ApplyToArgs args) = freeVars args
+
+instance Pretty Continuation where
+   pretty (CaseCont alts callStack) 
+      = text "case *" <+> braces (vcat (punctuate semi (map pretty alts))) $$
+        nest 3 (prettyCallStack callStack)
+   pretty (UpdateCont var callStack) 
+      = text "upd *" <+> text var $$
+        nest 3 (prettyCallStack callStack)
+   pretty (ArgCont atom) = text "arg" <+> pretty atom 
+   pretty (ApplyToArgs atoms) = parens (char '*' <+> hsep (map pretty atoms))
+
+isArgCont :: Continuation -> Bool
+isArgCont (ArgCont {}) = True
+isArgCont _other = False
+
+-- | The evaluation stack. 
+type Stack = [Continuation]
+
+prettyStack :: Stack -> Doc
+prettyStack stack = (vcat $ map prettyCont stack)
+   where
+   prettyCont :: Continuation -> Doc
+   prettyCont cont = text "-" <+> pretty cont
+
+-- | The heap (mapping variables to objects).
+type Heap = Map.Map Var Object
+
+-- | State to be threaded through evaluation.
+data EvalState 
+   = EvalState 
+     { state_unique :: !Int           -- ^ Unique counter for generating fresh variables.
+     , state_callStack :: CallStack   -- ^ Function call stack (for debugging).
+     , state_stepCount :: !Integer    -- ^ How many steps have been executed.
+     , state_lastRule :: !String      -- ^ The most recent evaluation rule applied.
+     , state_trace :: Bool            -- ^ Do we want tracing of evaluation steps? 
+     , state_maxTraceSteps :: Integer -- ^ Maximum number of evaluation steps to trace.
+     , state_traceDir :: String       -- ^ Name of directory to store trace files.
+     , state_gc :: Bool               -- ^ Do we want garbage collection?
+     , state_traceCallStack :: Bool   -- ^ Do we want the call stack shown in the trace?
+     }
+
+-- | Eval monad. Combines State and IO.
+type Eval a = StateT EvalState IO a
+
+initState :: [Flag] -> EvalState
+initState flags = 
+   EvalState 
+   { state_unique = 0
+   , state_callStack = []
+   , state_stepCount = 0 
+   , state_lastRule = ""
+   , state_trace = existsFlag flags Trace 
+   , state_maxTraceSteps = getMaxTraceSteps flags
+   , state_traceDir = getTraceDir flags
+   , state_gc = not $ existsFlag flags NoGC 
+   , state_traceCallStack = existsFlag flags CallStack
+   }
+
+initHeap :: Program -> Heap
+initHeap (Program decls) = Map.fromList $ map declToPair decls
+   where
+   declToPair :: Decl -> (Var, Object)
+   declToPair (Decl var obj) = (var, obj)
+
+initStack :: Stack
+initStack = []
+
+setRule :: String -> Eval ()
+setRule str = do
+   lr <- gets state_lastRule
+   modify $ \s -> s { state_lastRule = str } 
+
+incStepCount :: Eval ()
+incStepCount = do
+   sc <- gets state_stepCount
+   modify $ \s -> s { state_stepCount = sc + 1 } 
+
+pushCallStack :: String -> Eval ()
+pushCallStack str = do
+   cs <- gets state_callStack
+   modify $ \s -> s { state_callStack = push str cs }
+
+setCallStack :: CallStack -> Eval ()
+setCallStack cs = modify $ \s -> s { state_callStack = cs }
+
+-- | Lookup a variable in a heap. If found return the corresponding
+-- object, otherwise throw an error (it is a fatal error which can't
+-- be recovered from).
+lookupHeap :: Var -> Heap -> Object 
+lookupHeap var heap = 
+   case Map.lookup var heap of
+      Nothing -> error $ "undefined variable: " ++ show var
+      Just object -> object
+
+-- | Convenience wrapper for lookupHeap, for atoms which happen to be variables.
+lookupHeapAtom :: Atom -> Heap -> Object
+lookupHeapAtom (Variable var) heap = lookupHeap var heap
+lookupHeapAtom other _heap = error $ "lookupHeapAtom called with non variable " ++ show other
+
+-- | Add a new mapping to a heap, or update an existing one.
+updateHeap :: Var -> Object -> Heap -> Heap 
+updateHeap = Map.insert 
+
+-- | Generate a new unique variable. Uniqueness is guaranteed by using a
+-- "$" prefix, which is not allowed in the concrete sytax of ministg programs.
+freshVar :: Eval Var
+freshVar = do
+   u <- gets state_unique
+   modify $ \s -> s { state_unique = u + 1 }
+   return $ "$" ++ show u
+
+-- XXX not very good for printing large objects, nonetheless it is lazy.
+prettyHeapObject :: Heap -> Object -> String 
+prettyHeapObject heap (Con constructor args)
+   | length args == 0 = constructor
+   | otherwise = "(" ++ unwords (constructor : map (prettyHeapAtom heap) args) ++ ")"
+prettyHeapObject _heap (Fun {}) = "<function>"
+prettyHeapObject _heap (Pap {}) = "<pap>"
+prettyHeapObject _heap (Thunk {}) = "<thunk>"
+prettyHeapObject _heap BlackHole = "<blackhole>"
+prettyHeapObject _heap Error = "<error>"
+
+prettyHeapAtom :: Heap -> Atom -> String 
+prettyHeapAtom heap (Literal (Integer i)) = show i
+prettyHeapAtom heap (Variable var) = prettyHeapObject heap $ lookupHeap var heap
diff --git a/src/Ministg/TraceEval.hs b/src/Ministg/TraceEval.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/TraceEval.hs
@@ -0,0 +1,140 @@
+{-# OPTIONS_GHC -XPatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.TraceEval
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Trace the evaluation steps of the interpreter and generate HTML output. 
+-----------------------------------------------------------------------------
+
+module Ministg.TraceEval (traceEval, traceEnd) where
+
+import System.FilePath ((<.>), (</>))
+import Control.Monad (when, join)
+import Control.Monad.Trans (liftIO)
+import Control.Monad.State (gets)
+import Control.Applicative ((<$>))
+import Text.XHtml.Transitional as Html
+import Text.XHtml.Table hiding ((</>))
+import Data.Map as Map (toList)
+import Ministg.AST
+import Ministg.CallStack (CallStack, push, showCallStack)
+import Ministg.Pretty as Pretty (pretty, Doc, ($$), nest, render, text)
+import Ministg.State
+import Data.List as List (sortBy)
+
+traceEval :: Exp -> Stack -> Heap -> Eval ()
+traceEval exp stack heap = do
+   traceOn <- gets state_trace
+   when traceOn $ do 
+      count <- gets state_stepCount
+      maxSteps <- gets state_maxTraceSteps
+      when (count <= maxSteps) $ do
+         join (writeTraceFile <$> makeHtml exp stack heap)
+      when (count == maxSteps + 1) $ lastTracePage "Maximum trace steps exceeded"
+
+traceEnd :: Eval ()
+traceEnd = do
+   traceOn <- gets state_trace
+   when traceOn $ lastTracePage "The computation has completed"
+   
+lastTracePage :: String -> Eval ()
+lastTracePage msg = join (writeTraceFile <$> lastPage msg) 
+
+writeTraceFile :: Html -> Eval ()
+writeTraceFile html = do
+   traceFile <- nextTraceFileName
+   liftIO $ writeFile traceFile $ renderHtml html 
+
+nextTraceFileName :: Eval FilePath
+nextTraceFileName = do
+   traceDir <- gets state_traceDir
+   count <- gets state_stepCount
+   return $ traceDir </> mkHtmlFileName count 
+
+lastPage :: String -> Eval Html
+lastPage msg = do
+   count <- gets state_stepCount
+   return (theHead +++ theBody count)
+   where
+   theHead = header << thetitle << msg 
+   theBody count 
+      = body << (mainHeading +++ navigation)
+      where
+      mainHeading = h1 << msg 
+      navigation = paragraph ((anchor << "previous") ! [href $ mkHtmlFileName (count - 1)])
+
+makeHtml :: Exp -> Stack -> Heap -> Eval Html 
+makeHtml exp stack heap = do
+   count <- gets state_stepCount
+   rule <- gets state_lastRule
+   callStack <- gets state_callStack
+   wantCallStack <- gets state_traceCallStack
+   return $ headAndBody count rule 
+               (if wantCallStack then Just callStack else Nothing) 
+   where
+   headAndBody count rule maybeCallStack = theHead +++ theBody
+      where
+      stepStr = "Step " ++ show count
+      theHead = header << thetitle << stepStr 
+      theBody = 
+         body << (mainHeading +++ navigation +++ ruleSection +++ expStackSection +++ heapSection)
+         where
+         mainHeading = h1 << stepStr 
+         navigation = paragraph (previous +++ " " +++ next)
+         previous = if count == 0 then noHtml 
+                       else (anchor << "previous") ! [href $ mkHtmlFileName (count - 1)]
+         next = (anchor << "next") ! [href $ mkHtmlFileName (count + 1)]
+         ruleSection = if null rule then noHtml 
+                          else (h3 << "Most recent rule applied") +++ (paragraph << rule)
+         expStackSection = (h3 << "Stack and Code") +++ expStackCallTable exp stack maybeCallStack 
+         heapSection = (h3 << "Heap") +++ heapTable heap 
+
+expStackCallTable :: Exp -> Stack -> Maybe CallStack -> Html
+expStackCallTable exp stack maybeCallStack 
+   = simpleTable [border 3, cellpadding 10] [thestyle "vertical-align:top"] rows 
+   where
+   rows | Just callStack <- maybeCallStack =
+             [stackExprHeading ++ callStackHeading, stackExprData ++ callStackData callStack]
+        | otherwise = [stackExprHeading, stackExprData] 
+        where
+        stackExprHeading = [stringToHtml "Stack", stringToHtml "Expression"]
+        stackExprData = [stackTable stack, pre << expStr]
+        callStackHeading = [stringToHtml "Call Stack"]
+        callStackData callStack = [callStackTable callStack]
+        expStr = render $ pretty exp
+
+stackTable :: Stack -> Html
+stackTable [] = noHtml
+stackTable stack
+   = simpleTable [border 1, cellpadding 5, cellspacing 0] 
+                 [] (map stackRow stack)
+   where
+   stackRow :: Continuation -> [Html]
+   stackRow cont = [ pre << (render $ pretty cont) ]
+
+callStackTable :: CallStack -> Html
+callStackTable [] = noHtml
+callStackTable stack
+   = simpleTable [border 1, cellpadding 5, cellspacing 0] 
+                 [] (map stackRow stack)
+   where
+   stackRow :: String -> [Html]
+   stackRow str = [ pre << str ]
+
+heapTable :: Heap -> Html
+heapTable heap
+   = simpleTable [border 3, cellpadding 5, cellspacing 0] 
+                 [] (headingRow : map heapRow mappings)
+   where
+   headingRow = [stringToHtml "Variable", stringToHtml "Object"]
+   mappings = List.sortBy (\(x,_) (y,_) -> compare x y) $ Map.toList heap
+   heapRow :: (Var, Object) -> [Html]
+   heapRow (var, obj) = [pre << var, pre << render (pretty obj)]
+
+mkHtmlFileName :: Integer -> FilePath
+mkHtmlFileName count = "step" ++ show count <.> "html"
diff --git a/src/Ministg/Utils.hs b/src/Ministg/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Ministg/Utils.hs
@@ -0,0 +1,22 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Ministg.Utils
+-- Copyright   : (c) 2009 Bernie Pope 
+-- License     : BSD-style
+-- Maintainer  : bjpop@csse.unimelb.edu.au
+-- Stability   : experimental
+-- Portability : ghc
+--
+-- Some handy utilities. 
+-----------------------------------------------------------------------------
+module Ministg.Utils where
+
+import Control.Monad 
+   ( liftM )
+
+safeReadFile :: FilePath -> IO (Either String String) 
+safeReadFile file
+   = catch (rightReadFile file) $ \error -> return $ Left $ show error 
+   where
+   rightReadFile :: FilePath -> IO (Either String String)
+   rightReadFile file = liftM Right $ readFile file
diff --git a/test/Prelude.stg b/test/Prelude.stg
new file mode 100644
--- /dev/null
+++ b/test/Prelude.stg
@@ -0,0 +1,100 @@
+error = ERROR;
+unit = CON(Unit);
+true = CON(True);
+false = CON(False);
+nil = CON(Nil);
+zero = CON(I 0);
+one = CON(I 1);
+two = CON(I 2);
+three = CON(I 3);
+four = CON(I 4);
+five = CON(I 5);
+six = CON(I 6);
+seven = CON(I 7);
+eight = CON(I 8);
+nine = CON(I 9);
+ten = CON(I 10);
+
+multInt = FUN(x y ->
+   case x of { 
+      I i -> case y of { 
+               I j -> case mult# i j of { 
+                         x -> let { result = CON (I x) } in result }}});
+
+plusInt = FUN(x y ->
+   case x of { 
+      I i -> case y of { 
+               I j -> case plus# i j of { 
+                         x -> let { result = CON (I x) } in result }}});
+
+subInt = FUN(x y ->
+           case x of
+              { I i ->
+                  case y of
+                     { I j -> case sub# i j of
+                                 { x -> let { result = CON (I x) } in result }}});
+
+eqInt = FUN(x y ->
+           case x of
+              { I i ->
+                  case y of
+                     { I j -> case eq# i j of
+                                 { x -> intToBool# x }}});
+
+append = FUN(l1 l2 ->
+            case l1 of
+               { Nil -> l2;
+                 Cons hd tl -> let { rec = THUNK(append tl l2);
+                                     result = CON(Cons hd rec) }
+                               in result });
+
+const = FUN(x y -> x);
+apply = FUN(f x -> f x);
+
+map = FUN(f list ->
+   case list of {
+      Nil -> nil;
+      Cons h t -> let { x = THUNK(f h); rec = THUNK(map f t); res = CON(Cons x rec) } in res
+   });
+
+take = FUN(n xs ->
+   case eqInt n zero of
+      { True -> nil;
+        False -> case xs of
+                 { Nil -> nil;
+                   Cons hd tl -> let { m = THUNK(subInt n one);
+                                       rec = THUNK(take m tl);
+                                       result = CON(Cons hd rec) } in result }});
+
+head = FUN(xs -> case xs of { Cons hd tl -> hd });
+tail = FUN(xs -> case xs of { Cons hd tl -> tl });
+
+foldl = FUN(f acc list ->
+   case list of {
+      Nil -> acc;
+      Cons h t -> let { newAcc = THUNK(f acc h) } in foldl f newAcc t 
+   });
+
+# lazy sum with a well-known space leak
+sum = FUN(list -> foldl plusInt zero list);
+
+zipWith = FUN(f list1 list2 ->
+   case list1 of {
+      Nil -> nil;
+      Cons h1 t1 -> 
+         case list2 of {
+            Nil -> nil;
+            Cons h2 t2 ->
+               let { newHead = THUNK(f h1 h2); 
+                     newTail = THUNK(zipWith f t1 t2);
+                     result = CON(Cons newHead newTail)
+               } in result
+         }
+   });
+
+seq = FUN(x y -> case x of { z -> y });
+
+forcelist = FUN(list ->
+   case list of {
+      Nil -> unit;
+      Cons h t -> let { rec = THUNK(forcelist t) } in seq h rec });
diff --git a/test/append.stg b/test/append.stg
new file mode 100644
--- /dev/null
+++ b/test/append.stg
@@ -0,0 +1,6 @@
+list1 = CON(Cons one nil);
+list2 = CON(Cons one list1);
+list3 = CON(Cons zero list2);
+list4 = THUNK(append list3 list3);
+list5 = THUNK(append list4 list4);
+main = THUNK(let { f = THUNK(forcelist list5)} in seq f list5)
diff --git a/test/apply.stg b/test/apply.stg
new file mode 100644
--- /dev/null
+++ b/test/apply.stg
@@ -0,0 +1,2 @@
+twentytwo = CON(I 22);
+main = THUNK(apply const true twentytwo)
diff --git a/test/docs.stg b/test/docs.stg
new file mode 100644
--- /dev/null
+++ b/test/docs.stg
@@ -0,0 +1,26 @@
+nil = CON(Nil);
+zero = CON(I 0);
+one = CON(I 1);
+two = CON(I 2);
+three = CON(I 3);
+ 
+plusInt = FUN(x y ->
+   case x of {
+      I i -> case y of {
+               I j -> case plus# i j of {
+                         x -> let { result = CON (I x) } in result }}});
+ 
+foldl = FUN(f acc list ->
+   case list of {
+      Nil -> acc;
+      Cons h t -> let { newAcc = THUNK(f acc h) } in foldl f newAcc t
+   });
+ 
+# lazy sum with a well-known space leak
+sum = FUN(list -> foldl plusInt zero list);
+ 
+list1 = CON(Cons one nil);
+list2 = CON(Cons two list1);
+list3 = CON(Cons three list2);
+ 
+main = THUNK(sum list3);
diff --git a/test/empty.stg b/test/empty.stg
new file mode 100644
--- /dev/null
+++ b/test/empty.stg
diff --git a/test/error.stg b/test/error.stg
new file mode 100644
--- /dev/null
+++ b/test/error.stg
@@ -0,0 +1,1 @@
+main = ERROR;
diff --git a/test/fac.stg b/test/fac.stg
new file mode 100644
--- /dev/null
+++ b/test/fac.stg
@@ -0,0 +1,9 @@
+fac = FUN (x -> 
+         case eqInt x zero of {
+            True -> one;
+            False -> let { s = THUNK(subInt x one);
+                           rec = THUNK(fac s) }
+                     in multInt x rec
+         });
+
+main = THUNK (fac seven) 
diff --git a/test/fac_stack.stg b/test/fac_stack.stg
new file mode 100644
--- /dev/null
+++ b/test/fac_stack.stg
@@ -0,0 +1,9 @@
+fac = FUN (x -> stack "fac"
+         case eqInt x zero of {
+            True -> one;
+            False -> let { s = THUNK(subInt x one);
+                           rec = THUNK(fac s) }
+                     in multInt x rec
+         });
+
+main = THUNK (stack "main" fac seven) 
diff --git a/test/fibs.stg b/test/fibs.stg
new file mode 100644
--- /dev/null
+++ b/test/fibs.stg
@@ -0,0 +1,11 @@
+# fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
+
+fibs = THUNK(let { tailFibs = THUNK(tail fibs);
+                   zippedList = THUNK(zipWith plusInt fibs tailFibs);
+                   tailList = CON(Cons one zippedList);
+                   list = CON(Cons one tailList)
+             } in list);
+
+main = THUNK( let { result = THUNK(take five fibs);
+                    f = THUNK(forcelist result)
+                  } in seq f result)
diff --git a/test/loop.stg b/test/loop.stg
new file mode 100644
--- /dev/null
+++ b/test/loop.stg
@@ -0,0 +1,2 @@
+# this should crash with a blackhole.
+main = THUNK(main);
diff --git a/test/map.stg b/test/map.stg
new file mode 100644
--- /dev/null
+++ b/test/map.stg
@@ -0,0 +1,10 @@
+pzero = CON(Z);
+pone = CON(S pzero);
+list1 = CON(Cons pone nil);
+list2 = CON(Cons pone list1);
+list3 = CON(Cons pone list2);
+list4 = CON(Cons pone list3); 
+consttrue = PAP(const true);
+main = THUNK( let { result = THUNK(map const list4);
+                    f = THUNK(forcelist result) 
+                  } in seq f result )
diff --git a/test/map_pap.stg b/test/map_pap.stg
new file mode 100644
--- /dev/null
+++ b/test/map_pap.stg
@@ -0,0 +1,8 @@
+# in Haskell: main = head (map const [7,2,1]) 10 
+
+list1 = CON(Cons one nil);
+list2 = CON(Cons two list1);
+list3 = CON(Cons seven list2);
+main = THUNK(let { mc = THUNK(map const list3);
+                   constSeven = THUNK(head mc);
+                 } in constSeven ten);
diff --git a/test/ones.stg b/test/ones.stg
new file mode 100644
--- /dev/null
+++ b/test/ones.stg
@@ -0,0 +1,2 @@
+ones = CON(Cons one ones);
+main = THUNK(ones)
diff --git a/test/seq.stg b/test/seq.stg
new file mode 100644
--- /dev/null
+++ b/test/seq.stg
@@ -0,0 +1,10 @@
+# haskell: main = let x = 1 + 2 in seq x (foo x)
+main = THUNK(let {x = THUNK(plusInt one two);
+                  res = THUNK(foo x)} in seq x res);
+
+# compare with
+# haskell: main = foo (1 + 2)
+# main = THUNK(let {x = THUNK(plusInt one two) } in foo x);
+                  
+
+foo = FUN(x -> three)
diff --git a/test/sum.stg b/test/sum.stg
new file mode 100644
--- /dev/null
+++ b/test/sum.stg
@@ -0,0 +1,4 @@
+list1 = CON(Cons one nil);
+list2 = CON(Cons two list1);
+list3 = CON(Cons three list2);
+main = THUNK(sum list3)
diff --git a/test/sum_error.stg b/test/sum_error.stg
new file mode 100644
--- /dev/null
+++ b/test/sum_error.stg
@@ -0,0 +1,4 @@
+list1 = CON(Cons one nil);
+list2 = CON(Cons error list1);
+list3 = CON(Cons three list2);
+main = THUNK(sum list3);
diff --git a/test/take.stg b/test/take.stg
new file mode 100644
--- /dev/null
+++ b/test/take.stg
@@ -0,0 +1,3 @@
+ones = CON(Cons one ones);
+main = THUNK(let { result = THUNK(take three ones);
+                   f = THUNK(forcelist result)} in seq f result )