diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+Copyright (c) 2011, Sankel Software 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * 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.
+    * Neither the name of the Sankel Software nor the
+      names of its 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 SANKEL SOFTWARE 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/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/TinyLaunchbury.cabal b/TinyLaunchbury.cabal
new file mode 100644
--- /dev/null
+++ b/TinyLaunchbury.cabal
@@ -0,0 +1,16 @@
+Name:           TinyLaunchbury
+Version:        1.0
+License:        BSD3
+License-File:   LICENSE 
+Author:         Elliot Stern, David Sankell
+Maintainer:     Elliot Stern <eliyahu.ben.miney@gmail.com>
+Synopsis:       Simple implementation of call-by-need using Launchbury's semantics
+Category:       Compilers/Interpreters
+Description:    A simple implementation of Launchbury's operational semantics for lazy languages.
+Build-Type:      Simple
+Cabal-Version:   >= 1.2
+
+Library
+    Build-Depends:   base >= 4  && < 5,
+                     mtl >= 1   && < 3.0
+    Exposed-Modules: TinyLaunchbury
diff --git a/TinyLaunchbury.hs b/TinyLaunchbury.hs
new file mode 100644
--- /dev/null
+++ b/TinyLaunchbury.hs
@@ -0,0 +1,335 @@
+-- Copyright Sankell Software 2011
+
+module TinyLaunchbury (
+                  Expr(Lambda, Apply, Var, Let, Prim, Ctor, Case),
+                  reduce,
+                  displayReduce) where
+
+import Data.List(foldl',intercalate)
+import Control.Monad.State
+import Control.Monad.Error
+import Control.Monad.Identity
+import Control.Arrow( second, (***) )
+import Data.Monoid
+
+
+type Name = String 
+
+data Expr =  Lambda Name Expr
+           | Apply Expr Name
+           | Var Name
+           | Let Bindings Expr
+           | Prim Name Expr Expr
+           | Ctor Int [Name]
+           | Case Expr Alts
+           deriving Eq
+
+type Binding = (Name,Expr)
+type Bindings = [Binding]
+type Alt = (Int, ([Name], Expr) )
+type Alts = [Alt]
+
+-- |Gets the list of variable names from the bindings
+binders :: Bindings -> [Name]
+binders = map fst
+
+-- | Displays an Expression using a more common lambda calculus syntax
+-- rather than just printing the syntax tree.
+instance Show Expr where
+  show (Lambda x e) = "\\" ++ x ++ "." ++ show e
+  show (Apply e x) = show e ++ " " ++ x
+  show (Var x) = x
+  show (Let bindings e) = "let " ++ bindingStr ++ " in " ++ show e 
+       where showBinding (x,e') = x ++ " = " ++ show e'
+             bindingStr = intercalate ", " (map showBinding bindings)
+  show (Prim fun e e') = show e ++ " " ++ fun ++ " " ++ show e'
+  show (Ctor ctor []) = show ctor
+  show (Ctor ctor args) = "<" ++ show ctor ++ " " ++ unwords args ++">"
+  show (Case e alts) = "case " ++ show e ++ " of " ++ caseStr 
+         where dispCase (ctor, (args, e')) = show (Ctor ctor args) 
+                                                  ++ " -> " ++ show e'
+               caseStr = (intercalate ", " . map dispCase) alts
+
+type Heap = [(Name, Expr)]
+
+-- | Remove some binding from the heap.
+hRemoveBinding :: Name -> (Heap -> Heap)
+hRemoveBinding x = filter $ (/= x) . fst
+
+
+type StateErrorT s a m = ErrorT String (StateT s m) a
+runStateErrorT = runStateT. runErrorT 
+
+type StateError s a = StateErrorT s a Identity
+runStateError m = runIdentity. runStateErrorT m
+
+data ReduceState = RS { rsHeap :: Heap
+                      , rsFreshVars :: [Name]
+                      , rsLogIndentation :: Int
+                      , rsLog :: Log
+                      }
+
+rsInitial :: ReduceState
+rsInitial = RS { rsHeap = []
+               , rsFreshVars = freshVarNames
+               , rsLogIndentation = 0
+               , rsLog = []
+               }
+
+type ReduceM a =  StateError ReduceState a
+rmRun :: ReduceM a -> ReduceState-> (Either String a, ReduceState)
+rmRun = runStateError
+
+-- hides the implementation detail of fail vs throw error; makes it easier to
+-- swap out the underlying monad.
+rmErr :: String -> ReduceM Expr
+rmErr e = do appendToLog $ "Error: " ++ e
+             h  <- fmap rsHeap get
+             appendToLog (show h)
+             throwError e
+
+-- |Like sub, but for a list of things to substite
+-- usefull for implementing recursive lets (i.e. letrec)
+subs :: [(Name,Name)] -> (Expr -> Expr)
+subs = foldr (.) id . map (uncurry sub)
+
+-- |e[x/y] in Launchbury's notation
+--  [x ↦ y]e in Pierce's notation in TaPL
+--  recursively descend expression tree to substitute a free variable
+sub ::  Name -> Name -> (Expr -> Expr)
+sub x y e =
+ let subExpr = sub x y
+     subName z | x == z    = y
+               | otherwise = z
+     -- subAlt (ctor, (args, e'')) = (ctor, (map subName args, subExpr e''))
+     subAlt = second (map subName *** subExpr)
+ in case e of
+       Lambda z e'| z == x              -> e -- only want to sub free variables;
+                                             -- x is no longer free
+                  | otherwise           -> Lambda z (subExpr e')
+       Apply e' z                       -> Apply (subExpr e') (subName z)
+       Var z                            -> Var (subName z)
+       Let bs e'  | elem x (binders bs) -> e -- only want to sub free variables;
+                                             -- x is no longer free
+                  | otherwise           -> Let bs (subExpr e')
+       Prim fun e' e''                  -> Prim fun (subExpr e') (subExpr e'')
+                                        -- substitute the variables in the ctor;
+                                        -- the ctor itself should be left alone 
+       Ctor ctor args                   -> Ctor ctor (map subName args)
+       Case e' alts                     -> Case (subExpr e') (map subAlt alts) 
+
+-- helper function fro freshen; freshens an alternative in a case statement
+freshenAlt :: Alt -> ReduceM Alt
+freshenAlt (ctr, (ns,e)) = do e' <- freshen e
+                              return (ctr, (ns, e'))
+
+-- |freshen takes an expression, and returns the same expression with every 
+-- bound variable substituted for a fresh variable. 
+freshen :: Expr -> ReduceM Expr
+freshen l@(Lambda x e)     = do y <- getFreshVar
+                                e' <- (freshen . sub x y) e
+                                return $ Lambda y e'
+freshen (Apply e x)        = do e' <- freshen e 
+                                return $ Apply e' x
+freshen v@(Var _)          = return v
+freshen l@(Let bs e)       = do let vs = map fst bs 
+                                    es = map snd bs
+                                vs' <- getFreshVars (length bs)
+                                -- let is mutually recursive, so any binding
+                                -- can refer to any other binding
+                                let subFreshF = freshen . subs (zip vs vs')
+                                es' <- mapM subFreshF es
+                                e' <- subFreshF e
+                                return $ Let (zip vs' es') e'
+freshen (Prim fun e e')    = liftM2 (Prim fun) (freshen e) (freshen e') 
+                           -- if the constructor's args needed to be freshened
+                           -- they already were
+freshen c@(Ctor ctor args) = return c
+freshen (Case e alts)      = liftM2 Case (freshen e) (mapM freshenAlt alts)
+
+type ErrorOr a = Either String a
+type Log = String
+
+appendToLog :: String -> ReduceM ()
+appendToLog msg = modify $ \s ->  s {rsLog = rsLog s ++ "\n" 
+                                          ++ (replicate (rsLogIndentation s) '|'
+                                          ++ msg)}
+-- | returns whatever x is bound to in the heap, or calls rmErr if it isn't in
+-- the heap
+heapLookup :: Name -> ReduceM Expr
+heapLookup x = do me <- fmap (lookup x . rsHeap) get
+                  -- return the error if me is nothing; return me otherwise
+                  maybe (rmErr $ "Illigal free variable: " ++ x 
+                               ++ " isn't in the heap.") return me
+
+heapModify ::  (Heap -> Heap) -> ReduceM ()
+heapModify f = modify $ \s -> s { rsHeap = f (rsHeap s) }
+
+-- | Removes a binding from the heap.
+heapRemove :: Name -> ReduceM ()
+heapRemove x = heapModify (hRemoveBinding x)
+
+-- | Adds a binding to the heap
+heapAdd :: Name -> Expr -> ReduceM ()
+heapAdd x e = heapModify ((x,e):)
+
+getFreshVar :: ReduceM Name
+getFreshVar = do (v:vs) <- fmap rsFreshVars get
+                 modify (\s -> s {rsFreshVars = vs})
+                 return v
+
+getFreshVars :: Int -> ReduceM [Name]
+getFreshVars = sequence . flip replicate getFreshVar
+
+withLogIndent :: ReduceM b -> ReduceM b
+withLogIndent funarg = do s@(RS _ _ i _) <- get
+                          put $ s {rsLogIndentation = i+1}
+                          result <- funarg
+                          s' <- get
+                          put $ s' {rsLogIndentation = i}
+                          return result 
+
+realReduce :: Expr -> ReduceM ()
+realReduce e = do e' <- reduceM e
+                  appendToLog $ "Ans: " ++ show e'
+
+
+evalAndGetLog :: ReduceM a -> String
+evalAndGetLog = rsLog . snd . flip rmRun rsInitial
+
+evalAndGetExpr :: Expr -> Either String Expr
+evalAndGetExpr = fst . flip rmRun rsInitial . reduceM
+
+-- |Reduces an expression, and returns a string containing the log appended with
+-- the result
+reduce :: Expr -> String
+reduce =  evalAndGetLog . realReduce
+
+-- | Prints the result of reduce to stdout.  The main reason for this function
+--  is that the log contains newline Chars, and newlines don't format correctly
+--  in ghci.
+displayReduce :: Expr -> IO ()
+displayReduce = putStrLn . reduce
+
+
+freshVarNames :: [Name]
+freshVarNames = ["$" ++ show x | x <- [1..]]
+
+showHeap h = "{" ++ heapStr ++ "}" 
+  where showElem (x, e) = x ++ " -> " ++ show e
+        heapStr = intercalate ", " $ map showElem h
+
+
+
+-- |Performs long-step reduction of an expression, logging the steps taken along the way.
+reduceM :: Expr -> ReduceM Expr
+reduceM e = let logCase msg = do s <- get
+                                 appendToLog $ msg ++ show e
+                                             ++ " : " ++  showHeap (rsHeap s) 
+ in case e of
+        Lambda e' x ->  logCase "Returning lambda: " >> return (Lambda e' x)  
+        Apply e' x  -> do logCase "Reducing apply: "
+                          Lambda y' e'' <- withLogIndent $ reduceM e'
+                          withLogIndent $ reduceM (sub y' x e'')
+        Var x ->      do logCase "Reducing variable: " 
+                         e' <- heapLookup x
+                         heapRemove x
+                         z <- withLogIndent $ reduceM e'
+                         appendToLog $ "Rebinding var " ++ x ++ " to " ++ show z
+                         heapAdd x z
+                         freshen z
+        Let bs e' -> do logCase "Reducing let: "
+                        mapM_ (uncurry heapAdd) bs
+                        withLogIndent $ reduceM e'
+        Prim fun e1 e2 -> do  logCase "Reducing primitive: " 
+                              n1 <- withLogIndent $ reduceM e1
+                              n2 <- withLogIndent $ reduceM e2
+                              result <- executePrimitive fun n1 n2  
+                              appendToLog $ "Primitive evaluated to " 
+                                            ++ show result
+                              return result 
+        Ctor ctor args -> do logCase "Returning constructor: " 
+                             return $ Ctor ctor args
+        Case e' alts  -> 
+          do logCase "Reducing case statement: " 
+             e''@(Ctor ctor args) <- withLogIndent $ reduceM e'
+             case lookup ctor alts of
+                Just (altNs, altE) -> withLogIndent $ reduceM $ subs (zip altNs args) altE
+                Nothing -> rmErr $ "non-exhaustive patterns in case " ++ show e
+                                ++ "; no match for constructor " ++ show e''
+   
+executePrimitive :: Name -> Expr -> Expr -> ReduceM Expr
+executePrimitive f (Ctor n1 []) (Ctor n2 []) = 
+  let fReal = lookup f [("+",(+))
+                        ,("-",(-))
+                        ,("/",(div))
+                        ,("*",(*))]
+  in case fReal of 
+      Just fun -> return $ Ctor (fun n1 n2) []
+      Nothing -> rmErr $ "primitive " ++ f  
+                       ++ " doesn't exist for nullary constructors"
+executePrimitive f e e' = rmErr $ "e = " ++ show e ++ " e' = " ++ show e'
+
+-- Some example expressions, plus some functions to make constructing 
+-- expressions easier
+mkNum x = Ctor x []
+
+addExpr  = Prim "+" 
+multExpr = Prim "*" 
+
+add x y = addExpr (mkNum x) (mkNum y)
+addVar x y = addExpr (Var x) (mkNum y)
+addVars x y = addExpr (Var x) (Var y)
+multVars x y = multExpr (Var x) (Var y)
+applyVars x y = Apply (Var x) y
+
+simpleExpr = Let [("u", add 3 2),
+                  ("v", addVar "u" 1)]
+                 $ addVars "v" "v"
+
+-- Recursive, but refers to x before x is put back on the heap.
+-- will very quickly fail.
+errorExpr = Let [("x", Var "x")] (Var "x")
+
+fastExpr  = Let [("u", add 2 3),
+                 ("f", Let [("v", addVar "u" 1)]
+                           (Lambda "x" (addVars "v" "x"))),
+                 ("a", mkNum 2),
+                 ("b", mkNum 3)]
+                $ addExpr (applyVars "f" "a") (applyVars "f" "b")
+
+
+                
+slowExpr = Let [("u", add 2 3),
+                 ("f", (Lambda "x"
+                               (Let [("v", addVar "u" 1)]
+                                    (addVars "v" "x")))),
+                 ("a", mkNum 2),
+                 ("b", mkNum 3)]
+                 $ addExpr (applyVars "f" "a") (applyVars "f" "b") 
+            
+slowExprHaskell = let u = 3+5
+                      f = let v = u+1 in \x -> v + x
+                  in f 2 + f 3
+
+-- f reduces to \x.f x and is replaced onto the heap before
+-- we apply x to it.  
+infinteLoopExpr = Let [("f", Lambda "x" (applyVars "f" "x")),
+                       ("a", mkNum 2)]
+                  $ applyVars "f" "a" 
+
+
+
+nestedExpr = let applyAdd var expr = Apply (Apply expr "add") var 
+             in Let [("add", Lambda "x" $ Lambda "y" (addVars "x" "y"))
+                 ,("a", mkNum 1)
+                 ,("addA", applyVars "add" "a")
+                 ,("b", mkNum 2)
+                 ,("addB", applyVars "add" "b")
+                 ,("applyAToB", applyVars "addA" "addB")
+                 ,("c", mkNum 3)
+                 ,("addC", applyVars "add" "c")
+                 ,("applyCToAB", applyVars "applyAToB" "addC")
+                 ,("d", mkNum 4)
+                 ]
+                 $ applyVars "applyCToAB" "d"