diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,32 @@
+Copyright (c) 2006 Edwin Brady
+    School of Computer Science, University of St Andrews
+All rights reserved.
+
+This code is derived from software written by Edwin Brady
+(eb@dcs.st-and.ac.uk).
+
+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. None of the names of the copyright holders 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 ``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 HOLDERS 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.
+
+*** End of disclaimer. ***
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,39 @@
+import Distribution.Simple
+import Distribution.Simple.InstallDirs
+import Distribution.Simple.LocalBuildInfo
+import Distribution.PackageDescription
+
+import System
+
+system' cmd = do 
+    exit <- system cmd
+    case exit of
+      ExitSuccess -> return ()
+      ExitFailure _ -> exitWith exit
+
+buildLib args flags desc local 
+    = system' "make -C sdl"
+
+findSDL args flags
+    = do system' "make -C src SDLflags.hs"
+         return emptyHookedBuildInfo
+
+-- This is a hack. I don't know how to tell cabal that a data file needs
+-- installing but shouldn't be in the distribution. And it won't make the
+-- distribution if it's not there, so instead I just delete
+-- the file after configure.
+
+postConfLib args flags desc local
+    = system' "make -C sdl clean"
+
+addPrefix pfx var c = "export " ++ var ++ "=" ++ show pfx ++ "/" ++ c ++ ":$" ++ var
+
+postInstLib args flags desc local
+    = do let pfx = prefix (installDirTemplates local)
+         system' $ "make -C sdl install PREFIX=" ++ show pfx
+
+main = defaultMainWithHooks (simpleUserHooks { preBuild = findSDL,
+                                               postBuild = buildLib,
+                                               postConf = postConfLib,
+                                               postInst = postInstLib })
+
diff --git a/atuin.cabal b/atuin.cabal
new file mode 100644
--- /dev/null
+++ b/atuin.cabal
@@ -0,0 +1,26 @@
+Name:		atuin
+Version:	0.1.1
+Author:		Edwin Brady
+License:	BSD3
+License-file:	LICENSE
+Maintainer:	eb@cs.st-andrews.ac.uk
+Homepage:	http://www.dcs.st-and.ac.uk/~eb/epic.php
+Stability:	experimental
+Category:       Compilers/Interpreters
+Synopsis:	Embedded Turtle language compiler in Haskell, with Epic output
+Description:    This language is a demonstration of the Epic compiler API.
+                It is a dynamically typed language with higher order
+		functions and system interaction (specifically graphics). 
+                Requires SDL and SDL_gfx libraries, and their C headers.
+Data-files:     sdl/sdlrun.o sdl/sdlrun.h
+Extra-source-files: sdl/Makefile sdl/sdlrun.c sdl/sdlrun.h src/Makefile
+
+Cabal-Version:  >= 1.6
+Build-type:     Custom
+
+Executable     atuin
+               Main-is: Main.lhs
+               hs-source-dirs: src
+               Other-modules: Turtle MkEpic SDLprims Lexer Parser Paths_atuin
+               Build-depends: base >=4 && <5, haskell98, Cabal, array,
+                              directory, epic
diff --git a/sdl/Makefile b/sdl/Makefile
new file mode 100644
--- /dev/null
+++ b/sdl/Makefile
@@ -0,0 +1,15 @@
+CC = gcc 
+CFLAGS = `epic -includedirs`
+
+INSTALLDIR = ${PREFIX}/lib/elogo
+
+sdlrun.o : sdlrun.c sdlrun.h
+
+install:
+	mkdir -p ${INSTALLDIR}
+	install sdlrun.o sdlrun.h ${INSTALLDIR}
+
+clean:
+	rm -f sdlrun.o
+
+.PHONY:
diff --git a/sdl/sdlrun.c b/sdl/sdlrun.c
new file mode 100644
--- /dev/null
+++ b/sdl/sdlrun.c
@@ -0,0 +1,151 @@
+#include <stdio.h>
+#include <SDL/SDL.h>
+#include <SDL/SDL_gfxPrimitives.h>
+
+#include <closure.h>
+
+SDL_Surface* graphicsInit(int xsize, int ysize) {
+    SDL_Surface *screen;
+
+    if(SDL_Init(SDL_INIT_TIMER | SDL_INIT_VIDEO | SDL_INIT_AUDIO) <0 )
+    {
+	printf("Unable to init SDL: %s\n", SDL_GetError());
+	return NULL;
+    }
+
+    screen = SDL_SetVideoMode(xsize, ysize, 32,
+                              SDL_HWSURFACE | SDL_DOUBLEBUF);
+    if (screen==NULL) {
+	printf("Unable to init SDL: %s\n", SDL_GetError());
+	return NULL;
+    }
+
+    return screen;
+}
+
+void filledRect(void *s_in,
+	        int x, int y, int w, int h,
+	        int r, int g, int b, int a) 
+{
+    SDL_Surface* s = (SDL_Surface*)s_in;
+    Uint32 colour 
+	= SDL_MapRGBA(s->format, (Uint8)r, (Uint8)g, (Uint8)b, (Uint8) a);
+    SDL_Rect rect = { x, y, w, h };
+    SDL_FillRect(s, &rect, colour);
+}
+
+void filledEllipse(void* s_in,
+		   int x, int y, int rx, int ry,
+                   int r, int g, int b, int a) 
+{
+    SDL_Surface* s = (SDL_Surface*)s_in;
+    filledEllipseRGBA(s, x, y, rx, ry, r, g, b, a);
+}
+
+void drawLine(void* s_in,
+	      int x, int y, int ex, int ey,
+	      int r, int g, int b, int a) 
+{
+    SDL_Surface* s = (SDL_Surface*)s_in;
+    lineRGBA(s, x, y, ex, ey, r, g, b, a);
+}
+
+
+void flipBuffers(void* s_in) {
+    SDL_Surface* s = (SDL_Surface*)s_in;
+    SDL_Flip(s);
+}
+
+void* startSDL(int x, int y) {
+    SDL_Surface *s = graphicsInit(x, y);
+    return (void*)s;
+}
+
+VAL KEY(int tag, SDLKey key) {
+    VAL k;
+    switch(key) {
+    case SDLK_UP:
+	k = CONSTRUCTOR(0,0,NULL);
+	break;
+    case SDLK_DOWN:
+	k = CONSTRUCTOR(1,0,NULL);
+	break;
+    case SDLK_LEFT:
+	k = CONSTRUCTOR(2,0,NULL);
+	break;
+    case SDLK_RIGHT:
+	k = CONSTRUCTOR(3,0,NULL);
+	break;
+    default:
+	k = CONSTRUCTOR1(4,MKINT((int)key));
+	break;
+    }
+    return CONSTRUCTOR1(tag, k);
+}
+
+void* pollEvent() 
+{
+    SDL_Event event; // = (SDL_Event *) GC_MALLOC(sizeof(SDL_Event));
+    int r = SDL_PollEvent(&event);
+    if (r==0) {
+	// FIXME: This will do something different depending on erasure...
+	// Probably the only way is to generate C glue for an idris module?
+	// Assuming erasure here.
+	return CONSTRUCTOR(1,0,NULL); // Nothing
+    }
+    else {
+	VAL ievent = NULL;
+	switch(event.type) {
+	case SDL_KEYDOWN:
+	    ievent = KEY(0, event.key.keysym.sym);
+	    break;
+	case SDL_KEYUP:
+	    ievent = KEY(1, event.key.keysym.sym);
+	    break;
+	case SDL_QUIT:
+	    ievent = CONSTRUCTOR(2,0,NULL);
+	    break;
+	default:
+	    // FIXME: This will do something different depending on erasure...
+	    // Assuming erasure
+	    return CONSTRUCTOR(1,0,NULL); // Nothing
+	}
+	// FIXME: This will do something different depending on erasure...
+	// Assuming erasure
+	return (void*)(CONSTRUCTOR1(0, ievent)); // Just ievent
+    }
+}
+
+void pressAnyKey() 
+{
+    while(1) {
+	SDL_Event event; // = (SDL_Event *) GC_MALLOC(sizeof(SDL_Event));
+	SDL_WaitEvent(&event);
+	if (event.type == SDL_KEYUP) { return; }
+    }
+}
+
+void* waitEvent() 
+{
+    SDL_Event event; // = (SDL_Event *) GC_MALLOC(sizeof(SDL_Event));
+    SDL_WaitEvent(&event);
+
+    VAL ievent = NULL;
+    switch(event.type) {
+    case SDL_KEYDOWN:
+	ievent = KEY(0, event.key.keysym.sym);
+	break;
+    case SDL_KEYUP:
+	ievent = KEY(1, event.key.keysym.sym);
+	break;
+    case SDL_QUIT:
+	ievent = CONSTRUCTOR(2,0,NULL);
+	break;
+    default:
+	// FIXME: This will do something different depending on erasure...
+	// Assuming erasure
+	return CONSTRUCTOR(1,0,NULL); // Nothing
+    }
+    return (void*)(CONSTRUCTOR1(0, ievent)); // Just ievent
+}
+
diff --git a/sdl/sdlrun.h b/sdl/sdlrun.h
new file mode 100644
--- /dev/null
+++ b/sdl/sdlrun.h
@@ -0,0 +1,27 @@
+#ifndef __SDLRUN_H
+#define __SDLRUN_H
+
+// Start SDL, open a window with dimensions (x,y)
+void* startSDL(int x, int y);
+
+void flipBuffers(void* s_in);
+
+// Drawing primitives
+
+void filledRect(void *s,
+	        int x, int y, int w, int h,
+	        int r, int g, int b, int a);
+void filledEllipse(void* s_in,
+		   int x, int y, int rx, int ry,
+                   int r, int g, int b, int a);
+void drawLine(void* s_in,
+	      int x, int y, int ex, int ey,
+	      int r, int g, int b, int a);
+
+// Events
+void* pollEvent(); // builds an Epic value
+void* waitEvent(); // builds an Epic value
+
+void pressAnyKey(); 
+
+#endif
diff --git a/sdl/sdlrun.o b/sdl/sdlrun.o
new file mode 100644
Binary files /dev/null and b/sdl/sdlrun.o differ
diff --git a/src/Lexer.lhs b/src/Lexer.lhs
new file mode 100644
--- /dev/null
+++ b/src/Lexer.lhs
@@ -0,0 +1,213 @@
+> module Lexer where
+
+> import Char
+
+> import Turtle
+
+> type Result a = Either (String, FilePath, Int) a
+
+> type LineNumber = Int
+> type P a = String -> String -> LineNumber -> Result a
+ 
+> getLineNo :: P LineNumber
+> getLineNo = \s fn l -> Right l
+ 
+> getFileName :: P String
+> getFileName = \s fn l -> Right fn
+ 
+> getContent :: P String
+> getContent = \s fn l -> Right s
+ 
+> thenP :: P a -> (a -> P b) -> P b
+> m `thenP` k = \s fn l -> case m s fn l of
+>        Right a -> k a s fn l
+>        Left (e, f, ln) -> Left (e, f, ln)
+ 
+> returnP :: a -> P a
+> returnP a = \s fn l -> Right a
+> 
+> failP :: String -> P a
+> failP err = \s fn l -> Left (err, fn, l)
+ 
+> catchP :: P a -> (String -> P a) -> P a
+> catchP m k = \s fn l ->
+>    case m s fn l of
+>       Right a -> Right a
+>       Left (e, f, ln) -> k e s fn l
+ 
+> happyError :: P a
+> happyError = reportError "Parse error"
+ 
+> reportError :: String -> P a
+> reportError err = getFileName `thenP` \fn ->
+>                   getLineNo `thenP` \line ->
+>                   getContent `thenP` \content ->
+>                       failP (fn ++ ":" ++ show line ++ ":" ++ err ++ " at " ++ take 40 content ++ " ...")
+ 
+> data Token 
+>       = TokenName Id
+>       | TokenString String
+>       | TokenInt Int
+>       | TokenChar Char
+>       | TokenBool Bool
+>       | TokenOB
+>       | TokenCB
+>       | TokenOCB
+>       | TokenCCB
+>       | TokenOSB
+>       | TokenCSB
+>       | TokenPlus
+>       | TokenMinus
+>       | TokenTimes
+>       | TokenDivide
+>       | TokenEquals
+>       | TokenEQ
+>       | TokenGE
+>       | TokenLE
+>       | TokenGT
+>       | TokenLT
+>       | TokenLet
+>       | TokenIn
+>       | TokenIf
+>       | TokenThen
+>       | TokenElse
+>       | TokenRepeat
+>       | TokenSemi
+>       | TokenComma
+>       | TokenMkCol Colour
+>       | TokenEval
+>       | TokenFD
+>       | TokenRight
+>       | TokenLeft
+>       | TokenColour
+>       | TokenPenUp
+>       | TokenPenDown
+>       | TokenEOF
+>  deriving (Show, Eq)
+> 
+> 
+> lexer :: (Token -> P a) -> P a
+> lexer cont [] = cont TokenEOF []
+> lexer cont ('\n':cs) = \fn line -> lexer cont cs fn (line+1)
+> lexer cont (c:cs)
+>       | isSpace c = \fn line -> lexer cont cs fn line
+>       | isAlpha c = lexVar cont (c:cs)
+>       | isDigit c = lexNum cont (c:cs)
+>       | c == '_' = lexVar cont (c:cs)
+> lexer cont ('"':cs) = lexString cont cs
+> lexer cont ('\'':cs) = lexChar cont cs
+> lexer cont ('{':'-':cs) = lexerEatComment 0 cont cs
+> lexer cont ('-':'-':cs) = lexerEatToNewline cont cs
+> lexer cont ('(':cs) = cont TokenOB cs
+> lexer cont (')':cs) = cont TokenCB cs
+> lexer cont ('{':cs) = cont TokenOCB cs
+> lexer cont ('}':cs) = cont TokenCCB cs
+> lexer cont ('[':cs) = cont TokenOSB cs
+> lexer cont (']':cs) = cont TokenCSB cs
+> lexer cont ('+':cs) = cont TokenPlus cs
+> lexer cont ('-':cs) = cont TokenMinus cs
+> lexer cont ('*':cs) = cont TokenTimes cs
+> lexer cont ('/':cs) = cont TokenDivide cs
+> lexer cont ('=':'=':cs) = cont TokenEQ cs
+> lexer cont ('>':'=':cs) = cont TokenGE cs
+> lexer cont ('<':'=':cs) = cont TokenLE cs
+> lexer cont ('>':cs) = cont TokenGT cs
+> lexer cont ('<':cs) = cont TokenLT cs
+> lexer cont ('=':cs) = cont TokenEquals cs
+> lexer cont (';':cs) = cont TokenSemi cs
+> lexer cont (',':cs) = cont TokenComma cs
+> lexer cont (c:cs) = lexError c cs
+ 
+> lexError c s f l = failP (show l ++ ": Unrecognised token '" ++ [c] ++ "'\n") s f l
+
+> lexerEatComment nls cont ('-':'}':cs)
+>     = \fn line -> lexer cont cs fn (line+nls)
+> lexerEatComment nls cont ('\n':cs) = lexerEatComment (nls+1) cont cs
+> lexerEatComment nls cont (c:cs) = lexerEatComment nls cont cs
+> 
+> lexerEatToNewline cont ('\n':cs)
+>    = \fn line -> lexer cont cs fn (line+1)
+> lexerEatToNewline cont (c:cs) = lexerEatToNewline cont cs
+
+> lexNum cont cs = case (span isDigit cs) of
+>                     (num, rest) ->
+>                         cont (TokenInt (read num)) rest
+
+> lexString cont cs =
+>    \fn line ->
+>    case getstr cs of
+>       Just (str,rest,nls) -> cont (TokenString str) rest fn (nls+line)
+>       Nothing -> failP (fn++":"++show line++":Unterminated string contant")
+>                     cs fn line
+
+> lexChar cont cs =
+>    \fn line ->
+>    case getchar cs of
+>       Just (str,rest) -> cont (TokenChar str) rest fn line
+>       Nothing -> 
+>           failP (fn++":"++show line++":Unterminated character constant")
+>                        cs fn line
+
+> isAllowed c = isAlpha c || isDigit c || c `elem` "_\'?#"
+
+> lexVar cont cs =
+>    case span isAllowed cs of
+>       ("true",rest) -> cont (TokenBool True) rest
+>       ("false",rest) -> cont (TokenBool False) rest
+> -- expressions
+>       ("let",rest) -> cont TokenLet rest
+>       ("if",rest) -> cont TokenIf rest
+>       ("then",rest) -> cont TokenThen rest
+>       ("else",rest) -> cont TokenElse rest
+>       ("repeat",rest) -> cont TokenRepeat rest
+>       ("in",rest) -> cont TokenIn rest
+>       ("eval",rest) -> cont TokenEval rest
+> -- commands
+>       ("forward",rest) -> cont TokenFD rest
+>       ("right",rest) -> cont TokenRight rest
+>       ("left",rest) -> cont TokenLeft rest
+>       ("colour",rest) -> cont TokenColour rest
+>       ("penup",rest) -> cont TokenPenUp rest
+>       ("pendown",rest) -> cont TokenPenDown rest
+> -- colours
+>       ("black",rest) -> cont (TokenMkCol Black) rest
+>       ("red",rest) -> cont (TokenMkCol Red) rest
+>       ("green",rest) -> cont (TokenMkCol Green) rest
+>       ("blue",rest) -> cont (TokenMkCol Blue) rest
+>       ("yellow",rest) -> cont (TokenMkCol Yellow) rest
+>       ("cyan",rest) -> cont (TokenMkCol Cyan) rest
+>       ("magenta",rest) -> cont (TokenMkCol Magenta) rest
+>       ("white",rest) -> cont (TokenMkCol White) rest
+>       (var,rest)   -> cont (mkname var) rest
+ 
+> mkname :: String -> Token
+> mkname c = TokenName (mkId c)
+
+> getstr :: String -> Maybe (String,String,Int)
+> getstr cs = case getstr' "" cs 0 of
+>                Just (str,rest,nls) -> Just (reverse str,rest,nls)
+>                _ -> Nothing
+> getstr' acc ('\"':xs) = \nl -> Just (acc,xs,nl)
+> getstr' acc ('\\':'n':xs) = getstr' ('\n':acc) xs -- Newline
+> getstr' acc ('\\':'r':xs) = getstr' ('\r':acc) xs -- CR
+> getstr' acc ('\\':'t':xs) = getstr' ('\t':acc) xs -- Tab
+> getstr' acc ('\\':'b':xs) = getstr' ('\b':acc) xs -- Backspace
+> getstr' acc ('\\':'a':xs) = getstr' ('\a':acc) xs -- Alert
+> getstr' acc ('\\':'f':xs) = getstr' ('\f':acc) xs -- Formfeed
+> getstr' acc ('\\':'0':xs) = getstr' ('\0':acc) xs -- null
+> getstr' acc ('\\':x:xs) = getstr' (x:acc) xs -- Literal
+> getstr' acc ('\n':xs) = \nl ->getstr' ('\n':acc) xs (nl+1) -- Count the newline
+> getstr' acc (x:xs) = getstr' (x:acc) xs
+> getstr' _ _ = \nl -> Nothing
+ 
+> getchar :: String -> Maybe (Char,String)
+> getchar ('\\':'n':'\'':xs) = Just ('\n',xs) -- Newline
+> getchar ('\\':'r':'\'':xs) = Just ('\r',xs) -- CR
+> getchar ('\\':'t':'\'':xs) = Just ('\t',xs) -- Tab
+> getchar ('\\':'b':'\'':xs) = Just ('\b',xs) -- Backspace
+> getchar ('\\':'a':'\'':xs) = Just ('\a',xs) -- Alert
+> getchar ('\\':'f':'\'':xs) = Just ('\f',xs) -- Formfeed
+> getchar ('\\':'0':'\'':xs) = Just ('\0',xs) -- null
+> getchar ('\\':x:'\'':xs) = Just (x,xs) -- Literal
+> getchar (x:'\'':xs) = Just (x,xs)
+> getchar _ = Nothing
diff --git a/src/Main.lhs b/src/Main.lhs
new file mode 100644
--- /dev/null
+++ b/src/Main.lhs
@@ -0,0 +1,18 @@
+> module Main where
+
+> import Parser
+> import MkEpic
+
+> import System
+
+> usage [inf, outf] = return (inf, outf)
+> usage _ = fail "Usage: atuin [input] [output]"
+
+> main :: IO ()
+> main = do args <- getArgs
+>           (inf, outf) <- usage args
+>           putStrLn $ "Compiling " ++ inf ++ " to " ++ outf
+>           prog <- parseFile (args!!0)
+>           case prog of
+>                Left (e, f, l) -> putStrLn $ f ++ ":" ++ show l ++ ":" ++ e
+>                Right p -> output p (args !! 1)
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,4 @@
+SDLflags.hs: .PHONY
+	echo "module SDLflags where\nsdlflags=\"`sdl-config --libs`\"" > SDLflags.hs
+
+.PHONY:
diff --git a/src/MkEpic.lhs b/src/MkEpic.lhs
new file mode 100644
--- /dev/null
+++ b/src/MkEpic.lhs
@@ -0,0 +1,159 @@
+> module MkEpic(output) where
+
+Convert a Turtle program into an Epic program
+
+> import Turtle
+> import SDLprims
+> import SDLflags
+> import Paths_atuin
+
+> import Epic.Epic as Epic hiding (compile)
+
+> opts = [GCCOpt (sdlflags ++ " -l SDL_gfx"), MainInc "SDL/SDL.h"]
+
+Epic takes Strings as identifiers, so we'll need to convert our identifiers
+to strings...
+
+> fullId :: Id -> String
+> fullId n = e n
+>    where e [] = ""
+>          e (x:xs) = "_" ++ x ++ e xs
+
+...then to Epic identifiers.
+
+> epicId :: Id -> Name
+> epicId i = name (fullId i)
+
+The main compiler function, turns a logo program into an Epic
+term. Just traverses a Turtle and calls the appropriate Epic
+primitives, and the primitives we've defined in SDLprims.
+
+The compiled program maintains a turtle state, so we'll pass the
+state to the compiler.
+
+> class Compile a where
+>     compile :: Expr -> a -> Term
+
+> instance Compile Turtle where
+
+When we sequence commands, we need to pass the new state from the first
+command as input to the second command.
+
+>     compile state (Seq x y) 
+>        = let_ (compile state x) (\state' -> compile state' y)
+>     compile state (Turtle c)  = compile state c
+
+When applying a function we need to add the state as the first argument.
+
+>     compile state (Call i es) 
+>          = app (fn (fullId i) @@ state) es
+>        where app f [] = f
+>              app f (e:es) = app (f @@ compile state e) es
+
+>     compile state (If a t e) = if_ (getBool (compile state a))
+>                                    (compile state t) (compile state e)
+
+To repeat an action n times, call the "repeat" function. The action itself
+is parameterised over a state becaue it'll have a different state at each
+step of the loop. It's really handy to be able to use a Haskell function
+here! 
+
+>     compile state (Repeat n e) = fn "repeat" @@ state 
+>                                              @@ compile state n
+>                                              @@ (\st -> compile st e)
+
+>     compile state (Let i e scope) 
+>         = letN_ (epicId i) (compile state e) (compile state scope)
+
+To evaluate a delayed expression, pass it the current state.
+
+>     compile state (Eval e) = effect_ (compile state e @@ state)
+>     compile state Pass = unit_
+
+It's a dynamically typed language, so when we compute an expression we
+need to check the values are the right type at each step. The primitives
+in SDLprims do this for us.
+
+> instance Compile Exp where
+>     compile state (Infix op l r) 
+>         = (mkOp op) (compile state l) (compile state r)
+>         where mkOp Turtle.Plus = primPlus
+>               mkOp Turtle.Minus = primMinus
+>               mkOp Turtle.Times = primTimes
+>               mkOp Turtle.Divide = primDivide
+>               mkOp Turtle.Eq = primEq
+>               mkOp Turtle.LT = primLT
+>               mkOp Turtle.LE = primLE
+>               mkOp Turtle.GT = primGT
+>               mkOp Turtle.GE = primGE
+>     compile state (Var i) = ref (epicId i)
+>     compile state (Const i) = compile state i
+
+Delay evaluation of a code block. When we get around to evaluating it,
+we'll want to use the state at that point, not the state when the block is
+built, so make this a function.
+
+>     compile state (Block t) = lazy_ (\st -> compile st t)
+
+Values are wrapped in an ADT so we can see what type they are.
+i.e. data Value = MkInt Int | MkString Str | ...
+Primitives are defined for building these in SDLprims.
+
+> instance Compile Const where
+>     compile state (MkInt i) = mkint (int i)
+>     compile state (MkString s) = mkstr (str s)
+>     compile state (MkChar c) = mkchar (char c)
+>     compile state (MkBool b) = mkbool (bool b)
+>     compile state (MkCol Black) = mkcol col_black
+>     compile state (MkCol Red) = mkcol col_red
+>     compile state (MkCol Green) = mkcol col_green
+>     compile state (MkCol Blue) = mkcol col_blue
+>     compile state (MkCol Yellow) = mkcol col_yellow
+>     compile state (MkCol Cyan) = mkcol col_cyan
+>     compile state (MkCol Magenta) = mkcol col_magenta
+>     compile state (MkCol White) = mkcol col_white
+
+For turtle commands, we've also defined some primitives, so we just apply
+them to the current state and the given argument.
+
+> instance Compile Command where
+>     compile state (Fd i)     = fn "forward" @@ state @@ compile state i
+>     compile state (Rt i)     = fn "right"   @@ state @@ compile state i
+>     compile state (Lt i)     = fn "left"    @@ state @@ compile state i
+>     compile state (Colour c) = fn "colour"  @@ state @@ compile state c
+>     compile state PenUp      = fn "pen"     @@ state @@ bool False
+>     compile state PenDown    = fn "pen"     @@ state @@ bool True
+
+Convert a function with arguments into an Epic definition. We have the
+arguments in the definition, plus an additional state added by the system
+which carries the turtle state and SDL surface.
+
+> mkEpic :: (Id, Function) -> (Name, EpicDecl)
+> mkEpic (i, (args, p)) 
+>       = (epicId i, EpicFn (\ state -> (map epicId args, compile state p)))
+
+Epic main program - initialises SDL, sets up an initial turtle state,
+runs the program called "main" and waits for a key press.
+
+> runMain :: Term
+> runMain = 
+>   let_ (fn "initSDL" @@ int 640 @@ int 480)
+>   (\surface -> 
+>       (fn (fullId (mkId "main")) @@ (init_turtle surface)) +>
+>        flipBuffers surface +>
+>        pressAnyKey)
+
+Find the support files (the SDL glue code) and compile an Epic program
+with the primitives (from SDLprims) and the user's program.
+
+> output :: [(Id, Function)] -> FilePath -> IO ()
+> output prog fp = do -- TODO: run sdl-config
+>                     sdlo <- getDataFileName "sdl/sdlrun.o"
+>                     sdlh <- getDataFileName "sdl/sdlrun.h"
+>                     let eprog = map mkEpic prog
+>                     let incs = [(name "hdr", Include sdlh),
+>                                 (name "hdr", Include "math.h")]
+>                     compileObj (incs ++ sdlPrims ++ 
+>                                (name "main", EpicFn runMain):eprog)
+>                                 (fp++".o")
+>                     linkWith opts [fp++".o", sdlo] fp
diff --git a/src/Parser.y b/src/Parser.y
new file mode 100644
--- /dev/null
+++ b/src/Parser.y
@@ -0,0 +1,148 @@
+{ -- -*-Haskell-*-
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Parser where
+
+import Char
+import Turtle
+import Lexer
+
+}
+
+%name mkparse Program
+
+%tokentype { Token }
+%monad { P } { thenP } { returnP }
+%lexer { lexer } { TokenEOF }
+
+%token 
+      name            { TokenName $$ }
+      string          { TokenString $$ }
+      char            { TokenChar $$ }
+      int             { TokenInt $$ }
+      bool            { TokenBool $$ }
+      col             { TokenMkCol $$ }
+      let             { TokenLet }
+      in              { TokenIn }
+      if              { TokenIf }
+      then            { TokenThen }
+      else            { TokenElse }
+      repeat          { TokenRepeat }
+      '('             { TokenOB }
+      ')'             { TokenCB }
+      '{'             { TokenOCB }
+      '}'             { TokenCCB }
+      '['             { TokenOSB }
+      ']'             { TokenCSB }
+      '+'             { TokenPlus }
+      '-'             { TokenMinus }
+      '*'             { TokenTimes }
+      '/'             { TokenDivide }
+      '='             { TokenEquals }
+      eq              { TokenEQ }
+      le              { TokenLE }
+      ge              { TokenGE }
+      '<'             { TokenLT }
+      '>'             { TokenGT }
+      ';'             { TokenSemi }
+      ','             { TokenComma }
+      eval            { TokenEval }
+      forward         { TokenFD }
+      right           { TokenRight }
+      left            { TokenLeft }
+      colour          { TokenColour }
+      penup           { TokenPenUp }
+      pendown         { TokenPenDown }
+
+%nonassoc NONE
+%left eq 
+%left ';'
+%left '<' '>' le ge 
+%left '+' '-' 
+%left '*' '/' 
+%left NEG
+
+%%
+
+Program :: { [(Id, Function)] }
+Program : Function { [$1] }
+        | Function Program { $1:$2 }
+
+Function :: { (Id, Function) }
+Function : name '(' Vars ')' Block { ($1, ($3, $5)) }
+
+Vars :: { [Id] }
+Vars : { [] }
+     | name { [$1] }
+     | name ',' Vars { $1:$3 }
+
+TurtleProg :: { Turtle }
+TurtleProg : Turtle { $1 }
+           | Turtle TurtleProg { Seq $1 $2 }
+           | name '=' Expr TurtleProg { Let $1 $3 $4 }
+
+Block :: { Turtle }
+Block : '{' TurtleProg '}' { $2 }
+      | Turtle { $1 }
+
+Turtle :: { Turtle }
+Turtle : name '(' ExprList ')' { Call $1 $3 }
+       | if Expr Block ElseBlock
+               { If $2 $3 $4 }
+       | eval Expr { Eval $2 }
+       | repeat Expr Block { Repeat $2 $3 }
+       | forward Expr { Turtle (Fd $2) }
+       | right Expr { Turtle (Rt $2) }
+       | left Expr { Turtle (Lt $2) }
+       | colour Expr { Turtle (Colour $2) }
+       | penup { Turtle PenUp }
+       | pendown { Turtle PenDown }
+
+ElseBlock :: { Turtle }
+ElseBlock : { Pass }
+          | else Block { $2 }
+
+ExprList :: { [Exp] }
+ExprList : Expr { [$1] }
+         | Expr ',' ExprList { $1:$3 }
+
+Expr :: { Exp }
+Expr : name { Var $1 }
+     | Constant { Const $1 }
+     | '-' Expr %prec NEG { Infix Minus (Const (MkInt 0)) $2 }
+     | Expr '+' Expr { Infix Plus $1 $3 }
+     | Expr '-' Expr { Infix Minus $1 $3 }
+     | Expr '*' Expr { Infix Times $1 $3 }
+     | Expr '/' Expr { Infix Divide $1 $3 }
+     | Expr eq Expr  { Infix Eq $1 $3 }
+     | Expr '<' Expr { Infix Turtle.LT $1 $3 }
+     | Expr '>' Expr { Infix Turtle.GT $1 $3 }
+     | Expr le Expr  { Infix LE $1 $3 }
+     | Expr ge Expr  { Infix GE $1 $3 }
+     | '(' Expr ')'  { $2 }
+     | '{' TurtleProg '}' { Block $2 }
+
+Constant :: { Const }
+Constant : int    { MkInt $1 }
+         | string { MkString $1 }
+         | char   { MkChar $1 }
+         | bool   { MkBool $1 }
+         | col    { MkCol $1 }
+
+Line :: { LineNumber }
+     : {- empty -}      {% getLineNo }
+
+File :: { String } 
+     : {- empty -} %prec NONE  {% getFileName }
+
+{
+
+parse :: String -> FilePath -> Result [(Id, Function)]
+parse s fn = mkparse s fn 1
+
+parseFile :: FilePath -> IO (Result [(Id, Function)])
+parseFile fn = do s <- readFile fn
+                  let x = parse s fn
+                  return x
+
+}
diff --git a/src/SDLprims.lhs b/src/SDLprims.lhs
new file mode 100644
--- /dev/null
+++ b/src/SDLprims.lhs
@@ -0,0 +1,199 @@
+> {-# OPTIONS_GHC -fglasgow-exts #-}
+
+> module SDLprims where
+
+Epic primitives for calling SDL and basic operators
+
+> import Epic.Epic
+
+> initSDL :: Expr -> Expr -> Term
+> initSDL xsize ysize 
+>     = foreign_ tyPtr "startSDL" [(xsize, tyInt), (ysize, tyInt)]
+
+> pollEvent   = foreignConst_ tyPtr "pollEvent"
+> pressAnyKey = foreignConst_ tyUnit "pressAnyKey"
+
+> flipBuffers :: Expr -> Term
+> flipBuffers s = foreign_ tyUnit "flipBuffers" [(s, tyPtr)]
+
+Define some colours, and convert a colour into a tuple of the relevant
+RGBA values.
+
+> col_black   = con_ 0
+> col_red     = con_ 1
+> col_green   = con_ 2
+> col_blue    = con_ 3
+> col_yellow  = con_ 4
+> col_cyan    = con_ 5
+> col_magenta = con_ 6
+> col_white   = con_ 7
+
+> rgba col = case_ col 
+>              [con 0 (tuple_ @@ int 0   @@ int 0   @@ int 0   @@ int 255),
+>               con 1 (tuple_ @@ int 255 @@ int 0   @@ int 0   @@ int 255),
+>               con 2 (tuple_ @@ int 0   @@ int 255 @@ int 0   @@ int 255),
+>               con 3 (tuple_ @@ int 0   @@ int 0   @@ int 255 @@ int 255),
+>               con 4 (tuple_ @@ int 255 @@ int 255 @@ int 0   @@ int 255),
+>               con 5 (tuple_ @@ int 0   @@ int 255 @@ int 255 @@ int 255),
+>               con 6 (tuple_ @@ int 255 @@ int 0   @@ int 255 @@ int 255),
+>               con 7 (tuple_ @@ int 255 @@ int 255 @@ int 255 @@ int 255)]
+
+Constants - it's a dynamically typed language so we wrap them in an ADT
+which says what type they are.
+
+> mkint i  = con_ 0 @@ i
+> mkstr s  = con_ 1 @@ s
+> mkchar c = con_ 2 @@ c
+> mkbool b = con_ 3 @@ b
+> mkcol c  = con_ 4 @@ c
+
+Every time we use a constant, we'll have to extract it from the wrapper.
+If we're asking for the wrong type, quit with an error.
+
+ANNOYANCE: Having to add type annotations because we only have Alternative
+instances for (Expr -> e). Is there a way to make type inference know that
+it must be an Expr because that's the only instance we define? i.e. can
+we stop any other instances for (a -> e) being allowed somehow?
+
+> getInt x  = case_ x 
+>             [con 0 (\ (x :: Expr) -> x), defaultcase (error_ "Not an Int")]
+
+> getStr x  = case_ x 
+>             [con 1 (\ (x :: Expr) -> x), defaultcase (error_ "Not a String")]
+
+> getChar x = case_ x 
+>             [con 2 (\ (x :: Expr) -> x), defaultcase (error_ "Not a Char")]
+
+> getBool x = case_ x 
+>             [con 3 (\ (x :: Expr) -> x), defaultcase (error_ "Not a Bool")]
+
+> getCol x  = case_ x 
+>             [con 4 (\ (x :: Expr) -> x), defaultcase (error_ "Not a Colour")]
+
+Arithmetic operations
+
+> primPlus x y = mkint $ op_ Plus (getInt x) (getInt y)
+> primMinus x y = mkint $ op_ Minus (getInt x) (getInt y)
+> primTimes x y = mkint $ op_ Times (getInt x) (getInt y)
+> primDivide x y = mkint $ op_ Divide (getInt x) (getInt y)
+
+Comparisons
+
+> primEq x y = mkbool $ op_ OpEQ (getInt x) (getInt y)
+> primLT x y = mkbool $ op_ OpLT (getInt x) (getInt y)
+> primLE x y = mkbool $ op_ OpLE (getInt x) (getInt y)
+> primGT x y = mkbool $ op_ OpGT (getInt x) (getInt y)
+> primGE x y = mkbool $ op_ OpGE (getInt x) (getInt y)
+
+Graphics primitive, just extracts the tuple of RGBA values for the colour
+and calls the SDL_gfx primitive.
+
+> drawLine :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Term
+> drawLine surf x y ex ey col
+>          = case_ (rgba col)
+>              [tuple (\ r g b a ->
+>                 foreign_ tyUnit "drawLine" 
+>                   [(surf, tyPtr),
+>                    (x, tyInt), (y, tyInt), 
+>                    (ex, tyInt), (ey, tyInt),
+>                    (r, tyInt), (g, tyInt), 
+>                    (b, tyInt), (a, tyInt)]) ]
+
+We have integers and degrees, but sin and cos work with floats and radians.
+Here's some primitives to do the necessary conversions.
+
+> intToFloat x = foreign_ tyFloat "intToFloat" [(x, tyInt)]
+> floatToInt x = foreign_ tyInt "floatToInt" [(x, tyFloat)]
+
+> rad x = op_ FTimes (intToFloat x) (float (pi/180))
+
+> esin x = foreign_ tyFloat "sin" [(rad x, tyFloat)]
+> ecos x = foreign_ tyFloat "cos" [(rad x, tyFloat)]
+
+Turtle functions.
+In these, the arguments given by the user are in the Value ADT, so we'll
+need to extract the integer.
+
+To move forward, create a new state with the turtle at the new position, 
+and draw a line in the current colour between the two positions. 
+Return the new state.
+
+> forward :: Expr -> Expr -> Term
+> forward st dist = case_ st 
+>   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
+>             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
+>              let_ (op_ Plus x (floatToInt (op_ FTimes (intToFloat (getInt dist))
+>                                                        (esin dir))))
+>              (\x' -> let_ (op_ Plus y (floatToInt 
+>                                            (op_ FTimes (intToFloat (getInt dist))
+>                                                        (ecos dir))))
+>              (\y' -> if_ pen (fn "drawLine" @@ surf @@ x @@ y 
+>                                      @@ x' @@ y' @@ col)
+>                              unit_ +>
+>                      tuple_ @@ surf @@ x' @@ y' @@ dir @@ col @@ pen)))]
+
+To turn right, create a new state with the turtle turned right. 
+Return the new state.
+
+> right :: Expr -> Expr -> Term
+> right st ang = case_ st
+>   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
+>             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
+>          (tuple_ @@ surf @@ x @@ y @@ op_ Minus dir (getInt ang) @@ col @@ pen))]
+
+To turn left, create a new state with the turtle turned left. 
+Return the new state.
+
+> left :: Expr -> Expr -> Term
+> left st ang = case_ st
+>   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
+>             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
+>          (tuple_ @@ surf @@ x @@ y @@ op_ Plus dir (getInt ang) @@ col @@ pen))]
+
+> colour :: Expr -> Expr -> Term
+> colour st col' = case_ st
+>   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
+>             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
+>          (tuple_ @@ surf @@ x @@ y @@ dir @@ getCol col' @@ pen))]
+
+> pen :: Expr -> Expr -> Term
+> pen st b = case_ st
+>   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
+>             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
+>          (tuple_ @@ surf @@ x @@ y @@ dir @@ col @@ b))]
+
+Repeat n times
+
+> primRepeat :: Expr -> Expr -> Expr -> Term
+> primRepeat st n e = case_ (getInt n)
+>                 [constcase 0 st,
+>                  defaultcase (let_ (e @@ st)
+>                      (\st' -> fn "repeat" @@ st'
+>                                   @@ mkint (op_ Minus (getInt n) (int 1))
+>                                   @@ e))]
+
+Turtle state consists of an SDL surface,
+a position, a direction, a colour, and pen up/down:
+(surf, x, y, dir, col, bool)
+
+Note that we use primitives here, not the Value ADT, because we don't allow
+the user direct access to this tuple.
+
+> init_turtle surf = tuple_ @@ surf @@ 
+>                              int 320 @@ int 240 @@ int 180 @@ 
+>                              col_white @@ bool True
+
+Export the primitives as Epic functions.
+
+> sdlPrims = basic_defs ++
+>            [(name "initSDL",     EpicFn initSDL),
+>             (name "pollEvent",   EpicFn pollEvent),
+>             (name "flipBuffers", EpicFn flipBuffers),
+>             (name "drawLine",    EpicFn drawLine),
+>             (name "forward",     EpicFn forward),
+>             (name "left",        EpicFn left),
+>             (name "right",       EpicFn right),
+>             (name "colour",      EpicFn colour),
+>             (name "pen",         EpicFn pen),
+>             (name "repeat",      EpicFn primRepeat),
+>             (name "pressAnyKey", EpicFn pressAnyKey)]
diff --git a/src/Turtle.lhs b/src/Turtle.lhs
new file mode 100644
--- /dev/null
+++ b/src/Turtle.lhs
@@ -0,0 +1,49 @@
+> module Turtle where
+
+> type Id = [String]
+> type Root = String
+
+> mkId :: String -> Id
+> mkId = (:[])
+
+> data Exp = Infix Op Exp Exp
+>          | Var Id
+>          | Const Const
+>          | Block Turtle
+>   deriving Show
+
+> data Const = MkInt Int
+>            | MkString String
+>            | MkChar Char
+>            | MkBool Bool
+>            | MkCol Colour
+>   deriving Show
+
+> data Colour = Black | Red | Green | Blue | Yellow | Cyan | Magenta | White
+>   deriving (Show, Eq)
+
+> data Turtle = Call Id [Exp]
+>             | Turtle Command
+>             | Seq Turtle Turtle
+>             | If Exp Turtle Turtle
+>             | Repeat Exp Turtle
+>             | Let Id Exp Turtle
+>             | Eval Exp
+>             | Pass
+>   deriving Show
+
+> type Function = ([Id], Turtle)
+
+> data Op = Plus | Minus | Times  | Divide      -- int ops
+>         | Eq   | LT    | LE     | GT     | GE -- bool ops  
+>         | Car  | Cdr   | Append | Index       -- TODO: string/char ops
+>   deriving Show
+
+> data Command = Fd Exp
+>              | Rt Exp
+>              | Lt Exp
+>              | Colour Exp
+>              | PenUp
+>              | PenDown
+>    deriving Show
+
