diff --git a/BASIC.cabal b/BASIC.cabal
new file mode 100644
--- /dev/null
+++ b/BASIC.cabal
@@ -0,0 +1,21 @@
+Name:		BASIC
+Version:	0.1.0.0
+License:	BSD3
+Author:		Lennart Augustsson
+Maintainer:	Lennart Augustsson
+Category:	Language
+Synopsis:	Embedded BASIC
+Description:	A simplified version of the original BASIC embedded in Haskell.
+Build-type:	Simple
+Build-Depends:	base, containers, llvm >= 0.6.3, random, timeit
+Exposed-modules:	Language.BASIC
+Other-modules:
+	Language.BASIC.Interp
+	Language.BASIC.Parser
+	Language.BASIC.Translate
+	Language.BASIC.Types
+Extra-source-files:
+	examples/Hello.hs
+	examples/HiLo.hs
+	examples/Infinity.hs
+	examples/Makefile
diff --git a/Language/BASIC.hs b/Language/BASIC.hs
new file mode 100644
--- /dev/null
+++ b/Language/BASIC.hs
@@ -0,0 +1,27 @@
+-- |A simplified embedded version of original BASIC.
+-- Some things work, some things just give utterly mysterious type errors.
+--
+-- Beware, this is just a fun weekend hack.
+module Language.BASIC(module Language.BASIC.Parser, module Language.BASIC.Types, runBASIC, runBASIC') where
+import System.TimeIt
+
+import Language.BASIC.Parser hiding (Expr)
+import Language.BASIC.Types(Expr(I, S, X, Y, Z, RND, INT, SGN))
+import Language.BASIC.Interp
+import Language.BASIC.Translate
+
+-- |Run a BASIC program with an interpreter.
+runBASIC :: BASIC -> IO ()
+runBASIC x = do
+    let cmds = getBASIC x
+--    putStrLn $ unlines $ map show cmds
+    timeIt $ executeBASIC cmds
+
+-- |Run a BASIC program with a compiler.
+runBASIC' :: BASIC -> IO ()
+runBASIC' x = do
+    let cmds = getBASIC x
+--    putStrLn $ unlines $ map show cmds
+--    executeBASIC cmds
+    func <- translateBASIC cmds
+    timeIt func
diff --git a/Language/BASIC/Interp.hs b/Language/BASIC/Interp.hs
new file mode 100644
--- /dev/null
+++ b/Language/BASIC/Interp.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+module Language.BASIC.Interp(executeBASIC) where
+import Data.List
+import qualified Data.Map as M
+import System.Random
+import Text.Printf
+
+import Language.BASIC.Types
+
+executeBASIC :: [Expr a] -> IO ()
+executeBASIC cmds = run M.empty [] [] cmds
+  where --run stk cs | trace (show (stk, cmds)) False = undefined
+        run _ _ _ [] = return ()
+        run _ _ _ (Cmd _ End _:_) = return ()
+  	run env stk fors (Cmd _ Goto [Label l]:_) = goto env stk fors l
+	run env stk fors (Cmd _ Gosub [Label l]:cs) = goto env (cs:stk) fors l
+	run env stk fors (Cmd _ If [e, Label l]:cs) = do
+            d <- eval env e
+            if d /= Dbl 0 then goto env stk fors l else run env stk fors cs
+	run _ [] fors (Cmd _ Return _ : _) = error "RETURN without GOSUB"
+	run env (cs:stk) fors (Cmd _ Return _:_) = run env stk fors cs
+	run env stk fors cs@(Cmd _ For [v,l,_] : cs') = do
+            d <- eval env l
+	    run (M.insert v d env) stk (cs:fors) cs'
+	run env stk fors@((Cmd _ For [v,_,h] : bs) : fors') (Cmd _ Next [v'] : cs) | v == v' = do
+	    let Dbl i = env M.! v
+	    Dbl hv <- eval env h
+	    let i' = i + 1
+	    if i' <= hv then run (M.insert v (Dbl i') env) stk fors bs
+	               else run env stk fors' cs
+	run env stk fors (Cmd _ Next _ : _) = error $ "Unmatched FOR/NEXT"
+	run env stk fors (c:cs) = do env' <- run1 env c; run env' stk fors cs
+	goto env stk fors l = maybe (error $ "No line " ++ show l) (run env stk fors) (M.lookup l mcmds)
+	mcmds = M.fromList $ map (\ cs -> (cmdLabel (head cs), cs)) $ init $ tails cmds
+	run1 env (Cmd _ Print es) = do mapM_ (\ e -> eval env e >>= prExpr) es; putStrLn ""; return env
+	run1 env (Cmd _ Let [v,e]) = do d <- eval env e; return $ M.insert v d env
+	run1 env (Cmd _ Rem _) = return env
+	run1 env (Cmd _ Input [v]) = do
+            let loop = do
+                    s <- getLine
+		    case reads s of
+		        [(d,"")] -> return d
+			_ -> do putStrLn "Not a number, try again"; loop
+            d <- loop
+	    return $ M.insert v (Dbl d) env
+	run1 _ e = error $ "run1: " ++ show e
+	eval _ e@(Dbl _) = return e
+	eval _ e@(Str _) = return e
+	eval env (Binop e1 op e2) = do
+            v1 <- eval env e1
+	    v2 <- eval env e2
+            case (v1, op, v2) of
+             (Dbl d1, "+", Dbl d2)  -> return $ Dbl (d1 + d2)
+             (Dbl d1, "-", Dbl d2)  -> return $ Dbl (d1 - d2)
+             (Dbl d1, "*", Dbl d2)  -> return $ Dbl (d1 * d2)
+             (Dbl d1, "/", Dbl d2)  -> return $ Dbl (d1 / d2)
+             (Dbl d1, "<>", Dbl d2) -> return $ Dbl (if d1 /= d2 then 1 else 0)
+	     x -> error $ "Expected numbers " ++ show x
+	eval env (SGN e) = fmap (\ (Dbl x) -> Dbl $ signum x) $ eval env e
+	eval env (INT e) = fmap (\ (Dbl x) -> Dbl $ fromIntegral $ truncate x) $ eval env e
+	eval _   (RND _) = do d <- randomIO; return (Dbl d)
+	eval env x | x > Var = return $ maybe (Dbl 0) id $ M.lookup x env
+	eval _ x = error $ "eval: " ++ show x
+	prExpr (Dbl i) = putStr $ chopDec $ printf "%g" i
+	prExpr (Str s) = putStr s
+	prExpr e = error $ "prExpr: " ++ show e
+	chopDec s = let r = reverse s in if take 2 r == "0." then reverse (drop 2 r) else s
diff --git a/Language/BASIC/Parser.hs b/Language/BASIC/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Language/BASIC/Parser.hs
@@ -0,0 +1,192 @@
+{-# OPTIONS_GHC -fno-warn-missing-methods -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances, IncoherentInstances, ExtendedDefaultRules, OverloadedStrings, DeriveDataTypeable #-}
+module Language.BASIC.Parser(
+    getBASIC, BASIC,
+    PRINT(..), END(..), LET(..), GOTO(..), IF(..), THEN(..), INPUT(..), FOR(..), TO(..), NEXT(..),
+    Expr((:=)), (<>)
+    ) where
+import Data.List
+import Data.Maybe
+import Data.Function
+import Data.Typeable
+import Data.IORef
+import Data.String
+import System.IO.Unsafe
+
+import Language.BASIC.Types
+
+--import Debug.Trace
+
+getBASIC :: BASIC -> [Expr ()]
+getBASIC cs = getBASIC' (cs >> 999999 END)
+
+getBASIC' :: BASIC -> [Expr ()]
+getBASIC' None =
+    sortBy (compare `on` cmdLabel) $
+    joinPrint $
+    map joinAssign $
+    reverse $
+    unsafePerformIO (readIORef stack)
+getBASIC' e = error $ "getBASIC: " ++ show e
+
+joinPrint :: [Expr a] -> [Expr a]
+joinPrint (Cmd l Print es : e : cs) | not (isCmd e) = joinPrint (Cmd l Print (es ++ [e]) : cs)
+joinPrint (c : cs) = c : joinPrint cs
+joinPrint [] = []
+
+joinAssign :: Expr a -> Expr a
+--joinAssign c | trace (show c) False = undefined
+joinAssign (Cmd l For [v] := Binop e1 ";" e2) = Cmd l For [v, e1, e2]
+joinAssign (Cmd l Let [v] := e) = Cmd l Let [v, e]
+joinAssign c = c
+
+isCmd :: Expr a -> Bool
+isCmd (Cmd _ _ _) = True
+isCmd _ = False
+
+infix 4 <>
+(<>) :: Expr a -> Expr a -> Expr a
+(<>) = binop "<>"
+
+binop :: String -> Expr a -> Expr a -> Expr a
+binop op (Cmd l c [x]) y = Cmd l c (binops x op y)
+binop op x (Binop y ";" z) = Binop (Binop x op y) ";" z
+binop op (Binop x ";" y) z = Binop x ";" (Binop y op z)
+binop op x y = Binop x op y
+
+binops :: Expr a -> String -> Expr a -> [Expr a]
+binops x op (Binop y ";" z) = [Binop x op y, z]
+binops x op y = [Binop x op y]
+
+flex :: Expr a -> Expr b
+flex (Cmd l c es) = Cmd l c (map flex es)
+flex (Str s) = Str s
+flex (Dbl d) = Dbl d
+flex (Label l) = Label l
+flex (Binop e1 op e2) = Binop (flex e1) op (flex e2)
+flex (e1 := e2) = flex e1 := flex e2
+flex (RND x) = RND x
+flex (INT x) = INT (flex x)
+flex (SGN x) = SGN (flex x)
+flex Var = Var
+flex I = I
+flex S = S
+flex X = X
+flex Y = Y
+flex Z = Z
+flex None = None
+
+data PRINT = PRINT
+data END = END | STOP | RETURN | REM deriving (Eq)
+data LET = LET
+data GOTO = GOTO | GOSUB deriving (Eq)
+data IF = IF
+data THEN = THEN
+data INPUT = INPUT
+data FOR = FOR
+data TO = TO
+data NEXT = NEXT
+
+-- Yuck!  But this is the only way I could figure out
+-- how to make a Monad like Expr actually be able to save
+-- every statement.
+-- Now is we could just write 'x' instead of 'X' it there
+-- would be no need for unsafePerformIO.
+instance Monad Expr where
+    a >> b = unsafePerformIO $ do push (flex a); push (flex b)
+
+stack :: IORef [Expr ()]
+stack = unsafePerformIO $ newIORef []
+
+push :: Expr () -> IO (Expr a)
+push None = return None
+push x = do
+    s <- readIORef stack
+    writeIORef stack (x:s)
+    return None
+
+instance Num (Expr a) where
+    (+) = binop "+"
+    (-) = binop "-"
+    (*) = binop "*"
+    fromInteger = Dbl . fromInteger
+
+instance Fractional (Expr a) where
+    (/) = binop "/"
+    fromRational = Dbl . fromRational
+
+instance IsString (Expr a) where
+    fromString = Str
+
+-- (^) :: E
+
+instance Eq (PRINT -> Expr a -> Expr b)
+instance Show (PRINT -> Expr a -> Expr b)
+instance Num (PRINT -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i Print [flex v]
+
+instance Eq (PRINT -> t -> Expr a)
+instance Show (PRINT -> t -> Expr a)
+instance (Show t, Typeable t) => Num (PRINT -> t -> Expr a) where
+    fromInteger i _ x =
+        let f con = fmap (\ v -> Cmd i Print [con v]) (cast x)
+        in  case catMaybes [f Str, f (Dbl . fromInteger), f Dbl] of
+            c : _ -> c
+	    [] -> error $ "Bad type " ++ show x
+
+instance Eq (END -> Expr a)
+instance Show (END -> Expr a)
+instance Num (END -> Expr a) where
+    fromInteger i c = Cmd i (if c == RETURN then Return else if c == REM then Rem else End) []
+
+instance Eq (LET -> Expr a -> Expr b)
+instance Show (LET -> Expr a -> Expr b)
+instance Num (LET -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i Let [flex v]
+
+instance Eq (GOTO -> t -> Expr a)
+instance Show (GOTO -> t -> Expr a)
+instance (Integral t) => Num (GOTO -> t -> Expr a) where
+    fromInteger i c l = Cmd i (if c == GOSUB then Gosub else Goto) [Label $ toInteger l]
+
+instance Eq (IF -> Expr a -> Expr b)
+instance Show (IF -> Expr a -> Expr b)
+instance Num (IF -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i If [flex v]
+
+instance Eq (THEN -> t -> Expr a)
+instance Show (THEN -> t -> Expr a)
+instance (Integral t) => Num (THEN -> t -> Expr a) where
+    fromInteger c _ l = Binop (Dbl (fromInteger c)) ";" (Label $ fromIntegral l)
+
+instance Eq (INPUT -> Expr a -> Expr b)
+instance Show (INPUT -> Expr a -> Expr b)
+instance Num (INPUT -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i Input [flex v]
+
+instance Eq (FOR -> Expr a -> Expr b)
+instance Show (FOR -> Expr a -> Expr b)
+instance Num (FOR -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i For [flex v]
+
+instance Eq (TO -> t -> Expr a)
+instance Show (TO -> t -> Expr a)
+instance (Show t, Typeable t) => Num (TO -> t -> Expr a) where
+    fromInteger c _ x = -- Binop (Dbl (fromInteger c)) ";" (Dbl $ fromIntegral x)
+      Binop (Dbl (fromInteger c)) ";" $
+        let f con = fmap con (cast x)
+        in  case catMaybes [f (Dbl . fromInteger), f Dbl] of
+            e : _ -> e
+	    [] -> error $ "Bad type " ++ show x
+instance (Show t, Typeable t) => Fractional (TO -> t -> Expr a) where
+    fromRational c _ x = -- Binop (Dbl (fromRational c)) ";" (Dbl $ fromIntegral x)
+      Binop (Dbl (fromRational c)) ";" $
+        let f con = fmap con (cast x)
+        in  case catMaybes [f (Dbl . fromInteger), f Dbl] of
+            e : _ -> e
+	    [] -> error $ "Bad type " ++ show x
+
+instance Eq (NEXT -> Expr a -> Expr b)
+instance Show (NEXT -> Expr a -> Expr b)
+instance Num (NEXT -> Expr a -> Expr b) where
+    fromInteger i _ v = Cmd i Next [flex v]
diff --git a/Language/BASIC/Translate.hs b/Language/BASIC/Translate.hs
new file mode 100644
--- /dev/null
+++ b/Language/BASIC/Translate.hs
@@ -0,0 +1,166 @@
+module Language.BASIC.Translate(translateBASIC) where
+import Control.Monad
+import Data.List
+import qualified Data.Map as M
+import Data.Map((!), fromList)
+import Data.Word
+
+import LLVM.Core
+import LLVM.Util.File
+
+import Language.BASIC.Types
+
+renumber :: [Expr a] -> [Expr a]
+renumber cs =
+    let m = M.fromList $ zip (map cmdLabel cs) [10, 20 ..]
+        ren (Cmd l c es) = Cmd (m M.! l) c (map ren es)
+	ren (Label l) = Label (m M.! l)
+	ren e = e
+    in  map ren cs
+
+-- This assumes some sanity in loop nesting.
+removeFor :: [Expr a] -> [Expr a]
+removeFor [] = []
+removeFor (Cmd l For [v, lo, hi] : cs) =
+    let cs' = removeFor cs
+        (n, cs'') = removeNext cs'
+	removeNext [] = error $ "No NEXT for line " ++ show (l, v)
+	removeNext (Cmd ln Next [v'] : bs) | v == v' = (ln+2,
+	    [Cmd ln Let [v, Binop v "+" (Dbl 1)], Cmd (ln+1) Goto [Label (l+1)], Cmd (ln+2) Rem []] ++ bs)
+	removeNext (c:bs) = (ln, c:bs') where (ln, bs') = removeNext bs
+	loopStart = [Cmd l Let [v, lo], Cmd (l+1) If [Binop v ">" hi, Label n]]
+    in  loopStart ++ cs''
+removeFor (c:cs) = c : removeFor cs
+
+translateBASIC :: [Expr ()] -> IO (IO ())
+translateBASIC cmds = do
+    let cmds' = removeFor $ renumber cmds
+--    putStrLn $ unlines $ map show cmds'
+
+    let mfunc = trans cmds'
+    writeCodeGenModule "run.bc" mfunc
+    func <- optimizeFunctionCG mfunc
+--    writeCodeGenModule "runo.bc" mfunc'
+--    func <- simpleFunction mfunc
+    return func
+
+
+trans :: [Expr ()] -> CodeGenModule (Function (IO ()))
+trans acmds = do
+    atof     <- newNamedFunction ExternalLinkage "atof"     :: TFunction (Ptr Word8 -> IO Double)
+    gets     <- newNamedFunction ExternalLinkage "gets"     :: TFunction (Ptr Word8 -> IO (Ptr Word8))
+    printfv  <- newNamedFunction ExternalLinkage "printf"   :: TFunction (Ptr Word8 -> VarArgs Word32)
+    rand     <- newNamedFunction ExternalLinkage "rand"     :: TFunction (IO Word32)
+    sranddev <- newNamedFunction ExternalLinkage "sranddev" :: TFunction (IO ())
+    let printfd :: Function (Ptr Word8 -> Double -> IO Word32)
+        printfd = castVarArgs printfv
+        printfs :: Function (Ptr Word8 -> Ptr Word8 -> IO Word32)
+        printfs = castVarArgs printfv
+        printfn :: Function (Ptr Word8 -> IO Word32)
+        printfn = castVarArgs printfv
+
+    fmtg <- createStringNul "%g"
+    fmts <- createStringNul "%s"
+    fmtn <- createStringNul "\n"
+
+    let cmds = acmds ++ [Cmd 99999 End []]
+        nextmap = fromList $ zip (map cmdLabel cmds) (map cmdLabel (tail cmds))
+        strings = nub $ concatMap getCmdStrings cmds
+	getCmdStrings (Cmd _ _ es) = concatMap getExprStrings es
+	getCmdStrings _ = error "getCmdStrings"
+	getExprStrings (Str s) = [s]
+	getExprStrings (Binop e1 _ e2) = getExprStrings e1 ++ getExprStrings e2
+	getExprStrings _ = []
+    strmap <- liftM (fromList . zip strings) $ mapM createStringNul strings
+
+    let mkGlobal x = do
+            v <- createNamedGlobal False InternalLinkage (show x) (constOf (0 :: Double))
+	    return (x, v)
+    globmap <- liftM fromList $ mapM mkGlobal [I,S,X,Y,Z]
+
+    createFunction ExternalLinkage $ do
+        let mkBlk c = do b <- newBasicBlock; return (cmdLabel c, b)
+        blkmap <- liftM fromList $ mapM mkBlk cmds
+	let block = (blkmap !)
+	    next = block . (nextmap !)
+	    gen (Cmd l kw es) = do
+                defineBasicBlock (block l)
+		case (kw, es) of
+		    (End, _) -> ret ()
+		    (Goto, [Label d]) -> br (block d)
+		    (Print, as) -> do mapM_ pr as; newline; br (next l)
+		    (Let, [v, e]) -> do
+                        d <- genExpr e
+                        store d (globmap ! v)
+		        br (next l)
+		    (If, [b, Label d]) -> do
+                        v <- genBool b
+                        condBr v (block d) (next l)
+                    (Input, [v]) -> do
+                        buff <- arrayMalloc (100 :: Word32)
+			call gets buff
+			d <- call atof buff
+			store d (globmap ! v)
+			free buff
+			br (next l)
+		    (Rem, _) -> br (next l)
+		    x -> error $ "Unimplemented construct " ++ show x
+            gen _ = error "gen"
+
+            newline = do
+                tmp <- getElementPtr fmtn (0::Word32, (0::Word32, ()))
+                call printfn tmp
+
+            pr (Str s) = do
+	        tmp <- getElementPtr fmts (0::Word32, (0::Word32, ()))
+	        tmpa <- getElementPtr (strmap ! s) (0::Word32, (0::Word32, ()))
+                call printfs tmp tmpa
+            pr e = do
+                d <- genExpr e
+                tmp <- getElementPtr fmtg (0::Word32, (0::Word32, ()))
+                call printfd tmp d
+
+--	    genExpr e | trace (show e) False = undefined
+            genExpr (Dbl d) = return $ value $ constOf d
+	    genExpr (Binop e1 "+" e2) = binop add e1 e2
+	    genExpr (Binop e1 "-" e2) = binop sub e1 e2
+	    genExpr (Binop e1 "*" e2) = binop mul e1 e2
+	    genExpr (Binop e1 "/" e2) = binop fdiv e1 e2
+	    genExpr (INT e) = do
+	        v <- genExpr e
+--		r <- frem v (1 :: Double)
+--		sub v r
+                i <- fptoui v
+                uitofp (i :: Value Word64)
+            genExpr (RND _) = do
+                r <- call rand
+                d <- uitofp r
+		fdiv (d :: Value Double) (0x7fffffff :: Double)
+            genExpr (SGN e) = do
+                d <- genExpr e
+                n <- fcmp FPOLT d (0 :: Double)
+                p <- fcmp FPOGT d (0 :: Double)
+		nd <- uitofp n
+		pd <- uitofp p
+		sub (pd :: Value Double) (nd :: Value Double)
+	    genExpr e | e > Var = load (globmap ! e)
+	    genExpr e = error $ "genExpr: " ++ show e
+
+            genBool (Binop e1 "<>" e2) = binop (fcmp FPONE) e1 e2
+	    genBool (Binop e1 "==" e2) = binop (fcmp FPOEQ) e1 e2
+	    genBool (Binop e1 "<"  e2) = binop (fcmp FPOLT) e1 e2
+	    genBool (Binop e1 "<=" e2) = binop (fcmp FPOLE) e1 e2
+	    genBool (Binop e1 ">"  e2) = binop (fcmp FPOGT) e1 e2
+	    genBool (Binop e1 ">=" e2) = binop (fcmp FPOGE) e1 e2
+	    genBool e = error $ "Unknown bool op " ++ show e
+
+	    binop :: (Value Double -> Value Double -> CodeGenFunction r (Value c)) ->
+	             Expr () -> Expr () -> CodeGenFunction r (Value c)
+            binop op e1 e2 = do
+                d1 <- genExpr e1
+                d2 <- genExpr e2
+                op d1 d2
+
+        call sranddev
+	br (block $ cmdLabel $ head cmds)
+        mapM_ gen cmds
diff --git a/Language/BASIC/Types.hs b/Language/BASIC/Types.hs
new file mode 100644
--- /dev/null
+++ b/Language/BASIC/Types.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.BASIC.Types where
+import Data.Typeable
+
+infix 0 :=
+data Expr a
+    = Cmd Integer Command [Expr a]
+    | Str String
+    | Dbl Double
+    | Label Integer
+    | Binop (Expr a) String (Expr a)
+    | Expr a := Expr a
+    | RND () | INT (Expr a) | SGN (Expr a)
+    | Var
+    | I | S | X | Y | Z
+    | None
+    deriving (Eq, Ord, Show, Typeable)
+
+cmdLabel :: Expr a -> Integer
+cmdLabel (Cmd l _ _) = l
+cmdLabel e = error $ "Strange top level command " ++ show e
+
+data Command = Print | End | Let | Goto | Gosub | Return | If | Input | For | Next | Rem
+    deriving (Eq, Ord, Show, Typeable)
+
+type BASIC = Expr ()
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+module Main where
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/Hello.hs b/examples/Hello.hs
new file mode 100644
--- /dev/null
+++ b/examples/Hello.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings #-}
+module Hello where
+import Language.BASIC
+
+main :: IO ()
+main = runBASIC $ do
+
+    10 PRINT "Hello BASIC World!"
diff --git a/examples/HiLo.hs b/examples/HiLo.hs
new file mode 100644
--- /dev/null
+++ b/examples/HiLo.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings #-}
+module HiLo where
+import Language.BASIC
+
+main :: IO ()
+main = runBASIC $ do
+    10 GOSUB 1000
+    20 PRINT "* Welcome to HiLo *"
+    30 GOSUB 1000
+
+    100 LET I := INT(100 * RND())
+--    110 PRINT I
+    200 PRINT "Guess my number:"
+    210 INPUT X
+    220 LET S := SGN(I-X)
+    230 IF S <> 0 THEN 300
+
+    240 FOR X := 1 TO 5
+    250   PRINT X*X;" You won!"
+    260 NEXT X
+    270 STOP
+
+    300 IF S <> 1 THEN 400
+    310 PRINT "Your guess ";X;" is too low."
+    320 GOTO 200
+
+    400 PRINT "Your guess ";X;" is too high."
+    410 GOTO 200
+
+    1000 PRINT "*******************"
+    1010 RETURN
+
+    9999 END
diff --git a/examples/Infinity.hs b/examples/Infinity.hs
new file mode 100644
--- /dev/null
+++ b/examples/Infinity.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# LANGUAGE ExtendedDefaultRules, OverloadedStrings #-}
+module Infinity where
+import Language.BASIC
+
+main :: IO ()
+main = runBASIC' $ do
+
+    10 LET I := 1
+    20 LET S := 0
+    30 LET S := S + 1/I
+    40 LET I := I + 1
+    50 IF I <> 100000000 THEN 30
+    60 PRINT "Almost infinity is ";S
+    80 END
diff --git a/examples/Makefile b/examples/Makefile
new file mode 100644
--- /dev/null
+++ b/examples/Makefile
@@ -0,0 +1,16 @@
+ghc := ghc
+ghcflags := -Wall -optl -w
+examples := Hello HiLo Infinity
+
+all: $(examples)
+
+%: %.hs
+	$(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $<
+
+%.run: %
+	./$<
+
+run:	$(examples:%=%.run)
+
+clean:
+	rm -f $(examples) *.o *.hi *.s *.bc Fib *.exe *.exe.manifest *.bc