diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,34 +1,53 @@
 {-# LANGUAGE CPP #-}
+import Control.Monad
+import Data.IORef
+
 import Distribution.Simple
 import Distribution.Simple.InstallDirs as I
 import Distribution.Simple.LocalBuildInfo as L
 import qualified Distribution.Simple.Setup as S
 import qualified Distribution.Simple.Program as P
 import Distribution.PackageDescription
+import Distribution.Text
 
 import System.Exit
 import System.FilePath ((</>), splitDirectories)
+import System.Directory
 import qualified System.FilePath.Posix as Px
 import System.Process
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
 
 -- After Idris is built, we need to check and install the prelude and other libs
 
 make verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "make"
+mvn verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "mvn"
 
 #ifdef mingw32_HOST_OS
 -- make on mingw32 exepects unix style separators
 (<//>) = (Px.</>)
-idrisCmd local = Px.joinPath $ splitDirectories $ 
+idrisCmd local = Px.joinPath $ splitDirectories $
                  ".." <//> buildDir local <//> "idris" <//> "idris"
+rtsDir local = Px.joinPath $ splitDirectories $
+               ".." <//> buildDir local <//> "rts" <//> "libidris_rts"
 #else
 idrisCmd local = ".." </>  buildDir local </>  "idris" </>  "idris"
+rtsDir local = ".." </> buildDir local </> "rts" </> "libidris_rts"
 #endif
 
 cleanStdLib verbosity
     = do make verbosity [ "-C", "lib", "clean", "IDRIS=idris" ]
          make verbosity [ "-C", "effects", "clean", "IDRIS=idris" ]
 
-installStdLib pkg local verbosity copy
+cleanJavaLib verbosity 
+  = do dirty <- doesDirectoryExist ("java" </> "target")
+       when dirty $ mvn verbosity [ "-f", "java/pom.xml", "clean" ]
+       pomExists <- doesFileExist ("java" </> "pom.xml")
+       when pomExists $ removeFile ("java" </> "pom.xml")
+       execPomExists <- doesFileExist ("java" </> "executable_pom.xml")
+       when pomExists $ removeFile ("java" </> "executable_pom.xml")
+
+installStdLib pkg local withoutEffects verbosity copy
     = do let dirs = L.absoluteInstallDirs pkg local copy
          let idir = datadir dirs
          let icmd = idrisCmd local
@@ -38,11 +57,12 @@
                , "TARGET=" ++ idir
                , "IDRIS=" ++ icmd
                ]
-         make verbosity
-               [ "-C", "effects", "install"
-               , "TARGET=" ++ idir
-               , "IDRIS=" ++ icmd
-               ]
+         unless withoutEffects $
+           make verbosity
+                 [ "-C", "effects", "install"
+                 , "TARGET=" ++ idir
+                 , "IDRIS=" ++ icmd
+                 ]
          let idirRts = idir </> "rts"
          putStrLn $ "Installing run time system in " ++ idirRts
          make verbosity
@@ -51,6 +71,20 @@
                , "IDRIS=" ++ icmd
                ]
 
+installJavaLib pkg local verbosity copy version = do
+  let rtsFile = "idris-" ++ display version ++ ".jar"
+  putStrLn $ "Installing java libraries" 
+  mvn verbosity [ "install:install-file"
+                , "-Dfile=" ++ ("java" </> "target" </> rtsFile)
+                , "-DgroupId=org.idris-lang"
+                , "-DartifactId=idris"
+                , "-Dversion=" ++ display version
+                , "-Dpackaging=jar"
+                , "-DgeneratePom=True"
+                ]
+  let dir = datadir $ L.absoluteInstallDirs pkg local copy
+  copyFile ("java" </> "executable_pom.xml") (dir </> "executable_pom.xml")
+
 -- 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
@@ -63,14 +97,15 @@
                , "IDRIS=" ++ icmd
                ]
 
-checkStdLib local verbosity
+checkStdLib local withoutEffects verbosity
     = do let icmd = idrisCmd local
          putStrLn $ "Building libraries..."
          make verbosity
                [ "-C", "lib", "check"
                , "IDRIS=" ++ icmd
                ]
-         make verbosity
+         unless withoutEffects $
+           make verbosity
                [ "-C", "effects", "check"
                , "IDRIS=" ++ icmd
                ]
@@ -79,19 +114,61 @@
                , "IDRIS=" ++ icmd
                ]
 
+checkJavaLib verbosity = mvn verbosity [ "-f", "java" </> "pom.xml", "package" ]
+
+javaFlag flags = 
+  case lookup (FlagName "java") (S.configConfigurationsFlags flags) of
+    Just True -> True
+    Just False -> False
+    Nothing -> False
+
+noEffectsFlag flags =
+   case lookup (FlagName "noeffects") (S.configConfigurationsFlags flags) of
+      Just True -> True
+      Just False -> False
+      Nothing -> False
+
+preparePoms version
+    = do pomTemplate <- TIO.readFile ("java" </> "pom_template.xml")
+         TIO.writeFile ("java" </> "pom.xml") (insertVersion pomTemplate)
+         execPomTemplate <- TIO.readFile ("java" </> "executable_pom_template.xml")
+         TIO.writeFile ("java" </> "executable_pom.xml") (insertVersion execPomTemplate)
+    where
+      insertVersion template = 
+        T.replace (T.pack "$RTS-VERSION$") (T.pack $ display version) template
+
 -- Install libraries during both copy and install
 -- See http://hackage.haskell.org/trac/hackage/ticket/718
-main = defaultMainWithHooks $ simpleUserHooks
+main = do
+  defaultMainWithHooks $ simpleUserHooks
         { postCopy = \ _ flags pkg lbi -> do
-              installStdLib pkg lbi (S.fromFlag $ S.copyVerbosity flags)
+              let verb = S.fromFlag $ S.copyVerbosity flags
+              let withoutEffects = noEffectsFlag $ configFlags lbi
+              installStdLib pkg lbi withoutEffects verb
                                     (S.fromFlag $ S.copyDest flags)
         , postInst = \ _ flags pkg lbi -> do
-              installStdLib pkg lbi (S.fromFlag $ S.installVerbosity flags)
+              let verb = (S.fromFlag $ S.installVerbosity flags)
+              let withoutEffects = noEffectsFlag $ configFlags lbi
+              installStdLib pkg lbi withoutEffects verb
                                     NoCopyDest
+              when (javaFlag $ configFlags lbi) 
+                   (installJavaLib pkg 
+                                   lbi 
+                                   verb 
+                                   NoCopyDest 
+                                   (pkgVersion . package $ localPkgDescr lbi)
+                   )
         , postConf  = \ _ flags _ lbi -> do
               removeLibIdris lbi (S.fromFlag $ S.configVerbosity flags)
+              when (javaFlag $ configFlags lbi) 
+                   (preparePoms . pkgVersion . package $ localPkgDescr lbi)
         , postClean = \ _ flags _ _ -> do
-              cleanStdLib (S.fromFlag $ S.cleanVerbosity flags)
+              let verb = S.fromFlag $ S.cleanVerbosity flags
+              cleanStdLib verb
+              cleanJavaLib verb
         , postBuild = \ _ flags _ lbi -> do
-              checkStdLib lbi (S.fromFlag $ S.buildVerbosity flags)
+              let verb = S.fromFlag $ S.buildVerbosity flags
+              let withoutEffects = noEffectsFlag $ configFlags lbi
+              checkStdLib lbi withoutEffects verb
+              when (javaFlag $ configFlags lbi) (checkJavaLib verb)
         }
diff --git a/config.mk b/config.mk
--- a/config.mk
+++ b/config.mk
@@ -1,3 +1,35 @@
 GMP_INCLUDE_DIR :=
 CC              :=gcc
 CABAL           :=cabal
+#CABALFLAGS	:=
+## Enable Java RTS:
+#CABALFLAGS    :=-f Java
+## Disable building of Effects
+#CABALFLAGS :=-f NoEffects
+
+
+MACHINE         := $(shell $(CC) -dumpmachine)
+ifneq (, $(findstring darwin, $(MACHINE)))
+	OS      :=darwin
+else
+ifneq (, $(findstring cygwin, $(MACHINE)))
+	OS      :=windows
+else
+ifneq (, $(findstring mingw, $(MACHINE)))
+	OS      :=windows
+else
+	OS      :=unix
+endif
+endif
+endif
+
+ifeq ($(OS),darwin)
+	SHLIB_SUFFIX    :=.dylib
+else
+ifeq ($(OS),windows)
+	SHLIB_SUFFIX    :=.DLL
+else
+	SHLIB_SUFFIX    :=.so
+endif
+endif
+
diff --git a/effects/Effect/Exception.idr b/effects/Effect/Exception.idr
--- a/effects/Effect/Exception.idr
+++ b/effects/Effect/Exception.idr
@@ -17,7 +17,10 @@
 instance Handler (Exception a) (IOExcept a) where
      handle _ (Raise e) k = ioM (return (Left e))
 
-EXCEPTION : Type -> EFF 
+instance Handler (Exception a) (Either a) where
+     handle _ (Raise e) k = Left e
+
+EXCEPTION : Type -> EFFECT
 EXCEPTION t = MkEff () (Exception t) 
 
 raise : a -> Eff m [EXCEPTION a] b
diff --git a/effects/Effect/File.idr b/effects/Effect/File.idr
--- a/effects/Effect/File.idr
+++ b/effects/Effect/File.idr
@@ -40,7 +40,7 @@
     handle (FH h) EOF             k = do e <- ioe_lift (feof h)
                                          k (FH h) e
 
-FILE_IO : Type -> EFF
+FILE_IO : Type -> EFFECT
 FILE_IO t = MkEff t FileIO 
 
 open : Handler FileIO e =>
diff --git a/effects/Effect/Memory.idr b/effects/Effect/Memory.idr
new file mode 100644
--- /dev/null
+++ b/effects/Effect/Memory.idr
@@ -0,0 +1,168 @@
+module Effect.Memory
+
+import Effects
+import Control.IOExcept
+
+%access public
+
+abstract
+data MemoryChunk : Nat -> Nat -> Type where
+     CH : Ptr -> MemoryChunk size initialized
+
+abstract
+data RawMemory : Effect where
+     Allocate   : (n : Nat) ->
+                  RawMemory () (MemoryChunk n 0) ()
+     Free       : RawMemory (MemoryChunk n i) () ()
+     Initialize : Bits8 ->
+                  (size : Nat) ->
+                  so (i + size <= n) ->
+                  RawMemory (MemoryChunk n i) (MemoryChunk n (i + size)) ()
+     Peek       : (offset : Nat) ->
+                  (size : Nat) ->
+                  so (offset + size <= i) ->
+                  RawMemory (MemoryChunk n i) (MemoryChunk n i) (Vect Bits8 size)
+     Poke       :  (offset : Nat) ->
+                  (Vect Bits8 size) ->
+                  so (offset <= i && offset + size <= n) ->
+                  RawMemory (MemoryChunk n i) (MemoryChunk n (max i (offset + size))) ()
+     Move       : (src : MemoryChunk src_size src_init) ->
+                  (dst_offset : Nat) ->
+                  (src_offset : Nat) ->
+                  (size : Nat) ->
+                  so (dst_offset <= dst_init && dst_offset + size <= dst_size) ->
+                  so (src_offset + size <= src_init) ->
+                  RawMemory (MemoryChunk dst_size dst_init)
+                            (MemoryChunk dst_size (max dst_init (dst_offset + size))) ()
+     GetRawPtr  : RawMemory (MemoryChunk n i) (MemoryChunk n i) (MemoryChunk n i)
+
+private
+do_malloc : Nat -> IOExcept String Ptr
+do_malloc size with (fromInteger (cast size) == size)
+  | True  = do ptr <- ioe_lift $ mkForeign (FFun "malloc" [FInt] FPtr) (cast size)
+               fail  <- ioe_lift $ nullPtr ptr
+               if fail then ioe_fail "Cannot allocate memory"
+               else return ptr
+  | False = ioe_fail "The target architecture does not support adressing enough memory"
+
+private
+do_memset : Ptr -> Nat -> Bits8 -> Nat -> IO ()
+do_memset ptr offset c size
+  = mkForeign (FFun "idris_memset" [FPtr, FInt, FChar, FInt] FUnit)
+              ptr (cast offset) c (cast size)
+
+private
+do_free : Ptr -> IO ()
+do_free ptr = mkForeign (FFun "free" [FPtr] FUnit) ptr
+
+private
+do_memmove : Ptr -> Ptr -> Nat -> Nat -> Nat -> IO ()
+do_memmove dest src dest_offset src_offset size
+  = mkForeign (FFun "idris_memmove" [FPtr, FPtr, FInt, FInt, FInt] FUnit)
+              dest src (cast dest_offset) (cast src_offset) (cast size)
+
+private
+do_peek : Ptr -> Nat -> (size : Nat) -> IO (Vect Bits8 size)
+do_peek _   _       O = return (Prelude.Vect.Nil)
+do_peek ptr offset (S n)
+  = do b <- mkForeign (FFun "idris_peek" [FPtr, FInt] FChar) ptr (cast offset)
+       bs <- do_peek ptr (S offset) n
+       Prelude.Monad.return (Prelude.Vect.(::) b bs)
+
+private
+do_poke : Ptr -> Nat -> Vect Bits8 size -> IO ()
+do_poke _   _      []     = return ()
+do_poke ptr offset (b::bs)
+  = do mkForeign (FFun "idris_poke" [FPtr, FInt, FChar] FUnit) ptr (cast offset) b
+       do_poke ptr (S offset) bs
+
+instance Handler RawMemory (IOExcept String) where
+  handle () (Allocate n) k
+    = do ptr <- do_malloc n
+         k (CH ptr) ()
+  handle {res = MemoryChunk _ offset} (CH ptr) (Initialize c size _) k
+    = ioe_lift (do_memset ptr offset c size) $> k (CH ptr) ()
+  handle (CH ptr) (Free) k
+    = ioe_lift (do_free ptr) $> k () ()
+  handle (CH ptr) (Peek offset size _) k
+    = do res <- ioe_lift (do_peek ptr offset size)
+         k (CH ptr) res
+  handle (CH ptr) (Poke offset content _) k
+    = do ioe_lift (do_poke ptr offset content)
+         k (CH ptr) ()
+  handle (CH dest_ptr) (Move (CH src_ptr) dest_offset src_offset size _ _) k
+    = do ioe_lift (do_memmove dest_ptr src_ptr dest_offset src_offset size)
+         k (CH dest_ptr) ()
+  handle chunk (GetRawPtr) k
+    = k chunk chunk
+
+RAW_MEMORY : Type -> EFFECT
+RAW_MEMORY t = MkEff t RawMemory
+
+allocate : (n : Nat) -> EffM m [RAW_MEMORY ()] [RAW_MEMORY (MemoryChunk n 0)] ()
+allocate size = Allocate size
+
+initialize : {i : Nat} ->
+             {n : Nat} ->
+             Bits8 ->
+             (size : Nat) ->
+             so (i + size <= n) ->
+             EffM m [RAW_MEMORY (MemoryChunk n i)] [RAW_MEMORY (MemoryChunk n (i + size))] ()
+initialize c size prf = Initialize c size prf
+
+free : EffM m [RAW_MEMORY (MemoryChunk n i)] [RAW_MEMORY ()] ()
+free = Free
+
+peek : {i : Nat} ->
+       (offset : Nat) ->
+       (size : Nat) ->
+       so (offset + size <= i) ->
+       Eff m [RAW_MEMORY (MemoryChunk n i)] (Vect Bits8 size)
+peek offset size prf = Peek offset size prf
+
+poke : {n : Nat} ->
+       {i : Nat} ->
+       (offset : Nat) ->
+       Vect Bits8 size ->
+       so (offset <= i && offset + size <= n) ->
+       EffM m [RAW_MEMORY (MemoryChunk n i)] [RAW_MEMORY (MemoryChunk n (max i (offset + size)))] ()
+poke offset content prf = Poke offset content prf
+
+private
+getRawPtr : Eff m [RAW_MEMORY (MemoryChunk n i)] (MemoryChunk n i)
+getRawPtr = GetRawPtr
+
+private
+move' : {dst_size : Nat} ->
+        {dst_init : Nat} ->
+        {src_init : Nat} ->
+        (src_ptr : MemoryChunk src_size src_init) ->
+        (dst_offset : Nat) ->
+        (src_offset : Nat) ->
+        (size : Nat) ->
+        so (dst_offset <= dst_init && dst_offset + size <= dst_size) ->
+        so (src_offset + size <= src_init) ->
+        EffM m [RAW_MEMORY (MemoryChunk dst_size dst_init)]
+               [RAW_MEMORY (MemoryChunk dst_size (max dst_init (dst_offset + size)))] ()
+move' src_ptr dst_offset src_offset size dst_bounds src_bounds
+  = Move src_ptr dst_offset src_offset size dst_bounds src_bounds
+
+data MoveDescriptor = Dst | Src
+
+move : {dst_size : Nat} ->
+       {dst_init : Nat} ->
+       {src_size : Nat} ->
+       {src_init : Nat} ->
+       (dst_offset : Nat) ->
+       (src_offset : Nat) ->
+       (size : Nat) ->
+       so (dst_offset <= dst_init && dst_offset + size <= dst_size) ->
+       so (src_offset + size <= src_init) ->
+       EffM m [ Dst ::: RAW_MEMORY (MemoryChunk dst_size dst_init)
+              , Src ::: RAW_MEMORY (MemoryChunk src_size src_init)]
+              [ Dst ::: RAW_MEMORY (MemoryChunk dst_size (max dst_init (dst_offset + size)))
+              , Src ::: RAW_MEMORY (MemoryChunk src_size src_init)] ()
+move dst_offset src_offset size dst_bounds src_bounds
+  = do src_ptr <- Src :- getRawPtr
+       Dst :- move' src_ptr dst_offset src_offset size dst_bounds src_bounds
+       return ()
diff --git a/effects/Effect/Random.idr b/effects/Effect/Random.idr
--- a/effects/Effect/Random.idr
+++ b/effects/Effect/Random.idr
@@ -3,19 +3,19 @@
 import Effects
 
 data Random : Type -> Type -> Type -> Type where
-     getRandom : Random Int Int Int
+     getRandom : Random Integer Integer Integer
 
 using (m : Type -> Type)
   instance Handler Random m where
      handle seed getRandom k
-              = let seed' = 1664525 * seed + 1013904223 in
+              = let seed' = (1664525 * seed + 1013904223) `prim__sremBigInt` (pow 2 32) in
                     k seed' seed'
-                    
-RND : EFF
-RND = MkEff Int Random
 
-rndInt : Int -> Int -> Eff m [RND] Int
-rndInt lower upper = do v <- getRandom 
-                        return (v `mod` (upper - lower) + lower)
+RND : EFFECT
+RND = MkEff Integer Random
+
+rndInt : Integer -> Integer -> Eff m [RND] Integer
+rndInt lower upper = do v <- getRandom
+                        return (v `prim__sremBigInt` (upper - lower) + lower)
 
 
diff --git a/effects/Effect/Select.idr b/effects/Effect/Select.idr
--- a/effects/Effect/Select.idr
+++ b/effects/Effect/Select.idr
@@ -15,7 +15,7 @@
 instance Handler Selection List where
      handle r (Select xs) k = concatMap (k r) xs
      
-SELECT : EFF
+SELECT : EFFECT
 SELECT = MkEff () Selection
 
 select : List a -> Eff m [SELECT] a
diff --git a/effects/Effect/State.idr b/effects/Effect/State.idr
--- a/effects/Effect/State.idr
+++ b/effects/Effect/State.idr
@@ -13,7 +13,7 @@
      handle st Get     k = k st st
      handle st (Put n) k = k n ()
 
-STATE : Type -> EFF
+STATE : Type -> EFFECT
 STATE t = MkEff t State
 
 get : Eff m [STATE x] x
@@ -28,4 +28,15 @@
 update : (x -> x) -> Eff m [STATE x] ()
 update f = do val <- get
               put (f val) 
+
+updateM : (x -> y) -> EffM m [STATE x] [STATE y] ()
+updateM f = do val <- get
+               putM (f val) 
+
+locally : x -> Eff m [STATE x] t -> Eff m [STATE y] t
+locally newst prog = do st <- get
+                        putM newst
+                        val <- prog
+                        putM st
+                        return val
 
diff --git a/effects/Effect/StdIO.idr b/effects/Effect/StdIO.idr
--- a/effects/Effect/StdIO.idr
+++ b/effects/Effect/StdIO.idr
@@ -19,9 +19,6 @@
 
 data IOStream a = MkStream (List String -> (a, List String))
   
-injStream : a -> IOStream a
-injStream v = MkStream (\x => (v, []))
-  
 instance Handler StdIO IOStream where
     handle () (PutStr s) k
        = MkStream (\x => case k () () of
@@ -38,7 +35,7 @@
 
 --- The Effect and associated functions
 
-STDIO : EFF
+STDIO : EFFECT
 STDIO = MkEff () StdIO
 
 putStr : Handler StdIO e => String -> Eff e [STDIO] ()
@@ -55,5 +52,9 @@
           List String -> (a, List String)
 mkStrFn {a} env p input = case mkStrFn' of
                                MkStream f => f input
-  where mkStrFn' : IOStream a
+  where injStream : a -> IOStream a
+        injStream v = MkStream (\x => (v, []))
+        mkStrFn' : IOStream a
         mkStrFn' = runWith injStream env p
+
+  
diff --git a/effects/Effects.idr b/effects/Effects.idr
--- a/effects/Effects.idr
+++ b/effects/Effects.idr
@@ -10,8 +10,8 @@
 Effect : Type
 Effect = Type -> Type -> Type -> Type
 
-data EFF : Type where
-     MkEff : Type -> Effect -> EFF
+data EFFECT : Type where
+     MkEff : Type -> Effect -> EFFECT
 
 class Handler (e : Effect) (m : Type -> Type) where
      handle : res -> (eff : e res res' t) -> (res' -> t -> m a) -> m a
@@ -28,12 +28,12 @@
   subListId {xs = Nil} = SubNil
   subListId {xs = x :: xs} = Keep subListId
 
-data Env  : (m : Type -> Type) -> List EFF -> Type where
+data Env  : (m : Type -> Type) -> List EFFECT -> Type where
      Nil  : Env m Nil
      (::) : Handler eff m => a -> Env m xs -> Env m (MkEff a eff :: xs)
 
 data EffElem : (Type -> Type -> Type -> Type) -> Type ->
-               List EFF -> Type where
+               List EFFECT -> Type where
      Here : EffElem x a (MkEff a x :: xs)
      There : EffElem x a xs -> EffElem x a (y :: xs)
 
@@ -59,22 +59,22 @@
 ---- The Effect EDSL itself ----
 
 -- some proof automation
-findEffElem : Nat -> Tactic -- Nat is maximum search depth
-findEffElem O = Refine "Here" `Seq` Solve 
-findEffElem (S n) = GoalType "EffElem" 
+findEffElem : Nat -> List (TTName, Binder TT) -> TT -> Tactic -- Nat is maximum search depth
+findEffElem O ctxt goal = Refine "Here" `Seq` Solve 
+findEffElem (S n) ctxt goal = GoalType "EffElem" 
           (Try (Refine "Here" `Seq` Solve)
-               (Refine "There" `Seq` (Solve `Seq` findEffElem n)))
+               (Refine "There" `Seq` (Solve `Seq` findEffElem n ctxt goal)))
 
-findSubList : Nat -> Tactic
-findSubList O = Refine "SubNil" `Seq` Solve
-findSubList (S n)
+findSubList : Nat -> List (TTName, Binder TT) -> TT -> Tactic
+findSubList O ctxt goal = Refine "SubNil" `Seq` Solve
+findSubList (S n) ctxt goal
    = GoalType "SubList" 
          (Try (Refine "subListId" `Seq` Solve)
          ((Try (Refine "Keep" `Seq` Solve)
-               (Refine "Drop" `Seq` Solve)) `Seq` findSubList n))
+               (Refine "Drop" `Seq` Solve)) `Seq` findSubList n ctxt goal))
 
-updateResTy : (xs : List EFF) -> EffElem e a xs -> e a b t -> 
-              List EFF
+updateResTy : (xs : List EFFECT) -> EffElem e a xs -> e a b t -> 
+              List EFFECT
 updateResTy {b} (MkEff a e :: xs) Here n = (MkEff b e) :: xs
 updateResTy (x :: xs) (There p) n = x :: updateResTy xs p n
 
@@ -83,7 +83,7 @@
 data LRes : lbl -> Type -> Type where
      (:=) : (x : lbl) -> res -> LRes x res
 
-(:::) : lbl -> EFF -> EFF 
+(:::) : lbl -> EFFECT -> EFFECT 
 (:::) {lbl} x (MkEff r eff) = MkEff (LRes x r) eff
 
 private
@@ -97,11 +97,10 @@
 -- the language of Effects
 
 data EffM : (m : Type -> Type) ->
-            List EFF -> List EFF -> Type -> Type where
+            List EFFECT -> List EFFECT -> Type -> Type where
      value   : a -> EffM m xs xs a
      ebind   : EffM m xs xs' a -> (a -> EffM m xs' xs'' b) -> EffM m xs xs'' b
-     effect  : {a, b: _} -> {e : Effect} ->
-               (prf : EffElem e a xs) -> 
+     effect  : (prf : EffElem e a xs) -> 
                (eff : e a b t) -> 
                EffM m xs (updateResTy xs prf eff) t
      lift    : (prf : SubList ys xs) ->
@@ -114,17 +113,17 @@
                EffM m xs xs' a
      (:-)    : (l : ty) -> EffM m [x] [y] t -> EffM m [l ::: x] [l ::: y] t
 
---   Eff : List (EFF m) -> Type -> Type
+--   Eff : List (EFFECT m) -> Type -> Type
 
 implicit
-lift' : {default tactics { reflect findSubList 10; solve; }
+lift' : {default tactics { applyTactic findSubList 100; solve; }
            prf : SubList ys xs} ->
         EffM m ys ys' t -> EffM m xs (updateWith ys' xs prf) t
 lift' {prf} e = lift prf e
 
 implicit
 effect' : {a, b: _} -> {e : Effect} ->
-          {default tactics { reflect findEffElem 10; solve; } 
+          {default tactics { applyTactic findEffElem 100; solve; } 
              prf : EffElem e a xs} -> 
           (eff : e a b t) -> 
          EffM m xs (updateResTy xs prf eff) t
@@ -176,8 +175,12 @@
 eff env (catch prog handler) k
    = catch (eff env prog k)
            (\e => eff env (handler e) k)
+-- FIXME:
+-- xs is needed explicitly because otherwise the pattern binding for
+-- 'l' appears too late. Solution seems to be to reorder patterns at the
+-- end so that everything is in scope when it needs to be.
 eff {xs = [l ::: x]} env (l :- prog) k
-   = let env' = unlabel {l} env in
+   = let env' = unlabel env in
          eff env' prog (\envk, p' => k (relabel l envk) p')
 
 run : Applicative m => Env m xs -> EffM m xs xs' a -> m a
@@ -189,10 +192,13 @@
 runPure : Env id xs -> EffM id xs xs' a -> a
 runPure env prog = eff env prog (\env, r => r)
 
+runPureEnv : Env id xs -> EffM id xs xs' a -> (Env id xs', a)
+runPureEnv env prog = eff env prog (\env, r => (env, r))
+
 runWith : (a -> m a) -> Env m xs -> EffM m xs xs' a -> m a
 runWith inj env prog = eff env prog (\env, r => inj r)
 
-Eff : (Type -> Type) -> List EFF -> Type -> Type
+Eff : (Type -> Type) -> List EFFECT -> Type -> Type
 Eff m xs t = EffM m xs xs t
 
 -- some higher order things
@@ -204,4 +210,3 @@
 when : Applicative m => Bool -> Eff m xs () -> Eff m xs ()
 when True  e = e
 when False e = pure ()
-
diff --git a/effects/Makefile b/effects/Makefile
--- a/effects/Makefile
+++ b/effects/Makefile
@@ -4,7 +4,7 @@
 
 recheck: clean check
 
-install: 
+install:
 	$(IDRIS) --install effects.ipkg
 
 clean: .PHONY
diff --git a/effects/effects.ipkg b/effects/effects.ipkg
--- a/effects/effects.ipkg
+++ b/effects/effects.ipkg
@@ -3,4 +3,6 @@
 opts    = "-i ../lib"
 modules = Effects, 
           Effect.Exception, Effect.File, Effect.State,
-          Effect.Random, Effect.StdIO, Effect.Select
+          Effect.Random, Effect.StdIO, Effect.Select,
+          Effect.Memory
+
diff --git a/idris.cabal b/idris.cabal
--- a/idris.cabal
+++ b/idris.cabal
@@ -1,5 +1,5 @@
 Name:           idris
-Version:        0.9.7
+Version:        0.9.8
 License:        BSD3
 License-file:   LICENSE
 Author:         Edwin Brady
@@ -10,21 +10,21 @@
 Category:       Compilers/Interpreters, Dependent Types
 Synopsis:       Functional Programming Language with Dependent Types
 Description:    Idris is a general purpose language with full dependent types.
-                It is compiled, with eager evaluation. 
+                It is compiled, with eager evaluation.
                 Dependent types allow types to be predicated on values,
                 meaning that some aspects of a program's behaviour can be
-                specified precisely in the type. The language is closely 
+                specified precisely in the type. The language is closely
 		related to Epigram and Agda. There is a tutorial at <http://www.idris-lang.org/documentation>.
                 Features include:
                 .
                 * Full dependent types with dependent pattern matching
-                .                
-                * where clauses, with rule, simple case expressions, 
+                .
+                * where clauses, with rule, simple case expressions,
                   pattern matching let and lambda bindings
                 .
                 * Type classes, monad comprehensions
                 .
-                * do notation, idiom brackets, syntactic conveniences for lists, 
+                * do notation, idiom brackets, syntactic conveniences for lists,
                   tuples, dependent pairs
                 .
                 * Totality checking
@@ -42,19 +42,24 @@
                 * Hugs style interactive environment
 
 Cabal-Version:  >= 1.6
+
+
 Build-type:     Custom
 
+
 Data-files:            rts/libidris_rts.a rts/idris_rts.h rts/idris_gc.h
                        rts/idris_stdfgn.h rts/idris_main.c rts/idris_gmp.h
                        rts/libtest.c
                        js/Runtime-common.js
                        js/Runtime-node.js
                        js/Runtime-browser.js
-Extra-source-files:    lib/Makefile  lib/*.idr lib/Prelude/*.idr 
+Extra-source-files:    lib/Makefile  lib/*.idr lib/Prelude/*.idr
                        lib/Network/*.idr lib/Control/*.idr
                        lib/Control/Monad/*.idr lib/Language/*.idr
+                       lib/Language/Reflection/*.idr
                        lib/System/Concurrency/*.idr
                        lib/Data/*.idr lib/Debug/*.idr
+                       lib/Data/Vect/*.idr
                        lib/Decidable/*.idr
                        tutorial/examples/*.idr lib/base.ipkg
                        effects/Makefile effects/*.idr effects/Effect/*.idr
@@ -62,30 +67,39 @@
                        config.mk
                        rts/*.c rts/*.h rts/Makefile
                        js/*.js
+                       java/src/main/java/org/idris/rts/*.java
 
 source-repository head
   type:     git
-  location: git://github.com/edwinb/Idris-dev.git 
+  location: git://github.com/edwinb/Idris-dev.git
 
+Flag Java
+  Description: Build the Java RTS
+  Default:     False
 
+Flag NoEffects
+  Description: Do not build the effects package
+  Default:     False
+
 Executable     idris
                Main-is: Main.hs
                hs-source-dirs: src
-               Other-modules: Core.TT, Core.Evaluate, Core.Typecheck, 
-                              Core.ProofShell, Core.ProofState, Core.CoreParser, 
+               Other-modules: Core.TT, Core.Evaluate, Core.Execute, Core.Typecheck,
+                              Core.ProofShell, Core.ProofState, Core.CoreParser,
                               Core.ShellParser, Core.Unify, Core.Elaborate,
                               Core.CaseTree, Core.Constraints,
 
                               Idris.AbsSyntax, Idris.AbsSyntaxTree,
-                              Idris.Parser, Idris.REPL,
+                              Idris.Parser, Idris.Help, Idris.IdeSlave, Idris.REPL,
                               Idris.REPLParser, Idris.ElabDecls, Idris.Error,
                               Idris.Delaborate, Idris.Primitives, Idris.Imports,
                               Idris.Compiler, Idris.Prover, Idris.ElabTerm,
                               Idris.Coverage, Idris.IBC, Idris.Unlit,
-                              Idris.DataOpts, Idris.Transforms, Idris.DSL, 
+                              Idris.DataOpts, Idris.Transforms, Idris.DSL,
                               Idris.UnusedArgs, Idris.Docs, Idris.Completion,
+                              Idris.Providers,
 
-                              Util.Pretty, Util.System,
+                              Util.Pretty, Util.System, Util.DynamicLinker,
                               Pkg.Package, Pkg.PParser,
 
                               IRTS.Lang, IRTS.LParser, IRTS.Bytecode, IRTS.Simplified,
@@ -96,12 +110,22 @@
 
                               Paths_idris
 
-               Build-depends:   base>=4 && <5, parsec>=3, mtl, Cabal, 
+               Build-depends:   base>=4 && <5, parsec>=3, mtl, Cabal,
                                 haskeline>=0.7, split, directory,
-                                containers, process, transformers, filepath, 
-                                directory, binary, bytestring, pretty
-                                
+                                containers, process, transformers, filepath,
+                                directory, binary, bytestring, text, pretty,
+                                language-java>=0.2.2, libffi
+
                Extensions:      MultiParamTypeClasses, FunctionalDependencies,
                                 FlexibleInstances, TemplateHaskell
                ghc-prof-options: -auto-all -caf-all
                ghc-options: -rtsopts
+               if os(linux)
+                  cpp-options: -DLINUX
+                  build-depends: unix
+               if os(darwin)
+                  cpp-options: -DMACOSX
+                  build-depends: unix
+               if os(windows)
+                  cpp-options: -DWINDOWS
+                  build-depends: Win32
diff --git a/java/src/main/java/org/idris/rts/Closure.java b/java/src/main/java/org/idris/rts/Closure.java
new file mode 100644
--- /dev/null
+++ b/java/src/main/java/org/idris/rts/Closure.java
@@ -0,0 +1,17 @@
+package org.idris.rts;
+
+import java.util.concurrent.Callable;
+
+public abstract class Closure implements Callable<Object>, Runnable {
+    protected final Object [] context;
+
+    protected Closure(final Object ... context) {
+	this.context = context;
+    }
+
+    public void run() {
+	call();
+    }
+
+    public abstract Object call();
+}
diff --git a/java/src/main/java/org/idris/rts/ForeignPrimitives.java b/java/src/main/java/org/idris/rts/ForeignPrimitives.java
new file mode 100644
--- /dev/null
+++ b/java/src/main/java/org/idris/rts/ForeignPrimitives.java
@@ -0,0 +1,271 @@
+package org.idris.rts;
+
+import java.lang.reflect.InvocationTargetException;
+import java.util.Arrays;
+import java.util.List;
+import java.util.Map;
+import java.util.HashMap;
+import java.util.Set;
+import java.util.HashSet;
+import java.io.Closeable;
+import java.io.File;
+import java.io.IOException;
+import java.io.PrintStream;
+import java.io.InputStream;
+import java.nio.ByteBuffer;
+import java.nio.file.Files;
+import java.nio.file.OpenOption;
+import java.nio.file.StandardOpenOption;
+import java.nio.channels.Channels;
+import java.nio.channels.SeekableByteChannel;
+import java.nio.channels.ReadableByteChannel;
+import java.util.concurrent.BlockingQueue;
+import java.util.concurrent.LinkedBlockingQueue;
+import java.util.concurrent.Semaphore;
+
+@SuppressWarnings("unchecked")
+public class ForeignPrimitives {
+
+    private static final Map<Thread, List<String>> args = new HashMap<>();
+    private static final Semaphore messageMutex = new Semaphore(1);
+    private static final Map<Thread, BlockingQueue<Object>> messages = new HashMap<>();
+    private static final Set<Object> feofFiles = new HashSet<>();
+
+    public static synchronized void idris_initArgs(Thread t, String[] args) {
+        ForeignPrimitives.args.put(t, Arrays.asList(args));
+    }
+
+    public static synchronized int idris_numArgs(Object thread) {
+        List<String> argsForThread = ForeignPrimitives.args.get((Thread) thread);
+        return (argsForThread == null ? 0 : argsForThread.size());
+    }
+
+    public static synchronized String idris_getArg(Object thread, int num) {
+        List<String> argsForThread = ForeignPrimitives.args.get((Thread) thread);
+        return (argsForThread == null ? null : argsForThread.get(num));
+    }
+
+    public static String getenv(String x) {
+        return System.getenv(x);
+    }
+
+    public static void exit(int exitCode) {
+        System.exit(exitCode);
+    }
+
+    public static void usleep(int microsecs) {
+        try {
+            Thread.sleep(microsecs / 1000, microsecs % 1000);
+        } catch (InterruptedException ex) {
+        }
+    }
+
+    public static void idris_sendMessage(Object from, Object dest, Object message) throws InterruptedException {
+        messageMutex.acquire();
+        BlockingQueue<Object> messagesForTarget = messages.get((Thread) dest);
+        if (messagesForTarget == null) {
+            messagesForTarget = new LinkedBlockingQueue<>();
+            messages.put((Thread) dest, messagesForTarget);
+        }
+        messagesForTarget.put(message);
+        messageMutex.release();
+    }
+
+    public static int idris_checkMessage(Object dest) throws InterruptedException {
+        messageMutex.acquire();
+        BlockingQueue<Object> messagesForTarget = messages.get((Thread) dest);
+        messageMutex.release();
+        return (messagesForTarget == null ? 0 : messagesForTarget.size());
+    }
+
+    public static Object idris_recvMessage(Object dest) throws InterruptedException {
+        messageMutex.acquire();
+        BlockingQueue<Object> messagesForTarget = messages.get((Thread) dest);
+        if (messagesForTarget == null) {
+            messagesForTarget = new LinkedBlockingQueue();
+            messages.put((Thread) dest, messagesForTarget);
+        }
+        messageMutex.release();
+        return messagesForTarget.take();
+    }
+
+    public static void putStr(String str) {
+        System.out.print(str);
+    }
+
+    public static void putchar(char c) {
+        System.out.print(c);
+    }
+
+    public static int getchar() {
+        try {
+            return (char) System.in.read();
+        } catch (IOException ex) {
+            return -1;
+        }
+    }
+
+    public static SeekableByteChannel fileOpen(String name, String privs) {
+        try {
+            OpenOption[] options;
+            switch (privs) {
+                case "r":
+                    options = new StandardOpenOption[]{StandardOpenOption.READ};
+                    break;
+                case "r+":
+                    options = new StandardOpenOption[]{StandardOpenOption.READ,
+                        StandardOpenOption.WRITE};
+                    break;
+                case "w":
+                    options = new StandardOpenOption[]{StandardOpenOption.WRITE,
+                        StandardOpenOption.CREATE};
+                    break;
+                case "w+":
+                    options = new StandardOpenOption[]{StandardOpenOption.READ,
+                        StandardOpenOption.WRITE,
+                        StandardOpenOption.CREATE};
+                    break;
+                case "a":
+                    options = new StandardOpenOption[]{StandardOpenOption.WRITE,
+                        StandardOpenOption.CREATE,
+                        StandardOpenOption.APPEND};
+                    break;
+                case "a+":
+                    options = new StandardOpenOption[]{StandardOpenOption.READ,
+                        StandardOpenOption.WRITE,
+                        StandardOpenOption.CREATE,
+                        StandardOpenOption.APPEND};
+                    break;
+                default:
+                    options = new StandardOpenOption[]{};
+                    break;
+            }
+            return Files.newByteChannel(new File(name).toPath(), options);
+        } catch (IOException ex) {
+            return null;
+        }
+    }
+
+    public static synchronized void fileClose(Object file) throws IOException {
+        ((Closeable) file).close();
+        feofFiles.remove(file);
+    }
+
+    public static void fputStr(Object file, String string) throws IOException {
+        if (file instanceof PrintStream) {
+            ((PrintStream) file).print(string);
+        } else if (file instanceof SeekableByteChannel) {
+            ((SeekableByteChannel) file).write(ByteBuffer.wrap(string.getBytes()));
+        }
+    }
+
+    public static synchronized String idris_readStr(Object file) throws IOException {
+        ReadableByteChannel channel = file instanceof InputStream
+                ? Channels.newChannel((InputStream) file)
+                : (ReadableByteChannel) file;
+        ByteBuffer buf = ByteBuffer.allocate(1);
+        StringBuilder resultBuilder = new StringBuilder("");
+        String delimiter = System.getProperty("line.separator");
+        int read = 0;
+        do {
+            buf.rewind();
+            read = channel.read(buf);
+            if (read > 0) {
+                resultBuilder.append(new String(buf.array()));
+                if (resultBuilder.lastIndexOf(delimiter) > -1) {
+                    return resultBuilder.toString();
+                }
+            }
+            if (read < 0) {
+                feofFiles.add(file);
+            }
+        } while (read >= 0);
+        return resultBuilder.toString();
+    }
+
+    public static int fileEOF(Object file) {
+        return (feofFiles.contains(file) ? 1 : 0);
+    }
+
+    public static int isNull(Object o) {
+        return (o == null ? 1 : 0);
+    }
+
+    public static Object malloc(int size) {
+        return ByteBuffer.allocate(size);
+    }
+
+    public static void idris_memset(Object buf, int offset, Object c, int size) {
+        ByteBuffer buffer = (ByteBuffer)buf;
+        buffer.rewind();
+        buffer.position(offset);
+        byte init[] = new byte[size];
+        Arrays.fill(init, (Byte)c);
+        buffer.put(init, offset, size);
+        buffer.rewind();
+    }
+
+    public static void free(Object buf) {
+        buf = null;
+    }
+
+    public static Integer idris_peek(Object buf, int offset) {
+        ByteBuffer buffer = (ByteBuffer)buf;
+        return Integer.valueOf(buffer.get(offset));
+    }
+
+    public static void idris_poke(Object buf, int offset, Object data) {
+        ByteBuffer buffer = (ByteBuffer)buf;
+        buffer.put(offset, (Byte)data);
+    }
+
+    public static void idris_memmove(Object dstBuf, Object srcBuf, int dstOffset, int srcOffset, int size) {
+        ByteBuffer dst = (ByteBuffer)dstBuf;
+        ByteBuffer src = (ByteBuffer)srcBuf;
+        byte [] srcData = new byte[size];
+        src.rewind();
+        src.position(srcOffset);
+        src.get(srcData, 0, size);
+        src.rewind();
+        dst.rewind();
+        dst.position(dstOffset);
+        dst.put(srcData, 0, size);
+        dst.rewind();
+    }
+
+    public final static Object idris_K(final Object result, final Object drop) {
+        return result;
+    }
+
+    public final static Object idris_flipK(final Object drop, final Object result) {
+        return result;
+    }
+
+    public final static Object idris_assignStack(final Object[] context, final int start, final Object... vars) {
+        int i = start;
+        for (Object var : vars) {
+            context[i] = var;
+        }
+        return context;
+    }
+
+    public final static Object invokeOn(final Object obj, final String methodName, Object... args) throws NoSuchMethodException, IllegalAccessException, InvocationTargetException {
+        Class cls = (obj instanceof Class ? (Class)obj : obj.getClass());
+        Class argClasses[] = new Class[args.length];
+        int i = 0;
+        for (Object arg : args) {
+            argClasses[i] = arg.getClass();
+        }
+        return cls.getMethod(methodName, argClasses).invoke(obj, args);
+    }
+    
+    public final static Object newObject(final Object cls, Object... args) throws NoSuchMethodException, IllegalAccessException, InvocationTargetException, InstantiationException {
+        Class clazz = (cls instanceof Class ? (Class)cls : cls.getClass());
+        Class argClasses[] = new Class[args.length];
+        int i = 0;
+        for (Object arg : args) {
+            argClasses[i] = arg.getClass();
+        }
+        return clazz.getConstructor(argClasses).newInstance(args);
+    }
+}
diff --git a/java/src/main/java/org/idris/rts/IdrisObject.java b/java/src/main/java/org/idris/rts/IdrisObject.java
new file mode 100644
--- /dev/null
+++ b/java/src/main/java/org/idris/rts/IdrisObject.java
@@ -0,0 +1,19 @@
+package org.idris.rts;
+
+public class IdrisObject {
+    private final int constructorId;
+    private final Object data[];
+    
+    public IdrisObject(final int constructorId, final Object ... data) {
+	this.constructorId = constructorId;
+	this.data = data;
+    }
+    
+    public int getConstructorId() {
+	return constructorId;
+    }
+
+    public Object[] getData() {
+	return data;
+    }
+}
diff --git a/java/src/main/java/org/idris/rts/TailCallClosure.java b/java/src/main/java/org/idris/rts/TailCallClosure.java
new file mode 100644
--- /dev/null
+++ b/java/src/main/java/org/idris/rts/TailCallClosure.java
@@ -0,0 +1,26 @@
+package org.idris.rts;
+
+public class TailCallClosure extends Closure {
+    private final Closure function;
+
+    public TailCallClosure(Closure function) {
+	super();
+	this.function = function;
+    }
+
+    public final Object call() {
+	Closure function = this.function;
+	Object result = null;
+	while (function != null) {
+	    result = function.call();
+	    function = null;
+	    if (result instanceof TailCallClosure) {
+		function = ((TailCallClosure)result).function;
+	    } else {
+		return result;
+	    }
+	}
+	return result;
+    }
+}
+
diff --git a/js/Runtime-common.js b/js/Runtime-common.js
--- a/js/Runtime-common.js
+++ b/js/Runtime-common.js
@@ -10,7 +10,9 @@
 __IDRRT__.String = new __IDRRT__.Type('String');
 __IDRRT__.Integer = new __IDRRT__.Type('Integer');
 __IDRRT__.Float = new __IDRRT__.Type('Float');
+__IDRRT__.Ptr = new __IDRRT__.Type('Pointer')
 __IDRRT__.Forgot = new __IDRRT__.Type('Forgot');
+
 
 /** @constructor */
 __IDRRT__.Tailcall = function(f) { this.f = f };
diff --git a/lib/Builtins.idr b/lib/Builtins.idr
--- a/lib/Builtins.idr
+++ b/lib/Builtins.idr
@@ -25,6 +25,13 @@
 lazy : a -> a
 lazy x = x -- compiled specially
 
+-- Give the termination checker a hint.
+-- assert_smaller x v means that 'v' should be assumed smaller than the
+-- variable x in this call.
+
+assert_smaller : a -> b -> b
+assert_smaller var smallerval = smallerval -- compiled specially
+
 par : |(thunk:a) -> a
 par x = x -- compiled specially
 
@@ -44,6 +51,9 @@
 
 namespace Builtins {
 
+Not : Type -> Type
+Not a = a -> _|_
+
 id : a -> a
 id x = x
 
@@ -248,7 +258,7 @@
     (*) = prim__mulBigInt
 
     abs x = if x<0 then -x else x
-    fromInteger = prim__intToBigInt
+    fromInteger = prim__sextInt_BigInt
 
 
 instance Num Float where 
@@ -257,15 +267,15 @@
     (*) = prim__mulFloat
 
     abs x = if x<0 then -x else x
-    fromInteger = prim__intToFloat 
+    fromInteger = prim__toFloatInt
 
 partial
 div : Int -> Int -> Int
-div = prim__divInt
+div = prim__sdivInt
 
 partial
 mod : Int -> Int -> Int
-mod = prim__modInt
+mod = prim__sremInt
 
 
 (/) : Float -> Float -> Float
diff --git a/lib/Data/Bits.idr b/lib/Data/Bits.idr
--- a/lib/Data/Bits.idr
+++ b/lib/Data/Bits.idr
@@ -31,17 +31,17 @@
 natToBits' : machineTy n -> Nat -> machineTy n
 natToBits' a O = a
 natToBits' {n=n} a x with n
- natToBits' a (S x') | O = natToBits' (prim__addB8 a (prim__intToB8 1)) x'
- natToBits' a (S x') | S O = natToBits' (prim__addB16 a (prim__intToB16 1)) x'
- natToBits' a (S x') | S (S O) = natToBits' (prim__addB32 a (prim__intToB32 1)) x'
- natToBits' a (S x') | S (S (S _)) = natToBits' (prim__addB64 a (prim__intToB64 1)) x'
+ natToBits' a (S x') | O = natToBits' (prim__addB8 a (prim__truncInt_B8 1)) x'
+ natToBits' a (S x') | S O = natToBits' (prim__addB16 a (prim__truncInt_B16 1)) x'
+ natToBits' a (S x') | S (S O) = natToBits' (prim__addB32 a (prim__truncInt_B32 1)) x'
+ natToBits' a (S x') | S (S (S _)) = natToBits' (prim__addB64 a (prim__truncInt_B64 1)) x'
 
 natToBits : Nat -> machineTy n
 natToBits {n=n} x with n
-    | O = natToBits' (prim__intToB8 0) x
-    | S O = natToBits' (prim__intToB16 0) x
-    | S (S O) = natToBits' (prim__intToB32 0) x
-    | S (S (S _)) = natToBits' (prim__intToB64 0) x
+    | O = natToBits' (prim__truncInt_B8 0) x
+    | S O = natToBits' (prim__truncInt_B16 0) x
+    | S (S O) = natToBits' (prim__truncInt_B32 0) x
+    | S (S (S _)) = natToBits' (prim__truncInt_B64 0) x
 
 getPad : Nat -> machineTy n
 getPad n = natToBits ((bitsUsed (nextBytes n)) - n)
@@ -111,7 +111,8 @@
 
 public
 shiftRightLogical : Bits n -> Bits n -> Bits n
-shiftRightLogical (MkBits x) (MkBits y) = MkBits (shiftRightLogical' x y)
+shiftRightLogical {n} (MkBits x) (MkBits y) 
+    = MkBits {n} (shiftRightLogical' {n=nextBytes n} x y)
 
 shiftRightArithmetic' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)
 shiftRightArithmetic' {n=n} x c with (nextBytes n)
@@ -133,7 +134,7 @@
 
 public
 and : Bits n -> Bits n -> Bits n
-and (MkBits x) (MkBits y) = MkBits (and' x y)
+and {n} (MkBits x) (MkBits y) = MkBits (and' {n=nextBytes n} x y)
 
 or' : machineTy n -> machineTy n -> machineTy n
 or' {n=n} x y with n
@@ -144,7 +145,7 @@
 
 public
 or : Bits n -> Bits n -> Bits n
-or (MkBits x) (MkBits y) = MkBits (or' x y)
+or {n} (MkBits x) (MkBits y) = MkBits (or' {n=nextBytes n} x y)
 
 xor' : machineTy n -> machineTy n -> machineTy n
 xor' {n=n} x y with n
@@ -308,14 +309,14 @@
 zext' : machineTy (nextBytes n) -> machineTy (nextBytes (n+m))
 zext' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))
     | (O, O) = believe_me x
-    | (O, S O) = believe_me (prim__zextB8_16 (believe_me x))
-    | (O, S (S O)) = believe_me (prim__zextB8_32 (believe_me x))
-    | (O, S (S (S _))) = believe_me (prim__zextB8_64 (believe_me x))
+    | (O, S O) = believe_me (prim__zextB8_B16 (believe_me x))
+    | (O, S (S O)) = believe_me (prim__zextB8_B32 (believe_me x))
+    | (O, S (S (S _))) = believe_me (prim__zextB8_B64 (believe_me x))
     | (S O, S O) = believe_me x
-    | (S O, S (S O)) = believe_me (prim__zextB16_32 (believe_me x))
-    | (S O, S (S (S _))) = believe_me (prim__zextB16_64 (believe_me x))
+    | (S O, S (S O)) = believe_me (prim__zextB16_B32 (believe_me x))
+    | (S O, S (S (S _))) = believe_me (prim__zextB16_B64 (believe_me x))
     | (S (S O), S (S O)) = believe_me x
-    | (S (S O), S (S (S _))) = believe_me (prim__zextB32_64 (believe_me x))
+    | (S (S O), S (S (S _))) = believe_me (prim__zextB32_B64 (believe_me x))
     | (S (S (S _)), S (S (S _))) = believe_me x
 
 public
@@ -326,13 +327,13 @@
 intToBits' : Int -> machineTy (nextBytes n)
 intToBits' {n=n} x with (nextBytes n)
     | O = let pad = getPad {n=0} n in
-          prim__lshrB8 (prim__shlB8 (prim__intToB8 x) pad) pad
+          prim__lshrB8 (prim__shlB8 (prim__truncInt_B8 x) pad) pad
     | S O = let pad = getPad {n=1} n in
-            prim__lshrB16 (prim__shlB16 (prim__intToB16 x) pad) pad
+            prim__lshrB16 (prim__shlB16 (prim__truncInt_B16 x) pad) pad
     | S (S O) = let pad = getPad {n=2} n in
-                prim__lshrB32 (prim__shlB32 (prim__intToB32 x) pad) pad
+                prim__lshrB32 (prim__shlB32 (prim__truncInt_B32 x) pad) pad
     | S (S (S _)) = let pad = getPad {n=3} n in
-                    prim__lshrB64 (prim__shlB64 (prim__intToB64 x) pad) pad
+                    prim__lshrB64 (prim__shlB64 (prim__truncInt_B64 x) pad) pad
 
 public
 intToBits : Int -> Bits n
@@ -343,10 +344,10 @@
 
 bitsToInt' : machineTy n -> Int
 bitsToInt' {n=n} x with n
-    | O = prim__B32ToInt (prim__zextB8_32 x)
-    | S O = prim__B32ToInt (prim__zextB16_32 x)
-    | S (S O) = prim__B32ToInt x
-    | S (S (S _)) = prim__B32ToInt (prim__truncB64_32 x)
+    | O = prim__zextB8_Int x
+    | S O = prim__zextB16_Int x
+    | S (S O) = prim__zextB32_Int x
+    | S (S (S _)) = prim__truncB64_Int x
 
 public
 bitsToInt : Bits n -> Int
@@ -365,27 +366,27 @@
     | (O, O) = let pad = getPad {n=0} n in
                believe_me (prim__ashrB8 (prim__shlB8 (believe_me x) pad) pad)
     | (O, S O) = let pad = getPad {n=0} n in
-                 believe_me (prim__ashrB16 (prim__sextB8_16 (prim__shlB8 (believe_me x) pad))
-                                           (prim__zextB8_16 pad))
+                 believe_me (prim__ashrB16 (prim__sextB8_B16 (prim__shlB8 (believe_me x) pad))
+                                           (prim__zextB8_B16 pad))
     | (O, S (S O)) = let pad = getPad {n=0} n in
-                     believe_me (prim__ashrB32 (prim__sextB8_32 (prim__shlB8 (believe_me x) pad))
-                                               (prim__zextB8_32 pad))
+                     believe_me (prim__ashrB32 (prim__sextB8_B32 (prim__shlB8 (believe_me x) pad))
+                                               (prim__zextB8_B32 pad))
     | (O, S (S (S _))) = let pad = getPad {n=0} n in
-                         believe_me (prim__ashrB64 (prim__sextB8_64 (prim__shlB8 (believe_me x) pad))
-                                                   (prim__zextB8_64 pad))
+                         believe_me (prim__ashrB64 (prim__sextB8_B64 (prim__shlB8 (believe_me x) pad))
+                                                   (prim__zextB8_B64 pad))
     | (S O, S O) = let pad = getPad {n=1} n in
                    believe_me (prim__ashrB16 (prim__shlB16 (believe_me x) pad) pad)
     | (S O, S (S O)) = let pad = getPad {n=1} n in
-                       believe_me (prim__ashrB32 (prim__sextB16_32 (prim__shlB16 (believe_me x) pad))
-                                                 (prim__zextB16_32 pad))
+                       believe_me (prim__ashrB32 (prim__sextB16_B32 (prim__shlB16 (believe_me x) pad))
+                                                 (prim__zextB16_B32 pad))
     | (S O, S (S (S _))) = let pad = getPad {n=1} n in
-                           believe_me (prim__ashrB64 (prim__sextB16_64 (prim__shlB16 (believe_me x) pad))
-                                                     (prim__zextB16_64 pad))
+                           believe_me (prim__ashrB64 (prim__sextB16_B64 (prim__shlB16 (believe_me x) pad))
+                                                     (prim__zextB16_B64 pad))
     | (S (S O), S (S O)) = let pad = getPad {n=2} n in
                            believe_me (prim__ashrB32 (prim__shlB32 (believe_me x) pad) pad)
     | (S (S O), S (S (S _))) = let pad = getPad {n=2} n in
-                               believe_me (prim__ashrB64 (prim__sextB32_64 (prim__shlB32 (believe_me x) pad))
-                                                         (prim__zextB32_64 pad))
+                               believe_me (prim__ashrB64 (prim__sextB32_B64 (prim__shlB32 (believe_me x) pad))
+                                                         (prim__zextB32_B64 pad))
     | (S (S (S _)), S (S (S _))) = let pad = getPad {n=3} n in
                                    believe_me (prim__ashrB64 (prim__shlB64 (believe_me x) pad) pad)
 
@@ -397,14 +398,14 @@
 trunc' : machineTy (nextBytes (n+m)) -> machineTy (nextBytes n)
 trunc' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))
     | (O, O) = believe_me x
-    | (O, S O) = believe_me (prim__truncB16_8 (believe_me x))
-    | (O, S (S O)) = believe_me (prim__truncB32_8 (believe_me x))
-    | (O, S (S (S _))) = believe_me (prim__truncB64_8 (believe_me x))
+    | (O, S O) = believe_me (prim__truncB16_B8 (believe_me x))
+    | (O, S (S O)) = believe_me (prim__truncB32_B8 (believe_me x))
+    | (O, S (S (S _))) = believe_me (prim__truncB64_B8 (believe_me x))
     | (S O, S O) = believe_me x
-    | (S O, S (S O)) = believe_me (prim__truncB32_16 (believe_me x))
-    | (S O, S (S (S _))) = believe_me (prim__truncB64_16 (believe_me x))
+    | (S O, S (S O)) = believe_me (prim__truncB32_B16 (believe_me x))
+    | (S O, S (S (S _))) = believe_me (prim__truncB64_B16 (believe_me x))
     | (S (S O), S (S O)) = believe_me x
-    | (S (S O), S (S (S _))) = believe_me (prim__truncB64_32 (believe_me x))
+    | (S (S O), S (S (S _))) = believe_me (prim__truncB64_B32 (believe_me x))
     | (S (S (S _)), S (S (S _))) = believe_me x
 
 public
@@ -437,3 +438,4 @@
 
 instance Show (Bits n) where
     show = bitsToStr
+
diff --git a/lib/Data/BoundedList.idr b/lib/Data/BoundedList.idr
new file mode 100644
--- /dev/null
+++ b/lib/Data/BoundedList.idr
@@ -0,0 +1,93 @@
+module Data.BoundedList
+
+%access public
+%default total
+
+data BoundedList : Type -> Nat -> Type where
+  Nil : BoundedList a n
+  (::) : a -> BoundedList a n -> BoundedList a (S n)
+
+length : BoundedList a n -> Fin (S n)
+length [] = fO
+length (x :: xs) = fS (length xs)
+
+--------------------------------------------------------------------------------
+-- Indexing into bounded lists
+--------------------------------------------------------------------------------
+
+index : Fin (S n) -> BoundedList a n -> Maybe a
+index _      []        = Nothing
+index fO     (x :: _)  = Just x
+index (fS f) (_ :: xs) = index f xs
+
+--------------------------------------------------------------------------------
+-- Adjusting bounds
+--------------------------------------------------------------------------------
+
+weaken : BoundedList a n -> BoundedList a (n + m)
+weaken []        = []
+weaken (x :: xs) = x :: weaken xs
+
+--------------------------------------------------------------------------------
+-- Conversions to and from list
+--------------------------------------------------------------------------------
+
+take : (n : Nat) -> List a -> BoundedList a n
+take _ [] = []
+take O _ = []
+take (S n') (x :: xs) = x :: take n' xs
+
+toList : BoundedList a n -> List a
+toList [] = []
+toList (x :: xs) = x :: toList xs
+
+fromList : (xs : List a) -> BoundedList a (length xs)
+fromList [] = []
+fromList (x :: xs) = x :: fromList xs
+
+--------------------------------------------------------------------------------
+-- Building (bigger) bounded lists
+--------------------------------------------------------------------------------
+
+replicate : (n : Nat) -> a -> BoundedList a n
+replicate O _ = []
+replicate (S n) x = x :: replicate n x
+
+--------------------------------------------------------------------------------
+-- Folds
+--------------------------------------------------------------------------------
+
+foldl : (a -> b -> a) -> a -> BoundedList b n -> a
+foldl f e []      = e
+foldl f e (x::xs) = foldl f (f e x) xs
+
+foldr : (a -> b -> b) -> b -> BoundedList a n -> b
+foldr f e []      = e
+foldr f e (x::xs) = f x (foldr f e xs)
+
+--------------------------------------------------------------------------------
+-- Maps
+--------------------------------------------------------------------------------
+
+map : (a -> b) -> BoundedList a n -> BoundedList b n
+map f [] = []
+map f (x :: xs) = f x :: map f xs
+
+--------------------------------------------------------------------------------
+-- Misc
+--------------------------------------------------------------------------------
+
+%assert_total -- not sure why this isn't accepted - clearly decreasing on n
+pad : (xs : BoundedList a n) -> (padding : a) -> BoundedList a n
+pad {n=O}    []        _       = []
+pad {n=S n'} []        padding = padding :: (pad {n=n'} [] padding)
+pad {n=S n'} (x :: xs) padding = x :: pad {n=n'} xs padding
+
+
+--------------------------------------------------------------------------------
+-- Simple properties
+--------------------------------------------------------------------------------
+
+zeroBoundIsEmpty : (xs : BoundedList a 0) -> xs = the (BoundedList a 0) []
+zeroBoundIsEmpty [] = refl
+zeroBoundIsEmpty (_ :: _) impossible
diff --git a/lib/Data/SortedMap.idr b/lib/Data/SortedMap.idr
new file mode 100644
--- /dev/null
+++ b/lib/Data/SortedMap.idr
@@ -0,0 +1,235 @@
+module Data.SortedMap
+
+-- TODO: write merge and split
+
+data Tree : Nat -> Type -> Type -> Type where
+  Leaf : k -> v -> Tree O k v
+  Branch2 : Tree n k v -> k -> Tree n k v -> Tree (S n) k v
+  Branch3 : Tree n k v -> k -> Tree n k v -> k -> Tree n k v -> Tree (S n) k v
+
+branch4 :
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v ->
+  Tree (S (S n)) k v
+branch4 a b c d e f g =
+  Branch2 (Branch2 a b c) d (Branch2 e f g)
+
+branch5 :
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v ->
+  Tree (S (S n)) k v
+branch5 a b c d e f g h i =
+  Branch2 (Branch2 a b c) d (Branch3 e f g h i)
+
+branch6 :
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v ->
+  Tree (S (S n)) k v
+branch6 a b c d e f g h i j k =
+  Branch3 (Branch2 a b c) d (Branch2 e f g) h (Branch2 i j k)
+
+branch7 :
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v -> k ->
+  Tree n k v ->
+  Tree (S (S n)) k v
+branch7 a b c d e f g h i j k l m =
+  Branch3 (Branch3 a b c d e) f (Branch2 g h i) j (Branch2 k l m)
+
+merge1 : Tree n k v -> k -> Tree (S n) k v -> k -> Tree (S n) k v -> Tree (S (S n)) k v
+merge1 a b (Branch2 c d e) f (Branch2 g h i) = branch5 a b c d e f g h i
+merge1 a b (Branch2 c d e) f (Branch3 g h i j k) = branch6 a b c d e f g h i j k
+merge1 a b (Branch3 c d e f g) h (Branch2 i j k) = branch6 a b c d e f g h i j k
+merge1 a b (Branch3 c d e f g) h (Branch3 i j k l m) = branch7 a b c d e f g h i j k l m
+
+merge2 : Tree (S n) k v -> k -> Tree n k v -> k -> Tree (S n) k v -> Tree (S (S n)) k v
+merge2 (Branch2 a b c) d e f (Branch2 g h i) = branch5 a b c d e f g h i
+merge2 (Branch2 a b c) d e f (Branch3 g h i j k) = branch6 a b c d e f g h i j k
+merge2 (Branch3 a b c d e) f g h (Branch2 i j k) = branch6 a b c d e f g h i j k
+merge2 (Branch3 a b c d e) f g h (Branch3 i j k l m) = branch7 a b c d e f g h i j k l m
+
+merge3 : Tree (S n) k v -> k -> Tree (S n) k v -> k -> Tree n k v -> Tree (S (S n)) k v
+merge3 (Branch2 a b c) d (Branch2 e f g) h i = branch5 a b c d e f g h i
+merge3 (Branch2 a b c) d (Branch3 e f g h i) j k = branch6 a b c d e f g h i j k
+merge3 (Branch3 a b c d e) f (Branch2 g h i) j k = branch6 a b c d e f g h i j k
+merge3 (Branch3 a b c d e) f (Branch3 g h i j k) l m = branch7 a b c d e f g h i j k l m
+
+treeLookup : Ord k => k -> Tree n k v -> Maybe v
+treeLookup k (Leaf k' v) =
+  if k == k' then
+    Just v
+  else
+    Nothing
+treeLookup k (Branch2 t1 k' t2) =
+  if k <= k' then
+    treeLookup k t1
+  else
+    treeLookup k t2
+treeLookup k (Branch3 t1 k1 t2 k2 t3) =
+  if k <= k1 then
+    treeLookup k t1
+  else if k <= k2 then
+    treeLookup k t2
+  else
+    treeLookup k t3
+
+treeInsert' : Ord k => k -> v -> Tree n k v -> Either (Tree n k v) (Tree n k v, k, Tree n k v)
+treeInsert' k v (Leaf k' v') =
+  case compare k k' of
+    LT => Right (Leaf k v, k, Leaf k' v')
+    EQ => Left (Leaf k v)
+    GT => Right (Leaf k' v', k', Leaf k v)
+treeInsert' k v (Branch2 t1 k' t2) =
+  if k <= k' then
+    case treeInsert' k v t1 of
+      Left t1' => Left (Branch2 t1' k' t2)
+      Right (a, b, c) => Left (Branch3 a b c k' t2)
+  else
+    case treeInsert' k v t2 of
+      Left t2' => Left (Branch2 t1 k' t2')
+      Right (a, b, c) => Left (Branch3 t1 k' a b c)
+treeInsert' k v (Branch3 t1 k1 t2 k2 t3) =
+  if k <= k1 then
+    case treeInsert' k v t1 of
+      Left t1' => Left (Branch3 t1' k1 t2 k2 t3)
+      Right (a, b, c) => Right (Branch2 a b c, k1, Branch2 t2 k2 t3)
+  else
+    if k <= k2 then
+      case treeInsert' k v t2 of
+        Left t2' => Left (Branch3 t1 k1 t2' k2 t3)
+        Right (a, b, c) => Right (Branch2 t1 k1 a, b, Branch2 c k2 t3)
+    else
+      case treeInsert' k v t3 of
+        Left t3' => Left (Branch3 t1 k1 t2 k2 t3')
+        Right (a, b, c) => Right (Branch2 t1 k2 t2, k2, Branch2 a b c)
+
+treeInsert : Ord k => k -> v -> Tree n k v -> Either (Tree n k v) (Tree (S n) k v)
+treeInsert k v t =
+  case treeInsert' k v t of
+    Left t' => Left t'
+    Right (a, b, c) => Right (Branch2 a b c)
+
+delType : Nat -> Type -> Type -> Type
+delType O k v = ()
+delType (S n) k v = Tree n k v
+
+treeDelete : Ord k => k -> Tree n k v -> Either (Tree n k v) (delType n k v)
+treeDelete k (Leaf k' v) =
+  if k == k' then
+    Right ()
+  else
+    Left (Leaf k' v)
+treeDelete {n=S O} k (Branch2 t1 k' t2) =
+  if k <= k' then
+    case treeDelete k t1 of
+      Left t1' => Left (Branch2 t1' k' t2)
+      Right () => Right t2
+  else
+    case treeDelete k t2 of
+      Left t2' => Left (Branch2 t1 k' t2')
+      Right () => Right t1
+treeDelete {n=S O} k (Branch3 t1 k1 t2 k2 t3) =
+  if k <= k1 then
+    case treeDelete k t1 of
+      Left t1' => Left (Branch3 t1' k1 t2 k2 t3)
+      Right () => Left (Branch2 t2 k2 t3)
+  else if k <= k2 then
+    case treeDelete k t2 of
+      Left t2' => Left (Branch3 t1 k1 t2' k2 t3)
+      Right () => Left (Branch2 t1 k1 t3)
+  else
+    case treeDelete k t3 of
+      Left t3' => Left (Branch3 t1 k1 t2 k2 t3')
+      Right () => Left (Branch2 t1 k1 t2)
+treeDelete {n=S (S _)} k (Branch2 t1 k' t2) =
+  if k <= k' then
+    case treeDelete k t1 of
+      Left t1' => Left (Branch2 t1' k' t2)
+      Right t1' =>
+        case t2 of
+          Branch2 a b c => Right (Branch3 t1' k' a b c)
+          Branch3 a b c d e => Left (branch4 t1' k' a b c d e)
+  else
+    case treeDelete k t2 of
+      Left t2' => Left (Branch2 t1 k' t2')
+      Right t2' =>
+        case t1 of
+          Branch2 a b c => Right (Branch3 a b c k' t2')
+          Branch3 a b c d e => Left (branch4 a b c d e k' t2')
+treeDelete {n=(S (S _))} k (Branch3 t1 k1 t2 k2 t3) =
+  if k <= k1 then
+    case treeDelete k t1 of
+      Left t1' => Left (Branch3 t1' k1 t2 k2 t3)
+      Right t1' => Left (merge1 t1' k1 t2 k2 t3)
+  else if k <= k2 then
+    case treeDelete k t2 of
+      Left t2' => Left (Branch3 t1 k1 t2' k2 t3)
+      Right t2' => Left (merge2 t1 k1 t2' k2 t3)
+  else
+    case treeDelete k t3 of
+      Left t3' => Left (Branch3 t1 k1 t2 k2 t3')
+      Right t3' => Left (merge3 t1 k1 t2 k2 t3')
+
+-- FIXME: this is very inefficient
+treeToList : Ord k => Tree n k v -> List (k, v)
+treeToList (Leaf k v) = [(k, v)]
+treeToList (Branch2 t1 _ t2) = treeToList t1 ++ treeToList t2
+treeToList (Branch3 t1 _ t2 _ t3) = treeToList t1 ++ treeToList t2 ++ treeToList t3
+
+data SortedMap : Type -> Type -> Type where
+  Empty : SortedMap k v
+  M : (n:Nat) -> Tree n k v -> SortedMap k v
+
+empty : SortedMap k v
+empty = Empty
+
+lookup : Ord k => k -> SortedMap k v -> Maybe v
+lookup _ Empty = Nothing
+lookup k (M _ t) = treeLookup k t
+
+insert : Ord k => k -> v -> SortedMap k v -> SortedMap k v
+insert k v Empty = M O (Leaf k v)
+insert k v (M _ t) =
+  case treeInsert k v t of
+    Left t' => (M _ t')
+    Right t' => (M _ t')
+
+delete : Ord k => k -> SortedMap k v -> SortedMap k v
+delete _ Empty = Empty
+delete k (M O t) =
+  case treeDelete k t of
+    Left t' => (M _ t')
+    Right () => Empty
+delete k (M (S _) t) =
+  case treeDelete k t of
+    Left t' => (M _ t')
+    Right t' => (M _ t')
+
+fromList : Ord k => List (k, v) -> SortedMap k v
+fromList l = foldl (flip (uncurry insert)) empty l
+
+toList : Ord k => SortedMap k v -> List (k, v)
+toList Empty = []
+toList (M _ t) = treeToList t
+
+instance Functor (Tree n k) where
+  fmap f (Leaf k v) = Leaf k (f v)
+  fmap f (Branch2 t1 k t2) = Branch2 (fmap f t1) k (fmap f t2)
+  fmap f (Branch3 t1 k1 t2 k2 t3) = Branch3 (fmap f t1) k1 (fmap f t2) k2 (fmap f t3)
+
+instance Functor (SortedMap k) where
+  fmap _ Empty = Empty
+  fmap f (M _ t) = M _ (fmap f t)
diff --git a/lib/Data/SortedSet.idr b/lib/Data/SortedSet.idr
new file mode 100644
--- /dev/null
+++ b/lib/Data/SortedSet.idr
@@ -0,0 +1,25 @@
+module Data.SortedSet
+
+import Data.SortedMap
+
+-- TODO: add intersection, union, difference
+
+data SortedSet k = SetWrapper (Data.SortedMap.SortedMap k ())
+
+empty : SortedSet k
+empty = SetWrapper Data.SortedMap.empty
+
+insert : Ord k => k -> SortedSet k -> SortedSet k
+insert k (SetWrapper m) = SetWrapper (Data.SortedMap.insert k () m)
+
+delete : Ord k => k -> SortedSet k -> SortedSet k
+delete k (SetWrapper m) = SetWrapper (Data.SortedMap.delete k m)
+
+contains : Ord k => k -> SortedSet k -> Bool
+contains k (SetWrapper m) = isJust (Data.SortedMap.lookup k m)
+
+fromList : Ord k => List k -> SortedSet k
+fromList l = SetWrapper (Data.SortedMap.fromList (map (\i => (i, ())) l))
+
+toList : Ord k => SortedSet k -> List k
+toList (SetWrapper m) = map (\(i, _) => i) (Data.SortedMap.toList m)
diff --git a/lib/Data/Vect/Quantifiers.idr b/lib/Data/Vect/Quantifiers.idr
new file mode 100644
--- /dev/null
+++ b/lib/Data/Vect/Quantifiers.idr
@@ -0,0 +1,47 @@
+module Data.Vect.Quantifiers
+
+data Any : (P : a -> Type) -> Vect a n -> Type where
+  Here  : {P : a -> Type} -> {xs : Vect a n} -> P x -> Any P (x :: xs)
+  There : {P : a -> Type} -> {xs : Vect a n} -> Any P xs -> Any P (x :: xs)
+
+anyNilAbsurd : {P : a -> Type} -> Any P Nil -> _|_
+anyNilAbsurd Here impossible
+anyNilAbsurd There impossible
+
+anyElim : {xs : Vect a n} -> {P : a -> Type} -> (Any P xs -> b) -> (P x -> b) -> Any P (x :: xs) -> b
+anyElim _ f (Here p) = f p
+anyElim f _ (There p) = f p
+
+any : {P : a -> Type} -> ((x : a) -> Dec (P x)) -> (xs : Vect a n) -> Dec (Any P xs)
+any _ Nil = No anyNilAbsurd
+any p (x::xs) with (p x)
+  | Yes prf = Yes (Here prf)
+  | No prf =
+    case any p xs of
+      Yes prf' => Yes (There prf')
+      No prf' => No (anyElim prf' prf)
+
+data All : (P : a -> Type) -> Vect a n -> Type where
+  Nil : {P : a -> Type} -> All P Nil
+  (::) : {P : a -> Type} -> {xs : Vect a n} -> P x -> All P xs -> All P (x :: xs)
+
+negAnyAll : {P : a -> Type} -> {xs : Vect a n} -> Not (Any P xs) -> All (\x => Not (P x)) xs
+negAnyAll {xs=Nil} _ = Nil
+negAnyAll {xs=(x::xs)} f = (\x => f (Here x)) :: negAnyAll (\x => f (There x))
+
+notAllHere : {P : a -> Type} -> {xs : Vect a n} -> Not (P x) -> All P (x :: xs) -> _|_
+notAllHere _ Nil impossible
+notAllHere np (p :: _) = np p
+
+notAllThere : {P : a -> Type} -> {xs : Vect a n} -> Not (All P xs) -> All P (x :: xs) -> _|_
+notAllThere _ Nil impossible
+notAllThere np (_ :: ps) = np ps
+
+all : {P : a -> Type} -> ((x : a) -> Dec (P x)) -> (xs : Vect a n) -> Dec (All P xs)
+all _ Nil = Yes Nil
+all d (x::xs) with (d x)
+  | No prf = No (notAllHere prf)
+  | Yes prf =
+    case all d xs of
+      Yes prf' => Yes (prf :: prf')
+      No prf' => No (notAllThere prf')
diff --git a/lib/Decidable/Decidable.idr b/lib/Decidable/Decidable.idr
new file mode 100644
--- /dev/null
+++ b/lib/Decidable/Decidable.idr
@@ -0,0 +1,19 @@
+module Decidable.Decidable
+
+%access public
+
+--------------------------------------------------------------------------------
+-- Typeclass for decidable n-ary Relations
+--------------------------------------------------------------------------------
+
+using (t : Type)
+  class Rel (p : t) where
+    total liftRel : (Type -> Type) -> Type
+
+  class (Rel p) => Decidable (p : t) where
+    total decide : liftRel Dec
+
+using (P : Type, p : P)
+  data Given : Dec P -> Type where
+    always : Given (Yes p)
+
diff --git a/lib/Decidable/Equality.idr b/lib/Decidable/Equality.idr
--- a/lib/Decidable/Equality.idr
+++ b/lib/Decidable/Equality.idr
@@ -75,7 +75,7 @@
 leftNotRight refl impossible
 
 instance (DecEq a, DecEq b) => DecEq (Either a b) where
-  decEq {b=b} (Left x') (Left y') with (decEq x' y')
+  decEq (Left x') (Left y') with (decEq x' y')
     | Yes p = Yes $ cong p
     | No p = No $ \h : Left x' = Left y' => p $ leftInjective {b = b} h
   decEq (Right x') (Right y') with (decEq x' y')
diff --git a/lib/Decidable/Order.idr b/lib/Decidable/Order.idr
new file mode 100644
--- /dev/null
+++ b/lib/Decidable/Order.idr
@@ -0,0 +1,77 @@
+module Decidable.Order
+
+import Decidable.Decidable
+import Decidable.Equality
+
+--------------------------------------------------------------------------------
+-- Utility Lemmas
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- Preorders and Posets
+--------------------------------------------------------------------------------
+
+class Preorder t (po : t -> t -> Type) where
+  total transitive : (a : t) -> (b : t) -> (c : t) -> po a b -> po b c -> po a c
+  total reflexive : (a : t) -> po a a
+
+class (Preorder t po) => Poset t (po : t -> t -> Type) where
+  total antisymmetric : (a : t) -> (b : t) -> po a b -> po b a -> a = b
+
+--------------------------------------------------------------------------------
+-- Natural numbers
+--------------------------------------------------------------------------------
+
+data NatLTE : Nat -> Nat -> Type where
+  nEqn   : NatLTE n n
+  nLTESm : NatLTE n m -> NatLTE n (S m)
+
+total NatLTEIsTransitive : (m : Nat) -> (n : Nat) -> (o : Nat) ->
+                           NatLTE m n -> NatLTE n o ->
+                           NatLTE m o
+NatLTEIsTransitive m n n      mLTEn (nEqn) = mLTEn
+NatLTEIsTransitive m n (S o)  mLTEn (nLTESm nLTEo)
+  = nLTESm (NatLTEIsTransitive m n o mLTEn nLTEo)
+
+total NatLTEIsReflexive : (n : Nat) -> NatLTE n n
+NatLTEIsReflexive _ = nEqn
+
+instance Preorder Nat NatLTE where
+  transitive = NatLTEIsTransitive
+  reflexive  = NatLTEIsReflexive
+
+total NatLTEIsAntisymmetric : (m : Nat) -> (n : Nat) -> po m n -> po n m -> m = n
+NatLTEIsAntisymmetric n n nEqn nEqn = refl
+NatLTEIsAntisymmetric n m nEqn (nLTESm _) impossible
+NatLTEIsAntisymmetric n m (nLTESm _) nEqn impossible
+
+instance Poset Nat NatLTE where
+  antisymmetric = NatLTEIsAntisymmetric
+
+total zeroNeverGreater : {n : Nat} -> NatLTE (S n) O -> _|_
+zeroNeverGreater {n} (nLTESm _) impossible
+zeroNeverGreater {n}  nEqn      impossible
+
+total
+nGTSm : {n : Nat} -> {m : Nat} -> (NatLTE n m -> _|_) -> NatLTE n (S m) -> _|_
+nGTSm         disprf (nLTESm nLTEm) = FalseElim (disprf nLTEm)
+nGTSm {n} {m} disprf (nEqn) impossible
+
+total
+decideNatLTE : (n : Nat) -> (m : Nat) -> Dec (NatLTE n m)
+decideNatLTE    O      O  = Yes nEqn
+decideNatLTE (S x)     O  = No  zeroNeverGreater
+decideNatLTE    x   (S y) with (decEq x (S y))
+  | Yes eq      = rewrite eq in Yes nEqn
+  | No _ with (decideNatLTE x y)
+    | Yes nLTEm = Yes (nLTESm nLTEm)
+    | No  nGTm  = No (nGTSm nGTm)
+
+instance Rel NatLTE where
+  liftRel P = (n : Nat) -> (m : Nat) -> P (NatLTE n m)
+
+instance Decidable NatLTE where
+  decide = decideNatLTE
+
+lte : (m : Nat) -> (n : Nat) -> Dec (NatLTE m n)
+lte m n = decide {p = NatLTE} m n
diff --git a/lib/IO.idr b/lib/IO.idr
--- a/lib/IO.idr
+++ b/lib/IO.idr
@@ -21,22 +21,36 @@
 run__IO : IO () -> IO ()
 run__IO v = io_bind v (\v' => io_return v')
 
-data FTy = FInt | FFloat | FChar | FString | FPtr | FAny Type | FUnit
+data IntTy = ITNative | IT8 | IT16 | IT32 | IT64
+data FTy = FIntT IntTy | FFloat | FString | FPtr | FAny Type | FUnit
 
+FInt : FTy
+FInt = FIntT ITNative
+
+FChar : FTy
+FChar = FIntT IT8
+
+FShort : FTy
+FShort = FIntT IT16
+
+FLong : FTy
+FLong = FIntT IT64
+
 interpFTy : FTy -> Type
-interpFTy FInt     = Int
+interpFTy (FIntT ITNative) = Int
+interpFTy (FIntT IT8)  = Bits8
+interpFTy (FIntT IT16) = Bits16
+interpFTy (FIntT IT32) = Bits32
+interpFTy (FIntT IT64) = Bits64
 interpFTy FFloat   = Float
-interpFTy FChar    = Char
 interpFTy FString  = String
 interpFTy FPtr     = Ptr
 interpFTy (FAny t) = t
 interpFTy FUnit    = ()
 
 ForeignTy : (xs:List FTy) -> (t:FTy) -> Type
-ForeignTy xs t = mkForeign' (reverse xs) (IO (interpFTy t)) where 
-   mkForeign' : List FTy -> Type -> Type
-   mkForeign' Nil ty       = ty
-   mkForeign' (s :: ss) ty = mkForeign' ss (interpFTy s -> ty)
+ForeignTy Nil     rt = IO (interpFTy rt)
+ForeignTy (t::ts) rt = interpFTy t -> ForeignTy ts rt
 
 
 data Foreign : Type -> Type where
diff --git a/lib/Language/Reflection.idr b/lib/Language/Reflection.idr
--- a/lib/Language/Reflection.idr
+++ b/lib/Language/Reflection.idr
@@ -1,19 +1,176 @@
 module Language.Reflection
 
-TTName : Type
-TTName = String -- needs to capture namespaces too...
+%access public
 
-data TT = Var TTName
-        | Lam TTName TT TT
-        | Pi  TTName TT TT
-        | Let TTName TT TT TT
-        | App TTName TT TT
+data TTName = UN String
+            -- ^ User-provided name
+            | NS TTName (List String)
+            -- ^ Root, namespaces
+            | MN Int String
+            -- ^ Machine chosen names
+            | NErased
+            -- ^ Name of somethng which is never used in scope
 
+implicit
+userSuppliedName : String -> TTName
+userSuppliedName = UN
+
+data TTUExp = UVar Int
+            -- ^ universe variable
+            | UVal Int
+            -- ^ explicit universe variable
+
+-- | Primitive constants
+data Const = I Int | BI Nat | Fl Float | Ch Char | Str String
+           | IType | BIType | FlType   | ChType  | StrType
+           | B8 Bits8 | B16 Bits16 | B32 Bits32 | B64 Bits64
+           | B8Type   | B16Type    | B32Type    | B64Type
+           | PtrType | VoidType | Forgot
+
+abstract class ReflConst (a : Type) where
+   toConst : a -> Const
+
+instance ReflConst Int where
+   toConst x = I x
+
+instance ReflConst Nat where
+   toConst = BI
+
+instance ReflConst Float where
+   toConst = Fl
+
+instance ReflConst Char where
+   toConst = Ch
+
+instance ReflConst String where
+   toConst = Str
+
+instance ReflConst Bits8 where
+   toConst = B8
+
+instance ReflConst Bits16 where
+   toConst = B16
+
+instance ReflConst Bits32 where
+   toConst = B32
+
+instance ReflConst Bits64 where
+   toConst = B64
+
+implicit
+reflectConstant: (ReflConst a) => a -> Const
+reflectConstant = toConst
+
+
+-- | Types of named references
+data NameType = Bound
+              -- ^ reference which is just bound, e.g. by intro
+              | Ref
+              -- ^ reference to a variable
+              | DCon Int Int
+              -- ^ constructor with tag and number
+              | TCon Int Int
+              -- ^ type constructor with tag and number
+
+-- | Types annotations for bound variables in different
+-- binding contexts
+data Binder a = Lam a
+              | Pi a
+              | Let a a
+              | NLet a a
+              | Hole a
+              | GHole a
+              | Guess a a
+              | PVar a
+              | PVTy a
+
+
+instance Functor Binder where
+  fmap f (Lam x) = Lam (f x)
+  fmap f (Pi x) = Pi (f x)
+  fmap f (Let x y) = Let (f x) (f y)
+  fmap f (NLet x y) = NLet (f x) (f y)
+  fmap f (Hole x) = Hole (f x)
+  fmap f (GHole x) = GHole (f x)
+  fmap f (Guess x y) = Guess (f x) (f y)
+  fmap f (PVar x) = PVar (f x)
+  fmap f (PVTy x) = PVTy (f x)
+
+total
+traverse : (Applicative f) =>  (a -> f b) -> Binder a -> f (Binder b)
+traverse f (Lam x) = [| Lam (f x) |]
+traverse f (Pi x) = [| Pi (f x) |]
+traverse f (Let x y) = [| Let (f x) (f y) |]
+traverse f (NLet x y) = [| NLet (f x) (f y) |]
+traverse f (Hole x) = [| Hole (f x) |]
+traverse f (GHole x) = [| GHole (f x) |]
+traverse f (Guess x y) = [| Guess (f x) (f y) |]
+traverse f (PVar x) = [| PVar (f x) |]
+traverse f (PVTy x) = [| PVTy (f x) |]
+
+
+-- | Reflection of the well typed core language
+data TT = P NameType TTName TT
+        -- ^ named binders
+        | V Int
+        -- ^ variables
+        | Bind TTName (Binder TT) TT
+        -- ^ type annotated named bindings
+        | App TT TT
+        -- ^ (named) application of a function to a value
+        | TConst Const
+        -- ^ constants
+        | Proj TT Int
+        -- ^ argument projection; runtime only
+        | Erased
+        -- ^ erased terms
+        | Impossible
+        -- ^ impossible terms
+        | TType TTUExp
+        -- ^ types
+
+-- | Raw terms without types
+data Raw = Var TTName
+         | RBind TTName (Binder Raw) Raw
+         | RApp Raw Raw
+         | RType
+         | RForce Raw
+         | RConstant Const
+
 data Tactic = Try Tactic Tactic
-            | GoalType TTName Tactic -- only run if the goal has the right type
+            -- ^ try the first tactic and resort to the second one on failure
+            | GoalType String Tactic
+            -- ^ only run if the goal has the right type
             | Refine TTName
+            -- ^ resolve function name, find matching arguments in the
+            -- context and compute the proof target
             | Seq Tactic Tactic
+            -- ^ apply both tactics in sequence
             | Trivial
+            -- ^ intelligently construct the proof target from the context
             | Solve
-            | Exact TT -- not yet implemented
+            -- ^ infer the proof target from the context
+            | Intros
+            -- ^ introduce all variables into the context
+            | Intro TTName
+            -- ^ introduce a named variable into the context, use the
+            -- first one if the given name is not found
+            | ApplyTactic TT
+            -- ^ invoke the reflected rep. of another tactic
+            | Reflect TT
+            -- ^ turn a value into its reflected representation
+            | Fill Raw
+            -- ^ turn a raw value back into a term 
+            | Exact TT
+            -- ^ use the given value to conclude the proof
+            | Focus TTName
+            -- ^ focus a named hole
+            | Rewrite TT
+            -- ^ rewrite using the reflected rep. of a equality proof
+            | LetTac TTName TT
+            -- ^ name a reflected term
+            | LetTacTy TTName TT TT
+            -- ^ name a reflected term and type it
+            | Compute
+            -- ^ normalise the context
 
diff --git a/lib/Language/Reflection/Utils.idr b/lib/Language/Reflection/Utils.idr
new file mode 100644
--- /dev/null
+++ b/lib/Language/Reflection/Utils.idr
@@ -0,0 +1,185 @@
+module Language.Reflection.Utils
+
+--------------------------------------------------------
+-- Tactic construction conveniences
+--------------------------------------------------------
+
+seq : List Tactic -> Tactic
+seq []      = GoalType "This is an impossible case" Trivial
+seq [t]     = t
+seq (t::ts) = t `Seq` seq ts
+
+try : List Tactic -> Tactic
+try []      = GoalType "This is an impossible case" Trivial
+try [t]     = t
+try (t::ts) = t `Try` seq ts
+
+
+--------------------------------------------------------
+-- For use in tactic scripts
+--------------------------------------------------------
+mkPair : a -> b -> (a, b)
+mkPair a b = (a, b)
+
+
+--------------------------------------------------------
+-- Tools for constructing proof terms directly
+--------------------------------------------------------
+
+getUName : TTName -> Maybe String
+getUName (UN n)    = Just n
+getUName (NS n ns) = getUName n
+getUName _         = Nothing
+
+unApply : TT -> (TT, List TT)
+unApply t = unA t []
+  where unA : TT -> List TT -> (TT, List TT)
+        unA (App fn arg) args = unA fn (arg::args)
+        unA tm           args = (tm, args)
+
+mkApp : TT -> List TT -> TT
+mkApp tm []      = tm
+mkApp tm (a::as) = mkApp (App tm a) as
+
+binderTy : (Eq t) => Binder t -> t
+binderTy (Lam t)       = t
+binderTy (Pi t)        = t
+binderTy (Let t1 t2)   = t1
+binderTy (NLet t1 t2)  = t1
+binderTy (Hole t)      = t
+binderTy (GHole t)     = t
+binderTy (Guess t1 t2) = t1
+binderTy (PVar t)      = t
+binderTy (PVTy t)      = t
+
+instance Show TTName where
+  show (UN str)   = "(UN " ++ str ++ ")"
+  show (NS n ns)  = "(NS " ++ show n ++ " " ++ show ns ++ ")"
+  show (MN i str) = "(MN " ++ show i ++ " " ++ show str ++ ")"
+  show NErased    = "NErased"
+
+instance Eq TTName where
+  (UN str1)  == (UN str2)     = str1 == str2
+  (NS n ns)  == (NS n' ns')   = n == n' && ns == ns'
+  (MN i str) == (MN i' str')  = i == i' && str == str'
+  NErased    == NErased       = True
+  x          == y             = False
+
+instance Show TTUExp where
+  show (UVar i) = "(UVar " ++ show i ++ ")"
+  show (UVal i) = "(UVal " ++ show i ++ ")"
+
+instance Eq TTUExp where
+  (UVar i) == (UVar j) = i == j
+  (UVal i) == (UVal j) = i == j
+  x        == y        = False
+
+instance Show Const where
+  show (I i)      = "(I " ++ show i ++ ")"
+  show (BI n)     = "(BI " ++ show n ++ ")"
+  show (Fl f)     = "(Fl " ++ show f ++ ")"
+  show (Ch c)     = "(Ch " ++ show c ++ ")"
+  show (Str str)  = "(Str " ++ show str ++ ")"
+  show IType      = "IType"
+  show BIType     = "BIType"
+  show FlType     = "FlType"
+  show ChType     = "ChType"
+  show StrType    = "StrType"
+  show (B8 b)     = "(B8 ...)"
+  show (B16 b)    = "(B16 ...)"
+  show (B32 b)    = "(B32 ...)"
+  show (B64 b)    = "(B64 ...)"
+  show B8Type     = "B8Type"
+  show B16Type    = "B16Type"
+  show B32Type    = "B32Type"
+  show B64Type    = "B64Type"
+  show PtrType    = "PtrType"
+  show VoidType   = "VoidType"
+  show Forgot     = "Forgot"
+
+instance Eq Const where
+  (I i)     == (I i')      = i == i'
+  (BI n)    == (BI n')     = n == n'
+  (Fl f)    == (Fl f')     = f == f'
+  (Ch c)    == (Ch c')     = c == c'
+  (Str str) == (Str str')  = str == str'
+  IType     == IType       = True
+  BIType    == BIType      = True
+  FlType    == FlType      = True
+  ChType    == ChType      = True
+  StrType   == StrType     = True
+  (B8 b)    == (B8 b')     = False -- FIXME: b == b'
+  (B16 b)   == (B16 b')    = False -- FIXME: b == b'
+  (B32 b)   == (B32 b')    = False -- FIXME: b == b'
+  (B64 b)   == (B64 b')    = False -- FIXME: b == b'
+  B8Type    == B8Type      = True
+  B16Type   == B16Type     = True
+  B32Type   == B32Type     = True
+  B64Type   == B64Type     = True
+  PtrType   == PtrType     = True
+  VoidType  == VoidType    = True
+  Forgot    == Forgot      = True
+  x         == y           = False
+
+instance Show NameType where
+  show Bound = "Bound"
+  show Ref = "Ref"
+  show (DCon t ar) = "(DCon " ++ show t ++ " " ++ show ar ++ ")"
+  show (TCon t ar) = "(TCon " ++ show t ++ " " ++ show ar ++ ")"
+
+instance Eq NameType where
+  Bound       == Bound          = True
+  Ref         == Ref            = True
+  (DCon t ar) == (DCon t' ar')  = t == t' && ar == ar'
+  (TCon t ar) == (TCon t' ar')  = t == t' && ar == ar'
+  x           == y              = False
+
+instance (Show a) => Show (Binder a) where
+  show (Lam t) = "(Lam " ++ show t ++ ")"
+  show (Pi t) = "(Pi " ++ show t ++ ")"
+  show (Let t1 t2) = "(Let " ++ show t1 ++ " " ++ show t2 ++ ")"
+  show (NLet t1 t2) = "(NLet " ++ show t1 ++ " " ++ show t2 ++ ")"
+  show (Hole t) = "(Hole " ++ show t ++ ")"
+  show (GHole t) = "(GHole " ++ show t ++ ")"
+  show (Guess t1 t2) = "(Guess " ++ show t1 ++ " " ++ show t2 ++ ")"
+  show (PVar t) = "(PVar " ++ show t ++ ")"
+  show (PVTy t) = "(PVTy " ++ show t ++ ")"
+
+instance (Eq a) => Eq (Binder a) where
+  (Lam t)       == (Lam t')         = t == t'
+  (Pi t)        == (Pi t')          = t == t'
+  (Let t1 t2)   == (Let t1' t2')    = t1 == t1' && t2 == t2'
+  (NLet t1 t2)  == (NLet t1' t2')   = t1 == t1' && t2 == t2'
+  (Hole t)      == (Hole t')        = t == t'
+  (GHole t)     == (GHole t')       = t == t'
+  (Guess t1 t2) == (Guess t1' t2')  = t1 == t1' && t2 == t2'
+  (PVar t)      == (PVar t')        = t == t'
+  (PVTy t)      == (PVTy t')        = t == t'
+  x             == y                = False
+
+instance Show TT where
+  show = my_show
+    where %assert_total my_show : TT -> String
+          my_show (P nt n t) = "(P " ++ show nt ++ " " ++ show n ++ " " ++ show t ++ ")"
+          my_show (V i) = "(V " ++ show i ++ ")"
+          my_show (Bind n b t) = "(Bind " ++ show n ++ " " ++ show b ++ " " ++ show t ++ ")"
+          my_show (App t1 t2) = "(App " ++ show t1 ++ " " ++ show t2 ++ ")"
+          my_show (TConst c) = "(TConst " ++ show c ++ ")"
+          my_show (Proj tm i) = "(Proj " ++ show tm ++ " " ++ show i ++ ")"
+          my_show Erased = "Erased"
+          my_show Impossible = "Impossible"
+          my_show (TType u) = "(TType " ++ show u ++ ")"
+
+instance Eq TT where
+  a == b = equalp a b
+    where %assert_total equalp : TT -> TT -> Bool
+          equalp (P nt n t)   (P nt' n' t')    = nt == nt' && n == n' && t == t'
+          equalp (V i)        (V i')           = i == i'
+          equalp (Bind n b t) (Bind n' b' t')  = n == n' && b == b' && t == t'
+          equalp (App t1 t2)  (App t1' t2')    = t1 == t1' && t2 == t2'
+          equalp (TConst c)   (TConst c')      = c == c'
+          equalp (Proj tm i)  (Proj tm' i')    = tm == tm' && i == i'
+          equalp Erased       Erased           = True
+          equalp Impossible   Impossible       = True
+          equalp (TType u)    (TType u')       = u == u'
+          equalp x            y                = False
diff --git a/lib/Network/Cgi.idr b/lib/Network/Cgi.idr
--- a/lib/Network/Cgi.idr
+++ b/lib/Network/Cgi.idr
@@ -121,7 +121,7 @@
 runCGI : CGI a -> IO a
 runCGI prog = do 
     clen_in <- getEnv "CONTENT_LENGTH"
-    let clen = prim__strToInt clen_in
+    let clen = prim__fromStrInt clen_in
     content <- getContent clen
     query   <- getEnv "QUERY_STRING"
     cookie  <- getEnv "HTTP_COOKIE"
diff --git a/lib/Prelude.idr b/lib/Prelude.idr
--- a/lib/Prelude.idr
+++ b/lib/Prelude.idr
@@ -29,10 +29,10 @@
     show (S k) = "s" ++ show k
 
 instance Show Int where 
-    show = prim__intToStr
+    show = prim__toStrInt
 
 instance Show Integer where 
-    show = prim__bigIntToStr
+    show = prim__toStrBigInt
 
 instance Show Float where 
     show = prim__floatToStr
@@ -148,6 +148,10 @@
 %include "math.h"
 %lib "m"
 
+pow : (Num a) => a -> Nat -> a
+pow x O = 1
+pow x (S n) = x * (pow x n)
+
 exp : Float -> Float
 exp x = prim__floatExp x
 
@@ -178,6 +182,15 @@
 atan2 : Float -> Float -> Float
 atan2 y x = atan (y/x)
 
+sinh : Float -> Float
+sinh x = (exp x - exp (-x)) / 2
+
+cosh : Float -> Float
+cosh x = (exp x + exp (-x)) / 2
+
+tanh : Float -> Float
+tanh x = sinh x / cosh x
+
 sqrt : Float -> Float
 sqrt x = prim__floatSqrt x
 
@@ -189,12 +202,12 @@
 
 ---- Ranges
 
-%assert_total
+partial abstract
 count : (Ord a, Num a) => a -> a -> a -> List a
 count a inc b = if a <= b then a :: count (a + inc) inc b
                           else []
   
-partial
+partial abstract
 countFrom : (Ord a, Num a) => a -> a -> List a
 countFrom a inc = a :: lazy (countFrom (a + inc) inc)
   
@@ -242,11 +255,11 @@
 
 partial
 putChar : Char -> IO ()
-putChar c = mkForeign (FFun "putchar" [FChar] FUnit) c
+putChar c = mkForeign (FFun "putchar" [FInt] FUnit) (cast c)
 
 partial
 getChar : IO Char
-getChar = mkForeign (FFun "getchar" [] FChar)
+getChar = fmap cast $ mkForeign (FFun "getchar" [] FInt)
 
 ---- some basic file handling
 
@@ -268,7 +281,6 @@
 partial
 openFile : String -> Mode -> IO File
 openFile f m = fopen f (modeStr m) where 
-  modeStr : Mode -> String
   modeStr Read  = "r"
   modeStr Write = "w"
   modeStr ReadWrite = "r+"
@@ -315,7 +327,7 @@
 
 partial
 nullPtr : Ptr -> IO Bool
-nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p 
+nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p
                return (ok /= 0);
 
 partial
diff --git a/lib/Prelude/Cast.idr b/lib/Prelude/Cast.idr
--- a/lib/Prelude/Cast.idr
+++ b/lib/Prelude/Cast.idr
@@ -6,24 +6,24 @@
 -- String casts
 
 instance Cast String Int where
-    cast = prim__strToInt
+    cast = prim__fromStrInt
 
 instance Cast String Float where
     cast = prim__strToFloat
 
 instance Cast String Integer where
-    cast = prim__strToBigInt
+    cast = prim__fromStrBigInt
 
 -- Int casts
 
 instance Cast Int String where
-    cast = prim__intToStr
+    cast = prim__toStrInt
 
 instance Cast Int Float where
-    cast = prim__intToFloat
+    cast = prim__toFloatInt
 
 instance Cast Int Integer where
-    cast = prim__intToBigInt 
+    cast = prim__sextInt_BigInt
 
 instance Cast Int Char where
     cast = prim__intToChar
@@ -34,12 +34,12 @@
     cast = prim__floatToStr
 
 instance Cast Float Int where
-    cast = prim__floatToInt
+    cast = prim__fromFloatInt
 
 -- Integer casts
 
 instance Cast Integer String where
-    cast = prim__bigIntToStr
+    cast = prim__toStrBigInt
 
 -- Char casts
 
diff --git a/lib/Prelude/Maybe.idr b/lib/Prelude/Maybe.idr
--- a/lib/Prelude/Maybe.idr
+++ b/lib/Prelude/Maybe.idr
@@ -66,7 +66,7 @@
 -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
 -- <http://en.wikipedia.org/wiki/Monoid>: "Any semigroup S may be
 -- turned into a monoid simply by adjoining an element i not in S
--- and defining i+i = i and i+s = s = s+i for all s ∈ S."
+-- and defining i+i = i and i+s = s = s+i for all s in S."
 
 instance (Semigroup a) => Semigroup (Maybe a) where
   Nothing <+> m = m
diff --git a/lib/Prelude/Strings.idr b/lib/Prelude/Strings.idr
--- a/lib/Prelude/Strings.idr
+++ b/lib/Prelude/Strings.idr
@@ -36,7 +36,7 @@
 unpack : String -> List Char
 unpack s with (strM s)
   unpack ""             | StrNil = []
-  unpack (strCons x xs) | (StrCons _ xs) = x :: unpack xs
+  unpack (strCons x xs) | (StrCons x xs) = x :: unpack xs
 
 pack : List Char -> String
 pack [] = ""
@@ -114,4 +114,7 @@
 
 unwords : List String -> String
 unwords = pack . unwords' . map unpack
+
+length : String -> Nat
+length = fromInteger . prim_lenString
 
diff --git a/lib/Providers.idr b/lib/Providers.idr
new file mode 100644
--- /dev/null
+++ b/lib/Providers.idr
@@ -0,0 +1,5 @@
+module Providers
+
+public
+data Provider a = Provide a | Error String
+
diff --git a/lib/Uninhabited.idr b/lib/Uninhabited.idr
new file mode 100644
--- /dev/null
+++ b/lib/Uninhabited.idr
@@ -0,0 +1,12 @@
+module Uninhabited
+
+class Uninhabited t where
+  total uninhabited : t -> _|_
+
+instance Uninhabited (Fin O) where
+  uninhabited fO impossible
+  uninhabited (fS f) impossible
+
+instance Uninhabited (O = S n) where
+  uninhabited refl impossible
+
diff --git a/lib/base.ipkg b/lib/base.ipkg
--- a/lib/base.ipkg
+++ b/lib/base.ipkg
@@ -13,11 +13,19 @@
 
           System.Concurrency.Raw, System.Concurrency.Process,
 
-          Decidable.Equality,
+          Decidable.Equality, Decidable.Decidable, Decidable.Order,
 
-          Language.Reflection,
+          Uninhabited,
 
-          Data.Morphisms, Data.Bits, Data.Mod2, Data.Z, Data.Sign,
+          Providers,
+
+          Language.Reflection, Language.Reflection.Utils,
+
+          Data.Morphisms, 
+--           Data.Bits, Data.Mod2, 
+          Data.Z, Data.Sign,
+          Data.SortedMap, Data.SortedSet, Data.BoundedList,
+          Data.Vect.Quantifiers,
 
           Control.Monad.Identity, Control.Monad.State, Control.Category,
           Control.Arrow,
diff --git a/rts/Makefile b/rts/Makefile
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -1,15 +1,16 @@
 include ../config.mk
 
-OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o idris_bitstring.o
-HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h idris_bitstring.h
-CFLAGS = -O2 -Wall 
+OBJS = idris_rts.o idris_heap.o idris_gc.o idris_gmp.o idris_stdfgn.o idris_bitstring.o idris_opts.o idris_stats.o
+HDRS = idris_rts.h idris_heap.h idris_gc.h idris_gmp.h idris_stdfgn.h idris_bitstring.h idris_opts.h idris_stats.h
+CFLAGS = -O2 -Wall -fPIC
+
 ifneq ($(GMP_INCLUDE_DIR),)
-  CFLAGS += -isystem $(GMP_INCLUDE_DIR)
+	CFLAGS += -isystem $(GMP_INCLUDE_DIR)
 endif
 
 LIBTARGET = libidris_rts.a
 
-check : $(LIBTARGET)
+check : $(LIBTARGET) $(DYLIBTARGET)
 
 $(LIBTARGET) : $(OBJS)
 	ar r $(LIBTARGET) $(OBJS)
@@ -20,7 +21,7 @@
 	install $(LIBTARGET) $(HDRS) $(TARGET)
 
 clean : .PHONY
-	rm -f $(OBJS) $(LIBTARGET)
+	rm -f $(OBJS) $(LIBTARGET) $(DYLIBTARGET)
 
 idris_rts.o: idris_rts.h
 
diff --git a/rts/idris_bitstring.c b/rts/idris_bitstring.c
--- a/rts/idris_bitstring.c
+++ b/rts/idris_bitstring.c
@@ -60,6 +60,34 @@
     return MKINT((i_int)a->info.bits32);
 }
 
+VAL idris_b8const(VM *vm, uint8_t a) {
+    VAL cl = allocate(vm, sizeof(Closure), 0);
+    SETTY(cl, BITS8);
+    cl->info.bits8 = a;
+    return cl;
+}
+
+VAL idris_b16const(VM *vm, uint16_t a) {
+    VAL cl = allocate(vm, sizeof(Closure), 0);
+    SETTY(cl, BITS16);
+    cl->info.bits16 = a;
+    return cl;
+}
+
+VAL idris_b32const(VM *vm, uint32_t a) {
+    VAL cl = allocate(vm, sizeof(Closure), 0);
+    SETTY(cl, BITS32);
+    cl->info.bits32 = a;
+    return cl;
+}
+
+VAL idris_b64const(VM *vm, uint64_t a) {
+    VAL cl = allocate(vm, sizeof(Closure), 0);
+    SETTY(cl, BITS64);
+    cl->info.bits64 = a;
+    return cl;
+}
+
 VAL idris_b8Plus(VM *vm, VAL a, VAL b) {
     VAL cl = allocate(vm, sizeof(Closure), 0);
     SETTY(cl, BITS8);
diff --git a/rts/idris_bitstring.h b/rts/idris_bitstring.h
--- a/rts/idris_bitstring.h
+++ b/rts/idris_bitstring.h
@@ -11,6 +11,10 @@
 VAL idris_b32(VM *vm, VAL a);
 VAL idris_b64(VM *vm, VAL a);
 VAL idris_castB32Int(VM *vm, VAL a);
+VAL idris_b8const(VM *vm, uint8_t a);
+VAL idris_b16const(VM *vm, uint16_t a);
+VAL idris_b32const(VM *vm, uint32_t a);
+VAL idris_b64const(VM *vm, uint64_t a);
 
 VAL idris_b8Plus(VM *vm, VAL a, VAL b);
 VAL idris_b8Minus(VM *vm, VAL a, VAL b);
diff --git a/rts/idris_gc.c b/rts/idris_gc.c
--- a/rts/idris_gc.c
+++ b/rts/idris_gc.c
@@ -55,9 +55,9 @@
 void cheney(VM *vm) {
     int i;
     int ar;
-    char* scan = vm->heap;
+    char* scan = vm->heap.heap;
   
-    while(scan < vm->heap_next) {
+    while(scan < vm->heap.next) {
        size_t inc = *((size_t*)scan);
        VAL heap_item = (VAL)(scan+sizeof(size_t));
        // If it's a CON, copy its arguments
@@ -76,21 +76,22 @@
        }
        scan += inc;
     }
-    assert(scan == vm->heap_next);
+    assert(scan == vm->heap.next);
 }
 
 void idris_gc(VM* vm) {
+    HEAP_CHECK(vm)
+    STATS_ENTER_GC(vm->stats, vm->heap.size)
     // printf("Collecting\n");
 
-    char* newheap = malloc(vm -> heap_size);
-    char* oldheap = vm -> heap;
-    if (vm->oldheap != NULL) free(vm->oldheap);
-
-    vm->heap = newheap;
-    vm->heap_next = newheap;
-    vm->heap_end = newheap + vm->heap_size;
+    char* newheap = malloc(vm->heap.size);
+    char* oldheap = vm->heap.heap;
+    if (vm->heap.old != NULL) 
+        free(vm->heap.old);
 
-    vm->collections++;
+    vm->heap.heap = newheap;
+    vm->heap.next = newheap;
+    vm->heap.end  = newheap + vm->heap.size;
 
     VAL* root;
 
@@ -100,9 +101,7 @@
     for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {
         *root = copy(vm, *root);
     }
-    for(root = vm->argv; root < vm->argv + vm->argc; ++root) {
-        *root = copy(vm, *root);
-    }
+    
     vm->ret = copy(vm, vm->ret);
     vm->reg1 = copy(vm, vm->reg1);
 
@@ -111,20 +110,19 @@
     // After reallocation, if we've still more than half filled the new heap, grow the heap
     // for next time.
 
-    if ((vm->heap_next - vm->heap) > vm->heap_size >> 1) {
-        vm->heap_size += vm->heap_growth;
+    if ((vm->heap.next - vm->heap.heap) > vm->heap.size >> 1) {
+        vm->heap.size += vm->heap.growth;
     } 
-    vm->oldheap = oldheap;
+    vm->heap.old = oldheap;
     
-    // gcInfo(vm, 0);
+    STATS_LEAVE_GC(vm->stats, vm->heap.size, vm->heap.next - vm->heap.heap)
+    HEAP_CHECK(vm)
 }
 
 void idris_gcInfo(VM* vm, int doGC) {
-    printf("\nStack: %p %p\n", vm->valstack, vm->valstack_top); 
-    printf("Total allocations: %d\n", vm->allocations);
-    printf("GCs: %d\n", vm->collections);
-    printf("Final heap size %d\n", (int)(vm->heap_size));
-    printf("Final heap use %d\n", (int)(vm->heap_next - vm->heap));
+    printf("Stack: <BOT %p> <TOP %p>\n", vm->valstack, vm->valstack_top); 
+    printf("Final heap size         %d\n", (int)(vm->heap.size));
+    printf("Final heap use          %d\n", (int)(vm->heap.next - vm->heap.heap));
     if (doGC) { idris_gc(vm); }
-    printf("Final heap use after GC %d\n", (int)(vm->heap_next - vm->heap));
+    printf("Final heap use after GC %d\n", (int)(vm->heap.next - vm->heap.heap));
 }
diff --git a/rts/idris_gmp.c b/rts/idris_gmp.c
--- a/rts/idris_gmp.c
+++ b/rts/idris_gmp.c
@@ -52,6 +52,34 @@
     return cl;
 }
 
+VAL MKBIGUI(VM* vm, unsigned long val) {
+    mpz_t* bigint;
+    VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*) + 
+                          sizeof(mpz_t), 0);
+    bigint = (mpz_t*)(((char*)cl) + sizeof(ClosureType) + sizeof(void*));
+
+    mpz_init_set_ui(*bigint, val);
+
+    SETTY(cl, BIGINT);
+    cl -> info.ptr = (void*)bigint;
+
+    return cl;
+}
+
+VAL MKBIGSI(VM* vm, signed long val) {
+    mpz_t* bigint;
+    VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*) + 
+                          sizeof(mpz_t), 0);
+    bigint = (mpz_t*)(((char*)cl) + sizeof(ClosureType) + sizeof(void*));
+
+    mpz_init_set_si(*bigint, val);
+
+    SETTY(cl, BIGINT);
+    cl -> info.ptr = (void*)bigint;
+
+    return cl;
+}
+
 VAL GETBIG(VM * vm, VAL x) {
     if (ISINT(x)) {
         mpz_t* bigint;
diff --git a/rts/idris_gmp.h b/rts/idris_gmp.h
--- a/rts/idris_gmp.h
+++ b/rts/idris_gmp.h
@@ -5,6 +5,8 @@
 VAL MKBIGC(VM* vm, char* bigint);
 VAL MKBIGM(VM* vm, void* bigint);
 VAL MKBIGMc(VM* vm, void* bigint);
+VAL MKBIGUI(VM* vm, unsigned long val);
+VAL MKBIGSI(VM* vm, signed long val);
 
 VAL idris_bigPlus(VM*, VAL x, VAL y);
 VAL idris_bigMinus(VM*, VAL x, VAL y);
diff --git a/rts/idris_heap.c b/rts/idris_heap.c
new file mode 100644
--- /dev/null
+++ b/rts/idris_heap.c
@@ -0,0 +1,125 @@
+#include "idris_heap.h"
+#include "idris_rts.h"
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+
+void alloc_heap(Heap * h, size_t heap_size) 
+{
+    char * mem = malloc(heap_size); 
+    if (mem == NULL) {
+        fprintf(stderr, 
+                "RTS ERROR: Unable to allocate heap. Requested %d bytes.\n",
+                (int)heap_size);
+        exit(EXIT_FAILURE);
+    }
+
+    h->heap = mem;
+    h->next = h->heap;
+    h->end  = h->heap + heap_size;
+
+    h->size   = heap_size;
+    h->growth = heap_size;
+
+    h->old = NULL;
+}
+
+void free_heap(Heap * h) {
+    free(h->heap);
+
+    if (h->old != NULL) { 
+        free(h->old); 
+    }
+}
+
+// TODO: more testing
+/******************** Heap testing ********************************************/
+void heap_check_underflow(Heap * heap) {
+    if (!(heap->heap <= heap->next)) {
+       fprintf(stderr, "RTS ERROR: HEAP UNDERFLOW <bot %p> <cur %p>\n", 
+               heap->heap, heap->next);
+        exit(EXIT_FAILURE);
+    }
+}
+
+void heap_check_overflow(Heap * heap) {
+    if (!(heap->next <= heap->end)) {
+       fprintf(stderr, "RTS ERROR: HEAP OVERFLOW <cur %p> <end %p>\n", 
+               heap->next, heap->end);
+        exit(EXIT_FAILURE);
+    }
+}
+
+int is_valid_ref(VAL v) {
+    return (v != NULL) && !(ISINT(v));
+}
+
+int ref_in_heap(Heap * heap, VAL v) { 
+    return ((VAL)heap->heap <= v) && (v < (VAL)heap->next);
+}
+
+// Checks three important properties:
+// 1. Closure.
+//      Check if all pointers in the _heap_ points only to heap. 
+// 2. Unidirectionality. (if compact gc)
+//      All references in the heap should be are unidirectional. In other words,
+//      more recently allocated closure can point only to earlier allocated one.
+// 3. After gc there should be no forward references.
+//
+void heap_check_pointers(Heap * heap) {
+    char* scan = NULL;
+  
+    size_t item_size = 0;
+    for(scan = heap->heap; scan < heap->next; scan += item_size) {
+       item_size = *((size_t*)scan);
+       VAL heap_item = (VAL)(scan + sizeof(size_t));
+
+       switch(GETTY(heap_item)) {
+       case CON:
+           {
+             int ar = ARITY(heap_item);
+             int i = 0;
+             for(i = 0; i < ar; ++i) {
+                 VAL ptr = heap_item->info.c.args[i];
+
+                 if (is_valid_ref(ptr)) {
+                     // Check for closure.
+                     if (!ref_in_heap(heap, ptr)) {
+                         fprintf(stderr, 
+                                 "RTS ERROR: heap closure broken. "\
+                                 "<HEAP %p %p %p> <REF %p>\n",
+                                 heap->heap, heap->next, heap->end, ptr);
+                         exit(EXIT_FAILURE);
+                     }
+#if 0 // TODO macro
+                     // Check for unidirectionality.
+                     if (!(ptr < heap_item)) {
+                         fprintf(stderr, 
+                                 "RTS ERROR: heap unidirectionality broken:" \
+                                 "<CON %p> <FIELD %p>\n",
+                                 heap_item, ptr);
+                         exit(EXIT_FAILURE);
+                     }
+#endif
+                 }
+             }
+             break;
+           }
+       case FWD:
+           // Check for artifacts after cheney gc.
+           fprintf(stderr, "RTS ERROR: FWD in working heap.\n");
+           exit(EXIT_FAILURE);
+           break;
+       default:
+           break;
+       }
+    }
+}
+
+void heap_check_all(Heap * heap)
+{
+    heap_check_underflow(heap);
+    heap_check_overflow(heap);
+    heap_check_pointers(heap);
+}
diff --git a/rts/idris_heap.h b/rts/idris_heap.h
new file mode 100644
--- /dev/null
+++ b/rts/idris_heap.h
@@ -0,0 +1,29 @@
+#ifndef _IDRIS_HEAP_H
+#define _IDRIS_HEAP_H
+
+#include <stddef.h>
+
+typedef struct {
+    char*  next;   // Next allocated chunk. Should always (heap <= next < end).
+    char*  heap;   // Point to bottom of heap
+    char*  end;    // Point to top of heap
+    size_t size;   // Size of _next_ heap. Size of current heap is /end - heap/.
+    size_t growth; // Quantity of heap growth in bytes. 
+
+    char* old;
+} Heap;
+
+
+void alloc_heap(Heap * heap, size_t heap_size);
+void free_heap(Heap * heap);
+
+
+#ifdef IDRIS_DEBUG
+void heap_check_all(Heap * heap);
+// Should be used _between_ gc's.
+#define HEAP_CHECK(vm) heap_check_all(&(vm->heap));
+#else
+#define HEAP_CHECK(vm) 
+#endif // IDRIS_DEBUG
+
+#endif // _IDRIS_HEAP_H
diff --git a/rts/idris_main.c b/rts/idris_main.c
--- a/rts/idris_main.c
+++ b/rts/idris_main.c
@@ -1,9 +1,30 @@
+#include "idris_opts.h"
+#include "idris_stats.h"
+#include "idris_rts.h"
+// The default options should give satisfactory results under many circumstances.
+RTSOpts opts = { 
+    .init_heap_size = 4096000,
+    .max_stack_size = 4096000,
+    .show_summary   = 0
+};
+
 int main(int argc, char* argv[]) {
-    VM* vm = init_vm(4096000, 4096000, 1, argc, argv); // 1024000);
+    parse_shift_args(&opts, &argc, &argv);
+    
+    VM* vm = init_vm(opts.max_stack_size, opts.init_heap_size, 1, argc, argv);
     _idris__123_runMain0_125_(vm, NULL);
-    //_idris_main(vm, NULL);
-#ifdef IDRIS_TRACE
-    idris_gcInfo(vm, 1);
+
+#ifdef IDRIS_DEBUG
+    if (opts.show_summary) {
+        idris_gcInfo(vm, 1);
+    }
 #endif
-    terminate(vm);
+
+    Stats stats = terminate(vm);
+
+    if (opts.show_summary) {
+        print_stats(&stats);
+    }
+
+    return EXIT_SUCCESS;
 }
diff --git a/rts/idris_opts.c b/rts/idris_opts.c
new file mode 100644
--- /dev/null
+++ b/rts/idris_opts.c
@@ -0,0 +1,110 @@
+#include "idris_opts.h"
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+
+
+char usage[] = 
+    "\n"                                                        \
+    "Usage: <prog> [+RTS <rtsopts> -RTS] <args>\n\n"            \
+    "Options:\n\n"                                              \
+    "  -?    Print this message and exits.\n"                   \
+    "  -s    Summary GC statistics.\n"                          \
+    "  -H    Initial heap size. Egs: -H4M, -H500K, -H1G\n"      \
+    "  -K    Sets the maximum stack size. Egs: -K8M\n"          \
+    "\n";
+
+void print_usage(FILE * s) {
+    fprintf(s, usage);
+}
+
+int read_size(char * str) {
+    int size = 0;
+    char mult = ' ';
+
+    int r = sscanf(str, "%u%c", &size, &mult);
+
+    if (r == 1) 
+        return size;
+
+    if (r == 2) {
+        switch (mult) {
+        case 'K': size = size << 10; break;
+        case 'M': size = size << 20; break;
+        case 'G': size = size << 30; break;
+        default: 
+            fprintf(stderr, 
+                    "RTS Opts: Unable to recognize size suffix `%c'.\n" \
+                    "          Possible suffixes are K or M or G.\n",
+                    mult);
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+        return size;
+    }
+
+    fprintf(stderr, "RTS Opts: Unable to parse size. Egs: 1K, 10M, 2G.\n");
+    print_usage(stderr);
+    exit(EXIT_FAILURE);
+}
+
+
+int parse_args(RTSOpts * opts, int argc, char *argv[])
+{
+    if (argc == 0)
+        return 0;
+
+    if (strcmp(argv[0], "+RTS") != 0)
+        return 0;
+    
+    int i;
+    for (i = 1; i < argc; i++) {
+        if (strcmp(argv[i], "-RTS") == 0) {
+            return i + 1;
+        }
+
+        if (argv[i][0] != '-') {
+            fprintf(stderr, "RTS options should start with '-'.\n");
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+
+        switch (argv[i][1])
+        {
+        case '?':
+            print_usage(stdout);
+            exit(EXIT_SUCCESS);
+            break;
+
+        case 's':
+            opts->show_summary = 1;
+            break;
+
+        case 'H':
+            opts->init_heap_size = read_size(argv[i] + 2);
+            break;
+
+        case 'K':
+            opts->max_stack_size = read_size(argv[i] + 2);
+            break;
+
+        default:
+            printf("RTS opts: Wrong argument: %s\n", argv[i]);
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+    }
+
+    return argc;
+}
+
+void parse_shift_args(RTSOpts * opts, int * argc, char ** argv[]) {
+    size_t shift = parse_args(opts, (*argc) - 1, (*argv) + 1);
+
+    char *prg = (*argv)[0];
+    *argc = *argc - shift;
+    *argv = *argv + shift;
+    (*argv)[0] = prg;
+}
diff --git a/rts/idris_opts.h b/rts/idris_opts.h
new file mode 100644
--- /dev/null
+++ b/rts/idris_opts.h
@@ -0,0 +1,19 @@
+#ifndef _IDRIS_OPTS_H
+#define _IDRIS_OPTS_H
+
+#include <stddef.h>
+#include <stdio.h>
+
+typedef struct {
+    size_t init_heap_size;
+    size_t max_stack_size;
+    int    show_summary;
+} RTSOpts;
+
+void print_usage(FILE * s);
+
+// Parse rts options and shift arguments such that rts options becomes invisible
+// for main program.
+void parse_shift_args(RTSOpts * opts, int * argc, char ** argv[]);
+
+#endif
diff --git a/rts/idris_rts.c b/rts/idris_rts.c
--- a/rts/idris_rts.c
+++ b/rts/idris_rts.c
@@ -10,30 +10,24 @@
 #include "idris_gc.h"
 #include "idris_bitstring.h"
 
+
 VM* init_vm(int stack_size, size_t heap_size, 
             int max_threads, // not implemented yet
             int argc, char* argv[]) {
-    VAL* valstack = malloc(stack_size*sizeof(VAL));
-    int* intstack = malloc(stack_size*sizeof(int));
-    double* floatstack = malloc(stack_size*sizeof(double));
 
     VM* vm = malloc(sizeof(VM));
+    STATS_INIT_STATS(vm->stats)
+    STATS_ENTER_INIT(vm->stats)
+
+    VAL* valstack = malloc(stack_size * sizeof(VAL));
+
     vm->valstack = valstack;
     vm->valstack_top = valstack;
     vm->valstack_base = valstack;
-    vm->intstack = intstack;
-    vm->intstack_ptr = intstack;
-    vm->floatstack = floatstack;
-    vm->floatstack_ptr = floatstack;
     vm->stack_max = valstack + stack_size;
-    vm->heap = malloc(heap_size);
-    vm->oldheap = NULL;
-    vm->heap_next = vm->heap;
-    vm->heap_end = vm->heap + heap_size;
-    vm->heap_size = heap_size;
-    vm->collections = 0;
-    vm->allocations = 0;
-    vm->heap_growth = heap_size;
+
+    alloc_heap(&(vm->heap), heap_size);
+
     vm->ret = NULL;
     vm->reg1 = NULL;
 
@@ -51,34 +45,32 @@
     vm->max_threads = max_threads;
     vm->processes = 0;
 
-    int i;
-    // Assumption: there's enough space for this in the initial heap.
-    vm->argv = malloc(argc*sizeof(VAL));
+    vm->argv = argv;
     vm->argc = argc;
 
-    for(i = 0; i < argc; ++i) {
-        vm->argv[i] = MKSTR(vm, argv[i]);
-    }
-
+    STATS_LEAVE_INIT(vm->stats)
     return vm;
 }
 
-void terminate(VM* vm) {
+Stats terminate(VM* vm) {
+    Stats stats = vm->stats;
+    STATS_ENTER_EXIT(stats)
+
     free(vm->inbox);
     free(vm->valstack);
-    free(vm->intstack);
-    free(vm->floatstack);
-    free(vm->heap);
-    free(vm->argv);
-    if (vm->oldheap != NULL) { free(vm->oldheap); }
+    free_heap(&(vm->heap));
+
     pthread_mutex_destroy(&(vm -> inbox_lock));
     pthread_mutex_destroy(&(vm -> inbox_block));
     pthread_cond_destroy(&(vm -> inbox_waiting));
     free(vm);
+
+    STATS_LEAVE_EXIT(stats)
+    return stats;
 }
 
 void idris_requireAlloc(VM* vm, size_t size) {
-    if (!(vm -> heap_next + size < vm -> heap_end)) {
+    if (!(vm->heap.next + size < vm->heap.end)) {
         idris_gc(vm);
     }
 
@@ -106,12 +98,19 @@
     if ((size & 7)!=0) {
 	size = 8 + ((size >> 3) << 3);
     }
-    if (vm -> heap_next + size < vm -> heap_end) {
-        vm->allocations += size + sizeof(size_t);
-        void* ptr = (void*)(vm->heap_next + sizeof(size_t));
-        *((size_t*)(vm->heap_next)) = size + sizeof(size_t);
-        vm -> heap_next += size + sizeof(size_t);
+    
+    size_t chunk_size = size + sizeof(size_t);
+
+    if (vm->heap.next + chunk_size < vm->heap.end) {
+        STATS_ALLOC(vm->stats, chunk_size)
+        void* ptr = (void*)(vm->heap.next + sizeof(size_t));
+        *((size_t*)(vm->heap.next)) = chunk_size;
+        vm->heap.next += chunk_size;
+
+        assert(vm->heap.next <= vm->heap.end);
+
         memset(ptr, 0, size);
+
         if (lock) { // not message passing
            pthread_mutex_unlock(&vm->alloc_lock); 
         }
@@ -187,6 +186,34 @@
     return cl;
 }
 
+VAL MKB8(VM* vm, uint8_t bits8) {
+    Closure* cl = allocate(vm, sizeof(Closure), 1);
+    SETTY(cl, BITS8);
+    cl -> info.bits8 = bits8;
+    return cl;
+}
+
+VAL MKB16(VM* vm, uint16_t bits16) {
+    Closure* cl = allocate(vm, sizeof(Closure), 1);
+    SETTY(cl, BITS16);
+    cl -> info.bits16 = bits16;
+    return cl;
+}
+
+VAL MKB32(VM* vm, uint32_t bits32) {
+    Closure* cl = allocate(vm, sizeof(Closure), 1);
+    SETTY(cl, BITS32);
+    cl -> info.bits32 = bits32;
+    return cl;
+}
+
+VAL MKB64(VM* vm, uint64_t bits64) {
+    Closure* cl = allocate(vm, sizeof(Closure), 1);
+    SETTY(cl, BITS64);
+    cl -> info.bits64 = bits64;
+    return cl;
+}
+
 void PROJECT(VM* vm, VAL r, int loc, int arity) {
     int i;
     for(i = 0; i < arity; ++i) {
@@ -208,7 +235,7 @@
     for (root = vm->valstack; root < vm->valstack_top; ++root, ++i) {
         printf("%d: ", i);
         dumpVal(*root);
-        if (*root >= (VAL)(vm->heap) && *root < (VAL)(vm->heap_end)) { printf("OK"); }
+        if (*root >= (VAL)(vm->heap.heap) && *root < (VAL)(vm->heap.end)) { printf("OK"); }
         printf("\n");
     }
     printf("RET: ");
@@ -244,6 +271,22 @@
 
 }
 
+void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size) {
+    memset(((uint8_t*)ptr) + offset, c, size);
+}
+
+uint8_t idris_peek(void* ptr, i_int offset) {
+    return *(((uint8_t*)ptr) + offset);
+}
+
+void idris_poke(void* ptr, i_int offset, uint8_t data) {
+    *(((uint8_t*)ptr) + offset) = data;
+}
+
+void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size) {
+    memmove(dest + dest_offset, src + src_offset, size);
+}
+
 VAL idris_castIntStr(VM* vm, VAL i) {
     Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16, 0);
     SETTY(cl, STRING);
@@ -401,12 +444,14 @@
     callvm->processes--;
 
     free(td);
-    terminate(vm);
+
+    Stats stats = terminate(vm);
+    //    aggregate_stats(&(td->vm->stats), &stats);
     return NULL;
 }
 
 void* vmThread(VM* callvm, func f, VAL arg) {
-    VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size, 
+    VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap.size, 
                      callvm->max_threads,
                      0, NULL);
     vm->processes=1; // since it can send and receive messages
@@ -493,12 +538,12 @@
     // So: we try to copy, if a collection happens, we do the copy again
     // under the assumption there's enough space this time.
 
-    int gcs = dest->collections;
+    int gcs = dest->stats.collections;
     pthread_mutex_lock(&dest->alloc_lock); 
     VAL dmsg = copyTo(dest, msg);
     pthread_mutex_unlock(&dest->alloc_lock); 
 
-    if (dest->collections>gcs) {
+    if (dest->stats.collections > gcs) {
         // a collection will have invalidated the copy
         pthread_mutex_lock(&dest->alloc_lock); 
         dmsg = copyTo(dest, msg); // try again now there's room...
@@ -576,11 +621,10 @@
 }
 
 VAL idris_getArg(VM* vm, int i) {
-    return vm->argv[i];
+    return MKSTR(vm, vm->argv[i]);
 }
 
 void stackOverflow() {
   fprintf(stderr, "Stack overflow");
   exit(-1);
 }
-
diff --git a/rts/idris_rts.h b/rts/idris_rts.h
--- a/rts/idris_rts.h
+++ b/rts/idris_rts.h
@@ -9,6 +9,9 @@
 #include <pthread.h>
 #include <stdint.h>
 
+#include "idris_heap.h"
+#include "idris_stats.h"
+
 // Closures
 
 typedef enum {
@@ -41,18 +44,12 @@
 
 typedef struct {
     VAL* valstack;
-    int* intstack;
-    double* floatstack;
     VAL* valstack_top;
     VAL* valstack_base;
-    int* intstack_ptr;
-    double* floatstack_ptr;
-    char* heap;
-    char* oldheap;
-    char* heap_next;
-    char* heap_end;
     VAL* stack_max;
-   
+    
+    Heap heap;
+
     pthread_mutex_t inbox_lock;
     pthread_mutex_t inbox_block;
     pthread_mutex_t alloc_lock;
@@ -66,14 +63,12 @@
 
     int processes; // Number of child processes
     int max_threads; // maximum number of threads to run in parallel
+    
+    Stats stats;
 
     int argc;
-    VAL* argv; // command line arguments
+    char** argv; // command line arguments
 
-    size_t heap_size;
-    size_t heap_growth;
-    int allocations;
-    int collections;
     VAL ret;
     VAL reg1;
 } VM;
@@ -83,7 +78,7 @@
             int max_threads, 
             int argc, char* argv[]);
 // Clean up a VM once it's no longer needed
-void terminate(VM* vm);
+Stats terminate(VM* vm);
 
 // Functions all take a pointer to their VM, and previous stack base, 
 // and return nothing.
@@ -130,6 +125,7 @@
 #define ISINT(x) ((((i_int)x)&1) == 1)
 
 #define INTOP(op,x,y) MKINT((i_int)((((i_int)x)>>1) op (((i_int)y)>>1)))
+#define UINTOP(op,x,y) MKINT((i_int)((((uintptr_t)x)>>1) op (((uintptr_t)y)>>1)))
 #define FLOATOP(op,x,y) MKFLOAT(vm, ((GETFLOAT(x)) op (GETFLOAT(y))))
 #define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))
 #define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))
@@ -152,6 +148,10 @@
 VAL MKFLOAT(VM* vm, double val);
 VAL MKSTR(VM* vm, char* str);
 VAL MKPTR(VM* vm, void* ptr);
+VAL MKB8(VM* vm, uint8_t b);
+VAL MKB16(VM* vm, uint16_t b);
+VAL MKB32(VM* vm, uint32_t b);
+VAL MKB64(VM* vm, uint64_t b);
 
 // following versions don't take a lock when allocating
 VAL MKFLOATc(VM* vm, double val);
@@ -206,6 +206,12 @@
 VAL idris_castStrInt(VM* vm, VAL i);
 VAL idris_castFloatStr(VM* vm, VAL i);
 VAL idris_castStrFloat(VM* vm, VAL i);
+
+// Raw memory manipulation
+void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size);
+uint8_t idris_peek(void* ptr, i_int offset);
+void idris_poke(void* ptr, i_int offset, uint8_t data);
+void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size);
 
 // String primitives
 
diff --git a/rts/idris_stats.c b/rts/idris_stats.c
new file mode 100644
--- /dev/null
+++ b/rts/idris_stats.c
@@ -0,0 +1,68 @@
+#include "idris_stats.h"
+
+#include <stdio.h>
+#include <locale.h>
+
+#ifdef IDRIS_ENABLE_STATS
+
+void print_stats(const Stats * stats) {
+    clock_t total   = clock() - stats->start_time;
+    clock_t mut     = total - stats->init_time - stats->gc_time - stats->exit_time;
+    double  mut_sec = (double)mut   / CLOCKS_PER_SEC;
+
+    int avg_chunk = 0;
+    if (stats->alloc_count > 0) {
+        avg_chunk = (int)((double)stats->allocations / (double)stats->alloc_count);
+    }
+
+    int alloc_rate = 0;
+    if (mut > 0) {
+        alloc_rate  = (int)((double)(stats->allocations) / mut_sec);
+    }
+    
+    double gc_percent = 0.0;
+    double productivity = 0.0;
+    if (total > 0) {
+        gc_percent = 100 * (double)stats->gc_time / (double)total;
+        productivity = 100 * ((double)mut / (double)total);
+    }
+
+    setlocale(LC_NUMERIC, "");
+    printf("\n");
+    printf("%'20d bytes allocated in the heap\n",  stats->allocations);
+    printf("%'20d bytes copied during GC\n",       stats->copied);
+    printf("%'20d maximum heap size\n",            stats->max_heap_size);
+    printf("%'20d chunks allocated in the heap\n", stats->alloc_count);
+    printf("%'20d average chunk size\n\n",         avg_chunk);
+
+    printf("GC called %d times\n\n", stats->collections);
+
+    printf("INIT  time: %8.3fs\n",   (double)stats->init_time / CLOCKS_PER_SEC);
+    printf("MUT   time: %8.3fs\n",   mut_sec);
+    printf("GC    time: %8.3fs\n",   (double)stats->gc_time   / CLOCKS_PER_SEC);
+    printf("EXIT  time: %8.3fs\n",   (double)stats->exit_time / CLOCKS_PER_SEC);
+    printf("TOTAL time: %8.3fs\n\n", (double)total            / CLOCKS_PER_SEC);
+
+    printf("%%GC   time: %.2f%%\n\n", gc_percent);
+
+    printf("Alloc rate %'d bytes per MUT sec\n\n", alloc_rate);
+
+    printf("Productivity %.2f%%\n", productivity);
+}
+
+void aggregate_stats(Stats * stats1, const Stats * stats2) {
+    fprintf(stderr, "RTS error: aggregate_stats not implemented");
+}
+
+#else
+
+void print_stats(const Stats * stats) {
+    fprintf(stderr, "RTS ERROR: Stats are disabled.\n"  \
+                    "By the way GC called %d times.\n", stats->collections);
+}
+
+void aggregate_stats(Stats * stats1, const Stats * stats2) {
+    stats1->collections += stats2->collections;
+}
+
+#endif // IDRIS_ENABLE_STATS
diff --git a/rts/idris_stats.h b/rts/idris_stats.h
new file mode 100644
--- /dev/null
+++ b/rts/idris_stats.h
@@ -0,0 +1,73 @@
+#ifndef _IDRIS_STATS_H
+#define _IDRIS_STATS_H
+
+#include <time.h>
+
+// Should not be defined in release.
+#define IDRIS_ENABLE_STATS
+
+// TODO: measure user time, exclusive/inclusive stats
+typedef struct {
+#ifdef IDRIS_ENABLE_STATS
+    int allocations;       // Size of allocated space in bytes for all execution time.
+    int alloc_count;       // How many times alloc is called.
+    int copied;            // Size of space copied during GC.
+    int max_heap_size;     // Maximum heap size achieved.
+
+    clock_t init_time;     // Time spent for vm initialization.
+    clock_t exit_time;     // Time spent for vm termination.
+    clock_t gc_time;       // Time spent for gc for all execution time.
+    clock_t max_gc_pause;  // Time spent for longest gc.
+    clock_t start_time;    // Time of rts entry point.
+#endif // IDRIS_ENABLE_STATS
+    int collections;       // How many times gc called.
+} Stats; // without start time it's a monoid, can we remove start_time it somehow?
+
+void print_stats(const Stats * stats);
+void aggregate_stats(Stats * stats1, const Stats * stats2);
+
+
+#ifdef IDRIS_ENABLE_STATS
+
+#ifndef MAX
+#define MAX(a, b) ((a) > (b) ? (a) : (b))
+#endif
+
+#define STATS_INIT_STATS(stats)                 \
+    memset(&stats, 0, sizeof(Stats));           \
+    stats.start_time  = clock();                
+
+#define STATS_ALLOC(stats, size)                \
+    stats.allocations += size;                  \
+    stats.alloc_count = stats.alloc_count + 1;
+
+#define STATS_ENTER_INIT(stats) clock_t _start_time = clock();
+#define STATS_LEAVE_INIT(stats) stats.init_time = clock() - _start_time;
+
+#define STATS_ENTER_EXIT(stats) clock_t _start_time = clock();
+#define STATS_LEAVE_EXIT(stats) stats.exit_time = clock() - _start_time;
+
+#define STATS_ENTER_GC(stats, heap_size)                        \
+    clock_t _start_time = clock();                              \
+    stats.max_heap_size = MAX(stats.max_heap_size, heap_size);
+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped)          \
+    clock_t _pause = clock() - _start_time;                     \
+    stats.gc_time += _pause;                                    \
+    stats.max_gc_pause = MAX(_pause, stats.max_gc_pause);       \
+    stats.max_heap_size = MAX(stats.max_heap_size, heap_size);  \
+    stats.copied     += heap_occuped;                           \
+    stats.collections = stats.collections + 1;
+
+#else
+#define STATS_INIT_STATS(stats) memset(&stats, 0, sizeof(Stats));
+#define STATS_ENTER_INIT(stats) 
+#define STATS_LEAVE_INIT(stats) 
+#define STATS_ENTER_EXIT(stats)
+#define STATS_LEAVE_EXIT(stats)
+#define STATS_ALLOC(stats, size)
+#define STATS_ENTER_GC(stats, heap_size)
+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped)  \
+    stats.collections = stats.collections + 1;
+#endif // IDRIS_ENABLE_STATS
+
+#endif // _IDRIS_STATS_H
diff --git a/rts/idris_stdfgn.h b/rts/idris_stdfgn.h
--- a/rts/idris_stdfgn.h
+++ b/rts/idris_stdfgn.h
@@ -8,7 +8,6 @@
 
 void* fileOpen(char* f, char* mode);
 void fileClose(void* h);
-//char* freadStr(void* h);
 void fputStr(void*h, char* str);
 
 int isNull(void* ptr);
diff --git a/rts/libidris_rts.a b/rts/libidris_rts.a
Binary files a/rts/libidris_rts.a and b/rts/libidris_rts.a differ
diff --git a/src/Core/CaseTree.hs b/src/Core/CaseTree.hs
--- a/src/Core/CaseTree.hs
+++ b/src/Core/CaseTree.hs
@@ -14,11 +14,11 @@
 data CaseDef = CaseDef [Name] SC [Term]
     deriving Show
 
-data SC' t = Case Name [CaseAlt' t] -- invariant: lowest tags first
-           | ProjCase t [CaseAlt' t] -- special case for projections
+data SC' t = Case Name [CaseAlt' t] -- ^ invariant: lowest tags first
+           | ProjCase t [CaseAlt' t] -- ^ special case for projections
            | STerm t
-           | UnmatchedCase String -- error message
-           | ImpossibleCase -- already checked to be impossible
+           | UnmatchedCase String -- ^ error message
+           | ImpossibleCase -- ^ already checked to be impossible
     deriving (Eq, Ord, Functor)
 {-! 
 deriving instance Binary SC 
@@ -167,9 +167,15 @@
 
 simpleCase :: Bool -> Bool -> Phase -> FC -> [([Name], Term, Term)] -> 
               TC CaseDef
-simpleCase tc cover phase fc [] 
+simpleCase tc cover phase fc cs
+      = sc' tc cover phase fc (filter (\(_, _, r) -> 
+                                          case r of
+                                            Impossible -> False
+                                            _ -> True) cs) 
+          where
+ sc' tc cover phase fc [] 
                  = return $ CaseDef [] (UnmatchedCase "No pattern clauses") []
-simpleCase tc cover phase fc cs 
+ sc' tc cover phase fc cs 
       = let proj       = phase == RunTime
             pats       = map (\ (avs, l, r) -> 
                                    (avs, toPats tc l, (l, r))) cs
@@ -345,10 +351,13 @@
          return (newArgs, addRs rs)
   where 
     getNewVars [] = return []
-    getNewVars ((PV n) : ns) = do v <- getVar
+    getNewVars ((PV n) : ns) = do v <- getVar "e"
                                   nsv <- getNewVars ns
                                   return (v : nsv)
-    getNewVars (_ : ns) = do v <- getVar
+    getNewVars (PAny : ns) = do v <- getVar "i"
+                                nsv <- getNewVars ns
+                                return (v : nsv)
+    getNewVars (_ : ns) = do v <- getVar "e"
                              nsv <- getNewVars ns
                              return (v : nsv)
     addRs [] = []
@@ -357,8 +366,8 @@
     uniq i (UN n) = MN i n
     uniq i n = n
 
-getVar :: State CS Name
-getVar = do (t, v) <- get; put (t, v+1); return (MN v "e")
+getVar :: String -> State CS Name
+getVar b = do (t, v) <- get; put (t, v+1); return (MN v b)
 
 groupCons :: [Clause] -> State CS [Group]
 groupCons cs = gc [] cs
@@ -387,10 +396,12 @@
     do let alts' = map (repVar v) alts
        match vs alts' err
   where
-    repVar v (PV p : ps , (lhs, res)) = (ps, (lhs, subst p (P Bound v Erased) res))
+    repVar v (PV p : ps , (lhs, res)) 
+           = (ps, (lhs, subst p (P Bound v Erased) res))
     repVar v (PAny : ps , res) = (ps, res)
 
 -- fix: case e of S k -> f (S k)  ==> case e of S k -> f e
+
 depatt :: [Name] -> SC -> SC
 depatt ns tm = dp [] tm
   where
@@ -413,8 +424,9 @@
             | and ((length args == length args') :
                      (n == cn) : zipWith same args args') = P Ref x Erased
             | otherwise = applyMap ms nt cn pty args'
-          same n (P _ n' _) = n == n'
+          same n (P _ n' _) = n == n' 
           same _ _ = False
+
     applyMaps ms (App f a) = App (applyMaps ms f) (applyMaps ms a)
     applyMaps ms t = t
 
diff --git a/src/Core/CoreParser.hs b/src/Core/CoreParser.hs
--- a/src/Core/CoreParser.hs
+++ b/src/Core/CoreParser.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 
 module Core.CoreParser(parseTerm, parseFile, parseDef, pTerm, iName, 
-                       idrisLexer, maybeWithNS, pDocComment) where
+                       idrisLexer, maybeWithNS, pDocComment, opChars) where
 
 import Core.TT
 
@@ -31,7 +31,7 @@
                  = ["let", "in", "data", "codata", "record", "Type", 
                     "do", "dsl", "import", "impossible", 
                     "case", "of", "total", "partial", "mutual",
-                    "infix", "infixl", "infixr", 
+                    "infix", "infixl", "infixr", "rewrite",
                     "where", "with", "syntax", "proof", "postulate",
                     "using", "namespace", "class", "instance",
                     "public", "private", "abstract", "implicit",
@@ -39,8 +39,11 @@
                     "Bits8", "Bits16", "Bits32", "Bits64"]
            } 
 
-iOpStart = oneOf ":!#$%&*+./<=>?@\\^|-~"
-iOpLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
+-- | The characters allowed in operator names
+opChars = ":!#$%&*+./<=>?@\\^|-~"
+
+iOpStart = oneOf opChars
+iOpLetter = oneOf opChars
 --          <|> letter
 
 idrisLexer :: TokenParser a
@@ -463,7 +466,7 @@
 
     number base baseDigit
         = do{ digits <- many1 baseDigit
-            ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits
+            ; let n = foldl' (\x d -> base*x + toInteger (digitToInt d)) 0 digits
             ; seq n (return n)
             }
 
diff --git a/src/Core/Elaborate.hs b/src/Core/Elaborate.hs
--- a/src/Core/Elaborate.hs
+++ b/src/Core/Elaborate.hs
@@ -171,7 +171,7 @@
                                if isInj ctxt tm then return ()
                                 else lift $ tfail (NotInjective tm l r) 
   where isInj ctxt (P _ n _) 
-            | isConName Nothing n ctxt = True
+            | isConName n ctxt = True
         isInj ctxt (App f a) = isInj ctxt f
         isInj ctxt (Constant _) = True
         isInj ctxt (TType _) = True
@@ -210,7 +210,7 @@
 uniqueNameCtxt :: Context -> Name -> [Name] -> Elab' aux Name
 uniqueNameCtxt ctxt n hs 
     | n `elem` hs = uniqueNameCtxt ctxt (nextName n) hs
-    | [_] <- lookupTy Nothing n ctxt = uniqueNameCtxt ctxt (nextName n) hs
+    | [_] <- lookupTy n ctxt = uniqueNameCtxt ctxt (nextName n) hs
     | otherwise = return n
 
 elog :: String -> Elab' aux ()
@@ -356,7 +356,7 @@
     mkClaims _ _ _ _
             | Var n <- fn
                    = do ctxt <- get_context
-                        case lookupTy Nothing n ctxt of
+                        case lookupTy n ctxt of
                                 [] -> lift $ tfail $ NoSuchVariable n  
                                 _ -> fail $ "Too many arguments for " ++ show fn
             | otherwise = fail $ "Too many arguments for " ++ show fn
@@ -391,10 +391,13 @@
                              else
                              map fst (filter (not.snd) (zip args (map fst imps)))
        let (n, hunis) = -- trace ("AVOID UNIFY: " ++ show (fn, dont) ++ "\n" ++ show ptm) $ 
-                      unified p
+                        unified p
        let unify = -- trace ("Not done " ++ show hs) $ 
-                    dropGiven dont hunis hs
-       put (ES (p { dontunify = dont, unified = (n, unify) }, a) s prev)
+                   dropGiven dont hunis hs
+       let notunify = -- trace ("Not done " ++ show hs) $ 
+                       keepGiven dont hunis hs
+       put (ES (p { dontunify = dont, unified = (n, unify),
+                    notunified = notunify ++ notunified p }, a) s prev)
        ptm <- get_term
        g <- goal
 --        trace ("Goal " ++ show g ++ "\n" ++ show (fn,  imps, unify) ++ "\n" ++ show ptm) $ 
@@ -469,10 +472,27 @@
     mkMN n@(UN x) = MN 1000 x
     mkMN (NS n ns) = NS (mkMN n) ns
 
+-- If the goal is not a Pi-type, invent some names and make it a pi type
+checkPiGoal :: Elab' aux ()
+checkPiGoal = do g <- goal
+                 case g of
+                    Bind _ (Pi _) _ -> return ()
+                    _ -> do a <- unique_hole (MN 0 "argTy")
+                            b <- unique_hole (MN 0 "retTy")
+                            f <- unique_hole (MN 0 "f")
+                            claim a RType
+                            claim b RType
+                            claim f (RBind (MN 0 "aX") (Pi (Var a)) (Var b))
+                            movelast a
+                            movelast b
+                            fill (Var f)
+                            solve
+                            focus f
+
 simple_app :: Elab' aux () -> Elab' aux () -> Elab' aux ()
 simple_app fun arg =
-    do a <- unique_hole (MN 0 "a")
-       b <- unique_hole (MN 0 "b")
+    do a <- unique_hole (MN 0 "argTy")
+       b <- unique_hole (MN 0 "retTy")
        f <- unique_hole (MN 0 "f")
        s <- unique_hole (MN 0 "s")
        claim a RType
@@ -508,6 +528,19 @@
                   claim ty RType
                   forall n (Var ty)
 
+-- try a tactic, if it adds any unification problem, return an error
+no_errors :: Elab' aux () -> Elab' aux ()
+no_errors tac 
+   = do ps <- get_probs
+        tac
+        ps' <- get_probs
+        if (length ps' > length ps) then
+           case reverse ps' of
+                ((x,y,env,err) : _) ->
+                   let env' = map (\(x, b) -> (x, binderTy b)) env in
+                              lift $ tfail $ CantUnify False x y err env' 0
+           else return ()
+
 -- Try a tactic, if it fails, try another
 try :: Elab' aux a -> Elab' aux a -> Elab' aux a
 try t1 t2 = try' t1 t2 False
@@ -516,9 +549,9 @@
 try' t1 t2 proofSearch
           = do s <- get
                ps <- get_probs
-               case prunStateT ps t1 s of
-                    OK (v, s') -> do put s'
-                                     return v
+               case prunStateT 999999 False ps t1 s of
+                    OK ((v, _), s') -> do put s'
+                                          return v
                     Error e1 -> if recoverableErr e1 then
                                    do case runStateT t2 s of
                                          OK (v, s') -> do put s'; return v
@@ -539,42 +572,51 @@
 
 -- Try a selection of tactics. Exactly one must work, all others must fail
 tryAll :: [(Elab' aux a, String)] -> Elab' aux a
-tryAll xs = tryAll' [] (cantResolve, 0) (map fst xs)
+tryAll xs = tryAll' [] 999999 (cantResolve, 0) (map fst xs)
   where
     cantResolve :: Elab' aux a
     cantResolve = lift $ tfail $ CantResolveAlts (map snd xs) 
 
     tryAll' :: [Elab' aux a] -> -- successes
+               Int -> -- most problems
                (Elab' aux a, Int) -> -- smallest failure
                [Elab' aux a] -> -- still to try
                Elab' aux a
-    tryAll' [res] _   [] = res
-    tryAll' (_:_) _   [] = cantResolve
-    tryAll' [] (f, _) [] = f
-    tryAll' cs f (x:xs) 
+    tryAll' [res] pmax _   [] = res
+    tryAll' (_:_) pmax _   [] = cantResolve
+    tryAll' [] pmax (f, _) [] = f
+    tryAll' cs pmax f (x:xs) 
        = do s <- get
             ps <- get_probs
-            case prunStateT ps x s of
-                OK (v, s') -> tryAll' ((do put s'
-                                           return v):cs)  f xs
+            case prunStateT pmax True ps x s of
+                OK ((v, newps), s') -> 
+                    do let cs' = if (newps < pmax) 
+                                    then [do put s'; return v]
+                                    else (do put s'; return v) : cs
+                       tryAll' cs' newps f xs
                 Error err -> do put s
                                 if (score err) < 100
-                                    then tryAll' cs (better err f) xs
-                                    else tryAll' [] (better err f) xs -- give up
+                                    then tryAll' cs pmax (better err f) xs
+                                    else tryAll' [] pmax (better err f) xs -- give up
 
 
     better err (f, i) = let s = score err in
                             if (s >= i) then (lift (tfail err), s)
                                         else (f, i)
 
-prunStateT ps x s 
+prunStateT pmax zok ps x s 
       = case runStateT x s of
              OK (v, s'@(ES (p, _) _ _)) -> 
-                 if (length (problems p) > length ps)
+                 let newps = length (problems p) - length ps 
+                     newpmax = if newps < 0 then 0 else newps in
+                 if (newpmax > pmax || (not zok && newps > 0)) -- length ps == 0 && newpmax > 0))
                     then case reverse (problems p) of
                             ((_,_,_,e):_) -> Error e
-                    else OK (v, s')
+                    else OK ((v, newpmax), s')
              Error e -> Error e
+
+qshow :: Fails -> String
+qshow fs = show (map (\ (x, y, _, _) -> (x, y)) fs) 
 
 dumpprobs [] = ""
 dumpprobs ((_,_,_,e):es) = show e ++ "\n" ++ dumpprobs es
diff --git a/src/Core/Evaluate.hs b/src/Core/Evaluate.hs
--- a/src/Core/Evaluate.hs
+++ b/src/Core/Evaluate.hs
@@ -9,7 +9,7 @@
                 addDatatype, addCasedef, simplifyCasedef, addOperator,
                 lookupNames, lookupTy, lookupP, lookupDef, lookupVal, 
                 lookupTotal, lookupTyEnv, isConName, isFnName,
-                Value(..)) where
+                Value(..), Quote(..), evalState, initEval) where
 
 import Debug.Trace
 import Control.Monad.State
@@ -91,8 +91,9 @@
 simplify :: Context -> Bool -> Env -> TT Name -> TT Name
 simplify ctxt runtime env t 
    = evalState (do val <- eval False ctxt [(UN "lazy", 0),
-                                                     (UN "par", 0),
-                                                     (UN "fork", 0)] 
+                                           (UN "assert_smaller", 0),
+                                           (UN "par", 0),
+                                           (UN "fork", 0)] 
                                  (map finalEntry env) (finalise t) 
                                  [Simplify runtime]
                    quote 0 val) initEval
@@ -149,7 +150,7 @@
     ev ntimes_in stk top env (P Ref n ty) 
       | not top && hnf = liftM (VP Ref n) (ev ntimes stk top env ty)
       | (True, ntimes) <- usable simpl n ntimes_in
-         = do let val = lookupDefAcc Nothing n atRepl ctxt 
+         = do let val = lookupDefAcc n atRepl ctxt 
               case val of
                 [(Function _ tm, Public)] -> 
                        ev ntimes (n:stk) True env tm
@@ -220,7 +221,7 @@
                             _ -> return $ unload env f args
       | (True, ntimes) <- usable simpl n ntimes_in
         = traceWhen traceon (show stk) $
-          do let val = lookupDefAcc Nothing n atRepl ctxt
+          do let val = lookupDefAcc n atRepl ctxt
              case val of
                 [(CaseOp inl inr _ _ _ ns tree _ _, acc)]
                      | acc == Public -> -- unoptimised version
@@ -243,7 +244,7 @@
     apply ntimes stk top env f []     = return f
 
 --     specApply stk env f@(VP Ref n ty) args
---         = case lookupCtxt Nothing n statics of
+--         = case lookupCtxt n statics of
 --                 [as] -> if or as 
 --                           then trace (show (n, map fst (filter (\ (_, s) -> s) (zip args as)))) $ 
 --                                 return $ unload env f args
@@ -281,6 +282,7 @@
                                         Just (altmap, sc) -> evTree ntimes stk top env altmap sc
                                         _ -> return Nothing
             _ -> return Nothing
+    evTree ntimes stk top env amap ImpossibleCase = return Nothing
 
     conHeaded tm@(App _ _) 
         | (P (DCon _ _) _ _, args) <- unApply tm = True
@@ -396,7 +398,7 @@
     ev :: [HNF] -> TT Name -> Eval HNF
     ev env (P _ n ty) 
         | Just (Let t v) <- lookup n genv = ev env v
-    ev env (P Ref n ty) = case lookupDef Nothing n ctxt of
+    ev env (P Ref n ty) = case lookupDef n ctxt of
         [Function _ t]           -> ev env t
         [TyDecl nt ty]           -> return $ HP nt n ty
         [CaseOp inl _ _ _ _ [] tree _ _] ->
@@ -429,7 +431,7 @@
                                                app <- apply env sc' as
                                                wknH (-1) app
     apply env (HP Ref n ty) args
-        | [CaseOp _ _ _ _ _ ns tree _ _] <- lookupDef Nothing n ctxt
+        | [CaseOp _ _ _ _ _ ns tree _ _] <- lookupDef n ctxt
             = do c <- evCase env ns args tree
                  case c of
                     (Nothing, _, env') -> return $ unload env' (HP Ref n ty) args
@@ -524,6 +526,12 @@
     ceq ps (P xt x _) (P yt y _) 
         | x == y || (x, y) `elem` ps || (y,x) `elem` ps = return True
         | otherwise = sameDefs ps x y
+    ceq ps x (Bind n (Lam t) (App y (V 0))) = ceq ps x y
+    ceq ps (Bind n (Lam t) (App x (V 0))) y = ceq ps x y
+    ceq ps x (Bind n (Lam t) (App y (P Bound n' _)))
+        | n == n' = ceq ps x y
+    ceq ps (Bind n (Lam t) (App x (P Bound n' _))) y
+        | n == n' = ceq ps x y
     ceq ps (V x)      (V y)      = return (x == y)
     ceq ps (Bind _ xb xs) (Bind _ yb ys) 
                              = liftM2 (&&) (ceqB ps xb yb) (ceq ps xs ys)
@@ -558,7 +566,7 @@
     caseeq ps (UnmatchedCase _) (UnmatchedCase _) = return True
     caseeq ps _ _ = return False
 
-    sameDefs ps x y = case (lookupDef Nothing x ctxt, lookupDef Nothing y ctxt) of
+    sameDefs ps x y = case (lookupDef x ctxt, lookupDef y ctxt) of
                         ([Function _ xdef], [Function _ ydef])
                               -> ceq ((x,y):ps) xdef ydef
                         ([CaseOp _ _ _ _ _ _ xdef _ _],   
@@ -662,7 +670,7 @@
                   uconstraints :: [UConstraint],
                   next_tvar    :: Int,
                   definitions  :: Ctxt (Def, Accessibility, Totality) 
-                }
+                } deriving Show
 
 -- | The initial empty context
 initContext = MkContext [] 0 emptyContext
@@ -696,10 +704,10 @@
                        ctxt' = addDef n (d, Public, Unchecked) ctxt in
                        c { definitions = ctxt' }
 
-addTyDecl :: Name -> Type -> Context -> Context
-addTyDecl n ty uctxt 
+addTyDecl :: Name -> NameType -> Type -> Context -> Context
+addTyDecl n nt ty uctxt 
     = let ctxt = definitions uctxt
-          ctxt' = addDef n (TyDecl Ref ty, Public, Unchecked) ctxt in
+          ctxt' = addDef n (TyDecl nt ty, Public, Unchecked) ctxt in
           uctxt { definitions = ctxt' }
 
 addDatatype :: Datatype Name -> Context -> Context
@@ -723,7 +731,7 @@
               Type -> Context -> Context
 addCasedef n alwaysInline tcase covering asserted ps_in ps psrt ty uctxt 
     = let ctxt = definitions uctxt
-          access = case lookupDefAcc Nothing n False uctxt of
+          access = case lookupDefAcc n False uctxt of
                         [(_, acc)] -> acc
                         _ -> Public
           ctxt' = case (simpleCase tcase covering CompileTime (FC "" 0) ps, 
@@ -740,7 +748,7 @@
 simplifyCasedef :: Name -> Context -> Context
 simplifyCasedef n uctxt
    = let ctxt = definitions uctxt
-         ctxt' = case lookupCtxt Nothing n ctxt of
+         ctxt' = case lookupCtxt n ctxt of
               [(CaseOp inl inr ty [] ps args sc args' sc', acc, tot)] ->
                  ctxt -- nothing to simplify (or already done...)
               [(CaseOp inl inr ty ps_in ps args sc args' sc', acc, tot)] ->
@@ -773,40 +781,40 @@
 
 tfst (a, _, _) = a
 
-lookupNames :: Maybe [String] -> Name -> Context -> [Name]
-lookupNames root n ctxt
-                = let ns = lookupCtxtName root n (definitions ctxt) in
+lookupNames :: Name -> Context -> [Name]
+lookupNames n ctxt
+                = let ns = lookupCtxtName n (definitions ctxt) in
                       map fst ns
 
-lookupTy :: Maybe [String] -> Name -> Context -> [Type]
-lookupTy root n ctxt 
-                = do def <- lookupCtxt root n (definitions ctxt)
+lookupTy :: Name -> Context -> [Type]
+lookupTy n ctxt
+                = do def <- lookupCtxt n (definitions ctxt)
                      case tfst def of
                        (Function ty _) -> return ty
                        (TyDecl _ ty) -> return ty
                        (Operator ty _ _) -> return ty
                        (CaseOp _ _ ty _ _ _ _ _ _) -> return ty
 
-isConName :: Maybe [String] -> Name -> Context -> Bool
-isConName root n ctxt 
-     = or $ do def <- lookupCtxt root n (definitions ctxt)
+isConName :: Name -> Context -> Bool
+isConName n ctxt
+     = or $ do def <- lookupCtxt n (definitions ctxt)
                case tfst def of
                     (TyDecl (DCon _ _) _) -> return True
                     (TyDecl (TCon _ _) _) -> return True
                     _ -> return False
 
-isFnName :: Maybe [String] -> Name -> Context -> Bool
-isFnName root n ctxt 
-     = or $ do def <- lookupCtxt root n (definitions ctxt)
+isFnName :: Name -> Context -> Bool
+isFnName n ctxt
+     = or $ do def <- lookupCtxt n (definitions ctxt)
                case tfst def of
                     (Function _ _) -> return True
                     (Operator _ _ _) -> return True
                     (CaseOp _ _ _ _ _ _ _ _ _) -> return True
                     _ -> return False
 
-lookupP :: Maybe [String] -> Name -> Context -> [Term]
-lookupP root n ctxt 
-   = do def <-  lookupCtxt root n (definitions ctxt)
+lookupP :: Name -> Context -> [Term]
+lookupP n ctxt
+   = do def <-  lookupCtxt n (definitions ctxt)
         p <- case def of
           (Function ty tm, a, _) -> return (P Ref n ty, a)
           (TyDecl nt ty, a, _) -> return (P nt n ty, a)
@@ -816,22 +824,22 @@
             Hidden -> []
             _ -> return (fst p)
 
-lookupDef :: Maybe [String] -> Name -> Context -> [Def]
-lookupDef root n ctxt = map tfst $ lookupCtxt root n (definitions ctxt)
+lookupDef :: Name -> Context -> [Def]
+lookupDef n ctxt = map tfst $ lookupCtxt n (definitions ctxt)
 
-lookupDefAcc :: Maybe [String] -> Name -> Bool -> Context -> 
+lookupDefAcc :: Name -> Bool -> Context ->
                 [(Def, Accessibility)]
-lookupDefAcc root n mkpublic ctxt 
-    = map mkp $ lookupCtxt root n (definitions ctxt)
+lookupDefAcc n mkpublic ctxt
+    = map mkp $ lookupCtxt n (definitions ctxt)
   where mkp (d, a, _) = if mkpublic then (d, Public) else (d, a)
 
 lookupTotal :: Name -> Context -> [Totality]
-lookupTotal n ctxt = map mkt $ lookupCtxt Nothing n (definitions ctxt)
+lookupTotal n ctxt = map mkt $ lookupCtxt n (definitions ctxt)
   where mkt (d, a, t) = t
 
-lookupVal :: Maybe [String] -> Name -> Context -> [Value]
-lookupVal root n ctxt 
-   = do def <- lookupCtxt root n (definitions ctxt)
+lookupVal :: Name -> Context -> [Value]
+lookupVal n ctxt
+   = do def <- lookupCtxt n (definitions ctxt)
         case tfst def of
           (Function _ htm) -> return (veval ctxt [] htm)
           (TyDecl nt ty) -> return (VP nt n (veval ctxt [] ty))
diff --git a/src/Core/Execute.hs b/src/Core/Execute.hs
new file mode 100644
--- /dev/null
+++ b/src/Core/Execute.hs
@@ -0,0 +1,567 @@
+{-# LANGUAGE PatternGuards, ExistentialQuantification #-}
+module Core.Execute (execute) where
+
+import Idris.AbsSyntax
+import Idris.AbsSyntaxTree
+import IRTS.Lang( IntTy(..)
+                , intTyToConst
+                , FType(..))
+
+import Core.TT
+import Core.Evaluate
+import Core.CaseTree
+
+import Debug.Trace
+
+import Util.DynamicLinker
+import Util.System
+
+import Control.Applicative hiding (Const)
+import Control.Monad.Trans
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Error
+import Control.Monad
+import Data.Maybe
+import Data.Bits
+import qualified Data.Map as M
+
+import Foreign.LibFFI
+import Foreign.C.String
+import Foreign.Marshal.Alloc (free)
+import Foreign.Ptr
+
+import System.IO
+
+
+data Lazy = Delayed ExecEnv Context Term | Forced ExecVal deriving Show
+
+data ExecState = ExecState { exec_thunks :: M.Map Int Lazy -- ^ Thunks - the result of evaluating "lazy" or calling lazy funcs
+                           , exec_next_thunk :: Int -- ^ Ensure thunk key uniqueness
+                           , exec_implicits :: Ctxt [PArg] -- ^ Necessary info on laziness from idris monad
+                           , exec_dynamic_libs :: [DynamicLib] -- ^ Dynamic libs from idris monad
+                           }
+
+data ExecVal = EP NameType Name ExecVal
+             | EV Int
+             | EBind Name (Binder ExecVal) (ExecVal -> Exec ExecVal)
+             | EApp ExecVal ExecVal
+             | EType UExp
+             | EErased
+             | EConstant Const
+             | forall a. EPtr (Ptr a)
+             | EThunk Int
+             | EHandle Handle
+
+instance Show ExecVal where
+  show (EP _ n _)       = show n
+  show (EV i)           = "!!V" ++ show i ++ "!!"
+  show (EBind n b body) = "EBind " ++ show b ++ " <<fn>>"
+  show (EApp e1 e2)     = show e1 ++ " (" ++ show e2 ++ ")"
+  show (EType _)        = "Type"
+  show EErased          = "[__]"
+  show (EConstant c)    = show c
+  show (EPtr p)         = "<<ptr " ++ show p ++ ">>"
+  show (EThunk i)       = "<<thunk " ++ show i ++ ">>"
+  show (EHandle h)      = "<<handle " ++ show h ++ ">>"
+
+toTT :: ExecVal -> Exec Term
+toTT (EP nt n ty) = (P nt n) <$> (toTT ty)
+toTT (EV i) = return $ V i
+toTT (EBind n b body) = do body' <- body $ EP Bound n EErased
+                           b' <- fixBinder b
+                           Bind n b' <$> toTT body'
+    where fixBinder (Lam t)       = Lam   <$> toTT t
+          fixBinder (Pi t)        = Pi    <$> toTT t
+          fixBinder (Let t1 t2)   = Let   <$> toTT t1 <*> toTT t2
+          fixBinder (NLet t1 t2)  = NLet  <$> toTT t1 <*> toTT t2
+          fixBinder (Hole t)      = Hole  <$> toTT t
+          fixBinder (GHole t)     = GHole <$> toTT t
+          fixBinder (Guess t1 t2) = Guess <$> toTT t1 <*> toTT t2
+          fixBinder (PVar t)      = PVar  <$> toTT t
+          fixBinder (PVTy t)      = PVTy  <$> toTT t
+toTT (EApp e1 e2) = do e1' <- toTT e1
+                       e2' <- toTT e2
+                       return $ App e1' e2'
+toTT (EType u) = return $ TType u
+toTT EErased = return Erased
+toTT (EConstant c) = return (Constant c)
+toTT (EThunk i) = return (P (DCon 0 0) (MN i "THUNK") Erased) --(force i) >>= toTT
+toTT (EHandle _) = return Erased
+
+unApplyV :: ExecVal -> (ExecVal, [ExecVal])
+unApplyV tm = ua [] tm
+    where ua args (EApp f a) = ua (a:args) f
+          ua args t = (t, args)
+
+mkEApp :: ExecVal -> [ExecVal] -> ExecVal
+mkEApp f [] = f
+mkEApp f (a:args) = mkEApp (EApp f a) args
+
+initState :: Idris ExecState
+initState = do ist <- getIState
+               return $ ExecState M.empty 0 (idris_implicits ist) (idris_dynamic_libs ist)
+
+type Exec = ErrorT String (StateT ExecState IO)
+
+runExec :: Exec a -> ExecState -> IO (Either String a)
+runExec ex st = fst <$> runStateT (runErrorT ex) st
+
+getExecState :: Exec ExecState
+getExecState = lift get
+
+putExecState :: ExecState -> Exec ()
+putExecState = lift . put
+
+execFail :: String -> Exec a
+execFail = throwError
+
+execIO :: IO a -> Exec a
+execIO = lift . lift
+
+delay :: ExecEnv -> Context -> Term -> Exec ExecVal
+delay env ctxt tm =
+    do st <- getExecState
+       let i = exec_next_thunk st
+       putExecState $ st { exec_thunks = M.insert i (Delayed env ctxt tm) (exec_thunks st)
+                         , exec_next_thunk = exec_next_thunk st + 1
+                         }
+       return $ EThunk i
+
+force :: Int -> Exec ExecVal
+force i = do st <- getExecState
+             case M.lookup i (exec_thunks st) of
+               Just (Delayed env ctxt tm) -> do tm' <- doExec env ctxt tm
+                                                case tm' of
+                                                  EThunk i ->
+                                                      do res <- force i
+                                                         update res i
+                                                         return res
+                                                  _ -> do update tm' i
+                                                          return tm'
+               Just (Forced tm) -> return tm
+               Nothing -> execFail "Tried to exec non-existing thunk. This is a bug!"
+    where update :: ExecVal -> Int -> Exec ()
+          update tm i = do est <- getExecState
+                           putExecState $ est { exec_thunks = M.insert i (Forced tm) (exec_thunks est) }
+
+tryForce :: ExecVal -> Exec ExecVal
+tryForce (EThunk i) = force i
+tryForce tm = return tm
+
+debugThunks :: Exec ()
+debugThunks = do st <- getExecState
+                 execIO $ putStrLn (take 4000 (show (exec_thunks st)))
+
+execute :: Term -> Idris Term
+execute tm = do est <- initState
+                ctxt <- getContext
+                res <- lift $ flip runExec est $ do res <- doExec [] ctxt tm
+                                                    toTT res
+                case res of
+                  Left err -> fail err
+                  Right tm' -> return tm'
+
+ioWrap :: ExecVal -> ExecVal
+ioWrap tm = mkEApp (EP (DCon 0 2) (UN "prim__IO") EErased) [EErased, tm]
+
+ioUnit :: ExecVal
+ioUnit = ioWrap (EP Ref unitCon EErased)
+
+type ExecEnv = [(Name, ExecVal)]
+
+doExec :: ExecEnv -> Context -> Term -> Exec ExecVal
+doExec env ctxt p@(P Ref n ty) | Just v <- lookup n env = return v
+doExec env ctxt p@(P Ref n ty) =
+    do let val = lookupDef n ctxt
+       case val of
+         [Function _ tm] -> doExec env ctxt tm
+         [TyDecl _ _] -> return (EP Ref n EErased) -- abstract def
+         [Operator tp arity op] -> return (EP Ref n EErased) -- will be special-cased later
+         [CaseOp _ _ _ _ _ [] (STerm tm) _ _] -> -- nullary fun
+             doExec env ctxt tm
+         [CaseOp _ _ _ _ _ ns sc _ _] -> return (EP Ref n EErased)
+         [] -> execFail $ "Could not find " ++ show n ++ " in definitions."
+         thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined
+doExec env ctxt p@(P Bound n ty) =
+  case lookup n env of
+    Nothing -> execFail "not found"
+    Just tm -> return tm
+doExec env ctxt (P (DCon a b) n _) = return (EP (DCon a b) n EErased)
+doExec env ctxt (P (TCon a b) n _) = return (EP (TCon a b) n EErased)
+doExec env ctxt v@(V i) | i < length env = return (snd (env !! i))
+                        | otherwise      = execFail "env too small"
+doExec env ctxt (Bind n (Let t v) body) = do v' <- doExec env ctxt v
+                                             doExec ((n, v'):env) ctxt body
+doExec env ctxt (Bind n (NLet t v) body) = trace "NLet" $ undefined
+doExec env ctxt tm@(Bind n b body) = return $
+                                     EBind n (fmap (\_->EErased) b)
+                                           (\arg -> doExec ((n, arg):env) ctxt body)
+doExec env ctxt a@(App _ _) = execApp env ctxt (unApply a)
+doExec env ctxt (Constant c) = return (EConstant c)
+doExec env ctxt (Proj tm i) = let (x, xs) = unApply tm in
+                              doExec env ctxt ((x:xs) !! i)
+doExec env ctxt Erased = return EErased
+doExec env ctxt Impossible = fail "Tried to execute an impossible case"
+doExec env ctxt (TType u) = return (EType u)
+
+execApp :: ExecEnv -> Context -> (Term, [Term]) -> Exec ExecVal
+execApp env ctxt (f, args) = do newF <- doExec env ctxt f
+                                laziness <- (++ repeat False) <$> (getLaziness newF)
+                                newArgs <- mapM argExec (zip args laziness)
+                                execApp' env ctxt newF newArgs
+    where getLaziness (EP _ (UN "lazy") _) = return [False, True]
+          getLaziness (EP _ n _) = do est <- getExecState
+                                      let argInfo = exec_implicits est
+                                      case lookupCtxtName n argInfo of
+                                        [] -> return (repeat False)
+                                        [ps] -> return $ map lazyarg (snd ps)
+                                        many -> execFail $ "Ambiguous " ++ show n ++ ", found " ++ (take 200 $ show many)
+          getLaziness _ = return (repeat False) -- ok due to zip above
+          argExec :: (Term, Bool) -> Exec ExecVal
+          argExec (tm, False) = doExec env ctxt tm
+          argExec (tm, True) = delay env ctxt tm
+
+
+execApp' :: ExecEnv -> Context -> ExecVal -> [ExecVal] -> Exec ExecVal
+execApp' env ctxt v [] = return v -- no args is just a constant! can result from function calls
+execApp' env ctxt (EP _ (UN "unsafePerformIO") _) (ty:action:rest) | (prim__IO, [_, v]) <- unApplyV action =
+    execApp' env ctxt v rest
+
+execApp' env ctxt (EP _ (UN "io_bind") _) args@(_:_:v:k:rest) | (prim__IO, [_, v']) <- unApplyV v =
+    do v'' <- tryForce v'
+       res <- execApp' env ctxt k [v''] >>= tryForce
+       execApp' env ctxt res rest
+execApp' env ctxt con@(EP _ (UN "io_return") _) args@(tp:v:rest) =
+    do v' <- tryForce v
+       execApp' env ctxt (mkEApp con [tp, v']) rest
+
+-- Special cases arising from not having access to the C RTS in the interpreter
+execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:EConstant (Str arg):rest)
+    | Just (FFun "putStr" _ _) <- foreignFromTT fn = do execIO (putStr arg)
+                                                        execApp' env ctxt ioUnit rest
+execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:EConstant (Str f):EConstant (Str mode):rest)
+    | Just (FFun "fileOpen" _ _) <- foreignFromTT fn = do m <- case mode of
+                                                                 "r" -> return ReadMode
+                                                                 "w" -> return WriteMode
+                                                                 "a" -> return AppendMode
+                                                                 "rw" -> return ReadWriteMode
+                                                                 "wr" -> return ReadWriteMode
+                                                                 "r+" -> return ReadWriteMode
+                                                                 _ -> execFail ("Invalid mode for " ++ f ++ ": " ++ mode)
+                                                          h <- execIO $ openFile f m
+                                                          execApp' env ctxt (ioWrap (EHandle h)) rest
+
+execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:(EHandle h):rest)
+    | Just (FFun "fileEOF" _ _) <- foreignFromTT fn = do eofp <- execIO $ hIsEOF h
+                                                         let res = ioWrap (EConstant (I $ if eofp then 1 else 0))
+                                                         execApp' env ctxt res rest
+
+execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:(EHandle h):rest)
+    | Just (FFun "fileClose" _ _) <- foreignFromTT fn = do execIO $ hClose h
+                                                           execApp' env ctxt ioUnit rest
+
+execApp' env ctxt (EP _ (UN "mkForeign") _) (_:fn:(EPtr p):rest)
+    | Just (FFun "isNull" _ _) <- foreignFromTT fn = let res = ioWrap . EConstant . I $
+                                                               if p == nullPtr then 1 else 0
+                                                     in execApp' env ctxt res rest
+
+execApp' env ctxt f@(EP _ (UN "mkForeign") _) args@(ty:fn:xs) | Just (FFun f argTs retT) <- foreignFromTT fn
+                                                              , length xs >= length argTs =
+    do res <- stepForeign (ty:fn:take (length argTs) xs)
+       case res of
+         Nothing -> fail $ "Could not call foreign function \"" ++ f ++
+                           "\" with args " ++ show (take (length argTs) xs)
+         Just r -> return (mkEApp r (drop (length argTs) xs))
+                                                             | otherwise = return (mkEApp f args)
+
+execApp' env ctxt f@(EP _ n _) args =
+    do let val = lookupDef n ctxt
+       case val of
+         [Function _ tm] -> fail "should already have been eval'd"
+         [TyDecl nt ty] -> return $ mkEApp f args
+         [Operator tp arity op] ->
+             if length args >= arity
+               then do args' <- mapM tryForce $ take arity args
+                       case getOp n args' of
+                         Just res -> do r <- res
+                                        execApp' env ctxt r (drop arity args)
+                         Nothing -> return (mkEApp f args)
+               else return (mkEApp f args)
+         [CaseOp _ _ _ _ _ [] (STerm tm) _ _] -> -- nullary fun
+             do rhs <- doExec env ctxt tm
+                execApp' env ctxt rhs args
+         [CaseOp _ _ _ _ _  ns sc _ _] ->
+             do res <- execCase env ctxt ns sc args
+                return $ fromMaybe (mkEApp f args) res
+         thing -> return $ mkEApp f args
+    where getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)
+          getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 + i2)
+          getOp (UN "prim__andInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 .&. i2)
+          getOp (UN "prim__charToInt") [EConstant (Ch c)] =
+              primRes I (fromEnum c)
+          getOp (UN "prim__complInt") [EConstant (I i)] =
+              primRes I (complement i)
+          getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =
+              primRes Str (s1 ++ s2)
+          getOp (UN "prim__divInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 `div` i2)
+          getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =
+              primResBool (c1 == c2)
+          getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =
+              primResBool (i1 == i2)
+          getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =
+              primResBool (s1 == s2)
+          getOp (UN "prim__gtChar") [EConstant (Ch i1), EConstant (Ch i2)] =
+              primResBool (i1 > i2)
+          getOp (UN "prim__gteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
+              primResBool (i1 >= i2)
+          getOp (UN "prim__gtInt") [EConstant (I i1), EConstant (I i2)] =
+              primResBool (i1 > i2)
+          getOp (UN "prim__gteInt") [EConstant (I i1), EConstant (I i2)] =
+              primResBool (i1 >= i2)
+          getOp (UN "prim__intToFloat") [EConstant (I i)] =
+              primRes Fl (fromRational (toRational i))
+          getOp (UN "prim__intToStr") [EConstant (I i)] =
+              primRes Str (show i)
+          getOp (UN "prim_lenString") [EConstant (Str s)] =
+              primRes I (length s)
+          getOp (UN "prim__ltChar") [EConstant (Ch i1), EConstant (Ch i2)] =
+              primResBool (i1 < i2)
+          getOp (UN "prim__lteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
+              primResBool (i1 <= i2)
+          getOp (UN "prim__lteInt") [EConstant (I i1), EConstant (I i2)] =
+              primResBool (i1 <= i2)
+          getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =
+              primResBool (i1 < i2)
+          getOp (UN "prim__modInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 `mod` i2)
+          getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =
+              primRes BI (i1 * i2)
+          getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
+              primRes Fl (i1 * i2)
+          getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 * i2)
+          getOp (UN "prim__orInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 .|. i2)
+          getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =
+              Just $ do line <- execIO getLine
+                        return (EConstant (Str line))
+          getOp (UN "prim__readString") [EHandle h] =
+              Just $ do contents <- execIO $ hGetLine h
+                        return (EConstant (Str contents))
+          getOp (UN "prim__shLInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (shiftL i1 i2)
+          getOp (UN "prim__shRInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (shiftR i1 i2)
+          getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =
+              primRes Str (c:s)
+          getOp (UN "prim__strHead") [EConstant (Str (c:s))] =
+              primRes Ch c
+          getOp (UN "prim__strRev") [EConstant (Str s)] =
+              primRes Str (reverse s)
+          getOp (UN "prim__strTail") [EConstant (Str (c:s))] =
+              primRes Str s
+          getOp (UN "prim__subFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
+              primRes Fl (i1 - i2)
+          getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 - i2)
+          getOp (UN "prim__xorInt") [EConstant (I i1), EConstant (I i2)] =
+              primRes I (i1 `xor` i2)
+          getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing
+
+          primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)
+          primRes constr = Just . return . EConstant . constr
+
+          primResBool :: Bool -> Maybe (Exec ExecVal)
+          primResBool b = primRes I (if b then 1 else 0)
+
+execApp' env ctxt bnd@(EBind n b body) (arg:args) = do ret <- body arg
+                                                       let (f', as) = unApplyV ret
+                                                       execApp' env ctxt f' (as ++ args)
+execApp' env ctxt (EThunk i) args = do f <- force i
+                                       execApp' env ctxt f args
+execApp' env ctxt app@(EApp _ _) args2 | (f, args1) <- unApplyV app = execApp' env ctxt f (args1 ++ args2)
+execApp' env ctxt f args = return (mkEApp f args)
+
+
+
+
+
+-- | Overall wrapper for case tree execution. If there are enough arguments, it takes them,
+-- evaluates them, then begins the checks for matching cases.
+execCase :: ExecEnv -> Context -> [Name] -> SC -> [ExecVal] -> Exec (Maybe ExecVal)
+execCase env ctxt ns sc args =
+    let arity = length ns in
+    if arity <= length args
+    then do let amap = zip ns args
+--            trace ("Case " ++ show sc ++ "\n   in " ++ show amap ++"\n   in env " ++ show env ++ "\n\n" ) $ return ()
+            caseRes <- execCase' env ctxt amap sc
+            case caseRes of
+              Just res -> Just <$> execApp' (map (\(n, tm) -> (n, tm)) amap ++ env) ctxt res (drop arity args)
+              Nothing -> return Nothing
+    else return Nothing
+
+-- | Take bindings and a case tree and examines them, executing the matching case if possible.
+execCase' :: ExecEnv -> Context -> [(Name, ExecVal)] -> SC -> Exec (Maybe ExecVal)
+execCase' env ctxt amap (UnmatchedCase _) = return Nothing
+execCase' env ctxt amap (STerm tm) =
+    Just <$> doExec (map (\(n, v) -> (n, v)) amap ++ env) ctxt tm
+execCase' env ctxt amap (Case n alts) | Just tm <- lookup n amap =
+    do tm' <- tryForce tm
+       case chooseAlt tm' alts of
+         Just (newCase, newBindings) ->
+             let amap' = newBindings ++ (filter (\(x,_) -> not (elem x (map fst newBindings))) amap) in
+             execCase' env ctxt amap' newCase
+         Nothing -> return Nothing
+
+chooseAlt :: ExecVal -> [CaseAlt] -> Maybe (SC, [(Name, ExecVal)])
+chooseAlt _ (DefaultCase sc : alts) = Just (sc, [])
+chooseAlt (EConstant c) (ConstCase c' sc : alts) | c == c' = Just (sc, [])
+chooseAlt tm (ConCase n i ns sc : alts) | ((EP _ cn _), args) <- unApplyV tm
+                                        , cn == n = Just (sc, zip ns args)
+                                        | otherwise = chooseAlt tm alts
+chooseAlt tm (_:alts) = chooseAlt tm alts
+chooseAlt _ [] = Nothing
+
+
+
+
+idrisType :: FType -> ExecVal
+idrisType FUnit = EP Ref unitTy EErased
+idrisType ft = EConstant (idr ft)
+    where idr (FInt ty) = intTyToConst ty
+          idr FDouble = FlType
+          idr FChar = ChType
+          idr FString = StrType
+          idr FPtr = PtrType
+
+data Foreign = FFun String [FType] FType deriving Show
+
+
+call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)
+call (FFun name argTypes retType) args =
+    do fn <- findForeign name
+       case fn of
+         Nothing -> return Nothing
+         Just f -> do res <- call' f args retType
+                      return . Just . ioWrap $ res
+    where call' :: ForeignFun -> [ExecVal] -> FType -> Exec ExecVal
+          call' (Fun _ h) args (FInt ITNative) = do res <- execIO $ callFFI h retCInt (prepArgs args)
+                                                    return (EConstant (I (fromIntegral res)))
+          call' (Fun _ h) args (FInt IT8) = do res <- execIO $ callFFI h retCChar (prepArgs args)
+                                               return (EConstant (B8 (fromIntegral res)))
+          call' (Fun _ h) args (FInt IT16) = do res <- execIO $ callFFI h retCWchar (prepArgs args)
+                                                return (EConstant (B16 (fromIntegral res)))
+          call' (Fun _ h) args (FInt IT32) = do res <- execIO $ callFFI h retCInt (prepArgs args)
+                                                return (EConstant (B32 (fromIntegral res)))
+          call' (Fun _ h) args (FInt IT64) = do res <- execIO $ callFFI h retCLong (prepArgs args)
+                                                return (EConstant (B64 (fromIntegral res)))
+          call' (Fun _ h) args FDouble = do res <- execIO $ callFFI h retCDouble (prepArgs args)
+                                            return (EConstant (Fl (realToFrac res)))
+          call' (Fun _ h) args FChar = do res <- execIO $ callFFI h retCChar (prepArgs args)
+                                          return (EConstant (Ch (castCCharToChar res)))
+          call' (Fun _ h) args FString = do res <- execIO $ callFFI h retCString (prepArgs args)
+                                            hStr <- execIO $ peekCString res
+--                                            lift $ free res
+                                            return (EConstant (Str hStr))
+
+          call' (Fun _ h) args FPtr = do res <- execIO $ callFFI h (retPtr retVoid) (prepArgs args)
+                                         return (EPtr res)
+          call' (Fun _ h) args FUnit = do res <- execIO $ callFFI h retVoid (prepArgs args)
+                                          return (EP Ref unitCon EErased)
+--          call' (Fun _ h) args other = fail ("Unsupported foreign return type " ++ show other)
+
+
+          prepArgs = map prepArg
+          prepArg (EConstant (I i)) = argCInt (fromIntegral i)
+          prepArg (EConstant (B8 i)) = argCChar (fromIntegral i)
+          prepArg (EConstant (B16 i)) = argCWchar (fromIntegral i)
+          prepArg (EConstant (B32 i)) = argCInt (fromIntegral i)
+          prepArg (EConstant (B64 i)) = argCLong (fromIntegral i)
+          prepArg (EConstant (Fl f)) = argCDouble (realToFrac f)
+          prepArg (EConstant (Ch c)) = argCChar (castCharToCChar c) -- FIXME - castCharToCChar only safe for first 256 chars
+          prepArg (EConstant (Str s)) = argString s
+          prepArg (EPtr p) = argPtr p
+          prepArg other = trace ("Could not use " ++ take 100 (show other) ++ " as FFI arg.") undefined
+
+
+
+foreignFromTT :: ExecVal -> Maybe Foreign
+foreignFromTT t = case (unApplyV t) of
+                    (_, [(EConstant (Str name)), args, ret]) ->
+                        do argTy <- unEList args
+                           argFTy <- sequence $ map getFTy argTy
+                           retFTy <- getFTy ret
+                           return $ FFun name argFTy retFTy
+                    _ -> trace "failed to construct ffun" Nothing
+
+getFTy :: ExecVal -> Maybe FType
+getFTy (EApp (EP _ (UN "FIntT") _) (EP _ (UN intTy) _)) =
+    case intTy of
+      "ITNative" -> Just $ FInt ITNative
+      "IT8" -> Just $ FInt IT8
+      "IT16" -> Just $ FInt IT16
+      "IT32" -> Just $ FInt IT32
+      "IT64" -> Just $ FInt IT64
+      _ -> Nothing
+getFTy (EP _ (UN t) _) =
+    case t of
+      "FFloat"  -> Just FDouble
+      "FChar"   -> Just FChar
+      "FString" -> Just FString
+      "FPtr"    -> Just FPtr
+      "FUnit"   -> Just FUnit
+      _         -> Nothing
+getFTy _ = Nothing
+
+unList :: Term -> Maybe [Term]
+unList tm = case unApply tm of
+              (nil, [_]) -> Just []
+              (cons, ([_, x, xs])) ->
+                  do rest <- unList xs
+                     return $ x:rest
+              (f, args) -> Nothing
+
+unEList :: ExecVal -> Maybe [ExecVal]
+unEList tm = case unApplyV tm of
+               (nil, [_]) -> Just []
+               (cons, ([_, x, xs])) ->
+                   do rest <- unEList xs
+                      return $ x:rest
+               (f, args) -> Nothing
+
+
+toConst :: Term -> Maybe Const
+toConst (Constant c) = Just c
+toConst _ = Nothing
+
+stepForeign :: [ExecVal] -> Exec (Maybe ExecVal)
+stepForeign (ty:fn:args) = do let ffun = foreignFromTT fn
+                              f' <- case (call <$> ffun) of
+                                      Just f -> f args
+                                      Nothing -> return Nothing
+                              return f'
+stepForeign _ = fail "Tried to call foreign function that wasn't mkForeign"
+
+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
+mapMaybeM f [] = return []
+mapMaybeM f (x:xs) = do rest <- mapMaybeM f xs
+                        x' <- f x
+                        case x' of
+                          Just x'' -> return (x'':rest)
+                          Nothing -> return rest
+
+findForeign :: String -> Exec (Maybe ForeignFun)
+findForeign fn = do est <- getExecState
+                    let libs = exec_dynamic_libs est
+                    fns <- mapMaybeM getFn libs
+                    case fns of
+                      [f] -> return (Just f)
+                      [] -> do execIO . putStrLn $ "Symbol \"" ++ fn ++ "\" not found"
+                               return Nothing
+                      fs -> do execIO . putStrLn $ "Symbol \"" ++ fn ++ "\" is ambiguous. Found " ++
+                                                   show (length fs) ++ " occurrences."
+                               return Nothing
+    where getFn lib = execIO $ catchIO (tryLoadFn fn lib) (\_ -> return Nothing)
diff --git a/src/Core/ProofShell.hs b/src/Core/ProofShell.hs
--- a/src/Core/ProofShell.hs
+++ b/src/Core/ProofShell.hs
@@ -41,7 +41,7 @@
                 (state, show nf ++ " : " ++ show ty)
          err -> (state, show err)
 processCommand (Print n) state =
-    case lookupDef Nothing n (ctxt state) of
+    case lookupDef n (ctxt state) of
          [tm] -> (state, show tm)
          _ -> (state, "No such name")
 processCommand (Tac e)  state 
diff --git a/src/Core/ProofState.hs b/src/Core/ProofState.hs
--- a/src/Core/ProofState.hs
+++ b/src/Core/ProofState.hs
@@ -5,7 +5,8 @@
    evaluation/checking inside the proof system, etc. --}
 
 module Core.ProofState(ProofState(..), newProof, envAtFocus, goalAtFocus,
-                  Tactic(..), Goal(..), processTactic, dropGiven) where
+                  Tactic(..), Goal(..), processTactic, 
+                  dropGiven, keepGiven) where
 
 import Core.Typecheck
 import Core.Evaluate
@@ -27,6 +28,7 @@
                        ptype    :: Type,   -- original goal
                        dontunify :: [Name], -- explicitly given by programmer, leave it
                        unified  :: (Name, [(Name, Term)]),
+                       notunified :: [(Name, Term)],
                        solved   :: Maybe (Name, Term),
                        problems :: Fails,
                        injective :: [Name], 
@@ -78,8 +80,8 @@
 -- Some utilites on proof and tactic states
 
 instance Show ProofState where
-    show (PS nm [] _ _ tm _ _ _ _ _ _ _ _ _ _ _ _) = show nm ++ ": no more goals"
-    show (PS nm (h:hs) _ _ tm _ _ _ _ _ _ i _ _ ctxt _ _) 
+    show (PS nm [] _ _ tm _ _ _ _ _ _ _ _ _ _ _ _ _) = show nm ++ ": no more goals"
+    show (PS nm (h:hs) _ _ tm _ _ _ _ _ _ _ i _ _ ctxt _ _) 
           = let OK g = goal (Just h) tm
                 wkenv = premises g in
                 "Other goals: " ++ show hs ++ "\n" ++
@@ -102,12 +104,12 @@
                showG ps b = showEnv ps (binderTy b)
 
 instance Pretty ProofState where
-  pretty (PS nm [] _ _ trm _ _ _ _ _ _ _ _ _ _ _ _) =
+  pretty (PS nm [] _ _ trm _ _ _ _ _ _ _ _ _ _ _ _ _) =
     if size nm > breakingSize then
       pretty nm <> colon $$ nest nestingSize (text " no more goals.")
     else
       pretty nm <> colon <+> text " no more goals."
-  pretty p@(PS nm (h:hs) _ _ tm _ _ _ _ _ _ i _ _ ctxt _ _) =
+  pretty p@(PS nm (h:hs) _ _ tm _ _ _ _ _ _ _ i _ _ ctxt _ _) =
     let OK g  = goal (Just h) tm in
     let wkEnv = premises g in
       text "Other goals" <+> colon <+> pretty hs $$
@@ -155,10 +157,15 @@
 unify' :: Context -> Env -> TT Name -> TT Name -> StateT TState TC [(Name, TT Name)]
 unify' ctxt env topx topy = 
    do ps <- get
-      (u, fails) <- lift $ unify ctxt env topx topy (injective ps) (holes ps)
---       trace ("Unified " ++ show (topx, topy) ++ show (injective ps) ++ 
---              " " ++ show u ++ "\n" ++ qshow fails ++ "\nCurrent problems:\n"
---              ++ qshow (problems ps) ++ "\n" ++ show (holes ps)) $
+      let dont = dontunify ps
+      (u, fails) <- -- trace ("Trying " ++ show (topx, topy)) $ 
+                     lift $ unify ctxt env topx topy dont (holes ps)
+--       trace ("Unified " ++ show (topx, topy) ++ " without " ++ show dont ++
+-- --              " in " ++ show env ++ 
+--              "\n" ++ show u ++ "\n" ++ qshow fails ++ "\nCurrent problems:\n"
+--              ++ qshow (problems ps) ++ "\n" ++ show (holes ps) ++ "\n"
+--              ++ show (pterm ps) 
+--              ++ "\n----------") $
       case fails of
 --            [] -> return u
            err -> 
@@ -189,7 +196,7 @@
 newProof n ctxt ty = let h = holeName 0 
                          ty' = vToP ty in
                          PS n [h] [] 1 (Bind h (Hole ty') 
-                            (P Bound h ty')) ty [] (h, []) 
+                            (P Bound h ty')) ty [] (h, []) []
                             Nothing [] []
                             [] []
                             Nothing ctxt "" False
@@ -353,9 +360,8 @@
 -- As exact, but attempts to solve other goals by unification
 
 fill :: Raw -> RunTactic
-fill guess ctxt env (Bind x (Hole ty) sc) =
+fill guess ctxt env (Bind x (Hole ty) sc) = 
     do (val, valty) <- lift $ check ctxt env guess
-       s <- get
 --        let valtyn = normalise ctxt env valty
 --        let tyn = normalise ctxt env ty
        ns <- unify' ctxt env valty ty
@@ -383,10 +389,19 @@
        return $ Bind x (Guess ty val) sc
 complete_fill ctxt env t = fail $ "Can't complete fill at " ++ show t
 
+-- When solving something in the 'dont unify' set, we should check
+-- that the guess we are solving it with unifies with the thing unification
+-- found for it, if anything.
+
 solve :: RunTactic
 solve ctxt env (Bind x (Guess ty val) sc)
    | True         = do ps <- get
                        let (uh, uns) = unified ps
+                       case lookup x (notunified ps) of
+                           Just tm -> do -- trace ("AVOIDED " ++ show (x, tm, val)) $ 
+                                         -- return []
+                                         unify' ctxt env tm val
+                           _ -> return []
                        action (\ps -> ps { holes = holes ps \\ [x],
                                            solved = Just (x, val),
 --                                            problems = solveInProblems 
@@ -396,9 +411,9 @@
                                            instances = instances ps \\ [x] })
                        return $ {- Bind x (Let ty val) sc -} 
                                    instantiate val (pToV x sc)
-   | otherwise    = do ps <- get
-                       lift $ tfail $ IncompleteTerm val
-solve _ _ h = do ps <- get
+   | otherwise    = lift $ tfail $ IncompleteTerm val
+solve _ _ h@(Bind x t sc) 
+            = do ps <- get
                  fail $ "Not a guess " ++ show h ++ "\n" ++ show (holes ps, pterm ps)
 
 introTy :: Raw -> Maybe Name -> RunTactic
@@ -418,7 +433,7 @@
                                      let (uh, uns) = unified ps
 --                                      put (ps { unified = (uh, uns ++ ns) })
                                      return $ Bind n (Lam tyv) (Bind x (Hole t') (P Bound x t'))
-           _ -> fail "Nothing to introduce"
+           _ -> lift $ tfail $ CantIntroduce t'
 introTy ty n ctxt env _ = fail "Can't introduce here."
 
 intro :: Maybe Name -> RunTactic
@@ -433,14 +448,13 @@
            Bind y (Pi s) t -> -- trace ("in type " ++ show t') $
                let t' = instantiate (P Bound n s) (pToV y t) in 
                    return $ Bind n (Lam s) (Bind x (Hole t') (P Bound x t'))
-           _ -> fail "Nothing to introduce"
+           _ -> lift $ tfail $ CantIntroduce t'
 intro n ctxt env _ = fail "Can't introduce here."
 
 forall :: Name -> Raw -> RunTactic
 forall n ty ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' =
     do (tyv, tyt) <- lift $ check ctxt env ty
-       lift $ isType ctxt env tyt
-       lift $ isType ctxt env t
+       unify' ctxt env tyt (TType (UVar 0)) 
        return $ Bind n (Pi tyv) (Bind x (Hole t) (P Bound x t))
 forall n ty ctxt env _ = fail "Can't pi bind here"
 
@@ -562,6 +576,15 @@
 -- dropGiven du (u@(_, P a n ty) : us) | n `elem` du = dropGiven du us
 dropGiven du (u : us) hs = u : dropGiven du us hs
 
+keepGiven du [] hs = []
+keepGiven du ((n, P Bound t ty) : us) hs
+   | n `elem` du && not (t `elem` du)
+     && n `elem` hs && t `elem` hs
+            = keepGiven du us hs
+keepGiven du (u@(n, _) : us) hs 
+   | n `elem` du = u : keepGiven du us hs
+keepGiven du (u : us) hs = keepGiven du us hs
+
 updateSolved xs x = -- trace ("Updating " ++ show xs ++ " in " ++ show x) $ 
                       updateSolved' xs x
 updateSolved' xs (Bind n (Hole ty) t)
@@ -615,7 +638,7 @@
           ns' = map (\ (n, t) -> (n, updateSolved ns t)) ns 
           (ns'', probs') = updateProblems (context ps) ns' (problems ps)
                                           (injective ps) (holes ps)
-          tm' = -- trace ("Updating " ++ show ns' ++ "\n" ++ show ns'') $ --  ++ " in " ++ show (pterm ps)) $
+          tm' = -- trace ("Updating " ++ show ns_in ++ "\n" ++ show ns'') $ --  ++ " in " ++ show (pterm ps)) $
                   updateSolved ns'' (pterm ps) in
           return (ps { pterm = tm', 
                        unified = (h, []),
diff --git a/src/Core/TT.hs b/src/Core/TT.hs
--- a/src/Core/TT.hs
+++ b/src/Core/TT.hs
@@ -57,6 +57,8 @@
               -- unification succeed
          | InfiniteUnify Name Term [(Name, Type)]
          | CantConvert Term Term [(Name, Type)]
+         | NonFunctionType Term Term
+         | CantIntroduce Term
          | NoSuchVariable Name
          | NoTypeDecl Name
          | NotInjective Term Term Term
@@ -69,7 +71,9 @@
          | NonCollapsiblePostulate Name
          | AlreadyDefined Name
          | ProofSearchFail Err
+         | NoRewriting Term
          | At FC Err
+         | ProviderError String
   deriving Eq
 
 instance Sized Err where
@@ -82,11 +86,13 @@
   size (NoTypeDecl name) = size name
   size (NotInjective l c r) = size l + size c + size r
   size (CantResolve trm) = size trm
+  size (NoRewriting trm) = size trm
   size (CantResolveAlts _) = 1
   size (IncompleteTerm trm) = size trm
   size UniverseError = 1
   size ProgramLineComment = 1
   size (At fc err) = size fc + size err
+  size (ProviderError msg) = length msg
   size _ = 1
 
 score :: Err -> Int
@@ -102,6 +108,7 @@
     show (CantUnify _ l r e sc i) = "CantUnify " ++ show l ++ " " ++ show r ++ " "
                                       ++ show e ++ " in " ++ show sc ++ " " ++ show i
     show (Inaccessible n) = show n ++ " is not an accessible pattern variable"
+    show (ProviderError msg) = "Type provider error: " ++ msg
     show _ = "Error"
 
 instance Pretty Err where
@@ -114,6 +121,7 @@
     else
       text "Cannot unify" <+> colon <+> pretty l <+> text "and" <+> pretty r $$
         nest nestingSize (text "where" <+> pretty e <+> text "with" <+> (text . show $ i))
+  pretty (ProviderError msg) = text msg
   pretty _ = text "Error"
 
 data TC a = OK a
@@ -236,8 +244,8 @@
 
 -}
 
-lookupCtxtName :: Maybe [String] -> Name -> Ctxt a -> [(Name, a)]
-lookupCtxtName nspace n ctxt = case Map.lookup (nsroot n) ctxt of
+lookupCtxtName :: Name -> Ctxt a -> [(Name, a)]
+lookupCtxtName n ctxt = case Map.lookup (nsroot n) ctxt of
                                   Just xs -> filterNS (Map.toList xs)
                                   Nothing -> []
   where
@@ -250,12 +258,12 @@
     nsmatch (NS _ _)  _         = False
     nsmatch looking   found     = True
 
-lookupCtxt :: Maybe [String] -> Name -> Ctxt a -> [a]
-lookupCtxt ns n ctxt = map snd (lookupCtxtName ns n ctxt)
+lookupCtxt :: Name -> Ctxt a -> [a]
+lookupCtxt n ctxt = map snd (lookupCtxtName n ctxt)
 
 updateDef :: Name -> (a -> a) -> Ctxt a -> Ctxt a
 updateDef n f ctxt 
-  = let ds = lookupCtxtName Nothing n ctxt in
+  = let ds = lookupCtxtName n ctxt in
         foldr (\ (n, t) c -> addDef n (f t) c) ctxt ds  
 
 toAlist :: Ctxt a -> [(Name, a)]
@@ -422,7 +430,10 @@
 
 type UCs = (Int, [UConstraint])
 
-data NameType = Bound | Ref | DCon Int Int | TCon Int Int
+data NameType = Bound
+              | Ref
+              | DCon Int Int -- ^ Data constructor; Ints are tag and arity
+              | TCon Int Int -- ^ Type constructor; Ints are tag and arity
   deriving (Show, Ord)
 {-! 
 deriving instance Binary NameType 
diff --git a/src/Core/Typecheck.hs b/src/Core/Typecheck.hs
--- a/src/Core/Typecheck.hs
+++ b/src/Core/Typecheck.hs
@@ -60,7 +60,7 @@
 check' holes ctxt env top = chk env top where
   chk env (Var n)
       | Just (i, ty) <- lookupTyEnv n env = return (P Bound n ty, ty)
-      | (P nt n' ty : _) <- lookupP Nothing n ctxt = return (P nt n' ty, ty)
+      | (P nt n' ty : _) <- lookupP n ctxt = return (P nt n' ty, ty)
       | otherwise = do lift $ tfail $ NoSuchVariable n
   chk env (RApp f a)
       = do (fv, fty) <- chk env f
@@ -81,7 +81,7 @@
                     let apty = simplify initContext False env 
                                         (Bind x (Let aty av) t)
                     return (App fv av, apty)
-             t -> fail "Can't apply a non-function type"
+             t -> lift $ tfail $ NonFunctionType fv fty -- "Can't apply a non-function type"
     -- This rather unpleasant hack is needed because during incomplete 
     -- proofs, variables are locally bound with an explicit name. If we just 
     -- make sure bound names in function types are locally unique, machine
@@ -227,7 +227,7 @@
 checkProgram ctxt ((n, RConst t) : xs) 
    = do (t', tt') <- trace (show n) $ check ctxt [] t
         isType ctxt [] tt'
-        checkProgram (addTyDecl n t' ctxt) xs
+        checkProgram (addTyDecl n Ref t' ctxt) xs
 checkProgram ctxt ((n, RFunction (RawFun ty val)) : xs)
    = do (ty', tyt') <- trace (show n) $ check ctxt [] ty
         (val', valt') <- check ctxt [] val
diff --git a/src/Core/Unify.hs b/src/Core/Unify.hs
--- a/src/Core/Unify.hs
+++ b/src/Core/Unify.hs
@@ -29,7 +29,7 @@
 
 unify :: Context -> Env -> TT Name -> TT Name -> [Name] -> [Name] ->
          TC ([(Name, TT Name)], Fails)
-unify ctxt env topx topy injtc holes =
+unify ctxt env topx topy dont holes =
 --      trace ("Unifying " ++ show (topx, topy)) $
              -- don't bother if topx and topy are different at the head
       case runStateT (un False [] topx topy) (UI 0 []) of
@@ -54,8 +54,9 @@
 
     injective (P (DCon _ _) _ _) = True
     injective (P (TCon _ _) _ _) = True
-    injective (P _ n _)          = n `elem` injtc
-    injective (App f a)          = injective f
+    injective (App f (P _ _ _))  = injective f 
+    injective (App f (Constant _))  = injective f 
+    injective (App f a)          = injective f -- && injective a
     injective _                  = False
 
     notP (P _ _ _) = False
@@ -94,12 +95,16 @@
                 = unifyFail topx topy
     un' fn names topx@(P (TCon _ _) x _) topy@(P (DCon _ _) y _)
                 = unifyFail topx topy
+    un' fn names topx@(Constant _) topy@(P (TCon _ _) y _)
+                = unifyFail topx topy
+    un' fn names topx@(P (TCon _ _) x _) topy@(Constant _)
+                = unifyFail topx topy
     un' fn bnames tx@(P _ x _) ty@(P _ y _)  
         | (x,y) `elem` bnames || x == y = do sc 1; return []
         | injective tx && not (holeIn env y || y `elem` holes)
-             = unifyFail tx ty
+             = unifyTmpFail tx ty
         | injective ty && not (holeIn env x || x `elem` holes)
-             = unifyFail tx ty
+             = unifyTmpFail tx ty
     un' fn bnames xtm@(P _ x _) tm
         | holeIn env x || x `elem` holes
                        = do UI s f <- get
@@ -128,10 +133,9 @@
         | fst (bnames!!i) == x || snd (bnames!!i) == x = do sc 1; return []
 
     un' fn bnames appx@(App fx ax) appy@(App fy ay)
-      |    injective fx && metavarApp appy 
-        || injective fy && metavarApp appx 
-        || injective fx && injective fy  
-        || fx == fy
+      |    (injective fx && sameArgStruct appx appy && metavarApp appy)
+        || (injective fy && sameArgStruct appx appy && metavarApp appx)
+        || (injective fx && injective fy)
          = do let (headx, _) = unApply fx
               let (heady, _) = unApply fy
               -- fail quickly if the heads are disjoint
@@ -153,17 +157,21 @@
                     hf <- un' False bnames fx' fy'
                     sc 1
                     combine bnames hf ha)
-       | otherwise 
-          = do let (headx, argsx) = unApply appx
+       | otherwise = 
+            do let (headx, argsx) = unApply appx
                let (heady, argsy) = unApply appy
+               -- traceWhen (headx == heady) (show (appx, appy)) $
                if (length argsx == length argsy && 
-                   ((headx == heady) || (argsx == argsy) ||
-                    (notFn headx && notFn heady))) then
+                   ((headx == heady && inenv headx) || (argsx == argsy) ||
+                    (and (zipWith sameStruct (headx:argsx) (heady:argsy)))))
+                      then
+--                     (notFn headx && notFn heady))) then
                  do uf <- un' True bnames headx heady
                     unArgs uf argsx argsy
-                 else unifyTmpFail appx appy
+                 else -- trace ("TMPFAIL " ++ show (appx, appy, injective appx, injective appy)) $ 
+                        unifyTmpFail appx appy
       where hnormalise [] _ _ t = t
-            hnormalise ns ctxt env t = hnf ctxt env t
+            hnormalise ns ctxt env t = normalise ctxt env t
             checkHeads (P (DCon _ _) x _) (P (DCon _ _) y _)
                 | x /= y = unifyFail appx appy
             checkHeads (P (TCon _ _) x _) (P (TCon _ _) y _)
@@ -183,10 +191,39 @@
                      unArgs vs xs ys
 
             metavarApp tm = let (f, args) = unApply tm in
-                                all (\x -> metavar x || notFn x) (f : args)
+                                all (\x -> metavar x || inenv x) (f : args)
+            metavarArgs tm = let (f, args) = unApply tm in
+                                 all (\x -> metavar x || inenv x) args
+            metavarApp' tm = let (f, args) = unApply tm in
+                                 all (\x -> pat x || metavar x) (f : args)
+
+            sameArgStruct appx appy = let (_, ax) = unApply appx
+                                          (_, ay) = unApply appy in
+                                          and (zipWith sameStruct ax ay)
+
+            sameStruct fapp@(App f x) gapp@(App g y) 
+                = let (f',a') = unApply fapp
+                      (g',b') = unApply gapp in
+                      (f' == g' && length a' == length b' &&
+                          (injective f' || injective g'))
+                        || (sameStruct f g && sameStruct x y)
+            sameStruct (P _ x _) (P _ y _) = True
+            sameStruct (V i) (V j) = i == j
+            sameStruct (Constant x) (Constant y) = True
+            sameStruct (P _ _ _) (Constant y) = True
+            sameStruct (Constant x) (P _ _ _) = True
+            sameStruct (Bind n t sc) (P _ _ _) = True
+            sameStruct (P _ _ _) (Bind n t sc) = True
+            sameStruct (Bind n t sc) (Bind n' t' sc') = sameStruct sc sc'
+            sameStruct _ _ = False
+
             metavar t = case t of
-                             P _ x _ -> x `elem` holes || holeIn env x
+                             P _ x _ -> (x `elem` holes || holeIn env x) &&
+                                        not (x `elem` dont)
                              _ -> False
+            pat t = case t of
+                         P _ x _ -> x `elem` holes || patIn env x
+                         _ -> False
             inenv t = case t of
                            P _ x _ -> x `elem` (map fst env) 
                            _ -> False
@@ -197,6 +234,10 @@
         | n == n' = un' False bnames x y
     un' fn bnames (Bind n (Lam t) (App x (P Bound n' _))) y
         | n == n' = un' False bnames x y
+    un' fn bnames x (Bind n (Lam t) (App y (V 0)))
+        = un' False bnames x y
+    un' fn bnames (Bind n (Lam t) (App x (V 0))) y
+        = un' False bnames x y
 --     un' fn bnames (Bind x (PVar _) sx) (Bind y (PVar _) sy) 
 --         = un' False ((x,y):bnames) sx sy
 --     un' fn bnames (Bind x (PVTy _) sx) (Bind y (PVTy _) sy) 
@@ -285,8 +326,14 @@
     recoverable (P (TCon _ _) x _) (P (TCon _ _) y _)
         | x == y = True
         | otherwise = False
+    recoverable (Constant _) (P (DCon _ _) y _) = False
+    recoverable (P (DCon _ _) x _) (Constant _) = False
+    recoverable (Constant _) (P (TCon _ _) y _) = False
+    recoverable (P (TCon _ _) x _) (Constant _) = False
     recoverable (P (DCon _ _) x _) (P (TCon _ _) y _) = False
     recoverable (P (TCon _ _) x _) (P (DCon _ _) y _) = False
+    recoverable p@(Constant _) (App f a) = recoverable p f
+    recoverable (App f a) p@(Constant _) = recoverable f p
     recoverable p@(P _ n _) (App f a) = recoverable p f
 --     recoverable (App f a) p@(P _ _ _) = recoverable f p
     recoverable (App f a) (App f' a')
@@ -298,5 +345,12 @@
 holeIn :: Env -> Name -> Bool
 holeIn env n = case lookup n env of
                     Just (Hole _) -> True
+                    Just (Guess _ _) -> True
+                    _ -> False
+
+patIn :: Env -> Name -> Bool
+patIn env n = case lookup n env of
+                    Just (PVar _) -> True
+                    Just (PVTy _) -> True
                     _ -> False
 
diff --git a/src/IRTS/CodegenC.hs b/src/IRTS/CodegenC.hs
--- a/src/IRTS/CodegenC.hs
+++ b/src/IRTS/CodegenC.hs
@@ -10,6 +10,7 @@
 import Util.System
 
 import Data.Char
+import Data.List (intercalate)
 import System.Process
 import System.Exit
 import System.IO
@@ -47,7 +48,7 @@
              incFlags <- getIncFlags
              let gcc = comp ++ " " ++
                        gccDbg dbg ++
-                       " -I. " ++ objs ++ " -x c " ++ 
+                       " -I. " ++ objs ++ " -x c " ++
                        (if (exec == Executable) then "" else " -c ") ++
                        " " ++ tmpn ++
                        " " ++ libFlags ++
@@ -105,6 +106,10 @@
     mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"
     mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"
     mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"
+    mkConst (B8  x) = "idris_b8const(vm, "  ++ show x ++ ")"
+    mkConst (B16 x) = "idris_b16const(vm, " ++ show x ++ ")"
+    mkConst (B32 x) = "idris_b32const(vm, " ++ show x ++ ")"
+    mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ ")"
     mkConst _ = "MKINT(42424242)"
 bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
 bcc i (MKCON l tag args)
@@ -222,7 +227,10 @@
 bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0); exit(-1);"
 -- bcc i _ = indent i ++ "// not done yet\n"
 
-c_irts FInt l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
+
+
+c_irts (FInt ITNative) l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
+c_irts (FInt ty) l x = l ++ "idris_b" ++ show (intTyWidth ty) ++ "const(vm, " ++ x ++ ")"
 c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
 c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"
 c_irts FUnit l x = x
@@ -230,7 +238,8 @@
 c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"
 c_irts FAny l x = l ++ x
 
-irts_c FInt x = "GETINT(" ++ x ++ ")"
+irts_c (FInt ITNative) x = "GETINT(" ++ x ++ ")"
+irts_c (FInt ty) x = "(" ++ x ++ "->info.bits" ++ show (intTyWidth ty) ++ ")"
 irts_c FChar x = "GETINT(" ++ x ++ ")"
 irts_c FString x = "GETSTR(" ++ x ++ ")"
 irts_c FUnit x = x
@@ -238,23 +247,34 @@
 irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"
 irts_c FAny x = x
 
-doOp v LPlus [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LMinus [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LTimes [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LDiv [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LMod [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LAnd [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LOr [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LXOr [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LSHL [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LSHR [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LCompl [x] = v ++ "INTOP(~," ++ creg x ++ ")"
-doOp v LEq [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LLt [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LLe [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LGt [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LGe [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
+bitOp v op ty args = v ++ "idris_b" ++ show (intTyWidth ty) ++ op ++ "(vm, " ++ intercalate ", " (map creg args) ++ ")"
 
+bitCoerce v op input output arg
+    = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"
+
+signedTy :: IntTy -> String
+signedTy t = "int" ++ show (intTyWidth t) ++ "_t"
+
+doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LUDiv ITNative) [l, r] = v ++ "UINTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LSDiv ITNative) [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LURem ITNative) [l, r] = v ++ "UINTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LSRem ITNative) [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LAnd ITNative) [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LOr ITNative) [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LXOr ITNative) [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LSHL ITNative) [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LLSHR ITNative) [l, r] = v ++ "UINTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LASHR ITNative) [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LCompl ITNative) [x] = v ++ "INTOP(~," ++ creg x ++ ")"
+doOp v (LEq ITNative) [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LLt ITNative) [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LLe ITNative) [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LGt ITNative) [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LGe ITNative) [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
+
 doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LFTimes [l, r] = v ++ "FLOATOP(*," ++ creg l ++ ", " ++ creg r ++ ")"
@@ -265,31 +285,30 @@
 doOp v LFGt [l, r] = v ++ "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LFGe [l, r] = v ++ "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
 
-doOp v LBPlus [l, r] = v ++ "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBMinus [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBDec [l] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", MKINT(1))"
-doOp v LBTimes [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBDiv [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBMod [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBEq [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBLt [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBLe [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBGt [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
-doOp v LBGe [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LPlus ITBig) [l, r] = v ++ "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LMinus ITBig) [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LTimes ITBig) [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LSDiv ITBig) [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LSRem ITBig) [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LEq ITBig) [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LLt ITBig) [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LLe ITBig) [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LGt ITBig) [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
+doOp v (LGe ITBig) [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
 
 doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LStrEq [l,r] = v ++ "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
 doOp v LStrLen [x] = v ++ "idris_strlen(vm, " ++ creg x ++ ")"
 
-doOp v LIntFloat [x] = v ++ "idris_castIntFloat(" ++ creg x ++ ")"
-doOp v LFloatInt [x] = v ++ "idris_castFloatInt(" ++ creg x ++ ")"
-doOp v LIntStr [x] = v ++ "idris_castIntStr(vm, " ++ creg x ++ ")"
-doOp v LStrInt [x] = v ++ "idris_castStrInt(vm, " ++ creg x ++ ")"
-doOp v LIntBig [x] = v ++ "idris_castIntBig(vm, " ++ creg x ++ ")"
-doOp v LBigInt [x] = v ++ "idris_castBigInt(vm, " ++ creg x ++ ")"
-doOp v LStrBig [x] = v ++ "idris_castStrBig(vm, " ++ creg x ++ ")"
-doOp v LBigStr [x] = v ++ "idris_castBigStr(vm, " ++ creg x ++ ")"
+doOp v (LIntFloat ITNative) [x] = v ++ "idris_castIntFloat(" ++ creg x ++ ")"
+doOp v (LFloatInt ITNative) [x] = v ++ "idris_castFloatInt(" ++ creg x ++ ")"
+doOp v (LSExt ITNative ITBig) [x] = v ++ "idris_castIntBig(vm, " ++ creg x ++ ")"
+doOp v (LTrunc ITBig ITNative) [x] = v ++ "idris_castBigInt(vm, " ++ creg x ++ ")"
+doOp v (LStrInt ITBig) [x] = v ++ "idris_castStrBig(vm, " ++ creg x ++ ")"
+doOp v (LIntStr ITBig) [x] = v ++ "idris_castBigStr(vm, " ++ creg x ++ ")"
+doOp v (LIntStr ITNative) [x] = v ++ "idris_castIntStr(vm, " ++ creg x ++ ")"
+doOp v (LStrInt ITNative) [x] = v ++ "idris_castStrInt(vm, " ++ creg x ++ ")"
 doOp v LFloatStr [x] = v ++ "idris_castFloatStr(vm, " ++ creg x ++ ")"
 doOp v LStrFloat [x] = v ++ "idris_castStrFloat(vm, " ++ creg x ++ ")"
 
@@ -297,143 +316,43 @@
 doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"
 doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"
 
-doOp v LIntB8 [x] = v ++ "idris_b8(vm, " ++ creg x ++ ")"
-doOp v LIntB16 [x] = v ++ "idris_b16(vm, " ++ creg x ++ ")"
-doOp v LIntB32 [x] = v ++ "idris_b32(vm, " ++ creg x ++ ")"
-doOp v LIntB64 [x] = v ++ "idris_b64(vm, " ++ creg x ++ ")"
-
-doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"
-
-doOp v LB8Lt [x, y] = v ++ "idris_b8Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Lte [x, y] = v ++ "idris_b8Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Eq [x, y] = v ++ "idris_b8Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Gte [x, y] = v ++ "idris_b8Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Gt [x, y] = v ++ "idris_b8Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB8Shl [x, y] = v ++ "idris_b8Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8LShr [x, y] = v ++ "idris_b8Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8AShr [x, y] = v ++ "idris_b8AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8And [x, y] = v ++ "idris_b8And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Or [x, y] = v ++ "idris_b8Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Xor [x, y] = v ++ "idris_b8Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Compl [x] = v ++ "idris_b8Compl(vm, " ++ creg x ++ ")"
-
-doOp v LB8Plus [x, y] = v ++ "idris_b8Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Minus [x, y] = v ++ "idris_b8Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8Times [x, y] = v ++ "idris_b8Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8UDiv [x, y] = v ++ "idris_b8UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8SDiv [x, y] = v ++ "idris_b8SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8URem [x, y] = v ++ "idris_b8URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB8SRem [x, y] = v ++ "idris_b8SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB8Z16 [x] = v ++ "idris_b8Z16(vm, " ++ creg x ++ ")"
-doOp v LB8Z32 [x] = v ++ "idris_b8Z32(vm, " ++ creg x ++ ")"
-doOp v LB8Z64 [x] = v ++ "idris_b8Z64(vm, " ++ creg x ++ ")"
-doOp v LB8S16 [x] = v ++ "idris_b8S16(vm, " ++ creg x ++ ")"
-doOp v LB8S32 [x] = v ++ "idris_b8S32(vm, " ++ creg x ++ ")"
-doOp v LB8S64 [x] = v ++ "idris_b8S64(vm, " ++ creg x ++ ")"
-
-doOp v LB16Lt [x, y] = v ++ "idris_b16Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Lte [x, y] = v ++ "idris_b16Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Eq [x, y] = v ++ "idris_b16Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Gte [x, y] = v ++ "idris_b16Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Gt [x, y] = v ++ "idris_b16Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB16Shl [x, y] = v ++ "idris_b16Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16LShr [x, y] = v ++ "idris_b16Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16AShr [x, y] = v ++ "idris_b16AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16And [x, y] = v ++ "idris_b16And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Or [x, y] = v ++ "idris_b16Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Xor [x, y] = v ++ "idris_b16Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Compl [x] = v ++ "idris_b16Compl(vm, " ++ creg x ++ ")"
-
-doOp v LB16Plus [x, y] =
-  v ++ "idris_b16Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Minus [x, y] =
-  v ++ "idris_b16Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16Times [x, y] =
-  v ++ "idris_b16Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16UDiv [x, y] =
-  v ++ "idris_b16UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16SDiv [x, y] =
-  v ++ "idris_b16SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16URem [x, y] =
-  v ++ "idris_b16URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB16SRem [x, y] =
-  v ++ "idris_b16SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB16Z32 [x] = v ++ "idris_b16Z32(vm, " ++ creg x ++ ")"
-doOp v LB16Z64 [x] = v ++ "idris_b16Z64(vm, " ++ creg x ++ ")"
-doOp v LB16S32 [x] = v ++ "idris_b16S32(vm, " ++ creg x ++ ")"
-doOp v LB16S64 [x] = v ++ "idris_b16S64(vm, " ++ creg x ++ ")"
-doOp v LB16T8 [x] = v ++ "idris_b16T8(vm, " ++ creg x ++ ")"
-
-doOp v LB32Lt [x, y] = v ++ "idris_b32Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Lte [x, y] = v ++ "idris_b32Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Eq [x, y] = v ++ "idris_b32Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Gte [x, y] = v ++ "idris_b32Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Gt [x, y] = v ++ "idris_b32Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB32Shl [x, y] = v ++ "idris_b32Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32LShr [x, y] = v ++ "idris_b32Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32AShr [x, y] = v ++ "idris_b32AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32And [x, y] = v ++ "idris_b32And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Or [x, y] = v ++ "idris_b32Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Xor [x, y] = v ++ "idris_b32Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Compl [x] = v ++ "idris_b32Compl(vm, " ++ creg x ++ ")"
-
-doOp v LB32Plus [x, y] =
-  v ++ "idris_b32Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Minus [x, y] =
-  v ++ "idris_b32Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32Times [x, y] =
-  v ++ "idris_b32Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32UDiv [x, y] =
-  v ++ "idris_b32UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32SDiv [x, y] =
-  v ++ "idris_b32SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32URem [x, y] =
-  v ++ "idris_b32URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB32SRem [x, y] =
-  v ++ "idris_b32SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-
-doOp v LB32Z64 [x] = v ++ "idris_b32Z64(vm, " ++ creg x ++ ")"
-doOp v LB32S64 [x] = v ++ "idris_b32S64(vm, " ++ creg x ++ ")"
-doOp v LB32T8 [x] = v ++ "idris_b32T8(vm, " ++ creg x ++ ")"
-doOp v LB32T16 [x] = v ++ "idris_b32T16(vm, " ++ creg x ++ ")"
-
-doOp v LB64Lt [x, y] = v ++ "idris_b64Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Lte [x, y] = v ++ "idris_b64Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Eq [x, y] = v ++ "idris_b64Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Gte [x, y] = v ++ "idris_b64Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Gt [x, y] = v ++ "idris_b64Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
+doOp v (LLt ty) [x, y] = bitOp v "Lt" ty [x, y]
+doOp v (LLe ty) [x, y] = bitOp v "Lte" ty [x, y]
+doOp v (LEq ty) [x, y] = bitOp v "Eq" ty [x, y]
+doOp v (LGe ty) [x, y] = bitOp v "Gte" ty [x, y]
+doOp v (LGt ty) [x, y] = bitOp v "Gt" ty [x, y]
 
-doOp v LB64Shl [x, y] = v ++ "idris_b64Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64LShr [x, y] = v ++ "idris_b64Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64AShr [x, y] = v ++ "idris_b64AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64And [x, y] = v ++ "idris_b64And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Or [x, y] = v ++ "idris_b64Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Xor [x, y] = v ++ "idris_b64Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Compl [x] = v ++ "idris_b64Compl(vm, " ++ creg x ++ ")"
+doOp v (LSHL ty) [x, y] = bitOp v "Shl" ty [x, y]
+doOp v (LLSHR ty) [x, y] = bitOp v "Shr" ty [x, y]
+doOp v (LASHR ty) [x, y] = bitOp v "AShr" ty [x, y]
+doOp v (LAnd ty) [x, y] = bitOp v "And" ty [x, y]
+doOp v (LOr ty) [x, y] = bitOp v "Or" ty [x, y]
+doOp v (LXOr ty) [x, y] = bitOp v "Xor" ty [x, y]
+doOp v (LCompl ty) [x] = bitOp v "Compl" ty [x]
 
-doOp v LB64Plus [x, y] =
-  v ++ "idris_b64Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Minus [x, y] =
-  v ++ "idris_b64Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64Times [x, y] =
-  v ++ "idris_b64Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64UDiv [x, y] =
-  v ++ "idris_b64UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64SDiv [x, y] =
-  v ++ "idris_b64SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64URem [x, y] =
-  v ++ "idris_b64URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
-doOp v LB64SRem [x, y] =
-  v ++ "idris_b64SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
+doOp v (LPlus ty) [x, y] = bitOp v "Plus" ty [x, y]
+doOp v (LMinus ty) [x, y] = bitOp v "Minus" ty [x, y]
+doOp v (LTimes ty) [x, y] = bitOp v "Times" ty [x, y]
+doOp v (LUDiv ty) [x, y] = bitOp v "UDiv" ty [x, y]
+doOp v (LSDiv ty) [x, y] = bitOp v "SDiv" ty [x, y]
+doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]
+doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]
 
-doOp v LB64T8 [x] = v ++ "idris_b64T8(vm, " ++ creg x ++ ")"
-doOp v LB64T16 [x] = v ++ "idris_b64T16(vm, " ++ creg x ++ ")"
-doOp v LB64T32 [x] = v ++ "idris_b64T32(vm, " ++ creg x ++ ")"
+doOp v (LSExt from ITBig) [x] = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"
+doOp v (LSExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"
+doOp v (LSExt from ITNative) [x] = v ++ "MKINT((i_int)((" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ "))"
+doOp v (LSExt from to) [x]
+    | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x
+doOp v (LZExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, (uintptr_t)GETINT(" ++ creg x ++ ")"
+doOp v (LZExt from ITNative) [x] = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"
+doOp v (LZExt from ITBig) [x] = v ++ "MKBIGUI(vm, " ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"
+doOp v (LZExt from to) [x]
+    | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x
+doOp v (LTrunc ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"
+doOp v (LTrunc from ITNative) [x] = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"
+doOp v (LTrunc ITBig to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, mpz_get_ui(GETMPZ(" ++ creg x ++ "))"
+doOp v (LTrunc from to) [x]
+    | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x
 
 doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"
 doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"
@@ -460,7 +379,7 @@
 doOp v LFork [x] = v ++ "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"
 doOp v LPar [x] = v ++ creg x -- "MKPTR(vm, vmThread(vm, " ++ cname (MN 0 "EVAL") ++ ", " ++ creg x ++ "))"
 doOp v LVMPtr [] = v ++ "MKPTR(vm, vm)"
-doOp v LChInt args = v ++ creg (last args)
-doOp v LIntCh args = v ++ creg (last args)
+doOp v (LChInt ITNative) args = v ++ creg (last args)
+doOp v (LIntCh ITNative) args = v ++ creg (last args)
 doOp v LNoOp args = v ++ creg (last args)
 doOp _ op _ = "FAIL /* " ++ show op ++ " */"
diff --git a/src/IRTS/CodegenJava.hs b/src/IRTS/CodegenJava.hs
--- a/src/IRTS/CodegenJava.hs
+++ b/src/IRTS/CodegenJava.hs
@@ -1,23 +1,1588 @@
 module IRTS.CodegenJava (codegenJava) where
 
-import IRTS.BCImp
-import IRTS.Lang
-import IRTS.Simplified
-import Core.TT
-import Paths_idris
-import Util.System
-import IRTS.CodegenCommon
-
-import Data.Char
-import System.Process
-import System.Exit
-import System.IO
-import System.Directory
-import Control.Monad
-
-codegenJava :: [(Name, SDecl)] ->
-               String -> -- output file name
-               OutputType ->
-               IO ()
-codegenJava defs out exec = putStrLn "Not implemented yet"
-
+import           Core.TT
+import           IRTS.BCImp
+import           IRTS.CodegenCommon
+import           IRTS.Lang
+import           IRTS.Simplified
+import           Paths_idris
+import           Util.System
+
+import           Control.Applicative
+import           Control.Arrow
+import           Control.Monad
+import qualified Control.Monad.Trans as T
+import           Control.Monad.Trans.State
+import           Data.Char
+import           Data.Maybe (fromJust)
+import           Data.List (isPrefixOf, isSuffixOf, intercalate, foldl')
+import           Data.Int
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import           Language.Java.Parser
+import           Language.Java.Pretty
+import           Language.Java.Syntax hiding (Name)
+import qualified Language.Java.Syntax as J
+import           System.Directory
+import           System.Exit
+import           System.FilePath
+import           System.IO
+import           System.Process
+
+data CodeGenerationEnv = CodeGenerationEnv { globalVariablePositions :: [(Name, Integer)] }
+
+type CodeGeneration = StateT (CodeGenerationEnv) (Either String)
+
+codegenJava :: [(Name, SExp)] -> -- initialization of globals
+               [(Name, SDecl)] ->
+               FilePath -> -- output file name
+               [String] -> -- headers
+               [String] -> -- libs
+               OutputType ->
+               IO ()
+codegenJava globalInit defs out hdrs libs exec = do
+  withTempdir (takeBaseName out) $ \ tmpDir -> do
+    let srcdir = tmpDir </> "src" </> "main" </> "java"
+    createDirectoryIfMissing True srcdir
+    let (Ident clsName) = 
+          either error id (evalStateT (mkClassName out) (mkCodeGenEnv globalInit))
+    let outjava = srcdir </> clsName <.> "java"
+    let jout = either error
+                      (flatIndent . prettyPrint)
+                      (evalStateT (mkCompilationUnit globalInit defs hdrs out) (mkCodeGenEnv globalInit))
+    writeFile outjava jout
+    if (exec == Raw)
+       then copyFile outjava (takeDirectory out </> clsName <.> "java")
+       else do
+         execPom <- getExecutablePom
+         execPomTemplate <- TIO.readFile execPom
+         let execPom = T.replace (T.pack "$MAIN-CLASS$")
+                                 (T.pack clsName)
+                                 (T.replace (T.pack "$ARTIFACT-NAME$") 
+                                            (T.pack $ takeBaseName out) 
+                                            (T.replace (T.pack "$DEPENDENCIES$")
+                                                       (mkPomDependencies libs)
+                                                       execPomTemplate
+                                            )
+                                 )
+         TIO.writeFile (tmpDir </> "pom.xml") execPom
+         mvnCmd <- getMvn
+         let args = ["-f", (tmpDir </> "pom.xml")]
+         (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["compile"]) ""
+         when (exit /= ExitSuccess) $ error ("FAILURE: " ++ mvnCmd ++ " compile\n" ++ err ++ mvout)
+         if (exec == Object)
+            then do
+              classFiles <- 
+                map (\ clsFile -> tmpDir </> "target" </> "classes" </> clsFile)
+                . filter ((".class" ==) . takeExtension) 
+                <$> getDirectoryContents (tmpDir </> "target" </> "classes")
+              mapM_ (\ clsFile -> copyFile clsFile (takeDirectory out </> takeFileName clsFile)) 
+                    classFiles
+             else do
+               (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["package"]) ""
+               when (exit /= ExitSuccess) (error ("FAILURE: " ++ mvnCmd ++ " package\n" ++ err ++ mvout))
+               copyFile (tmpDir </> "target" </> (takeBaseName out) <.> "jar") out
+               handle <- openBinaryFile out ReadMode
+               contents <- TIO.hGetContents handle
+               hClose handle
+               handle <- openBinaryFile out WriteMode
+               TIO.hPutStr handle (T.append (T.pack jarHeader) contents)
+               hFlush handle
+               hClose handle
+               perms <- getPermissions out
+               setPermissions out (setOwnerExecutable True perms)
+         readProcess mvnCmd (args ++ ["clean"]) ""
+         removeFile (tmpDir </> "pom.xml")
+
+jarHeader :: String
+jarHeader = 
+  "#!/bin/sh\n"
+  ++ "MYSELF=`which \"$0\" 2>/dev/null`\n"
+  ++ "[ $? -gt 0 -a -f \"$0\" ] && MYSELF=\"./$0\"\n"
+  ++ "java=java\n"
+  ++ "if test -n \"$JAVA_HOME\"; then\n"
+  ++ "  java=\"$JAVA_HOME/bin/java\"\n"
+  ++ "fi\n"
+  ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\""
+  ++ "exit 1\n"
+
+mkPomDependencies :: [String] -> T.Text
+mkPomDependencies deps =
+  T.concat $ map (T.concat . map (T.append (T.pack "    ")) . mkDependency . T.pack) deps
+  where
+    mkDependency s = 
+      case T.splitOn (T.pack ":") s of
+        [g, a, v] ->
+          [ T.pack $ "<dependency>\n"
+          , T.append (T.pack "  ") $ mkGroupId g
+          , T.append (T.pack "  ") $ mkArtifactId a
+          , T.append (T.pack "  ") $ mkVersion v
+          , T.pack $ "</dependency>\n"
+          ]
+        _     -> []
+    mkGroupId g    = T.append (T.pack $ "<groupId>")    (T.append g $ T.pack "</groupId>\n")
+    mkArtifactId a = T.append (T.pack $ "<artifactId>") (T.append a $ T.pack "</artifactId>\n")
+    mkVersion v    = T.append (T.pack $ "<version>")    (T.append v $ T.pack "</version>\n")
+
+mkCodeGenEnv :: [(Name, SExp)] -> CodeGenerationEnv
+mkCodeGenEnv globalInit = 
+  CodeGenerationEnv $ zipWith (\ (name, _) pos -> (name, pos)) globalInit [0..]
+
+mkCompilationUnit :: [(Name, SExp)] -> [(Name, SDecl)] -> [String] -> FilePath -> CodeGeneration CompilationUnit
+mkCompilationUnit globalInit defs hdrs out =
+  CompilationUnit Nothing ( [ ImportDecl False idrisRts True
+                            , ImportDecl True idrisForeign True
+                            , ImportDecl False bigInteger False
+                            , ImportDecl False stringBuffer False
+                            , ImportDecl False runtimeException False
+                            , ImportDecl False scanner False
+                            , ImportDecl False arrays False
+                            ] ++ otherHdrs
+                          )
+                          <$> mkTypeDecl globalInit defs out
+  where
+    idrisRts = J.Name $ map Ident ["org", "idris", "rts"]
+    idrisForeign = J.Name $ map Ident ["org", "idris", "rts", "ForeignPrimitives"]
+    bigInteger = J.Name $ map Ident ["java", "math", "BigInteger"]
+    stringBuffer = J.Name $ map Ident ["java", "lang", "StringBuffer"]
+    runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]
+    scanner = J.Name $ map Ident ["java", "util", "Scanner"]
+    arrays = J.Name $ map Ident ["java", "util", "Arrays"]
+    otherHdrs = map ( (\ name -> ImportDecl False name False)
+                      . J.Name 
+                      . map (Ident . T.unpack) 
+                      . T.splitOn (T.pack ".") 
+                      . T.pack) 
+                $ filter (not . isSuffixOf ".h") hdrs
+
+flatIndent :: String -> String
+flatIndent (' ' : ' ' : xs) = flatIndent xs
+flatIndent (x:xs) = x:flatIndent xs
+flatIndent [] = []
+
+prefixCallNamespaces :: Ident -> SExp -> SExp
+prefixCallNamespaces (Ident name) (SApp tail (NS n ns) args) = SApp tail (NS n (name:ns)) args
+prefixCallNamespaces name (SLet var e1 e2) = SLet var (prefixCallNamespaces name e1) (prefixCallNamespaces name e2)
+prefixCallNamespaces name (SUpdate var e) = SUpdate var (prefixCallNamespaces name e)
+prefixCallNamespaces name (SCase var alts) = SCase var (map (prefixCallNamespacesCase name) alts)
+prefixCallNamespaces name (SChkCase var alts) = SChkCase var (map (prefixCallNamespacesCase name) alts)
+prefixCallNamespaces _ exp = exp
+
+prefixCallNamespacesCase :: Ident -> SAlt -> SAlt
+prefixCallNamespacesCase name (SConCase x y n ns e) = SConCase x y n ns (prefixCallNamespaces name e)
+prefixCallNamespacesCase name (SConstCase c e) = SConstCase c (prefixCallNamespaces name e)
+prefixCallNamespacesCase name (SDefaultCase e) = SDefaultCase (prefixCallNamespaces name e)
+
+prefixCallNamespacesDecl :: Ident -> SDecl -> SDecl
+prefixCallNamespacesDecl name (SFun fname args i e) = SFun fname args i (prefixCallNamespaces name e)
+
+mkTypeDecl :: [(Name, SExp)] -> [(Name, SDecl)] -> FilePath -> CodeGeneration [TypeDecl]
+mkTypeDecl globalInit defs out =
+  (\ name body -> [ClassTypeDecl $ ClassDecl [ Public
+                                             ,  Annotation $ SingleElementAnnotation 
+                                                             (J.Name [Ident "SuppressWarnings"])
+                                                             (EVVal . InitExp . Lit $ String "unchecked")
+                                             ] 
+                                             name 
+                                             [] 
+                                             Nothing 
+                                             [] 
+                                             body])
+  <$> mkClassName out
+  <*> ( mkClassName out 
+        >>= (\ ident -> mkClassBody globalInit (map (second (prefixCallNamespacesDecl ident)) defs))
+      )
+
+mkClassName :: FilePath -> CodeGeneration Ident
+mkClassName path =
+  T.lift $ left (\ err -> "Parser error in \"" ++ path ++ "\": " ++ (show err))
+                (parser ident . takeBaseName $ takeFileName path)
+
+mkClassBody :: [(Name, SExp)] -> [(Name, SDecl)] -> CodeGeneration ClassBody
+mkClassBody globalInit defs = 
+  (\ globals defs -> ClassBody . (globals++) . addMainMethod . mergeInnerClasses $ defs)
+  <$> mkGlobalContext globalInit
+  <*> mapM mkDecl defs
+
+mkGlobalContext :: [(Name, SExp)] -> CodeGeneration [Decl]
+mkGlobalContext [] = return []
+mkGlobalContext initExps = 
+  (\ exps -> [ MemberDecl $ FieldDecl [Private, Static, Final] 
+                                      objectArrayType 
+                                      [VarDecl (VarId $ Ident "globalContext") 
+                                               (Just . InitArray $ ArrayInit exps)               
+                                      ]
+             ]
+  )
+  <$> mapM (\ (_, exp) -> InitExp <$> mkExp exp) initExps
+
+  
+
+addMainMethod :: [Decl] -> [Decl]
+addMainMethod decls
+  | findMain decls = mkMainMethod : decls
+  | otherwise = decls
+  where
+    findMain ((MemberDecl (MemberClassDecl (ClassDecl _ (Ident "Main") _ _ _ (ClassBody body)))):_) =
+      findMainMethod body
+    findMain (_:decls) = findMain decls
+    findMain [] = False
+
+    findMainMethod ((MemberDecl (MethodDecl _ _ _ (Ident "main") [] _ _)):_) = True
+    findMainMethod (_:decls) = findMainMethod decls
+    findMainMethod [] = False
+
+mkMainMethod :: Decl
+mkMainMethod = 
+  MemberDecl $ MethodDecl [Public, Static] 
+                          [] 
+                          Nothing 
+                          (Ident "main") 
+                          [FormalParam [] stringArrayType False (VarId $ Ident "args")]
+                          [] 
+                          (MethodBody . Just $ Block [ BlockStmt . ExpStmt . MethodInv $
+                                                                 MethodCall (J.Name [Ident "idris_initArgs"])
+                                                                            [ MethodInv $ TypeMethodCall
+                                                                                        (J.Name [Ident "Thread"])
+                                                                                        []
+                                                                                        (Ident "currentThread")
+                                                                                        []
+                                                                            , ExpName $ J.Name [Ident "args"]
+                                                                            ]           
+                                                     , BlockStmt . ExpStmt . MethodInv $
+                                                                 MethodCall (J.Name [Ident "runMain_0"])
+                                                                            []
+                                                     ]
+                          )
+
+mergeInnerClasses :: [Decl] -> [Decl]
+mergeInnerClasses = foldl' mergeInner []
+  where
+    mergeInner ((decl@(MemberDecl (MemberClassDecl (ClassDecl priv name targs ext imp (ClassBody body))))):decls)
+               decl'@(MemberDecl (MemberClassDecl (ClassDecl _ name' _ ext' imp' (ClassBody body'))))
+      | name == name' =
+        (MemberDecl $ MemberClassDecl $
+                    ClassDecl priv
+                              name
+                              targs
+                              (mplus ext ext')
+                              (imp ++ imp')
+                              (ClassBody $ mergeInnerClasses (body ++ body')))
+        : decls
+      | otherwise = decl:(mergeInner decls decl')
+    mergeInner (decl:decls) decl' = decl:(mergeInner decls decl')
+    mergeInner [] decl' = [decl']
+
+
+mkIdentifier :: Name -> CodeGeneration Ident
+mkIdentifier (NS name _) = mkIdentifier name
+mkIdentifier (MN i name) = (\ (Ident x) -> Ident $ x ++ ('_' : show i))
+                           <$> mkIdentifier (UN name)
+mkIdentifier (UN name) =
+  T.lift $ left (\ err -> "Parser error in \"" ++ name ++ "\": " ++ (show err))
+                ( parser ident
+                . cleanReserved
+                . cleanNonLetter
+                . cleanStart
+                $ cleanWs False name)
+  where
+    cleanStart (x:xs)
+      | isNumber x = '_' : (x:xs)
+      | otherwise = (x:xs)
+    cleanStart [] = []
+    cleanNonLetter (x:xs)
+      | x == '#' = "_Hash" ++ cleanNonLetter xs
+      | x == '@' = "_At" ++ cleanNonLetter xs
+      | x == '$' = "_Dollar" ++ cleanNonLetter xs
+      | x == '!' = "_Bang" ++ cleanNonLetter xs
+      | x == '.' = "_Dot" ++ cleanNonLetter xs
+      | x == '\'' = "_Prime" ++ cleanNonLetter xs
+      | x == '*' = "_Times" ++ cleanNonLetter xs
+      | x == '+' = "_Plus" ++ cleanNonLetter xs
+      | x == '/' = "_Divide" ++ cleanNonLetter xs
+      | x == '-' = "_Minus" ++ cleanNonLetter xs
+      | x == '%' = "_Mod" ++ cleanNonLetter xs
+      | x == '<' = "_LessThan" ++ cleanNonLetter xs
+      | x == '=' = "_Equals" ++ cleanNonLetter xs
+      | x == '>' = "_MoreThan" ++ cleanNonLetter xs
+      | x == '[' = "_LSBrace" ++ cleanNonLetter xs
+      | x == ']' = "_RSBrace" ++ cleanNonLetter xs
+      | x == '(' = "_LBrace" ++ cleanNonLetter xs
+      | x == ')' = "_RBrace" ++ cleanNonLetter xs
+      | x == '_' = "__" ++ cleanNonLetter xs
+      | not (isAlphaNum x) = "_" ++ (show $ ord x) ++ xs
+      | otherwise = x:cleanNonLetter xs
+    cleanNonLetter [] = []
+    cleanWs capitalize (x:xs)
+      | isSpace x  = cleanWs True xs
+      | capitalize = (toUpper x) : (cleanWs False xs)
+      | otherwise  = x : (cleanWs False xs)
+    cleanWs _ [] = []
+
+
+    cleanReserved "param" = "_param"
+    cleanReserved "globalContext" = "_globalContext"
+    cleanReserved "context" = "_context"
+    cleanReserved "newcontext" = "_newcontext"
+
+    cleanReserved "void" = "_void"
+    cleanReserved "null" = "_null"
+    cleanReserved "int" = "_int"
+    cleanReserved "long" = "_long"
+    cleanReserved "char" = "_char"
+    cleanReserved "byte" = "_byte"
+    cleanReserved "double" = "_double"
+    cleanReserved "float" = "_float"
+    cleanReserved "boolean" = "_boolean"
+    cleanReserved "Object" = "_Object"
+    cleanReserved "String" = "_String"
+    cleanReserved "StringBuilder" = "_StringBuilder"
+    cleanReserved "StringBuffer" = "_StringBuffer"
+    cleanReserved "Scanner" = "_Scanner"
+    cleanReserved "Integer" = "_Integer"
+    cleanReserved "Double" = "_Double"
+    cleanReserved "Byte" = "_Byte"
+    cleanReserved "Character" = "_Character"
+    cleanReserved "BigInteger" = "_BigInteger"
+    cleanReserved "Boolean" = "_Boolean"
+    cleanReserved "Closure" = "_Closure"
+    cleanReserved "IdrisObject" = "_IdrisObject"
+    cleanReserved "TailCallClosure" = "_TailCallClosure"
+    cleanReserved "System" = "_System"
+    cleanReserved "Math" = "_Math"
+    cleanReserved "Arrays" = "_Arrays"
+    cleanReserved "RuntimeException" = "_RuntimeException"
+    cleanReserved "Comparable" = "_Comparable"
+
+    cleanReserved "class" = "_class"
+    cleanReserved "enum" = "_enum"
+    cleanReserved "interface" = "_interface"
+    cleanReserved "extends" = "_extends"
+    cleanReserved "implements" = "_implements"
+    cleanReserved "public" = "_public"
+    cleanReserved "private" = "_private"
+    cleanReserved "protected" = "_protected"
+    cleanReserved "static" = "_static"
+    cleanReserved "final" = "_final"
+    cleanReserved "abstract" = "_abstract"
+    cleanReserved "strict" = "_strict"
+    cleanReserved "volatile" = "_volatile"
+    cleanReserved "transient" = "_transient"
+    cleanReserved "native" = "_native"
+    cleanReserved "const" = "_const"
+
+    cleanReserved "import" = "_import"
+    cleanReserved "package" = "_package"
+
+    cleanReserved "throw" = "_throw"
+    cleanReserved "throws" = "_throws"
+    cleanReserved "try" = "_try"
+    cleanReserved "catch" = "_catch"
+
+    cleanReserved "synchronized" = "_synchronized"
+
+    cleanReserved "if" = "_if"
+    cleanReserved "else" = "_else"
+    cleanReserved "switch" = "_switch"
+    cleanReserved "case" = "_case"
+    cleanReserved "default" = "_default"
+
+    cleanReserved "while" = "_while"
+    cleanReserved "for" = "_for"
+    cleanReserved "do" = "_do"
+    cleanReserved "break" = "_break"
+    cleanReserved "continue" = "_continue"
+    cleanReserved "goto" = "_goto"
+
+    cleanReserved "this" = "_this"
+    cleanReserved "super" = "_super"
+    cleanReserved "new" = "_new"
+    cleanReserved "return" = "_return"
+
+    cleanReserved "idris_initArgs" = "_idris_initArgs"
+    cleanReserved "idris_numArgs" = "_idris_numArgs"
+    cleanReserved "idris_getArg" = "_idris_getArg"
+    cleanReserved "getenv" = "_getenv"
+    cleanReserved "exit" = "_exit"
+    cleanReserved "usleep" = "_usleep"
+    cleanReserved "idris_sendMessage" = "_idris_sendMessage"
+    cleanReserved "idris_checkMessage" = "_idris_checkMessage"
+    cleanReserved "idris_recvMessage" = "_idris_recvMessage"
+    cleanReserved "putStr" = "_putStr"
+    cleanReserved "putchar" = "_putchar"
+    cleanReserved "getchar" = "_getchar"
+    cleanReserved "fileOpen" = "_fileOpen"
+    cleanReserved "fileClose" = "_fileClose"
+    cleanReserved "fputStr" = "_fputStr"
+    cleanReserved "fileEOF" = "_fileEOF"
+    cleanReserved "isNull" = "_isNull"
+    cleanReserved "idris_K" = "_idris_K"
+    cleanReserved "idris_flipK" = "_idris_flipK"
+    cleanReserved "idris_assignStack" = "_idris_assignStack"
+    cleanReserved "free" = "_free"
+    cleanReserved "malloc" = "_malloc"
+    cleanReserved "idris_memset" = "_idris_memset"
+    cleanReserved "idris_peek" = "_idris_peek"
+    cleanReserved "idris_poke" = "_idris_poke"
+    cleanReserved "idris_memmove" = "_idris_memmove"
+
+    cleanReserved x = x
+
+mkName :: Name -> CodeGeneration J.Name
+mkName (NS name nss) = (\ n ns -> J.Name (n:ns))
+                       <$> mkIdentifier name
+                       <*> mapM (mkIdentifier . UN) nss
+mkName n = J.Name . (:[]) <$> mkIdentifier n
+
+voidType :: ClassType
+voidType = ClassType [(Ident "Void", [])]
+
+objectType :: ClassType
+objectType = ClassType [(Ident "Object", [])]
+
+objectArrayType :: Language.Java.Syntax.Type
+objectArrayType = RefType . ArrayType . RefType . ClassRefType $ objectType
+
+idrisClosureType :: ClassType
+idrisClosureType = ClassType [(Ident "Closure", [])]
+
+idrisTailCallClosureType :: ClassType
+idrisTailCallClosureType = ClassType [(Ident "TailCallClosure", [])]
+
+idrisObjectType :: ClassType
+idrisObjectType = ClassType [(Ident "IdrisObject", [])]
+
+contextArray :: LVar -> Exp
+contextArray (Loc _) = ExpName $ J.Name [Ident "context"]
+contextArray (Glob _) = ExpName $ J.Name [Ident "globalContext"]
+
+charType :: ClassType
+charType = ClassType [(Ident "Character", [])]
+
+byteType :: ClassType
+byteType = ClassType [(Ident "Byte", [])]
+
+shortType :: ClassType
+shortType = ClassType [(Ident "Short", [])]
+
+integerType :: ClassType
+integerType = ClassType [(Ident "Integer", [])]
+
+longType :: ClassType
+longType = ClassType [(Ident "Long", [])]
+
+nextIntTy :: IntTy -> IntTy
+nextIntTy IT8 = IT16
+nextIntTy IT16 = IT32
+nextIntTy IT32 = IT64
+nextIntTy IT64 = IT64
+nextIntTy ITNative = IT64
+
+intTyToIdent :: IntTy -> Ident
+intTyToIdent IT8  = Ident "Byte"
+intTyToIdent IT16 = Ident "Short"
+intTyToIdent IT32 = Ident "Integer"
+intTyToIdent IT64 = Ident "Long"
+intTyToIdent ITNative = Ident "Integer"
+intTyToIdent ITBig = Ident "BigInteger"
+
+intTyToClass :: IntTy -> ClassType
+intTyToClass ty = ClassType [(intTyToIdent ty, [])]
+
+intTyToMethod :: IntTy -> String
+intTyToMethod IT8  = "byteValue"
+intTyToMethod IT16 = "shortValue"
+intTyToMethod IT32 = "intValue"
+intTyToMethod IT64 = "longValue"
+intTyToMethod ITNative = "intValue"
+
+intTyToPrimTy :: IntTy -> PrimType
+intTyToPrimTy IT8  = ByteT
+intTyToPrimTy IT16 = ShortT
+intTyToPrimTy IT32 = IntT
+intTyToPrimTy IT64 = LongT
+intTyToPrimTy ITNative = IntT
+
+bigIntegerType :: ClassType
+bigIntegerType = ClassType [(Ident "BigInteger", [])]
+
+doubleType :: ClassType
+doubleType = ClassType [(Ident "Double", [])]
+
+stringType :: ClassType
+stringType = ClassType [(Ident "String", [])]
+
+stringArrayType :: Language.Java.Syntax.Type
+stringArrayType = RefType . ArrayType . RefType . ClassRefType $ stringType
+
+exceptionType :: ClassType
+exceptionType = ClassType [(Ident "Throwable", [])]
+
+runtimeExceptionType :: ClassType
+runtimeExceptionType = ClassType [(Ident "RuntimeException", [])]
+
+comparableType :: ClassType
+comparableType = ClassType [(Ident "Comparable", [])]
+
+mkDecl :: (Name, SDecl) -> CodeGeneration Decl
+mkDecl ((NS n (ns:nss)), decl) =
+  (\ name body -> MemberDecl $ MemberClassDecl $ ClassDecl [Public, Static] name [] Nothing [] body)
+  <$> mkIdentifier (UN ns)
+  <*> mkClassBody [] [(NS n nss, decl)]
+mkDecl (_, SFun name params stackSize body) =
+  (\ name params paramNames methodBody ->
+     MemberDecl $ MethodDecl [Public, Static]
+                             []
+                             (Just . RefType $ ClassRefType objectType)
+                             name
+                             params
+                             []
+                             (MethodBody . Just $ Block 
+                                           [ LocalVars [Final]
+                                                       objectArrayType
+                                                       [ VarDecl (VarDeclArray . VarId $ Ident "context")
+                                                                 (Just . InitArray . ArrayInit $
+                                                                       paramNames 
+                                                                       ++ replicate stackSize (InitExp . Lit $ Null))
+                                                       ]
+                                           , BlockStmt . Return $ Just methodBody
+                                           ]
+                             )
+  )
+  <$> mkIdentifier name
+  <*> mapM mkFormalParam params
+  <*> mapM (\ p -> (InitExp . ExpName) <$> mkName p) params
+  <*> mkExp body
+
+
+mkClosure :: [Name] -> Int -> SExp -> CodeGeneration Exp
+mkClosure params stackSize body =
+  (\ paramArray body -> 
+     InstanceCreation [] 
+                      idrisClosureType 
+                      [paramArray]
+                      (Just $ ClassBody [body])
+  )
+  <$> mkStackInit params stackSize
+  <*> mkClosureCall body
+
+mkFormalParam :: Name -> CodeGeneration FormalParam
+mkFormalParam name =
+  (\ name -> FormalParam [Final] (RefType . ClassRefType $ objectType) False (VarId name))
+  <$> mkIdentifier name
+
+mkClosureCall :: SExp -> CodeGeneration Decl
+mkClosureCall body =
+  (\ body -> MemberDecl $ MethodDecl [Public] [] (Just . RefType $ ClassRefType objectType) (Ident "call") [] [] body)
+  <$> mkMethodBody body
+
+mkMethodBody :: SExp -> CodeGeneration MethodBody
+mkMethodBody exp =
+  (\ exp -> MethodBody . Just . Block $ [BlockStmt . Return . Just $ exp])
+  <$> mkExp exp
+
+mkStackInit :: [Name] -> Int -> CodeGeneration Exp
+mkStackInit params stackSize =
+  (\ localVars -> ArrayCreateInit objectArrayType 0 . ArrayInit $
+                  (map (InitExp . ExpName) localVars)
+                  ++ (replicate (stackSize) (InitExp $ Lit Null)))
+  <$> mapM mkName params
+
+mkK :: Exp -> Exp -> Exp
+mkK result drop = 
+  MethodInv $ MethodCall (J.Name [Ident "idris_K"]) [ result, drop ]
+
+mkFlipK :: Exp -> Exp -> Exp
+mkFlipK drop result = 
+  MethodInv $ MethodCall (J.Name [Ident "idris_flipK"]) [ drop, result ]
+
+mkLet :: LVar -> SExp -> SExp -> CodeGeneration Exp
+mkLet (Loc pos) oldExp newExp =
+  (\ oldExp newExp ->
+     mkFlipK ( Assign ( ArrayLhs $ ArrayIndex (ExpName $ J.Name [Ident "context"])
+                                              (Lit $ Int (toInteger pos)))
+                      EqualA
+                      newExp
+             )
+             oldExp
+  )
+  <$> mkExp oldExp
+  <*> mkExp newExp
+mkLet (Glob _) _ _ = T.lift $ Left "Cannot let bind to global variable"
+
+reverseNameSpace :: J.Name -> J.Name
+reverseNameSpace (J.Name ids) =
+  J.Name ((tail ids) ++ [head ids])
+
+mkCase :: Bool -> LVar -> [SAlt] -> CodeGeneration Exp
+mkCase checked var ((SConCase parentStackPos consIndex _ params branchExpression):cases) =
+  mkConsCase checked
+             var
+             parentStackPos 
+             consIndex 
+             params 
+             branchExpression
+             (SCase var cases)
+mkCase checked var (c@(SConstCase constant branchExpression):cases) =
+  (\ constant branchExpression alternative var-> 
+     Cond ( MethodInv $ PrimaryMethodCall (constant)
+                                          []
+                                          (Ident "equals")
+                                          [var]
+          )
+          branchExpression
+          alternative
+  )
+  <$> mkExp (SConst constant)
+  <*> mkExp branchExpression
+  <*> mkCase checked var cases
+  <*> mkVarAccess Nothing var
+mkCase checked var (SDefaultCase exp:cases) = mkExp exp
+mkCase checked  _ [] = mkExp (SError "Non-exhaustive pattern")
+
+mkConsCase :: Bool -> LVar -> Int -> Int -> [Name] -> SExp -> SExp -> CodeGeneration Exp
+mkConsCase checked
+           toDeconstruct
+           parentStackStart 
+           consIndex 
+           params 
+           branchExpression 
+           alternative =
+  (\ caseBinding alternative var varCasted-> 
+     Cond (BinOp (InstanceOf (var) 
+                             (ClassRefType idrisObjectType)
+                 )
+                 CAnd
+                 ( BinOp
+                   ( MethodInv $ PrimaryMethodCall (varCasted)
+                                                   []
+                                                   (Ident "getConstructorId")
+                                                   []
+                   )
+                   Equal
+                   (Lit $ Int (toInteger consIndex))
+                 )
+          )
+          (caseBinding)
+          alternative
+  )
+  <$> mkCaseBinding checked toDeconstruct parentStackStart params branchExpression
+  <*> mkExp alternative
+  <*> mkVarAccess (Nothing) toDeconstruct
+  <*> mkVarAccess (Just idrisObjectType) toDeconstruct
+
+
+mkCaseBinding :: Bool -> LVar -> Int -> [Name] -> SExp -> CodeGeneration Exp
+mkCaseBinding True  var parentStackStart params branchExpression =
+  (\ branchExpression deconstruction -> 
+     mkFlipK (MethodInv $ MethodCall (J.Name [Ident "idris_assignStack"])
+             ( (ExpName $ J.Name [Ident "context"])
+               : (Lit $ Int (toInteger parentStackStart))
+               : deconstruction
+             ))
+             (branchExpression)
+  )
+  <$> mkExp branchExpression
+  <*> mkCaseBindingDeconstruction var params
+mkCaseBinding False var parentStackStart params branchExpression =
+  (\ bindingMethod deconstruction ->
+     MethodInv $ PrimaryMethodCall 
+               ( MethodInv $ PrimaryMethodCall (InstanceCreation []
+                                                                 (ClassType [(Ident "Object", [])])
+                                                                 []
+                                                                 (Just $ ClassBody [MemberDecl $ bindingMethod])
+                                               )
+                                               []
+                                               (Ident "apply")
+                                               ( contextArray (Loc undefined) : deconstruction )
+               )
+               []
+               (Ident "call")
+               []
+  )
+  <$> mkCaseBindingMethod parentStackStart params branchExpression
+  <*> mkCaseBindingDeconstruction var params
+
+mkCaseBindingDeconstruction :: LVar -> [Name] -> CodeGeneration [Exp]
+mkCaseBindingDeconstruction var members =
+  mapM (mkProjection var) ([0..(length members - 1)])
+
+mkCaseBindingMethod :: Int -> [Name] -> SExp -> CodeGeneration MemberDecl
+mkCaseBindingMethod parentStackStart params branchExpression =
+  (\ formalParams caseBindingStack branchExpression -> 
+     MethodDecl [Final, Public]
+                []
+                (Just . RefType $ ClassRefType idrisClosureType)
+                (Ident "apply")
+                (mkContextParam:formalParams)
+                []
+                (MethodBody . Just . Block $
+                              caseBindingStack ++
+                              [BlockStmt . Return $ Just branchExpression]))
+  <$> mapM mkFormalParam params
+  <*> mkBindingStack False parentStackStart params
+  <*> mkBindingClosure branchExpression
+
+mkContextParam :: FormalParam
+mkContextParam = 
+  FormalParam [Final] (objectArrayType) False (VarId (Ident "context"))
+
+mkBindingClosure :: SExp -> CodeGeneration Exp
+mkBindingClosure oldExp =
+  (\ oldCall -> 
+     InstanceCreation [] 
+                      idrisClosureType
+                      [ ExpName $ J.Name [Ident "new_context"] ]
+                      (Just $ ClassBody [oldCall])
+  )
+  <$> mkClosureCall oldExp
+
+
+mkBindingStack :: Bool -> Int -> [Name] -> CodeGeneration [BlockStmt]
+mkBindingStack checked parentStackStart params =
+  (\ paramNames ->
+    ( LocalVars [Final]
+                objectArrayType
+                [ VarDecl (VarDeclArray . VarId $ Ident "new_context")
+                          (Just . InitExp $ mkContextCopy checked parentStackStart params)
+                ])
+    : ( map (\ (param, pos) ->
+               BlockStmt . ExpStmt $
+                         Assign (ArrayLhs $ ArrayIndex (ExpName $ J.Name [Ident "new_context"])
+                                                       (Lit $ Int (toInteger pos)))
+                                EqualA
+                                (ExpName param)) $ zip paramNames [parentStackStart..]
+      )
+  ) 
+  <$> mapM mkName params
+
+mkContextCopy :: Bool -> Int -> [Name] -> Exp
+mkContextCopy True parentStackStart params =
+  MethodInv $ PrimaryMethodCall (ExpName $ J.Name [Ident "context"])
+                                []
+                                (Ident "clone")
+                                []
+mkContextCopy False parentStackStart params =
+  MethodInv $ TypeMethodCall (J.Name [Ident "Arrays"])
+                             []
+                             (Ident "copyOf")
+                             [ ExpName $ J.Name [Ident "context"]
+                             , MethodInv
+                             $ TypeMethodCall (J.Name [Ident "Math"])
+                                 []
+                                 (Ident "max")
+                                 [ FieldAccess $ PrimaryFieldAccess (ExpName $ J.Name [Ident "context"])
+                                                                    (Ident "length")
+                                 , Lit . Int $ toInteger (parentStackStart + length params)
+                                 ]
+                             ]
+
+mkProjection :: LVar -> Int -> CodeGeneration Exp
+mkProjection var memberNr =
+  (\ var -> ArrayAccess $ ArrayIndex ( MethodInv $ PrimaryMethodCall
+                                                   (var)
+                                                   []
+                                                   (Ident "getData")
+                                                   []
+                                     )
+                                     (Lit $ Int (toInteger memberNr))
+  )
+  <$> mkVarAccess (Just idrisObjectType) var
+
+type ClassName = String
+
+mkPrimitive :: ClassName -> Literal -> Exp
+mkPrimitive className value = 
+  MethodInv $ TypeMethodCall (J.Name [Ident className]) 
+                             []
+                             (Ident "valueOf")
+                             [Lit $ value]
+
+mkClass :: ClassType -> Exp
+mkClass classType =
+  ClassLit . Just . RefType .ClassRefType $ classType
+
+mkBinOpExp :: ClassType -> Op -> [LVar] -> CodeGeneration Exp
+mkBinOpExp castTo op (var:vars) = do
+  start <- mkVarAccess (Just castTo) var
+  foldM (\ exp var -> BinOp exp op <$> mkVarAccess (Just castTo) var) start vars
+
+mkBinOpExpTrans :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> Op -> [LVar] -> CodeGeneration Exp
+mkBinOpExpTrans opTransformation resultTransformation castTo op (var:vars) = do
+  start <- (mkVarAccess (Just castTo) var) 
+  foldM (\ exp var -> resultTransformation 
+                        . BinOp (opTransformation exp) op 
+                        . opTransformation 
+                        <$> mkVarAccess (Just castTo) var) 
+        start
+        vars
+
+mkBinOpExpConv :: String -> PrimType -> ClassType -> Op -> [LVar] -> CodeGeneration Exp
+mkBinOpExpConv fromMethodName toType fromType@(ClassType [(cls@(Ident _), [])]) op args =
+  mkBinOpExpTrans (\ exp -> MethodInv $ TypeMethodCall (J.Name [cls]) 
+                                                       [] 
+                                                       (Ident fromMethodName) 
+                                                       [exp]
+                  ) 
+                  (\ exp -> MethodInv $ TypeMethodCall (J.Name [cls]) 
+                                                       [] 
+                                                       (Ident "valueOf") 
+                                                       [Cast (PrimType $ toType) exp]
+                  )
+                  fromType
+                  op 
+                  args
+
+mkLogicalBinOpExp :: ClassType -> Op -> [LVar] -> CodeGeneration Exp
+mkLogicalBinOpExp castTo op (var:vars) = do
+  start <- mkVarAccess (Just castTo) var
+  foldM (\ exp var -> mkBoolToNumber castTo . BinOp exp op <$> mkVarAccess (Just castTo) var) 
+        start
+        vars
+
+mkMethodOpChain1 :: (Exp -> Exp) -> ClassType -> String -> [LVar] -> CodeGeneration Exp
+mkMethodOpChain1 = mkMethodOpChain id
+
+mkMethodOpChain :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> String -> [LVar] -> CodeGeneration Exp
+mkMethodOpChain initialTransformation resultTransformation castTo method (arg:args) = do
+  start <- initialTransformation <$> mkVarAccess (Just $ castTo) arg
+  foldM (\ exp arg' -> 
+           resultTransformation 
+           . MethodInv 
+           . PrimaryMethodCall exp [] (Ident method)
+           . (:[])
+           <$> mkVarAccess (Just $ castTo) arg'
+        )
+        start
+        args
+
+mkBoolToNumber :: ClassType -> Exp -> Exp
+mkBoolToNumber (ClassType [(Ident name, [])]) boolExp =
+  Cond boolExp (mkPrimitive name (Int 1)) (mkPrimitive name (Int 0))
+
+mkZeroExt :: String -> Int -> ClassType -> ClassType -> LVar -> CodeGeneration Exp
+mkZeroExt toMethod bits fromType toType@(ClassType [(toTypeName, [])]) var = do
+  (\ var sext -> 
+     MethodInv $ TypeMethodCall (J.Name [toTypeName])
+                                []
+                                (Ident "valueOf")
+                                [ Cond ( BinOp (var)
+                                               LThan
+                                               (Lit $ Int 0)
+                                       )
+                                       ( BinOp (Lit $ Int (2^bits))
+                                               Add
+                                               (sext)
+                                       )
+                                       sext
+                                ]
+   )
+  <$> mkVarAccess (Just $ fromType) var
+  <*> mkSignedExt' toMethod fromType var
+  
+mkSignedExt :: String -> ClassType -> ClassType -> LVar -> CodeGeneration Exp
+mkSignedExt toMethod fromType (ClassType [(toTypeName, [])]) var =
+  (\ sext -> MethodInv $ TypeMethodCall (J.Name [toTypeName])
+                                        []
+                                        (Ident "valueOf")
+                                        [ sext ]
+  )
+  <$> mkSignedExt' toMethod fromType var
+
+mkSignedExt' :: String -> ClassType -> LVar -> CodeGeneration Exp
+mkSignedExt' toMethod fromType var =
+  (\ var -> MethodInv $ PrimaryMethodCall (var)
+                                          [] 
+                                          (Ident toMethod)
+                                          []
+  )
+  <$> mkVarAccess (Just $ fromType) var
+
+data SPartialOrder
+  = SLt
+  | SLe
+  | SEq
+  | SGe
+  | SGt
+
+mkPartialOrder :: SPartialOrder -> Exp -> Exp
+mkPartialOrder SLt x = (BinOp (Lit $ Int (-1)) Equal x)
+mkPartialOrder SLe x = 
+  BinOp (BinOp (Lit $ Int (-1)) Equal x)
+        COr
+        (BinOp (Lit $ Int 0) Equal x)
+mkPartialOrder SEq x = BinOp (Lit $ Int 0) Equal x
+mkPartialOrder SGe x =
+  BinOp (BinOp (Lit $ Int 1) Equal x)
+        COr
+        (BinOp (Lit $ Int 0) Equal x)
+mkPartialOrder SGt x = (BinOp (Lit $ Int 1) Equal x)
+
+varPos :: LVar -> CodeGeneration Integer
+varPos (Loc i) = return (toInteger i)
+varPos (Glob name) = do
+  positions <- globalVariablePositions <$> get
+  case lookup name positions of
+    (Just pos) -> return pos
+    Nothing -> T.lift . Left $ "Invalid global variable id: " ++ show name
+
+mkVarAccess :: Maybe ClassType -> LVar -> CodeGeneration Exp
+mkVarAccess Nothing var = 
+  (\ pos -> ArrayAccess $ ArrayIndex (contextArray var) (Lit $ Int pos)) 
+  <$> varPos var
+mkVarAccess (Just castTo) var = 
+  Cast (RefType . ClassRefType $ castTo) <$> (mkVarAccess Nothing var)
+
+mkPrimitiveCast :: ClassType -> ClassType -> LVar -> CodeGeneration Exp
+mkPrimitiveCast fromType (ClassType [(toType, [])]) var =
+  (\ var -> 
+     MethodInv $ TypeMethodCall (J.Name [toType])
+                                []
+                                (Ident "valueOf")
+                                [var]
+  )
+  <$> mkVarAccess (Just fromType) var
+
+mkToString :: ClassType -> LVar -> CodeGeneration Exp
+mkToString castTo var =
+  (\ var -> MethodInv $ PrimaryMethodCall (var)
+                                          []
+                                          (Ident "toString")
+                                          []
+  )
+  <$> mkVarAccess (Just castTo) var
+data Std = In | Out | Err
+
+instance Show Std where
+  show In = "in"
+  show Out = "out"
+  show Err = "err"
+
+mkSystemStd :: Std -> Exp
+mkSystemStd std = FieldAccess $ PrimaryFieldAccess (ExpName $ J.Name [Ident "System"]) (Ident $ show std)
+
+mkSystemOutPrint :: Exp -> Exp
+mkSystemOutPrint value =
+  MethodInv $ PrimaryMethodCall (mkSystemStd Out)
+                                []
+                                (Ident "print")
+                                [value]
+
+mkMathFun :: String -> LVar -> CodeGeneration Exp
+mkMathFun funName var =
+  (\ var -> MethodInv $ TypeMethodCall (J.Name [Ident "Double"])
+                                       []
+                                       (Ident "valueOf")
+                                       [ MethodInv $ TypeMethodCall (J.Name [Ident "Math"])
+                                                                    []
+                                                                    (Ident funName)
+                                                                    [var]
+                                       ]
+  )
+  <$> mkVarAccess (Just doubleType) var
+
+mkStringAtIndex :: LVar -> Exp -> CodeGeneration Exp
+mkStringAtIndex var indexExp =
+  (\ var -> MethodInv $ TypeMethodCall (J.Name [Ident "Integer"]) 
+                                       []
+                                       (Ident "valueOf")
+                                       [ MethodInv $ PrimaryMethodCall (var)
+                                                                       []
+                                                                       (Ident "charAt")
+                                                                       [indexExp]
+                                       ]
+  )
+  <$> mkVarAccess (Just stringType) var
+
+mkForeignType :: FType -> Maybe ClassType
+mkForeignType (FInt ty) = return (intTyToClass ty)
+mkForeignType FChar = return integerType
+mkForeignType FString = return stringType
+mkForeignType FPtr = return objectType
+mkForeignType FDouble = return doubleType
+mkForeignType FAny = return objectType
+mkForeignType FUnit = Nothing
+
+mkForeignVarAccess :: FType -> LVar -> CodeGeneration Exp
+mkForeignVarAccess (FInt ty) var = 
+  (\ var -> MethodInv $ PrimaryMethodCall var
+                                          []
+                                          (Ident (intTyToMethod ty))
+                                          []
+  )
+  <$> mkVarAccess (Just $ intTyToClass ty) var
+mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess (FInt IT32) var
+mkForeignVarAccess FDouble var = 
+  (\ var -> MethodInv $ PrimaryMethodCall (var)
+                                          []
+                                          (Ident "doubleValue")
+                                          []
+  )
+  <$> mkVarAccess (Just doubleType) var
+mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var 
+ 
+mkFromForeignType :: FType -> Exp -> Exp
+mkFromForeignType (FInt ty) from = 
+  MethodInv $ TypeMethodCall (J.Name [intTyToIdent ty])
+                             []
+                             (Ident "valueOf")
+                             [from]
+mkFromForeignType FChar from = mkFromForeignType (FInt IT32) from
+mkFromForeignType FDouble from =   
+  MethodInv $ TypeMethodCall (J.Name [Ident "Double"])
+                             []
+                             (Ident "valueOf")
+                             [from]
+mkFromForeignType _ from = from
+
+mkForeignInvoke :: FType -> String -> [(FType, LVar)] -> CodeGeneration Exp
+mkForeignInvoke fType method args =
+  (\ foreignInvokeMeth -> 
+     MethodInv $ PrimaryMethodCall (InstanceCreation [] 
+                                                     objectType 
+                                                     [] 
+                                                     (Just $ ClassBody [ MemberDecl $ foreignInvokeMeth ])
+                                   )
+                                   []
+                                   (Ident "foreignInvoke")
+                                   []
+  )
+  <$> mkForeignInvokeMethod fType method args
+
+
+mkForeignInvokeMethod :: FType -> String -> [(FType, LVar)] -> CodeGeneration MemberDecl 
+mkForeignInvokeMethod fType method args =
+  (\ tryBlock -> 
+    MethodDecl [Public, Final]
+               []
+               (Just . RefType $ ClassRefType objectType)
+               (Ident "foreignInvoke")
+               []
+               []
+               (MethodBody . Just $ Block 
+                             [ BlockStmt 
+                               $ Try tryBlock
+                                   [ Catch (FormalParam [] 
+                                                        (RefType $ ClassRefType exceptionType)
+                                                        False
+                                                        (VarId $ Ident "ex")
+                                           )
+                                           (Block [ BlockStmt 
+                                                    . Throw
+                                                    $ InstanceCreation []
+                                                                       runtimeExceptionType
+                                                                       [ExpName $ J.Name [Ident "ex"]]
+                                                                       Nothing
+                                                  ]
+                                           )
+                                   ]
+                                   Nothing
+                             ]
+               )
+  )
+ <$> mkForeignInvokeTryBlock fType method args
+
+
+mkForeignInvokeTryBlock :: FType -> String -> [(FType, LVar)] -> CodeGeneration Block
+mkForeignInvokeTryBlock FUnit method args =
+  (\ method args -> Block [ BlockStmt . ExpStmt . MethodInv $ MethodCall method args
+                          , BlockStmt $ Return (Just $ Lit Null)
+                          ]
+  )
+  <$> ( T.lift $ left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))
+                 (parser name method)
+      )
+  <*> mapM (uncurry mkForeignVarAccess) args
+mkForeignInvokeTryBlock fType method args =
+  (\ method args -> Block [ BlockStmt . Return 
+                                 . Just 
+                                 . mkFromForeignType fType
+                                 . MethodInv 
+                                 $ MethodCall method args
+                          ]
+  )
+  <$> ( T.lift $ left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))
+                      (parser name method)
+      )
+  <*> mapM (uncurry mkForeignVarAccess) args
+
+mkMethodClosure :: Name -> [LVar] -> CodeGeneration Exp
+mkMethodClosure name args =
+  (\ name args -> 
+     InstanceCreation []
+                      idrisClosureType
+                      [ (ExpName $ J.Name [Ident "context"]) ]
+                      ( Just 
+                        $ ClassBody 
+                            [ MemberDecl 
+                              $ MethodDecl [Public, Final]
+                                           []
+                                           (Just . RefType $ ClassRefType objectType)
+                                           (Ident "call")
+                                           []
+                                           []
+                                           ( MethodBody 
+                                             . Just 
+                                             $ Block [ BlockStmt 
+                                                       . Return 
+                                                       . Just 
+                                                       . MethodInv 
+                                                       $ MethodCall (reverseNameSpace name) 
+                                                                    args
+                                                     ]
+                                           )
+                            ]
+                      )
+  )
+  <$> mkName name
+  <*> mapM (mkExp . SV) args
+
+mkThread :: LVar -> CodeGeneration Exp
+mkThread arg =
+  (\ eval -> 
+     MethodInv  
+     $ PrimaryMethodCall (InstanceCreation [] 
+                                           (ClassType [(Ident "Thread", [])]) 
+                                           [ eval ] 
+                                           ( Just 
+                                             $ ClassBody [ MemberDecl 
+                                                           $ MethodDecl [Public, Final]
+                                                                        []
+                                                                        (Just . RefType $ ClassRefType objectType)
+                                                                        (Ident "_start")
+                                                                        []
+                                                                        []
+                                                                        ( MethodBody 
+                                                                          . Just 
+                                                                          $ Block [ BlockStmt 
+                                                                                    . ExpStmt 
+                                                                                    . MethodInv 
+                                                                                     $ MethodCall (J.Name [Ident "start"])
+                                                                                                  []
+                                                                                  , BlockStmt 
+                                                                                    . Return 
+                                                                                    . Just 
+                                                                                    $ This
+                                                                                  ]
+                                                                        )
+                                                         ]
+                                           )
+                         )
+                         []
+                         (Ident "_start")
+                         []
+  )
+  <$> mkThreadBinding arg
+
+mkThreadBinding :: LVar -> CodeGeneration Exp
+mkThreadBinding var =
+  (\ bindingMethod var ->
+     MethodInv $ PrimaryMethodCall ( InstanceCreation []
+                                                      objectType
+                                                      []
+                                                      (Just $ ClassBody [MemberDecl $ bindingMethod])
+                                   )
+                                   []
+                                   (Ident "apply")
+                                   [ var ]
+  )
+  <$> mkThreadBindingMethod
+  <*> mkVarAccess Nothing var
+
+
+mkThreadBindingMethod :: CodeGeneration MemberDecl
+mkThreadBindingMethod = 
+  (\ compute -> 
+     MethodDecl [Final, Public]
+                []
+                (Just . RefType $ ClassRefType idrisClosureType)
+                (Ident "apply")
+                [ FormalParam [Final] (RefType . ClassRefType $ objectType) False (VarId $ Ident "param") ]
+                []
+                (MethodBody . Just $ Block
+                            [ mkThreadBindingStack
+                            , BlockStmt . Return $ Just compute
+                            ]
+                )
+  )
+  <$> mkBindingClosure (SUpdate (Loc 0) (SApp False (MN 0 "EVAL") [Loc 0]))
+
+
+mkThreadBindingStack :: BlockStmt
+mkThreadBindingStack =
+  LocalVars [Final]
+            objectArrayType
+            [ VarDecl (VarDeclArray . VarId $ Ident "new_context")
+                        (Just . InitArray $ ArrayInit [InitExp . ExpName $ J.Name [Ident "param"]])
+            ]
+ 
+
+mkExp :: SExp -> CodeGeneration Exp
+mkExp (SV var) = mkVarAccess Nothing var
+mkExp (SApp False name args) =
+  (\ methClosure ->
+     MethodInv $ PrimaryMethodCall ( InstanceCreation []
+                                                      idrisTailCallClosureType
+                                                      [ methClosure ]
+                                                      Nothing
+                                   )
+                                   []
+                                   (Ident "call")
+                                   []
+  )
+  <$> mkMethodClosure name args
+mkExp (SApp True name args) =
+  (\ methClosure ->
+     ( InstanceCreation []
+                        idrisTailCallClosureType
+                        [ methClosure ]
+                        Nothing
+     )
+  )
+  <$> mkMethodClosure name args
+mkExp (SLet var new old) =
+  mkLet var old new
+mkExp (SUpdate var exp) =
+  (\ rhs varPos -> Assign (ArrayLhs $ ArrayIndex (contextArray var) (Lit $ Int varPos))
+                          EqualA
+                          rhs
+  )
+  <$> mkExp exp
+  <*> varPos var
+mkExp (SCon conId name args) =
+  (\ args -> InstanceCreation []
+                              idrisObjectType
+                              ((Lit $ Int (toInteger conId)):args)
+                              Nothing)
+  <$> mapM (mkExp .SV) args
+mkExp (SCase var alts) = mkCase False var alts
+mkExp (SChkCase var alts) = mkCase True var alts
+mkExp (SProj var i) = mkProjection var i
+mkExp (SConst (I x)) = 
+  let x' :: Int32; x' = fromInteger (toInteger x) in
+  return $ mkPrimitive "Integer" (Int (fromInteger (toInteger x')))
+mkExp (SConst (BI x)) =
+  return $ InstanceCreation [] 
+                            (ClassType [(Ident "BigInteger", [])])
+                            [Lit $ String (show x)]
+                            Nothing
+mkExp (SConst (Fl x)) = return $ mkPrimitive "Double" (Double x)
+mkExp (SConst (Ch x)) = return $ mkPrimitive "Integer" (Char x)
+mkExp (SConst (Str x)) = return $ Lit $ String x
+mkExp (SConst IType) = return $ mkClass integerType
+mkExp (SConst BIType) = return $ mkClass bigIntegerType
+mkExp (SConst FlType) = return $ mkClass doubleType
+mkExp (SConst ChType) = return $ mkClass charType
+mkExp (SConst StrType) = return $ mkClass stringType
+mkExp (SConst (B8 x)) = return $ mkPrimitive "Byte" (String (show x))
+mkExp (SConst (B16 x)) = return $ mkPrimitive "Short" (String (show x))
+mkExp (SConst (B32 x)) = return $ mkPrimitive "Integer" (Int (toInteger x))
+mkExp (SConst (B64 x)) = return $ mkPrimitive "Long" (String (show x))
+mkExp (SConst (B8Type))= return $ mkClass byteType
+mkExp (SConst (B16Type)) = return $ mkClass shortType
+mkExp (SConst (B32Type)) = return $ mkClass integerType
+mkExp (SConst (B64Type)) = return $ mkClass longType
+mkExp (SConst (PtrType)) = return $ mkClass objectType
+mkExp (SConst (VoidType)) = return $ mkClass voidType
+mkExp (SConst (Forgot)) = return $ mkClass objectType
+mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args
+mkExp (SOp (LPlus ITNative) args) = mkExp (SOp (LPlus IT32) args)
+mkExp (SOp (LMinus ITNative) args) = mkExp (SOp (LMinus IT32) args)
+mkExp (SOp (LTimes ITNative) args) = mkExp (SOp (LTimes IT32) args)
+mkExp (SOp (LSDiv ITNative) args) = mkExp (SOp (LSDiv IT32) args)
+mkExp (SOp (LSRem ITNative) args) = mkExp (SOp (LSRem IT32) args)
+mkExp (SOp (LAnd ITNative) args) = mkExp (SOp (LAnd IT32) args)
+mkExp (SOp (LOr ITNative) args) = mkExp (SOp (LOr IT32) args)
+mkExp (SOp (LXOr ITNative) args) = mkExp (SOp (LXOr IT32) args)
+mkExp (SOp (LCompl ITNative) args) = mkExp (SOp (LCompl IT32) args)
+mkExp (SOp (LSHL ITNative) args) = mkExp (SOp (LSHL IT32) args)
+mkExp (SOp (LASHR ITNative) args) = mkExp (SOp (LASHR IT32) args)
+mkExp (SOp (LEq ITNative) args) = mkExp (SOp (LEq IT32) args)
+mkExp (SOp (LLt ITNative) args) = mkExp (SOp (LLt IT32) args)
+mkExp (SOp (LLe ITNative) args) = mkExp (SOp (LLe IT32) args)
+mkExp (SOp (LGt ITNative) args) = mkExp (SOp (LGt IT32) args)
+mkExp (SOp (LGe ITNative) args) = mkExp (SOp (LGe IT32) args)
+mkExp (SOp LFPlus args) = mkBinOpExp doubleType Add args
+mkExp (SOp LFMinus args) = mkBinOpExp doubleType Sub args
+mkExp (SOp LFTimes args) = mkBinOpExp doubleType Mult args
+mkExp (SOp LFDiv args) = mkBinOpExp doubleType Div args
+mkExp (SOp LFEq args) = 
+  mkMethodOpChain1 (mkBoolToNumber doubleType) doubleType "equals" args
+mkExp (SOp LFLt args) = mkLogicalBinOpExp integerType LThan args
+mkExp (SOp LFLe args) = mkLogicalBinOpExp integerType LThanE args
+mkExp (SOp LFGt args) = mkLogicalBinOpExp integerType GThan args
+mkExp (SOp LFGe args) = mkLogicalBinOpExp integerType GThanE args
+mkExp (SOp (LPlus ITBig) args) = mkMethodOpChain1 id bigIntegerType "add" args
+mkExp (SOp (LMinus ITBig) args) = mkMethodOpChain1 id bigIntegerType "subtract" args
+mkExp (SOp (LTimes ITBig) args) = mkMethodOpChain1 id bigIntegerType "multiply" args
+mkExp (SOp (LSDiv ITBig) args) = mkMethodOpChain1 id bigIntegerType "divide" args
+mkExp (SOp (LSRem ITBig) args) = mkMethodOpChain1 id bigIntegerType "mod" args
+mkExp (SOp (LEq ITBig) args) = 
+  mkMethodOpChain1 (mkBoolToNumber bigIntegerType) bigIntegerType "equals" args
+mkExp (SOp (LLt ITBig) args) =
+  mkMethodOpChain1 ( mkBoolToNumber bigIntegerType 
+                     . mkPartialOrder SLt
+                   ) 
+                   bigIntegerType 
+                   "compareTo" 
+                   args
+mkExp (SOp (LLe ITBig) args) =
+  mkMethodOpChain1 ( mkBoolToNumber bigIntegerType 
+                   . mkPartialOrder SLe
+                   ) 
+                   bigIntegerType 
+                   "compareTo" 
+                   args
+mkExp (SOp (LGt ITBig) args) =
+  mkMethodOpChain1 ( mkBoolToNumber bigIntegerType 
+                   . mkPartialOrder SGt
+                   ) 
+                   bigIntegerType 
+                   "compareTo" 
+                   args
+mkExp (SOp (LGe ITBig) args) =
+  mkMethodOpChain1 ( mkBoolToNumber bigIntegerType 
+                   . mkPartialOrder SGe
+                   ) 
+                   bigIntegerType 
+                   "compareTo" 
+                   args
+mkExp (SOp LStrConcat args) =
+  mkMethodOpChain (\ exp -> InstanceCreation [] 
+                                             (ClassType [(Ident "StringBuilder", [])])
+                                             [exp]
+                                             Nothing
+                  )
+                  (\ exp -> MethodInv $ PrimaryMethodCall exp [] (Ident "toString") [])
+                  stringType 
+                  "append"
+                  args
+mkExp (SOp LStrLt args@[_, _]) =
+  mkMethodOpChain1 ( mkBoolToNumber integerType
+                   . mkPartialOrder SLt
+                   )
+                   stringType
+                   "compareTo"
+                   args
+mkExp (SOp LStrEq args@[_, _]) =
+  mkMethodOpChain1 ( mkBoolToNumber integerType)
+                   stringType
+                   "equals"
+                   args
+mkExp (SOp LStrLen [arg]) =
+  (\ var -> MethodInv $ PrimaryMethodCall var [] (Ident "length") [])
+  <$> mkVarAccess (Just stringType) arg
+mkExp (SOp (LIntFloat ity) [arg]) =
+  mkPrimitiveCast (intTyToClass ity) doubleType arg
+mkExp (SOp (LFloatInt ity) [arg]) =
+  mkPrimitiveCast doubleType (intTyToClass ity) arg
+mkExp (SOp (LIntStr ITBig) [arg]) =
+  (\ var -> InstanceCreation [] bigIntegerType [var] Nothing)
+  <$> mkVarAccess (Just stringType) arg
+mkExp (SOp (LIntStr ity) [arg]) =
+  mkToString (intTyToClass ity) arg
+mkExp (SOp (LStrInt ity) [arg]) =
+  mkPrimitiveCast stringType (intTyToClass ity) arg
+mkExp (SOp LFloatStr [arg]) =
+  mkToString doubleType arg
+mkExp (SOp LStrFloat [arg]) =
+  mkPrimitiveCast doubleType stringType arg
+mkExp (SOp (LSExt ITNative ITBig) [arg]) =
+  mkPrimitiveCast integerType bigIntegerType arg
+mkExp (SOp (LTrunc ITBig ITNative) [arg]) =
+  mkPrimitiveCast bigIntegerType integerType arg
+mkExp (SOp (LChInt ITNative) [arg]) =
+  mkVarAccess (Just integerType) arg
+mkExp (SOp (LIntCh ITNative) [arg]) =
+  mkVarAccess (Just integerType) arg
+mkExp (SOp LPrintNum [arg]) =
+  mkSystemOutPrint <$> (mkVarAccess Nothing arg)
+mkExp (SOp LPrintStr [arg]) =
+  mkSystemOutPrint <$> (mkVarAccess (Just stringType) arg)
+mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])
+mkExp (SOp (LLt ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThan args
+mkExp (SOp (LLe ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThanE args
+mkExp (SOp (LEq ty) args) = 
+  mkMethodOpChain1 (mkBoolToNumber (intTyToClass ty)) (intTyToClass ty) "equals" args
+mkExp (SOp (LGt ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThan args
+mkExp (SOp (LGe ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThanE args
+mkExp (SOp (LPlus ty) args) = mkBinOpExp (intTyToClass ty) Add args
+mkExp (SOp (LMinus ty) args) = mkBinOpExp (intTyToClass ty) Sub args
+mkExp (SOp (LTimes ty) args) = mkBinOpExp (intTyToClass ty) Mult args
+mkExp (SOp (LUDiv IT64) (arg:args)) = do
+  (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)
+  return $ foldl (\ exp arg ->
+                    MethodInv $ PrimaryMethodCall
+                              ( MethodInv $ PrimaryMethodCall
+                                            ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
+                                                                         []
+                                                                         (Ident "valueOf")
+                                                                         [ exp ]
+                                            )
+                                            []
+                                            (Ident "divide")
+                                            [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
+                                                                         []
+                                                                         (Ident "valueOf")
+                                                                         [ arg ]
+                                            ]
+                              )
+                              []
+                              (Ident "longValue")
+                              []
+                 )                                
+           arg
+           args
+mkExp (SOp (LUDiv ty) args) = 
+  mkBinOpExpConv (intTyToMethod $ nextIntTy ty) 
+                 (intTyToPrimTy $ nextIntTy ty) 
+                 (intTyToClass ty) 
+                 Div 
+                 args
+mkExp (SOp (LSDiv ty) args) = mkBinOpExp (intTyToClass ty) Div args
+mkExp (SOp (LURem IT64) (arg:args)) = do
+  (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)
+  return $ foldl (\ exp arg ->
+                    MethodInv $ PrimaryMethodCall
+                              ( MethodInv $ PrimaryMethodCall
+                                            ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
+                                                                         []
+                                                                         (Ident "valueOf")
+                                                                         [ exp ]
+                                            )
+                                            []
+                                            (Ident "remainder")
+                                            [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
+                                                                         []
+                                                                         (Ident "valueOf")
+                                                                         [ arg ]
+                                            ]
+                              )
+                              []
+                              (Ident "longValue")
+                              []
+                 )                                
+           arg
+           args
+mkExp (SOp (LURem ty) args) =
+  mkBinOpExpConv (intTyToMethod $ nextIntTy ty) 
+                 (intTyToPrimTy $ nextIntTy ty) 
+                 (intTyToClass ty)
+                 Rem
+                 args
+mkExp (SOp (LSRem ty) args) = mkBinOpExp (intTyToClass ty) Rem args
+mkExp (SOp (LSHL ty) args) = mkBinOpExp (intTyToClass ty) LShift args
+mkExp (SOp (LLSHR ty) args) = mkBinOpExp (intTyToClass ty) RRShift args
+mkExp (SOp (LASHR ty) args) = mkBinOpExp (intTyToClass ty) RShift args
+mkExp (SOp (LAnd ty) args) = mkBinOpExp (intTyToClass ty) And args
+mkExp (SOp (LOr ty) args) = mkBinOpExp (intTyToClass ty) Or args
+mkExp (SOp (LXOr ty) args) = mkBinOpExp (intTyToClass ty) Xor args
+mkExp (SOp (LCompl ty) [var]) = PreBitCompl <$> mkVarAccess (Just $ intTyToClass ty) var
+mkExp (SOp (LZExt from to) [var])
+    | intTyWidth from < intTyWidth to
+        = mkZeroExt (intTyToMethod to) (intTyWidth from) (intTyToClass from) (intTyToClass to) var
+mkExp (SOp (LSExt from to) [var])
+    | intTyWidth from < intTyWidth to
+        = mkSignedExt (intTyToMethod to) (intTyToClass from) (intTyToClass to) var
+mkExp (SOp (LTrunc from to) [var])
+    | intTyWidth from > intTyWidth to
+        = (\ var -> MethodInv $ 
+            TypeMethodCall (J.Name [intTyToIdent to])
+                           []
+                           (Ident "valueOf")
+                           [ MethodInv 
+                             $ PrimaryMethodCall var [] (Ident (intTyToMethod to)) [] ]
+  )
+  <$> mkVarAccess (Just $ intTyToClass from) var
+mkExp (SOp LFExp [arg]) = mkMathFun "exp" arg
+mkExp (SOp LFLog [arg]) = mkMathFun "log" arg
+mkExp (SOp LFSin [arg]) = mkMathFun "sin" arg
+mkExp (SOp LFCos [arg]) = mkMathFun "cos" arg
+mkExp (SOp LFTan [arg]) = mkMathFun "tan" arg
+mkExp (SOp LFASin [arg]) = mkMathFun "asin" arg
+mkExp (SOp LFACos [arg]) = mkMathFun "acos" arg
+mkExp (SOp LFATan [arg]) = mkMathFun "atan" arg
+mkExp (SOp LFSqrt [arg]) = mkMathFun "sqrt" arg
+mkExp (SOp LFFloor [arg]) = mkMathFun "floor" arg
+mkExp (SOp LFCeil [arg]) = mkMathFun "ceil" arg
+mkExp (SOp LStrHead [arg]) = mkStringAtIndex arg (Lit $ Int 0)
+mkExp (SOp LStrTail [arg]) = 
+  (\ var -> MethodInv $ PrimaryMethodCall (var)
+                                         []
+                                         (Ident "substring")
+                                         [Lit $ Int 1]
+  ) 
+  <$> mkVarAccess (Just stringType) arg
+mkExp (SOp LStrCons [c, cs]) =
+  (\ cVar csVar -> MethodInv $ 
+         PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation [] 
+                                                                             (ClassType [(Ident "StringBuilder", [])])
+                                                                             [csVar]
+                                                                             Nothing
+                                                           )
+                                                           []
+                                                           (Ident "insert")
+                                                           [ Lit $ Int 0, 
+                                                             Cast (PrimType CharT) 
+                                                                  (MethodInv $ PrimaryMethodCall 
+                                                                               (cVar)
+                                                                               []
+                                                                               (Ident "intValue")
+                                                                               []
+                                                                  )
+                                                           ]
+                           )
+                           []
+                           (Ident "toString")
+                           []
+ )
+ <$> mkVarAccess (Just integerType) c
+ <*> mkVarAccess (Just stringType) cs
+mkExp (SOp LStrIndex [str, i]) = mkVarAccess (Just integerType) i >>= mkStringAtIndex str 
+mkExp (SOp LStrRev [str]) = 
+  (\ var -> MethodInv $ 
+         PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation []
+                                                                            (ClassType [(Ident "StringBuffer", [])])
+                                                                            [var]
+                                                                            Nothing
+                                                           )
+                                                           []
+                                                           (Ident "reverse")
+                                                           []
+                           )
+                           []
+                           (Ident "toString")
+                           []
+  )
+  <$> mkVarAccess (Just stringType) str
+mkExp (SOp LStdIn []) = return $ mkSystemStd In
+mkExp (SOp LStdOut []) = return $ mkSystemStd Out
+mkExp (SOp LStdErr []) = return $ mkSystemStd Err
+mkExp (SOp LFork [arg]) = mkThread arg
+mkExp (SOp LPar [arg]) = mkExp (SV arg)
+mkExp (SOp LVMPtr []) = 
+  return $ MethodInv $ TypeMethodCall (J.Name [Ident "Thread"]) [] (Ident "currentThread") []
+mkExp (SOp LNoOp args) = mkExp . SV $ last args
+mkExp (SNothing) = return $ Lit Null
+mkExp (SError err) =
+  return . MethodInv $ 
+         PrimaryMethodCall (InstanceCreation [] 
+                                             runtimeExceptionType 
+                                             [Lit $ String err]
+                                             ( Just $ ClassBody
+                                                    [ MemberDecl $ MethodDecl [Public, Final]
+                                                                              []
+                                                                              (Just . RefType $ ClassRefType objectType)
+                                                                              (Ident "throwSelf")
+                                                                              []
+                                                                              []
+                                                                              ( MethodBody . Just $
+                                                                                          Block [ BlockStmt (Throw This) ]
+                                                                              )
+                                                     ]
+                                             )
+                           )
+                           []
+                           (Ident "throwSelf")
+                           []
+mkExp other = error (show other)
diff --git a/src/IRTS/CodegenJavaScript.hs b/src/IRTS/CodegenJavaScript.hs
--- a/src/IRTS/CodegenJavaScript.hs
+++ b/src/IRTS/CodegenJavaScript.hs
@@ -139,6 +139,7 @@
 translateConstant StrType = "__IDRRT__.String"
 translateConstant BIType  = "__IDRRT__.Integer"
 translateConstant FlType  = "__IDRRT__.Float"
+translateConstant PtrType = "__IDRRT__.Ptr"
 translateConstant Forgot  = "__IDRRT__.Forgot"
 translateConstant c       =
   "(function(){throw 'Unimplemented Const: " ++ show c ++ "';})()"
@@ -202,58 +203,58 @@
   ++ ";\n});"
 
 translateExpression (SOp op vars)
-  | LPlus       <- op
+  | (LPlus _)   <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
-  | LMinus      <- op
+  | (LMinus _)  <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs
-  | LTimes      <- op
+  | (LTimes _)  <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs
-  | LDiv        <- op
+  | (LSDiv _)   <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs
-  | LMod        <- op
+  | (LSRem _)   <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs
-  | LEq         <- op
+  | (LEq _)     <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
-  | LLt         <- op
+  | (LLt _)     <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs
-  | LLe         <- op
+  | (LLe _)     <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs
-  | LGt         <- op
+  | (LGt _)     <- op 
   , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs
-  | LGe         <- op
+  | (LGe _)     <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
-  | LAnd        <- op
+  | (LAnd _)    <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs
-  | LOr         <- op
+  | (LOr _)     <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs
-  | LXOr        <- op
+  | (LXOr _)    <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs
-  | LSHL        <- op
+  | (LSHL _)    <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs
-  | LSHR        <- op
+  | (LASHR _)   <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs
-  | LCompl      <- op
+  | (LCompl _)  <- op
   , (arg:_)     <- vars = '~' : translateVariableName arg
 
-  | LBPlus      <- op
+  | (LPlus ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".add(" lhs rhs  ++ ")"
-  | LBMinus     <- op
+  | (LMinus ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".minus(" lhs rhs ++ ")"
-  | LBTimes     <- op
+  | (LTimes ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".times(" lhs rhs ++ ")"
-  | LBDiv       <- op
+  | (LSDiv ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".divide(" lhs rhs ++ ")"
-  | LBMod       <- op
+  | (LSRem ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".mod(" lhs rhs ++ ")"
-  | LBEq        <- op
+  | (LEq ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".equals(" lhs rhs ++ ")"
-  | LBLt        <- op
+  | (LLt ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".lesser(" lhs rhs ++ ")"
-  | LBLe        <- op
+  | (LLe ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".lesserOrEquals(" lhs rhs ++ ")"
-  | LBGt        <- op
+  | (LGt ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".greater(" lhs rhs ++ ")"
-  | LBGe        <- op
+  | (LGe ITBig) <- op
   , (lhs:rhs:_) <- vars = translateBinaryOp ".greaterOrEquals(" lhs rhs ++ ")"
 
   | LFPlus      <- op
@@ -284,29 +285,29 @@
   | LStrLen     <- op
   , (arg:_)     <- vars = translateVariableName arg ++ ".length"
 
-  | LStrInt     <- op
+  | (LStrInt ITNative) <- op
   , (arg:_)     <- vars = "parseInt(" ++ translateVariableName arg ++ ")"
-  | LIntStr     <- op
+  | (LIntStr ITNative) <- op
   , (arg:_)     <- vars = "String(" ++ translateVariableName arg ++ ")"
-  | LIntBig     <- op
+  | (LSExt ITNative ITBig) <- op
   , (arg:_)     <- vars = "__IDRRT__.bigInt(" ++ translateVariableName arg ++ ")"
-  | LBigInt     <- op
+  | (LTrunc ITBig ITNative) <- op
   , (arg:_)     <- vars = translateVariableName arg ++ ".valueOf()"
-  | LBigStr     <- op
+  | (LIntStr ITBig) <- op
   , (arg:_)     <- vars = translateVariableName arg ++ ".toString()"
-  | LStrBig     <- op
+  | (LStrInt ITBig) <- op
   , (arg:_)     <- vars = "__IDRRT__.bigInt(" ++ translateVariableName arg ++ ")"
   | LFloatStr   <- op
   , (arg:_)     <- vars = "String(" ++ translateVariableName arg ++ ")"
   | LStrFloat   <- op
   , (arg:_)     <- vars = "parseFloat(" ++ translateVariableName arg ++ ")"
-  | LIntFloat   <- op
+  | (LIntFloat ITNative) <- op
   , (arg:_)     <- vars = translateVariableName arg
-  | LFloatInt   <- op
+  | (LFloatInt ITNative) <- op
   , (arg:_)     <- vars = translateVariableName arg
-  | LChInt      <- op
+  | (LChInt ITNative) <- op
   , (arg:_)     <- vars = translateVariableName arg ++ ".charCodeAt(0)"
-  | LIntCh      <- op
+  | (LIntCh ITNative) <- op
   , (arg:_)     <- vars =
     "String.fromCharCode(" ++ translateVariableName arg ++ ")"
 
@@ -385,11 +386,11 @@
   , (obj:as) <- args =
     concat [object obj, method, arguments as]
 
-  | "[]=" == fun
+  | "[]=" `isSuffixOf` fun
   , (idx:val:[]) <- args =
     concat [array, index idx, assign val]
 
-  | "[]" == fun
+  | "[]" `isSuffixOf` fun
   , (idx:[]) <- args =
     array ++ index idx
 
@@ -450,7 +451,7 @@
   | IType    <- ty = matchHelper "Int"
   | BIType   <- ty = matchHelper "Integer"
   | FlType   <- ty = matchHelper "Float"
-  | PtrType  <- ty = matchHelper "Pointer"
+  | PtrType  <- ty = matchHelper "Ptr"
   | Forgot   <- ty = matchHelper "Forgot"
   where
     matchHelper tyName = translateTypeMatch var tyName e
diff --git a/src/IRTS/Compiler.hs b/src/IRTS/Compiler.hs
--- a/src/IRTS/Compiler.hs
+++ b/src/IRTS/Compiler.hs
@@ -71,7 +71,7 @@
                                       (concatMap mkObj objs)
                                       (concatMap mkLib libs) NONE
                                   ViaJava ->
-                                    codegenJava c f outty
+                                    codegenJava [] c f hdrs libs outty
                                   ViaJavaScript ->
                                     codegenJavaScript JavaScript c f outty
                                   ViaNode ->      
@@ -98,7 +98,7 @@
 allNames :: [Name] -> Name -> Idris [Name]
 allNames ns n | n `elem` ns = return []
 allNames ns n = do i <- getIState
-                   case lookupCtxt Nothing n (idris_callgraph i) of
+                   case lookupCtxt n (idris_callgraph i) of
                       [ns'] -> do more <- mapM (allNames (n:ns)) (map fst (calls ns')) 
                                   return (nub (n : concat more))
                       _ -> return [n]
@@ -169,6 +169,8 @@
           | (P _ (UN "lazy") _, [_, arg]) <- unApply tm
               = do arg' <- ir' env arg
                    return $ LLazyExp arg'
+          | (P _ (UN "assert_smaller") _, [_, _, _, arg]) <- unApply tm
+              = ir' env arg
           | (P _ (UN "par") _, [_, arg]) <- unApply tm
               = do arg' <- ir' env arg
                    return $ LOp LPar [LLazyExp arg']
@@ -205,12 +207,12 @@
                         Just tm -> return tm
                         _ -> do
                                  let collapse 
-                                        = case lookupCtxt Nothing n 
+                                        = case lookupCtxt n
                                                    (idris_optimisation i) of
                                                [oi] -> collapsible oi
                                                _ -> False
                                  let unused 
-                                        = case lookupCtxt Nothing n 
+                                        = case lookupCtxt n
                                                       (idris_callgraph i) of
                                                [CGInfo _ _ _ _ unusedpos] -> 
                                                       unusedpos
@@ -264,31 +266,40 @@
       doForeign :: [Name] -> [TT Name] -> Idris LExp
       doForeign env (_ : fgn : args)
          | (_, (Constant (Str fgnName) : fgnArgTys : ret : [])) <- unApply fgn
-              = let tys = getFTypes fgnArgTys
+              = let maybeTys = getFTypes fgnArgTys
                     rty = mkIty' ret in
-                    do args' <- mapM (ir' env) args
-                       -- wrap it in a prim__IO
-                       -- return $ con_ 0 @@ impossible @@ 
-                       return $ -- LLazyExp $
-                           LForeign LANG_C rty fgnName (zip tys args')
+                case maybeTys of
+                  Nothing -> fail $ "Foreign type specification is not a constant list: " ++ show (fgn:args)
+                  Just tys -> do
+                    args' <- mapM (ir' env) args
+                    -- wrap it in a prim__IO
+                    -- return $ con_ 0 @@ impossible @@
+                    return $ -- LLazyExp $
+                      LForeign LANG_C rty fgnName (zip tys args')
          | otherwise = fail "Badly formed foreign function call"
 
-getFTypes :: TT Name -> [FType]
+getFTypes :: TT Name -> Maybe [FType]
 getFTypes tm = case unApply tm of
-                 (nil, []) -> []
+                 (nil, []) -> Just []
                  (cons, [ty, xs]) -> 
-                    let rest = getFTypes xs in
-                        mkIty' ty : rest
+                     fmap (mkIty' ty :) (getFTypes xs)
+                 _ -> Nothing
 
 mkIty' (P _ (UN ty) _) = mkIty ty
+mkIty' (App (P _ (UN "FIntT") _) (P _ (UN intTy) _)) = mkIntIty intTy
 mkIty' _ = FAny
 
-mkIty "FInt"    = FInt
 mkIty "FFloat"  = FDouble
 mkIty "FChar"   = FChar
 mkIty "FString" = FString
 mkIty "FPtr"    = FPtr
 mkIty "FUnit"   = FUnit
+
+mkIntIty "ITNative" = FInt ITNative
+mkIntIty "IT8"  = FInt IT8
+mkIntIty "IT16" = FInt IT16
+mkIntIty "IT32" = FInt IT32
+mkIntIty "IT64" = FInt IT64
 
 zname = NS (UN "O") ["Nat","Prelude"] 
 sname = NS (UN "S") ["Nat","Prelude"] 
diff --git a/src/IRTS/Defunctionalise.hs b/src/IRTS/Defunctionalise.hs
--- a/src/IRTS/Defunctionalise.hs
+++ b/src/IRTS/Defunctionalise.hs
@@ -80,14 +80,14 @@
 --     aa env e@(LApp tc (MN 0 "EVAL") [a]) = e
     aa env (LApp tc (LV (Glob n)) args)
        = do args' <- mapM (aa env) args 
-            case lookupCtxt Nothing n defs of
+            case lookupCtxt n defs of
                 [LConstructor _ i ar] -> return $ DApp tc n args'
                 [LFun _ _ as _] -> let arity = length as in
                                        fixApply tc n args' arity
                 [] -> return $ chainAPPLY (DV (Glob n)) args'
     aa env (LLazyApp n args)
        = do args' <- mapM (aa env) args
-            case lookupCtxt Nothing n defs of
+            case lookupCtxt n defs of
                 [LConstructor _ i ar] -> return $ DApp False n args'
                 [LFun _ _ as _] -> let arity = length as in
                                        fixLazyApply n args' arity
diff --git a/src/IRTS/LParser.hs b/src/IRTS/LParser.hs
--- a/src/IRTS/LParser.hs
+++ b/src/IRTS/LParser.hs
@@ -61,7 +61,7 @@
          case checked of
            OK c -> case tgt of
                      ViaC -> codegenC c "a.out" outty ["math.h"] "" "" TRACE
-                     ViaJava -> codegenJava c "a.out" outty
+                     ViaJava -> codegenJava [] c "a.out" [] [] outty
            Error e -> fail $ show e 
 
 parseFOVM :: FilePath -> IO [(Name, LDecl)]
@@ -92,39 +92,39 @@
 
 pLExp = buildExpressionParser optable pLExp' 
 
-optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
-            binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,
+optable = [[binary "*" (\x y -> LOp (LTimes ITNative) [x,y]) AssocLeft,
+            binary "/" (\x y -> LOp (LSDiv ITNative) [x,y]) AssocLeft,
             binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,
             binary "/." (\x y -> LOp LFDiv [x,y]) AssocLeft,
-            binary "*:" (\x y -> LOp LBTimes [x,y]) AssocLeft,
-            binary "/:" (\x y -> LOp LBDiv [x,y]) AssocLeft
+            binary "*:" (\x y -> LOp (LTimes ITBig) [x,y]) AssocLeft,
+            binary "/:" (\x y -> LOp (LSDiv ITBig) [x,y]) AssocLeft
             ],
            [
-            binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
-            binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,
+            binary "+" (\x y -> LOp (LPlus ITNative) [x,y]) AssocLeft,
+            binary "-" (\x y -> LOp (LMinus ITNative) [x,y]) AssocLeft,
             binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,
             binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,
             binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft,
-            binary "+:" (\x y -> LOp LBPlus [x,y]) AssocLeft,
-            binary "-:" (\x y -> LOp LBMinus [x,y]) AssocLeft
+            binary "+:" (\x y -> LOp (LPlus ITBig) [x,y]) AssocLeft,
+            binary "-:" (\x y -> LOp (LMinus ITBig) [x,y]) AssocLeft
             ],
            [
-            binary "==" (\x y -> LOp LEq [x, y]) AssocNone,
+            binary "==" (\x y -> LOp (LEq ITNative) [x, y]) AssocNone,
             binary "==." (\x y -> LOp LFEq [x, y]) AssocNone,
-            binary "<" (\x y -> LOp LLt [x, y]) AssocNone,
+            binary "<" (\x y -> LOp (LLt ITNative) [x, y]) AssocNone,
             binary "<." (\x y -> LOp LFLt [x, y]) AssocNone,
-            binary ">" (\x y -> LOp LGt [x, y]) AssocNone,
+            binary ">" (\x y -> LOp (LGt ITNative) [x, y]) AssocNone,
             binary ">." (\x y -> LOp LFGt [x, y]) AssocNone,
-            binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,
+            binary "<=" (\x y -> LOp (LLe ITNative) [x, y]) AssocNone,
             binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,
-            binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,
+            binary ">=" (\x y -> LOp (LGe ITNative) [x, y]) AssocNone,
             binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone,
 
-            binary "==:" (\x y -> LOp LBEq [x, y]) AssocNone,
-            binary "<:" (\x y -> LOp LBLt [x, y]) AssocNone,
-            binary ">:" (\x y -> LOp LBGt [x, y]) AssocNone,
-            binary "<=:" (\x y -> LOp LBLe [x, y]) AssocNone,
-            binary ">=:" (\x y -> LOp LBGe [x, y]) AssocNone
+            binary "==:" (\x y -> LOp (LEq ITBig) [x, y]) AssocNone,
+            binary "<:" (\x y -> LOp (LLt ITBig) [x, y]) AssocNone,
+            binary ">:" (\x y -> LOp (LGt ITBig) [x, y]) AssocNone,
+            binary "<=:" (\x y -> LOp (LLe ITBig) [x, y]) AssocNone,
+            binary ">=:" (\x y -> LOp (LGe ITBig) [x, y]) AssocNone
           ]]
 
 binary name f assoc = Infix (do reservedOp name; return f) assoc
@@ -164,7 +164,7 @@
      
 pLang = do reserved "C"; return LANG_C
 
-pType = do reserved "Int"; return FInt
+pType = do reserved "Int"; return (FInt ITNative)
     <|> do reserved "Float"; return FDouble
     <|> do reserved "String"; return FString
     <|> do reserved "Unit"; return FUnit
@@ -184,21 +184,21 @@
     <|> do reserved "StringFloat"; lchar '('; e <- pLExp; lchar ')'
            return (LOp LStrFloat [e])
     <|> do reserved "FloatInt"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LFloatInt [e])
+           return (LOp (LFloatInt ITNative) [e])
     <|> do reserved "IntFloat"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LIntFloat [e])
+           return (LOp (LIntFloat ITNative) [e])
     <|> do reserved "StringInt"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LStrInt [e])
+           return (LOp (LStrInt ITNative) [e])
     <|> do reserved "IntString"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LIntStr [e])
+           return (LOp (LIntStr ITNative) [e])
     <|> do reserved "BigInt"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LBigInt [e])
+           return (LOp (LTrunc ITBig ITNative) [e])
     <|> do reserved "IntBig"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LIntBig [e])
+           return (LOp (LSExt ITNative ITBig) [e])
     <|> do reserved "BigString"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LBigStr [e])
+           return (LOp (LIntStr ITBig) [e])
     <|> do reserved "StringBig"; lchar '('; e <- pLExp; lchar ')'
-           return (LOp LStrBig [e])
+           return (LOp (LStrInt ITBig) [e])
 
 pPrim :: LParser LExp
 pPrim = do reserved "StrEq"; lchar '(';
diff --git a/src/IRTS/Lang.hs b/src/IRTS/Lang.hs
--- a/src/IRTS/Lang.hs
+++ b/src/IRTS/Lang.hs
@@ -3,6 +3,7 @@
 import Core.TT
 import Control.Monad.State hiding(lift)
 import Data.List
+import Foreign.Storable (sizeOf)
 import Debug.Trace
 
 data LVar = Loc Int | Glob Name
@@ -28,36 +29,38 @@
 -- Primitive operators. Backends are not *required* to implement all
 -- of these, but should report an error if they are unable
 
-data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod 
-            | LAnd | LOr | LXOr | LCompl | LSHL| LSHR
-            | LEq | LLt | LLe | LGt | LGe
+data IntTy = ITNative | IT8 | IT16 | IT32 | IT64 | ITBig
+  deriving (Show, Eq)
+
+intTyWidth :: IntTy -> Int
+intTyWidth IT8 = 8
+intTyWidth IT16 = 16
+intTyWidth IT32 = 32
+intTyWidth IT64 = 64
+intTyWidth ITNative = 8 * sizeOf (0 :: Int)
+intTyWidth ITBig = error "IRTS.Lang.intTyWidth: Big integers have variable width"
+
+intTyToConst :: IntTy -> Const
+intTyToConst IT8 = B8Type
+intTyToConst IT16 = B16Type
+intTyToConst IT32 = B32Type
+intTyToConst IT64 = B64Type
+intTyToConst ITBig = BIType
+intTyToConst ITNative = IType
+
+data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy
+            | LUDiv IntTy | LSDiv IntTy | LURem IntTy | LSRem IntTy
+            | LAnd IntTy | LOr IntTy | LXOr IntTy | LCompl IntTy
+            | LSHL IntTy | LLSHR IntTy | LASHR IntTy
+            | LEq IntTy | LLt IntTy | LLe IntTy | LGt IntTy | LGe IntTy
+            | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy
             | LFPlus | LFMinus | LFTimes | LFDiv 
             | LFEq | LFLt | LFLe | LFGt | LFGe
-            | LBPlus | LBMinus | LBDec | LBTimes | LBDiv | LBMod 
-            | LBEq | LBLt | LBLe | LBGt | LBGe
             | LStrConcat | LStrLt | LStrEq | LStrLen
-            | LIntFloat | LFloatInt | LIntStr | LStrInt | LFloatStr | LStrFloat
-            | LIntBig | LBigInt | LStrBig | LBigStr | LChInt | LIntCh
+            | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy
+            | LFloatStr | LStrFloat | LChInt IntTy | LIntCh IntTy
             | LPrintNum | LPrintStr | LReadStr
 
-            | LB8Lt | LB8Lte | LB8Eq | LB8Gt | LB8Gte
-            | LB8Plus | LB8Minus | LB8Times | LB8UDiv | LB8SDiv | LB8URem | LB8SRem
-            | LB8Shl | LB8LShr | LB8AShr | LB8And | LB8Or | LB8Xor | LB8Compl
-            | LB8Z16 | LB8Z32 | LB8Z64 | LB8S16 | LB8S32 | LB8S64 -- Zero/Sign extension
-            | LB16Lt | LB16Lte | LB16Eq | LB16Gt | LB16Gte
-            | LB16Plus | LB16Minus | LB16Times | LB16UDiv | LB16SDiv | LB16URem | LB16SRem
-            | LB16Shl | LB16LShr | LB16AShr | LB16And | LB16Or | LB16Xor | LB16Compl
-            | LB16Z32 | LB16Z64 | LB16S32 | LB16S64 | LB16T8 -- and Truncation
-            | LB32Lt | LB32Lte | LB32Eq | LB32Gt | LB32Gte
-            | LB32Plus | LB32Minus | LB32Times | LB32UDiv | LB32SDiv | LB32URem | LB32SRem
-            | LB32Shl | LB32LShr | LB32AShr | LB32And | LB32Or | LB32Xor | LB32Compl
-            | LB32Z64 | LB32S64 | LB32T8 | LB32T16
-            | LB64Lt | LB64Lte | LB64Eq | LB64Gt | LB64Gte
-            | LB64Plus | LB64Minus | LB64Times | LB64UDiv | LB64SDiv | LB64URem | LB64SRem
-            | LB64Shl | LB64LShr | LB64AShr | LB64And | LB64Or | LB64Xor | LB64Compl
-            | LB64T8 | LB64T16 | LB64T32
-            | LIntB8 | LIntB16 | LIntB32 | LIntB64 | LB32Int
-
             | LFExp | LFLog | LFSin | LFCos | LFTan | LFASin | LFACos | LFATan
             | LFSqrt | LFFloor | LFCeil
 
@@ -76,7 +79,7 @@
 data FLang = LANG_C
   deriving (Show, Eq)
 
-data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
+data FType = FInt IntTy | FChar | FString | FUnit | FPtr | FDouble | FAny
   deriving (Show, Eq)
 
 data LAlt = LConCase Int Name [Name] LExp
diff --git a/src/IRTS/Simplified.hs b/src/IRTS/Simplified.hs
--- a/src/IRTS/Simplified.hs
+++ b/src/IRTS/Simplified.hs
@@ -46,7 +46,7 @@
 simplify tl (DV (Loc i)) = return (SV (Loc i))
 simplify tl (DV (Glob x)) 
     = do ctxt <- ldefs
-         case lookupCtxt Nothing x ctxt of
+         case lookupCtxt x ctxt of
               [DConstructor _ t 0] -> return $ SCon t x []
               _ -> return $ SV (Glob x)
 simplify tl (DApp tc n args) = do args' <- mapM sVar args
@@ -88,7 +88,7 @@
 
 sVar (DV (Glob x))
     = do ctxt <- ldefs
-         case lookupCtxt Nothing x ctxt of
+         case lookupCtxt x ctxt of
               [DConstructor _ t 0] -> sVar (DC t x [])
               _ -> return (Glob x, Nothing)
 sVar (DV x) = return (x, Nothing)
@@ -136,7 +136,7 @@
     sc env (SV (Glob n)) =
        case lookup n (reverse env) of -- most recent first
               Just i -> do lvar i; return (SV (Loc i))
-              Nothing -> case lookupCtxt Nothing n ctxt of
+              Nothing -> case lookupCtxt n ctxt of
                               [DConstructor _ i ar] ->
                                   if True -- ar == 0 
                                      then return (SCon i n [])
@@ -146,7 +146,7 @@
                               [] -> fail $ "Codegen error: No such variable " ++ show n
     sc env (SApp tc f args)
        = do args' <- mapM (scVar env) args
-            case lookupCtxt Nothing f ctxt of
+            case lookupCtxt f ctxt of
                 [DConstructor n tag ar] ->
                     if True -- (ar == length args)
                        then return $ SCon tag n args'
@@ -160,7 +160,7 @@
             return $ SForeign l ty f args'
     sc env (SCon tag f args)
        = do args' <- mapM (scVar env) args
-            case lookupCtxt Nothing f ctxt of
+            case lookupCtxt f ctxt of
                 [DConstructor n tag ar] ->
                     if True -- (ar == length args)
                        then return $ SCon tag n args'
@@ -197,7 +197,7 @@
     scVar env (Glob n) =
        case lookup n (reverse env) of -- most recent first
               Just i -> do lvar i; return (Loc i)
-              Nothing -> case lookupCtxt Nothing n ctxt of
+              Nothing -> case lookupCtxt n ctxt of
                               [DConstructor _ i ar] ->
                                   fail $ "Codegen error : can't pass constructor here"
                               [_] -> return (Glob n)
@@ -207,7 +207,7 @@
 
     scalt env (SConCase _ i n args e)
        = do let env' = env ++ zip args [length env..]
-            tag <- case lookupCtxt Nothing n ctxt of
+            tag <- case lookupCtxt n ctxt of
                         [DConstructor _ i ar] -> 
                              if True -- (length args == ar) 
                                 then return i
diff --git a/src/Idris/AbsSyntax.hs b/src/Idris/AbsSyntax.hs
--- a/src/Idris/AbsSyntax.hs
+++ b/src/Idris/AbsSyntax.hs
@@ -8,7 +8,9 @@
 import Core.Elaborate hiding (Tactic(..))
 import Core.Typecheck
 import Idris.AbsSyntaxTree
+import Idris.IdeSlave
 import IRTS.CodegenCommon
+import Util.DynamicLinker
 
 import Paths_idris
 
@@ -23,7 +25,7 @@
 import Debug.Trace
 
 import Util.Pretty
-
+import Util.System
 
 getContext :: Idris Context
 getContext = do i <- getIState; return (tt_ctxt i)
@@ -40,9 +42,22 @@
 addLib :: String -> Idris ()
 addLib f = do i <- getIState; putIState $ i { idris_libs = f : idris_libs i }
 
+addDyLib :: [String] -> Idris (Either DynamicLib String)
+addDyLib libs = do i <- getIState
+                   handle <- lift $ mapM (\l -> catchIO (tryLoadLib l) (\_ -> return Nothing)) libs
+                   case msum handle of
+                     Nothing -> return (Right $ "Could not load dynamic alternatives \"" ++
+                                                concat (intersperse "," libs) ++ "\"")
+                     Just x -> do let ls = idris_dynamic_libs i
+                                  putIState $ i { idris_dynamic_libs = x:ls }
+                                  return (Left x)
+
 addHdr :: String -> Idris ()
 addHdr f = do i <- getIState; putIState $ i { idris_hdrs = f : idris_hdrs i }
 
+addLangExt :: LanguageExt -> Idris ()
+addLangExt TypeProviders = do i <- getIState ; putIState $ i { idris_language_extensions = [TypeProviders] }
+
 totcheck :: (FC, Name) -> Idris ()
 totcheck n = do i <- getIState; putIState $ i { idris_totcheck = idris_totcheck i ++ [n] }
 
@@ -76,7 +91,7 @@
         findCoercions fn cs
     where findCoercions t [] = []
           findCoercions t (n : ns) =
-             let ps = case lookupTy Nothing n (tt_ctxt i) of
+             let ps = case lookupTy n (tt_ctxt i) of
                          [ty] -> case unApply (getRetTy ty) of
                                    (t', _) -> 
                                       if t == t' then [n] else []
@@ -107,7 +122,7 @@
 addInstance :: Bool -> Name -> Name -> Idris ()
 addInstance int n i 
     = do ist <- getIState
-         case lookupCtxt Nothing n (idris_classes ist) of
+         case lookupCtxt n (idris_classes ist) of
                 [CI a b c d ins] ->
                      do let cs = addDef n (CI a b c d (addI i ins)) (idris_classes ist)
                         putIState $ ist { idris_classes = cs }
@@ -127,7 +142,7 @@
 addClass :: Name -> ClassInfo -> Idris ()
 addClass n i 
    = do ist <- getIState
-        let i' = case lookupCtxt Nothing n (idris_classes ist) of
+        let i' = case lookupCtxt n (idris_classes ist) of
                       [c] -> c { class_instances = class_instances i }
                       _ -> i
         putIState $ ist { idris_classes = addDef n i' (idris_classes ist) }
@@ -181,7 +196,7 @@
 checkUndefined :: FC -> Name -> Idris ()
 checkUndefined fc n 
     = do i <- getContext
-         case lookupTy Nothing n i of
+         case lookupTy n i of
              (_:_)  -> fail $ show fc ++ ":" ++ 
                        show n ++ " already defined"
              _ -> return ()
@@ -189,7 +204,7 @@
 isUndefined :: FC -> Name -> Idris Bool
 isUndefined fc n 
     = do i <- getContext
-         case lookupTy Nothing n i of
+         case lookupTy n i of
              (_:_)  -> return False
              _ -> return True
 
@@ -208,10 +223,14 @@
          let ics = zip cs (repeat fc) ++ idris_constraints i
          putIState $ i { tt_ctxt = ctxt', idris_constraints = ics }
 
-addDeferred :: [(Name, Type)] -> Idris ()
-addDeferred ns = do mapM_ (\(n, t) -> updateContext (addTyDecl n (tidyNames [] t))) ns
-                    i <- getIState
-                    putIState $ i { idris_metavars = map fst ns ++ idris_metavars i }
+addDeferred = addDeferred' Ref
+addDeferredTyCon = addDeferred' (TCon 0 0)
+
+addDeferred' :: NameType -> [(Name, Type)] -> Idris ()
+addDeferred' nt ns 
+  = do mapM_ (\(n, t) -> updateContext (addTyDecl n nt (tidyNames [] t))) ns
+       i <- getIState
+       putIState $ i { idris_metavars = map fst ns ++ idris_metavars i }
   where tidyNames used (Bind (MN i x) b sc)
             = let n' = uniqueName (UN x) used in
                   Bind n' b $ tidyNames (n':used) sc
@@ -224,11 +243,44 @@
 solveDeferred n = do i <- getIState
                      putIState $ i { idris_metavars = idris_metavars i \\ [n] }
 
+iResult :: String -> Idris ()
+iResult s = do i <- getIState
+               case idris_outputmode i of
+                 RawOutput -> case s of
+                                   "" -> return ()
+                                   s  -> liftIO $ putStrLn s
+                 IdeSlave n ->
+                   let good = SexpList [SymbolAtom "ok", toSExp s] in
+                       liftIO $ putStrLn $ convSExp "return" good n
+
+iFail :: String -> Idris ()
+iFail s = do i <- getIState
+             case idris_outputmode i of
+               RawOutput -> case s of
+                                 "" -> return ()
+                                 s  -> liftIO $ putStrLn s
+               IdeSlave n ->
+                 let good = SexpList [SymbolAtom "error", toSExp s] in
+                     liftIO $ putStrLn $ convSExp "return" good n
+
 iputStrLn :: String -> Idris ()
-iputStrLn = liftIO . putStrLn
+iputStrLn s = do i <- getIState
+                 case idris_outputmode i of
+                   RawOutput -> liftIO $ putStrLn s
+                   IdeSlave n ->
+                     case span (/=':') s of
+                       (fn, ':':rest) -> case span isDigit rest of
+                         ([], ':':msg) -> write
+                         ([], msg) -> write
+                         (num, ':':msg) -> iWarn (FC fn (read num)) msg
+                       _  -> write
+                     where write = liftIO $ putStrLn $ convSExp "write-string" s n
 
 iWarn :: FC -> String -> Idris ()
-iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)
+iWarn fc err = do i <- getIState
+                  case idris_outputmode i of
+                    RawOutput -> liftIO $ putStrLn (show fc ++ ":" ++ err)
+                    IdeSlave n -> liftIO $ putStrLn $ convSExp "warning" (fc_fname fc, fc_line fc, err) n
 
 setLogLevel :: Int -> Idris ()
 setLogLevel l = do i <- getIState
@@ -279,6 +331,12 @@
                let opt' = opts { opt_repl = t }
                putIState $ i { idris_options = opt' }
 
+setQuiet :: Bool -> Idris ()
+setQuiet q = do i <- getIState
+                let opts = idris_options i
+                let opt' = opts { opt_quiet = q }
+                putIState $ i { idris_options = opt' }
+
 setTarget :: Target -> Idris ()
 setTarget t = do i <- getIState
                  let opts = idris_options i
@@ -299,6 +357,11 @@
 outputTy = do i <- getIState
               return $ opt_outputTy $ idris_options i
 
+setIdeSlave :: Bool -> Idris ()
+setIdeSlave True  = do i <- getIState
+                       putIState $ i { idris_outputmode = (IdeSlave 0) }
+setIdeSlave False = return ()
+
 verbose :: Idris Bool
 verbose = do i <- getIState
              return (opt_verbose (idris_options i))
@@ -352,7 +415,7 @@
 
 allImportDirs :: IState -> Idris [FilePath]
 allImportDirs i = do let optdirs = opt_importdirs (idris_options i)
-                     return ("." : optdirs)
+                     return ("." : reverse optdirs)
 
 impShow :: Idris Bool
 impShow = do i <- getIState
@@ -497,6 +560,7 @@
                      PLet n' (en ty) (en v) (en (shadow n n' s))
        | otherwise = PLet n (en ty) (en v) (en s)
     en (PEq f l r) = PEq f (en l) (en r)
+    en (PRewrite f l r) = PRewrite f (en l) (en r)
     en (PTyped l r) = PTyped (en l) (en r)
     en (PPair f l r) = PPair f (en l) (en r)
     en (PDPair f l t r) = PDPair f (en l) (en t) (en r)
@@ -622,7 +686,7 @@
 getPriority i tm = 1 -- pri tm 
   where
     pri (PRef _ n) =
-        case lookupP Nothing n (tt_ctxt i) of
+        case lookupP n (tt_ctxt i) of
             ((P (DCon _ _) _ _):_) -> 1
             ((P (TCon _ _) _ _):_) -> 1
             ((P Ref _ _):_) -> 1
@@ -632,6 +696,7 @@
     pri (PFalse _) = 0
     pri (PRefl _ _) = 1
     pri (PEq _ l r) = max 1 (max (pri l) (pri r))
+    pri (PRewrite _ l r) = max 1 (max (pri l) (pri r))
     pri (PApp _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.getTm) as))) 
     pri (PCase _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.snd) as))) 
     pri (PTyped l r) = pri l
@@ -668,6 +733,45 @@
 
 -- Dealing with implicit arguments
 
+-- Add constraint bindings from using block
+
+addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
+addUsingConstraints syn fc t 
+   = do ist <- get
+        let ns = namesIn [] ist t
+        let cs = getConstraints t -- check declared constraints
+        let addconsts = uconsts \\ cs
+        -- if all names in the arguments of addconsts appear in ns,
+        -- add the constraint implicitly
+        return (doAdd addconsts ns t)
+   where uconsts = filter uconst (using syn)
+         uconst (UConstraint _ _) = True
+         uconst _ = False
+
+         doAdd [] _ t = t
+         -- if all of args in ns, then add it
+         doAdd (UConstraint c args : cs) ns t
+             | all (\n -> elem n ns) args 
+                   = PPi (Constraint False Dynamic "") (MN 0 "cu")
+                         (mkConst c args) (doAdd cs ns t)
+             | otherwise = doAdd cs ns t
+
+         mkConst c args = PApp fc (PRef fc c) 
+                             (map (\n -> PExp 0 False (PRef fc n) "") args)
+
+         getConstraints (PPi (Constraint _ _ _) _ c sc)
+             = getcapp c ++ getConstraints sc
+         getConstraints (PPi _ _ c sc) = getConstraints sc
+         getConstraints _ = []
+
+         getcapp (PApp _ (PRef _ c) args) 
+             = do ns <- mapM getName args
+                  return (UConstraint c ns)
+         getcapp _ = []
+
+         getName (PExp _ _ (PRef _ n) _) = return n
+         getName _ = []
+
 -- Add implicit Pi bindings for any names in the term which appear in an
 -- argument position.
 
@@ -697,9 +801,13 @@
             then (tm, reverse declimps) 
             else implicitise syn ignore ist (pibind uvars ns tm)
   where
-    uvars = using syn
+    uvars = map ipair (filter uimplicit (using syn))
     pvars = syn_params syn
 
+    ipair (UImplicit x y) = (x, y)
+    uimplicit (UImplicit _ _) = True
+    uimplicit _ = False
+
     dropAll (x:xs) ys | x `elem` ys = dropAll xs ys
                       | otherwise   = x : dropAll xs ys
     dropAll [] ys = []
@@ -742,6 +850,10 @@
         = do (decls, ns) <- get
              let isn = namesIn uvars ist l ++ namesIn uvars ist r
              put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))
+    imps top env (PRewrite _ l r)
+        = do (decls, ns) <- get
+             let isn = namesIn uvars ist l ++ namesIn uvars ist r
+             put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))
     imps top env (PTyped l r)
         = imps top env l
     imps top env (PPair _ l r)
@@ -801,6 +913,9 @@
     ai env (PEq fc l r)   = let l' = ai env l
                                 r' = ai env r in
                                 PEq fc l' r'
+    ai env (PRewrite fc l r)   = let l' = ai env l
+                                     r' = ai env r in
+                                     PRewrite fc l' r'
     ai env (PTyped l r) = let l' = ai env l
                               r' = ai env r in
                               PTyped l' r'
@@ -855,9 +970,9 @@
 
 aiFn :: Bool -> Bool -> IState -> FC -> Name -> [PArg] -> Either Err PTerm
 aiFn inpat True ist fc f []
-  = case lookupDef Nothing f (tt_ctxt ist) of
+  = case lookupDef f (tt_ctxt ist) of
         [] -> Right $ PPatvar fc f
-        alts -> let ialts = lookupCtxt Nothing f (idris_implicits ist) in
+        alts -> let ialts = lookupCtxt f (idris_implicits ist) in
                     -- trace (show f ++ " " ++ show (fc, any (all imp) ialts, ialts, any constructor alts)) $ 
                     if (not (vname f) || tcname f 
                            || any constructor alts || any allImp ialts)
@@ -877,7 +992,7 @@
     | f `elem` primNames = Right $ PApp fc (PRef fc f) as
 aiFn inpat expat ist fc f as
           -- This is where namespaces get resolved by adding PAlternative
-        = case lookupCtxtName Nothing f (idris_implicits ist) of
+        = case lookupCtxtName f (idris_implicits ist) of
             [(f',ns)] -> Right $ mkPApp fc (length ns) (PRef fc f') (insertImpl ns as)
             [] -> if f `elem` idris_metavars ist
                     then Right $ PApp fc (PRef fc f) as
@@ -914,6 +1029,42 @@
          | n == n' = Just (t, reverse acc ++ gs)
     find n (g : gs) acc = find n gs (g : acc)
 
+-- replace non-linear occurrences with _
+-- ASSUMPTION: This is called before adding 'alternatives' because otherwise
+-- it is hard to get right!
+
+stripLinear :: IState -> PTerm -> PTerm
+stripLinear i tm = evalState (sl tm) [] where 
+    sl :: PTerm -> State [Name] PTerm
+    sl (PRef fc f) 
+         | (_:_) <- lookupTy f (tt_ctxt i)
+              = return $ PRef fc f
+         | otherwise = do ns <- get
+                          if (f `elem` ns)
+                             then return Placeholder
+                             else do put (f : ns)
+                                     return (PRef fc f)
+    sl (PPatvar fc f) 
+                     = do ns <- get
+                          if (f `elem` ns)
+                             then return Placeholder
+                             else do put (f : ns)
+                                     return (PPatvar fc f)
+    sl (PApp fc fn args) = do fn' <- sl fn
+                              args' <- mapM slA args
+                              return $ PApp fc fn' args'
+       where slA (PImp p l n t d) = do t' <- sl t
+                                       return $ PImp p l n t' d
+             slA (PExp p l t d) = do t' <- sl t
+                                     return $ PExp p l t' d
+             slA (PConstraint p l t d) 
+                                = do t' <- sl t
+                                     return $ PConstraint p l t' d
+             slA (PTacImplicit p l n sc t d) 
+                                = do t' <- sl t
+                                     return $ PTacImplicit p l n sc t' d
+    sl x = return x
+
 mkPApp fc a f [] = f
 mkPApp fc a f as = let rest = drop a as in
                        appRest fc (PApp fc f (take a as)) rest
@@ -1011,18 +1162,24 @@
 --     match (PRef _ n) (PRef _ n') | n == n' = return []
 --                                  | otherwise = Nothing
     match (PRef f n) (PApp _ x []) = match (PRef f n) x
+    match (PPatvar f n) xr = match (PRef f n) xr
+    match xr (PPatvar f n) = match xr (PRef f n)
     match (PApp _ x []) (PRef f n) = match x (PRef f n)
     match (PRef _ n) tm@(PRef _ n')
         | n == n' && not names && 
-          (not (isConName Nothing n (tt_ctxt i)) || tm == Placeholder)
+          (not (isConName n (tt_ctxt i)) || tm == Placeholder)
             = return [(n, tm)]
         | n == n' = return []
     match (PRef _ n) tm 
-        | not names && (not (isConName Nothing n (tt_ctxt i)) || tm == Placeholder)
+        | not names && (not (isConName n (tt_ctxt i)) || tm == Placeholder)
             = return [(n, tm)]
     match (PEq _ l r) (PEq _ l' r') = do ml <- match' l l'
                                          mr <- match' r r'
                                          return (ml ++ mr)
+    match (PRewrite _ l r) (PRewrite _ l' r') 
+                                    = do ml <- match' l l'
+                                         mr <- match' r r'
+                                         return (ml ++ mr)
     match (PTyped l r) (PTyped l' r') = do ml <- match l l'
                                            mr <- match r r'
                                            return (ml ++ mr)
@@ -1104,6 +1261,7 @@
     sm xs (PApp f x as) = PApp f (sm xs x) (map (fmap (sm xs)) as)
     sm xs (PCase f x as) = PCase f (sm xs x) (map (pmap (sm xs)) as)
     sm xs (PEq f x y) = PEq f (sm xs x) (sm xs y)
+    sm xs (PRewrite f x y) = PRewrite f (sm xs x) (sm xs y)
     sm xs (PTyped x y) = PTyped (sm xs x) (sm xs y)
     sm xs (PPair f x y) = PPair f (sm xs x) (sm xs y)
     sm xs (PDPair f x t y) = PDPair f (sm xs x) (sm xs t) (sm xs y)
@@ -1119,6 +1277,7 @@
     sm (PApp f x as) = PApp f (sm x) (map (fmap sm) as)
     sm (PCase f x as) = PCase f (sm x) (map (pmap sm) as)
     sm (PEq f x y) = PEq f (sm x) (sm y)
+    sm (PRewrite f x y) = PRewrite f (sm x) (sm y)
     sm (PTyped x y) = PTyped (sm x) (sm y)
     sm (PPair f x y) = PPair f (sm x) (sm y)
     sm (PDPair f x t y) = PDPair f (sm x) (sm t) (sm y)
diff --git a/src/Idris/AbsSyntaxTree.hs b/src/Idris/AbsSyntaxTree.hs
--- a/src/Idris/AbsSyntaxTree.hs
+++ b/src/Idris/AbsSyntaxTree.hs
@@ -10,6 +10,7 @@
 import IRTS.Lang
 import IRTS.CodegenCommon
 import Util.Pretty
+import Util.DynamicLinker
 
 import Paths_idris
 
@@ -23,24 +24,44 @@
 
 import Debug.Trace
 
-data IOption = IOption { opt_logLevel :: Int,
-                         opt_typecase :: Bool,
+data IOption = IOption { opt_logLevel   :: Int,
+                         opt_typecase   :: Bool,
                          opt_typeintype :: Bool,
-                         opt_coverage :: Bool,
-                         opt_showimp  :: Bool,
+                         opt_coverage   :: Bool,
+                         opt_showimp    :: Bool,
                          opt_errContext :: Bool,
-                         opt_repl     :: Bool,
-                         opt_verbose  :: Bool,
-                         opt_target   :: Target,
-                         opt_outputTy :: OutputType,
-                         opt_ibcsubdir :: FilePath,
+                         opt_repl       :: Bool,
+                         opt_verbose    :: Bool,
+                         opt_quiet      :: Bool,
+                         opt_target     :: Target,
+                         opt_outputTy   :: OutputType,
+                         opt_ibcsubdir  :: FilePath,
                          opt_importdirs :: [FilePath],
-                         opt_cmdline :: [Opt] -- remember whole command line
+                         opt_cmdline    :: [Opt] -- remember whole command line
                        }
     deriving (Show, Eq)
 
-defaultOpts = IOption 0 False False True False False True True ViaC Executable "" [] []
+defaultOpts = IOption { opt_logLevel   = 0
+                      , opt_typecase   = False
+                      , opt_typeintype = False
+                      , opt_coverage   = True
+                      , opt_showimp    = False
+                      , opt_errContext = False
+                      , opt_repl       = True
+                      , opt_verbose    = True
+                      , opt_quiet      = False
+                      , opt_target     = ViaC
+                      , opt_outputTy   = Executable
+                      , opt_ibcsubdir  = ""
+                      , opt_importdirs = []
+                      , opt_cmdline    = []
+                      }
 
+data LanguageExt = TypeProviders deriving (Show, Eq, Read, Ord)
+
+-- | The output mode in use
+data OutputMode = RawOutput | IdeSlave Integer deriving Show
+
 -- TODO: Add 'module data' to IState, which can be saved out and reloaded quickly (i.e
 -- without typechecking).
 -- This will include all the functions and data declarations, plus fixity declarations
@@ -58,7 +79,8 @@
     idris_dsls :: Ctxt DSL,
     idris_optimisation :: Ctxt OptInfo, 
     idris_datatypes :: Ctxt TypeInfo,
-    idris_patdefs :: Ctxt [([Name], Term, Term)], -- not exported
+    idris_patdefs :: Ctxt ([([Name], Term, Term)], [PTerm]), -- not exported
+      -- ^ list of lhs/rhs, and a list of missing clauses
     idris_flags :: Ctxt [FnOpt],
     idris_callgraph :: Ctxt CGInfo, -- name, args used in each pos
     idris_calledgraph :: Ctxt [Name],
@@ -78,19 +100,22 @@
     idris_hdrs :: [String],
     proof_list :: [(Name, [String])],
     errLine :: Maybe Int,
-    lastParse :: Maybe Name, 
+    lastParse :: Maybe Name,
     indent_stack :: [Int],
     brace_stack :: [Maybe Int],
     hide_list :: [(Name, Maybe Accessibility)],
     default_access :: Accessibility,
     default_total :: Bool,
     ibc_write :: [IBCWrite],
-    compiled_so :: Maybe String
+    compiled_so :: Maybe String,
+    idris_dynamic_libs :: [DynamicLib],
+    idris_language_extensions :: [LanguageExt],
+    idris_outputmode :: OutputMode
    }
 
 data SizeChange = Smaller | Same | Bigger | Unknown
     deriving (Show, Eq)
-{-! 
+{-!
 deriving instance Binary SizeChange
 !-}
 
@@ -122,6 +147,7 @@
               | IBCImport FilePath
               | IBCObj FilePath
               | IBCLib String
+              | IBCDyLib String
               | IBCHeader String
               | IBCAccess Name Accessibility
               | IBCTotal Name Totality
@@ -136,10 +162,11 @@
                    emptyContext emptyContext emptyContext emptyContext 
                    emptyContext emptyContext emptyContext emptyContext
                    [] "" defaultOpts 6 [] [] [] [] [] [] [] [] []
-                   [] Nothing Nothing [] [] [] Hidden False [] Nothing
+                   [] Nothing Nothing [] [] [] Hidden False [] Nothing [] [] RawOutput
 
 -- | The monad for the main REPL - reading and processing files and updating 
 -- global state (hence the IO inner monad).
+--type Idris = WriterT [Either String (IO ())] (State IState a))
 type Idris = StateT IState IO
 
 -- Commands in the REPL
@@ -160,6 +187,7 @@
              | TotCheck Name
              | Reload
              | Load FilePath 
+             | ChangeDirectory FilePath
              | ModImport String 
              | Edit
              | Compile Target String
@@ -180,6 +208,8 @@
              | Defn Name
              | Info Name
              | Missing Name
+             | DynamicLink FilePath
+             | ListDynamic
              | Pattelab PTerm
              | DebugInfo Name
              | Search PTerm
@@ -190,6 +220,8 @@
 data Opt = Filename String
          | Ver
          | Usage
+         | Quiet
+         | Ideslave
          | ShowLibs
          | ShowLibdir
          | ShowIncs
@@ -220,6 +252,7 @@
          | FOVM String
          | UseTarget Target
          | OutputTy OutputType
+         | Extension LanguageExt
     deriving (Show, Eq)
 
 -- Parsed declarations
@@ -330,12 +363,22 @@
    | PSyntax  FC Syntax -- ^ Syntax definition
    | PMutual  FC [PDecl' t] -- ^ Mutual block
    | PDirective (Idris ()) -- ^ Compiler directive. The parser inserts the corresponding action in the Idris monad.
+   | PProvider SyntaxInfo FC Name t t -- ^ Type provider. The first t is the type, the second is the term
   deriving Functor
 {-!
 deriving instance Binary PDecl'
 !-}
 
-data PClause' t = PClause  FC Name t [t] t [PDecl' t]
+-- | One clause of a top-level definition. Term arguments to constructors are:
+--
+-- 1. The whole application (missing for PClauseR and PWithR because they're within a "with" clause)
+--
+-- 2. The list of patterns
+--
+-- 3. The right-hand side
+--
+-- 4. The where block (PDecl' t)
+data PClause' t = PClause  FC Name t [t] t [PDecl' t] -- ^ A normal top-level definition.
                 | PWith    FC Name t [t] t [PDecl' t]
                 | PClauseR FC        [t] t [PDecl' t]
                 | PWithR   FC        [t] t [PDecl' t]
@@ -371,12 +414,19 @@
 declared (PTy _ _ _ _ n t) = [n]
 declared (PPostulate _ _ _ _ n t) = [n]
 declared (PClauses _ _ n _) = [] -- not a declaration
-declared (PRecord _ _ _ n _ _ c _) = [n, c]
+declared (PCAF _ n _) = [n]
 declared (PData _ _ _ _ (PDatadecl n _ ts)) = n : map fstt ts
    where fstt (_, a, _, _) = a
+declared (PData _ _ _ _ (PLaterdecl n _)) = [n]
 declared (PParams _ _ ds) = concatMap declared ds
-declared (PMutual _ ds) = concatMap declared ds
 declared (PNamespace _ ds) = concatMap declared ds
+declared (PRecord _ _ _ n _ _ c _) = [n, c]
+declared (PClass _ _ _ _ n _ ms) = n : concatMap declared ms
+declared (PInstance _ _ _ _ _ _ _ _) = []
+declared (PDSL n _) = [n]
+declared (PSyntax _ _) = []
+declared (PMutual _ ds) = concatMap declared ds
+declared (PDirective _) = []
 
 -- get the names declared, not counting nested parameter blocks
 tldeclared :: PDecl -> [Name]
@@ -390,20 +440,27 @@
 tldeclared (PParams _ _ ds) = [] 
 tldeclared (PMutual _ ds) = concatMap tldeclared ds
 tldeclared (PNamespace _ ds) = concatMap tldeclared ds
--- declared (PImport _) = []
 
+
 defined :: PDecl -> [Name]
 defined (PFix _ _ _) = []
 defined (PTy _ _ _ _ n t) = []
 defined (PPostulate _ _ _ _ n t) = []
 defined (PClauses _ _ n _) = [n] -- not a declaration
-defined (PRecord _ _ _ n _ _ c _) = [n, c]
+defined (PCAF _ n _) = [n]
 defined (PData _ _ _ _ (PDatadecl n _ ts)) = n : map fstt ts
    where fstt (_, a, _, _) = a
+defined (PData _ _ _ _ (PLaterdecl n _)) = []
 defined (PParams _ _ ds) = concatMap defined ds
-defined (PMutual _ ds) = concatMap defined ds
 defined (PNamespace _ ds) = concatMap defined ds
--- declared (PImport _) = []
+defined (PRecord _ _ _ n _ _ c _) = [n, c]
+defined (PClass _ _ _ _ n _ ms) = n : concatMap defined ms
+defined (PInstance _ _ _ _ _ _ _ _) = []
+defined (PDSL n _) = [n]
+defined (PSyntax _ _) = []
+defined (PMutual _ ds) = concatMap defined ds
+defined (PDirective _) = []
+--defined _ = []
 
 updateN :: [(Name, Name)] -> Name -> Name
 updateN ns n | Just n' <- lookup n ns = n'
@@ -442,6 +499,7 @@
            | PRefl FC PTerm
            | PResolveTC FC
            | PEq FC PTerm PTerm
+           | PRewrite FC PTerm PTerm
            | PPair FC PTerm PTerm
            | PDPair FC PTerm PTerm PTerm
            | PAlternative Bool [PTerm] -- True if only one may work
@@ -468,6 +526,7 @@
   mpt (PLam n t s) = PLam n (mapPT f t) (mapPT f s)
   mpt (PPi p n t s) = PPi p n (mapPT f t) (mapPT f s)
   mpt (PLet n ty v s) = PLet n (mapPT f ty) (mapPT f v) (mapPT f s)
+  mpt (PRewrite fc t s) = PRewrite fc (mapPT f t) (mapPT f s)
   mpt (PApp fc t as) = PApp fc (mapPT f t) (map (fmap (mapPT f)) as)
   mpt (PCase fc c os) = PCase fc (mapPT f c) (map (pmap (mapPT f)) os)
   mpt (PEq fc l r) = PEq fc (mapPT f l) (mapPT f r)
@@ -491,7 +550,9 @@
                 | ProofState | ProofTerm | Undo
                 | Try (PTactic' t) (PTactic' t)
                 | TSeq (PTactic' t) (PTactic' t)
-                | ReflectTac t -- see Language.Reflection module
+                | ApplyTactic t -- see Language.Reflection module
+                | Reflect t
+                | Fill t
                 | GoalType String (PTactic' t)
                 | Qed | Abandon
     deriving (Show, Eq, Functor)
@@ -516,6 +577,9 @@
   size Undo = 1
   size (Try l r) = 1 + size l + size r
   size (TSeq l r) = 1 + size l + size r
+  size (ApplyTactic t) = 1 + size t
+  size (Reflect t) = 1 + size t
+  size (Fill t) = 1 + size t
   size Qed = 1
   size Abandon = 1
 
@@ -659,7 +723,14 @@
               Nothing
   where f = FC "(builtin)" 0
 
-data SyntaxInfo = Syn { using :: [(Name, PTerm)],
+data Using = UImplicit Name PTerm
+           | UConstraint Name [Name]
+    deriving (Show, Eq)
+{-!
+deriving instance Binary Using
+!-}
+
+data SyntaxInfo = Syn { using :: [Using],
                         syn_params :: [(Name, PTerm)],
                         syn_namespace :: [String],
                         no_imp :: [Name],
@@ -844,10 +915,10 @@
         bracket p 1 $
           prettySe 1 f <+>
             if impl then
-              foldl fS empty as
+              foldl' fS empty as
               -- foldr (<+>) empty $ map prettyArgS as
             else
-              foldl fSe empty args
+              foldl' fSe empty args
               -- foldr (<+>) empty $ map prettyArgSe args
       where
         fS l r =
@@ -878,6 +949,12 @@
           prettySe 10 l <+> text "=" $$ nest nestingSize (prettySe 10 r)
         else
           prettySe 10 l <+> text "=" <+> prettySe 10 r
+    prettySe p (PRewrite _ l r) =
+      bracket p 2 $
+        if size r > breakingSize then
+          text "rewrite" <+> prettySe 10 l <+> text "in" $$ nest nestingSize (prettySe 10 r)
+        else
+          text "rewrite" <+> prettySe 10 l <+> text "in" <+> prettySe 10 r
     prettySe p (PTyped l r) =
       lparen <> prettySe 10 l <+> colon <+> prettySe 10 r <> rparen
     prettySe p (PPair _ l r) =
@@ -930,7 +1007,7 @@
 showImp :: Bool -> PTerm -> String
 showImp impl tm = se 10 tm where
     se p (PQuote r) = "![" ++ show r ++ "]"
-    se p (PPatvar fc n) = show n
+    se p (PPatvar fc n) = if impl then show n ++ "[p]" else show n
     se p (PInferRef fc n) = "!" ++ show n -- ++ "[" ++ show fc ++ "]"
     se p (PRef fc n) = if impl then show n -- ++ "[" ++ show fc ++ "]"
                                else showbasic n
@@ -965,6 +1042,9 @@
         = bracket p 2 $ se 10 ty ++ " => " ++ se 10 sc
     se p (PPi (TacImp _ _ s _) n ty sc)
         = bracket p 2 $ "{tacimp " ++ show n ++ " : " ++ se 10 ty ++ "} -> " ++ se 10 sc
+    se p e
+        | Just str <- slist p e = str
+        | Just num <- snat p e  = show num
     se p (PApp _ (PRef _ f) [])
         | not impl = show f
     se p (PApp _ (PRef _ op@(UN (f:_))) args)
@@ -985,6 +1065,7 @@
     se p (PTrue _) = "()"
     se p (PFalse _) = "_|_"
     se p (PEq _ l r) = bracket p 2 $ se 10 l ++ " = " ++ se 10 r
+    se p (PRewrite _ l r) = bracket p 2 $ "rewrite " ++ se 10 l ++ " in " ++ se 10 r
     se p (PTyped l r) = "(" ++ se 10 l ++ " : " ++ se 10 r ++ ")"
     se p (PPair _ l r) = "(" ++ se 10 l ++ ", " ++ se 10 r ++ ")"
     se p (PDPair _ l t r) = "(" ++ se 10 l ++ " ** " ++ se 10 r ++ ")"
@@ -1002,6 +1083,37 @@
     se p (PCoerced t) = se p t
 --     se p x = "Not implemented"
 
+    slist' p (PApp _ (PRef _ nil) _)
+      | nsroot nil == UN "Nil" = Just []
+    slist' p (PApp _ (PRef _ cons) args)
+      | nsroot cons == UN "::",
+        (PExp {getTm=tl}):(PExp {getTm=hd}):imps <- reverse args,
+        all isImp imps,
+        Just tl' <- slist' p tl
+      = Just (hd:tl')
+      where
+        isImp (PImp {}) = True
+        isImp _         = False
+    slist' _ _ = Nothing
+
+    slist p e | Just es <- slist' p e = Just $
+      case es of []  -> "[]"
+                 [x] -> "[" ++ se p x ++ "]"
+                 xs  -> "[" ++ intercalate "," (map (se p) xs) ++ "]"
+    slist _ _ = Nothing
+
+    -- since Prelude is always imported, S & O are unqualified iff they're the
+    -- Nat ones.
+    snat p (PRef _ o)
+      | show o == (natns++"O") || show o == "O" = Just 0
+    snat p (PApp _ s [PExp {getTm=n}])
+      | show s == (natns++"S") || show s == "S",
+        Just n' <- snat p n
+      = Just $ 1 + n'
+    snat _ _ = Nothing
+
+    natns = "Prelude.Nat."
+
     sArg (PImp _ _ n tm _) = siArg (n, tm)
     sArg (PExp _ _ tm _) = seArg tm
     sArg (PConstraint _ _ tm _) = scArg tm
@@ -1030,6 +1142,7 @@
   size (PRefl fc _) = 1
   size (PResolveTC fc) = 1
   size (PEq fc left right) = 1 + size left + size right
+  size (PRewrite fc left right) = 1 + size left + size right
   size (PPair fc left right) = 1 + size left + size right
   size (PDPair fs left ty right) = 1 + size left + size ty + size right
   size (PAlternative a alts) = 1 + size alts
@@ -1062,6 +1175,7 @@
     ni env (PPi _ n ty sc) = ni env ty ++ ni (n:env) sc
     ni env (PHidden tm)    = ni env tm
     ni env (PEq _ l r)     = ni env l ++ ni env r
+    ni env (PRewrite _ l r) = ni env l ++ ni env r
     ni env (PTyped l r)    = ni env l ++ ni env r
     ni env (PPair _ l r)   = ni env l ++ ni env r
     ni env (PDPair _ (PRef _ n) t r)  = ni env t ++ ni (n:env) r
@@ -1076,7 +1190,7 @@
   where
     ni env (PRef _ n)        
         | not (n `elem` env) 
-            = case lookupTy Nothing n (tt_ctxt ist) of
+            = case lookupTy n (tt_ctxt ist) of
                 [] -> [n]
                 _ -> if n `elem` (map fst uvars) then [n] else []
     ni env (PApp _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)
@@ -1084,6 +1198,7 @@
     ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
     ni env (PPi _ n ty sc) = ni env ty ++ ni (n:env) sc
     ni env (PEq _ l r)     = ni env l ++ ni env r
+    ni env (PRewrite _ l r) = ni env l ++ ni env r
     ni env (PTyped l r)    = ni env l ++ ni env r
     ni env (PPair _ l r)   = ni env l ++ ni env r
     ni env (PDPair _ (PRef _ n) t r) = ni env t ++ ni (n:env) r
@@ -1099,7 +1214,7 @@
   where
     ni env (PRef _ n)        
         | n `elem` vars && not (n `elem` env) 
-            = case lookupTy Nothing n (tt_ctxt ist) of
+            = case lookupTy n (tt_ctxt ist) of
                 [] -> [n]
                 _ -> []
     ni env (PApp _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)
@@ -1107,6 +1222,7 @@
     ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
     ni env (PPi _ n ty sc) = ni env ty ++ ni (n:env) sc
     ni env (PEq _ l r)     = ni env l ++ ni env r
+    ni env (PRewrite _ l r) = ni env l ++ ni env r
     ni env (PTyped l r)    = ni env l ++ ni env r
     ni env (PPair _ l r)   = ni env l ++ ni env r
     ni env (PDPair _ (PRef _ n) t r) = ni env t ++ ni (n:env) r
diff --git a/src/Idris/Completion.hs b/src/Idris/Completion.hs
--- a/src/Idris/Completion.hs
+++ b/src/Idris/Completion.hs
@@ -3,8 +3,10 @@
 
 import Core.Evaluate (ctxtAlist)
 import Core.TT
+import Core.CoreParser (opChars)
 
 import Idris.AbsSyntaxTree
+import Idris.Help
 
 import Control.Monad.State.Strict
 
@@ -13,40 +15,12 @@
 
 import System.Console.Haskeline
 
--- TODO: add specific classes of identifiers to complete, fx metavariables
--- | A specification of the arguments that REPL commands can take
-data CmdArg = ExprArg -- ^ The command takes an expression
-            | NameArg -- ^ The command takes a name
-            | FileArg -- ^ The command takes a file
-            | ModuleArg -- ^ The command takes a module name
-            | OptionArg -- ^ The command takes an option
 
--- | Information about how to complete the various commands
-cmdArgs :: [(String, CmdArg)]
-cmdArgs = [ (":t", ExprArg)
-          , (":miss", NameArg)
-          , (":missing", NameArg)
-          , (":i", NameArg)
-          , (":info", NameArg)
-          , (":total", NameArg)
-          , (":l", FileArg)
-          , (":load", FileArg)
-          , (":m", ModuleArg) -- NOTE: Argumentless form is a different command
-          , (":p", NameArg)
-          , (":prove", NameArg)
-          , (":a", NameArg)
-          , (":addproof", NameArg)
-          , (":rmproof", NameArg)
-          , (":showproof", NameArg)
-          , (":c", FileArg)
-          , (":compile", FileArg)
-          , (":js", FileArg)
-          , (":javascript", FileArg)
-          , (":set", OptionArg)
-          , (":unset", OptionArg)
-          ]
-commands = map fst cmdArgs
+fst3 :: (a, b, c) -> a
+fst3 (a, b, c) = a
 
+commands = concatMap fst3 help
+
 -- | A specification of the arguments that tactics can take
 data TacticArg = NameTArg -- ^ Names: n1, n2, n3, ... n
                | ExprTArg
@@ -61,7 +35,9 @@
              , ("let", Nothing) -- FIXME syntax for let
              , ("focus", Just ExprTArg)
              , ("exact", Just ExprTArg)
+             , ("applyTactic", Just ExprTArg)
              , ("reflect", Just ExprTArg)
+             , ("fill", Just ExprTArg)
              , ("try", Just AltsTArg)
              ] ++ map (\x -> (x, Nothing)) [
               "intro", "intros", "compute", "trivial", "solve", "attack",
@@ -80,12 +56,20 @@
 
 -- FIXME: Respect module imports
 -- | Get the user-visible names from the current interpreter state.
-names :: Idris[String]
+names :: Idris [String]
 names = do i <- get
            let ctxt = tt_ctxt i
-           return $ nub $ mapMaybe (nameString . fst) $ ctxtAlist ctxt
+           return . nub $
+             mapMaybe (nameString . fst) (ctxtAlist ctxt) ++
+             -- Explicitly add primitive types, as these are special-cased in the parser
+             ["Int", "Integer", "Float", "Char", "String", "Type",
+              "Ptr", "Bits8", "Bits16", "Bits32", "Bits64"]
 
+metavars :: Idris [String]
+metavars = do i <- get
+              return . map (show . nsroot) $ idris_metavars i \\ primDefs
 
+
 modules :: Idris [String]
 modules = do i <- get
              return $ map show $ imported i
@@ -97,15 +81,20 @@
                     then [simpleCompletion n]
                     else map simpleCompletion prefixMatches
     where prefixMatches = filter (isPrefixOf n) ns
-          uniqueExists = n `elem` prefixMatches
+          uniqueExists = [n] == prefixMatches
 
 completeName :: [String] -> String -> Idris [Completion]
 completeName extra n = do ns <- names
                           return $ completeWith (extra ++ ns) n
 
 completeExpr :: [String] -> CompletionFunc Idris
-completeExpr extra = completeWord Nothing " \t" (completeName extra)
+completeExpr extra = completeWord Nothing (" \t(){}:" ++ opChars) (completeName extra)
 
+completeMetaVar :: CompletionFunc Idris
+completeMetaVar = completeWord Nothing (" \t(){}:" ++ opChars) completeM
+    where completeM m = do mvs <- metavars
+                           return $ completeWith mvs m
+
 completeOption :: CompletionFunc Idris
 completeOption = completeWord Nothing " \t" completeOpt
     where completeOpt = return . (completeWith ["errorcontext", "showimplicits"])
@@ -113,14 +102,22 @@
 isWhitespace :: Char -> Bool
 isWhitespace = (flip elem) " \t\n"
 
+lookupInHelp :: String -> Maybe CmdArg
+lookupInHelp cmd = lookupInHelp' cmd help
+    where lookupInHelp' cmd ((cmds, arg, _):xs) | elem cmd cmds = Just arg
+                                                | otherwise   = lookupInHelp' cmd xs
+          lookupInHelp' cmd [] = Nothing
+
 -- | Get the completion function for a particular command
 completeCmd :: String -> CompletionFunc Idris
-completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookup cmd cmdArgs
+completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookupInHelp cmd
     where completeArg FileArg = completeFilename (prev, next)
           completeArg NameArg = completeExpr [] (prev, next) -- FIXME only complete one name
           completeArg OptionArg = completeOption (prev, next)
           completeArg ModuleArg = noCompletion (prev, next) -- FIXME do later
           completeArg ExprArg = completeExpr [] (prev, next)
+          completeArg MetaVarArg = completeMetaVar (prev, next) -- FIXME only complete one name
+          completeArg NoArg = noCompletion (prev, next)
           completeCmdName = return $ ("", completeWith commands cmd)
 
 -- | Complete REPL commands and defined identifiers
diff --git a/src/Idris/Coverage.hs b/src/Idris/Coverage.hs
--- a/src/Idris/Coverage.hs
+++ b/src/Idris/Coverage.hs
@@ -17,28 +17,13 @@
 
 import Control.Monad.State
 
--- Generate the LHSes which are missing from a case tree
--- Eliminate the ones which cannot be well typed
-
-genMissing :: Name -> [Name] -> SC -> Idris [PTerm] 
-genMissing fn args sc 
-   = do sc' <- expandTree sc
-        logLvl 5 $ "Checking missing cases for " ++ 
-                     show fn ++ "\n" ++ (show sc')
-        (got, missing) <- gm fn (map (\x -> P Bound x Erased) args) sc'
-        return $ filter (\x -> not (x `elem` got)) missing
-
--- Make a term to feed to the pattern matcher from a LHS declared impossible
--- (we can't type check it, but we need the case analysis to check for 
--- covering...)
-
 mkPatTm :: PTerm -> Idris Term
 mkPatTm t = do i <- getIState
                let timp = addImpl' True [] [] i t
                evalStateT (toTT timp) 0
   where
     toTT (PRef _ n) = do i <- lift getIState
-                         case lookupDef Nothing n (tt_ctxt i) of
+                         case lookupDef n (tt_ctxt i) of
                               [TyDecl nt _] -> return $ P nt n Erased
                               _ -> return $ P Ref n Erased
     toTT (PApp _ t args) = do t' <- toTT t
@@ -48,101 +33,6 @@
                 put (v + 1)
                 return (P Bound (MN v "imp") Erased) 
 
-mkPTerm :: Name -> [TT Name] -> Idris PTerm
-mkPTerm f args = do i <- getIState
-                    let fapp = mkApp (P Bound f Erased) (map eraseName args)
-                    return $ delab i fapp
-  where eraseName (App f a) = App (eraseName f) (eraseName a)
-        eraseName (P _ (MN _ _) _) = Erased
-        eraseName t                = t
-
-gm :: Name -> [TT Name] -> SC -> Idris ([PTerm], [PTerm])
-gm fn args (Case n alts) = do m <- mapM (gmAlt fn args n) alts
-                              let (got, missing) = unzip m
-                              return (concat got, concat missing)
-gm fn args (STerm tm)    = do logLvl 3 ("Covered: " ++ show args)
-                              t <- mkPTerm fn args
-                              return ([t], [])
-gm fn args ImpossibleCase = do logLvl 3 ("Impossible: " ++ show args)
-                               t <- mkPTerm fn args
-                               return ([], [])
-gm fn args (UnmatchedCase _) = do logLvl 3 ("Missing: " ++ show args)
-                                  t <- mkPTerm fn args
-                                  return ([], [t])
-
-gmAlt fn args n (ConCase cn t cargs sc)
-   = do let args' = map (subst n (mkApp (P Bound cn Erased)
-                                        (map (\x -> P Bound x Erased) cargs))) 
-                        args
-        gm fn args' sc
-gmAlt fn args n (ConstCase c sc)
-   = do let args' = map (subst n (Constant c)) args
-        gm fn args' sc
-gmAlt fn args n (DefaultCase sc)
-   = do gm fn args sc
-
-getDefault (DefaultCase sc : _) = sc
-getDefault (_ : cs) = getDefault cs
-getDefault [] = UnmatchedCase ""
-
-dropDefault (DefaultCase sc : rest) = dropDefault rest
-dropDefault (c : cs) = c : dropDefault cs
-dropDefault [] = [] 
-
-expandTree :: SC -> Idris SC
-expandTree (Case n alts) = do i <- getIState
-                              as <- expandAlts i (dropDefault alts) 
-                                                 (getDefault alts)
-                              alts' <- mapM expandTreeA as
-                              return (Case n alts')
-    where expandTreeA (ConCase n i ns sc) = do sc' <- expandTree sc
-                                               return (ConCase n i ns sc')
-          expandTreeA (ConstCase i sc) = do sc' <- expandTree sc
-                                            return (ConstCase i sc')
-          expandTreeA (DefaultCase sc) = do sc' <- expandTree sc
-                                            return (DefaultCase sc')
-expandTree t = return t
-
-expandAlts :: IState -> [CaseAlt] -> SC -> Idris [CaseAlt]
-expandAlts i all@(ConstCase c _ : alts) def
-    = return $ all ++ [DefaultCase def]
-expandAlts i all@(ConCase n _ _ _ : alts) def
-    | (TyDecl c@(DCon _ arity) ty : _) <- lookupDef Nothing n (tt_ctxt i)
-         = do let tyn = getTy n (tt_ctxt i)
-              case lookupCtxt Nothing tyn (idris_datatypes i) of
-                  (TI ns _ _: _) -> do let ps = map mkPat ns
-                                       return $ addAlts ps (altsFor all) all
-                  _ -> return all
-  where
-    altsFor [] = []
-    altsFor (ConCase n _ _ _ : alts) = n : altsFor alts
-    altsFor (_ : alts) = altsFor alts
-
-    addAlts [] got alts = alts
-    addAlts ((n, arity) : ps) got alts
-        | n `elem` got = addAlts ps got alts
-        | otherwise = addAlts ps got (alts ++ 
-                             [ConCase n (-1) (argList arity) def])
-
-    argList i = take i (map (\x -> (MN x "ign")) [0..])
-
-    getTy n ctxt 
-      = case lookupTy Nothing n ctxt of
-            (t : _) -> case unApply (getRetTy t) of
-                        (P _ tyn _, _) -> tyn
-                        x -> error $ "Can't happen getTy 1 " ++ show (n, x)
-            _ -> error "Can't happen getTy 2"
-
-    mkPat x = case lookupCtxt Nothing x (idris_implicits i) of
-                    (pargs : _)
-                       -> (x, length pargs)  
-                    _ -> error "Can't happen - genAll"
-expandAlts i alts def = return alts 
-        
-
-
--- OLD STUFF: probably broken...
-
 -- Given a list of LHSs, generate a extra clauses which cover the remaining
 -- cases. The ones which haven't been provided are marked 'absurd' so that the
 -- checker will make sure they can't happen.
@@ -160,7 +50,7 @@
         logLvl 10 $ show argss ++ "\n" ++ show all_args
         logLvl 10 $ "Original: \n" ++ 
              showSep "\n" (map (\t -> showImp True (delab' i t True)) xs)
-        let parg = case lookupCtxt Nothing n (idris_implicits i) of
+        let parg = case lookupCtxt n (idris_implicits i) of
                         (p : _) -> p
                         _ -> repeat (pexp Placeholder)
         let tryclauses = mkClauses parg all_args
@@ -217,8 +107,8 @@
                     [] -> [Placeholder]
                     xs -> nub xs
   where 
-    conForm (PApp _ (PRef fc n) _) = isConName Nothing n (tt_ctxt i)
-    conForm (PRef fc n) = isConName Nothing n (tt_ctxt i)
+    conForm (PApp _ (PRef fc n) _) = isConName n (tt_ctxt i)
+    conForm (PRef fc n) = isConName n (tt_ctxt i)
     conForm _ = False
 
     otherPats :: PTerm -> [PTerm]
@@ -227,22 +117,22 @@
     otherPats arg = return Placeholder 
 
     ops fc n xs o
-        | (TyDecl c@(DCon _ arity) ty : _) <- lookupDef Nothing n (tt_ctxt i)
+        | (TyDecl c@(DCon _ arity) ty : _) <- lookupDef n (tt_ctxt i)
             = do xs' <- mapM otherPats (map getTm xs)
                  let p = PApp fc (PRef fc n) (zipWith upd xs' xs)
                  let tyn = getTy n (tt_ctxt i)
-                 case lookupCtxt Nothing tyn (idris_datatypes i) of
+                 case lookupCtxt tyn (idris_datatypes i) of
                          (TI ns _ _ : _) -> p : map (mkPat fc) (ns \\ [n])
                          _ -> [p]
     ops fc n arg o = return Placeholder
 
-    getTy n ctxt = case lookupTy Nothing n ctxt of
+    getTy n ctxt = case lookupTy n ctxt of
                           (t : _) -> case unApply (getRetTy t) of
                                         (P _ tyn _, _) -> tyn
                                         x -> error $ "Can't happen getTy 1 " ++ show (n, x)
                           _ -> error "Can't happen getTy 2"
 
-    mkPat fc x = case lookupCtxt Nothing x (idris_implicits i) of
+    mkPat fc x = case lookupCtxt x (idris_implicits i) of
                       (pargs : _)
                          -> PApp fc (PRef fc x) (map (upd Placeholder) pargs)  
                       _ -> error "Can't happen - genAll"
@@ -272,50 +162,62 @@
             = n /= n' && posArg sc
     posArg t = True
 
--- Totality checking - check for structural recursion 
--- (no mutual definitions yet)
-
-data LexOrder = LexXX | LexEQ | LexLT
-    deriving (Show, Eq, Ord)
-
 calcProd :: IState -> FC -> Name -> [([Name], Term, Term)] -> Idris Totality
-calcProd i fc n pats = do patsprod <- mapM prodRec pats
-                          if (and patsprod) 
-                             then return Productive
-                             else return (Partial NotProductive)
+calcProd i fc topn pats 
+    = cp topn pats []
    where
      -- every application of n must be in an argument of a coinductive 
-     -- constructor
+     -- constructor, in every function reachable from here in the
+     -- call graph.
+     cp n pats done = do patsprod <- mapM (prodRec n done) pats
+                         if (and patsprod) 
+                            then return Productive
+                            else return (Partial NotProductive)
 
-     prodRec :: ([Name], Term, Term) -> Idris Bool
-     prodRec (_, _, tm) = prod False tm 
+     prodRec :: Name -> [Name] -> ([Name], Term, Term) -> Idris Bool
+     prodRec n done _ | n `elem` done = return True
+     prodRec n done (_, _, tm) = prod n done False tm 
 
-     prod ok ap@(App _ _)
-        | (P _ (UN "lazy") _, [_, arg]) <- unApply ap = prod ok arg
-        | (P _ f ty, args) <- unApply ap
-            = let co = cotype ty in
-                  if f == n 
-                     then do argsprod <- mapM (prod co) args
-                             return (and (ok : argsprod) )
-                     else do argsprod <- mapM (prod co) args
-                             return (and argsprod)
-     prod ok (App f a) = liftM2 (&&) (prod False f) (prod False a)
-     prod ok (Bind _ (Let t v) sc) = liftM2 (&&) (prod False v) (prod False v)
-     prod ok (Bind _ b sc) = prod ok sc
-     prod ok t = return True 
-    
-     cotype ty 
+     prod :: Name -> [Name] -> Bool -> Term -> Idris Bool
+     prod n done ok ap@(App _ _)
+        | (P _ (UN "lazy") _, [_, arg]) <- unApply ap = prod n done ok arg
+        | (P nt f _, args) <- unApply ap
+            = do recOK <- checkProdRec (n:done) f
+                 let ctxt = tt_ctxt i
+                 let [ty] = lookupTy f ctxt -- must exist!
+                 let co = cotype nt f ty in
+                     if (not recOK) then return False else
+                       if f == topn 
+                         then do argsprod <- mapM (prod n done co) args
+                                 return (and (ok : argsprod) )
+                         else do argsprod <- mapM (prod n done co) args
+                                 return (and argsprod)
+     prod n done ok (App f a) = liftM2 (&&) (prod n done False f) 
+                                            (prod n done False a)
+     prod n done ok (Bind _ (Let t v) sc) 
+         = liftM2 (&&) (prod n done False v) (prod n done False v)
+     prod n done ok (Bind _ b sc) = prod n done ok sc
+     prod n done ok t = return True 
+   
+     checkProdRec :: [Name] -> Name -> Idris Bool
+     checkProdRec done f 
+        = case lookupCtxt f (idris_patdefs i) of
+               [(def, _)] -> do ok <- mapM (prodRec f done) def
+                                return (and ok)
+               _ -> return True -- defined elsewhere, can't call topn
+
+     cotype (DCon _ _) n ty 
         | (P _ t _, _) <- unApply (getRetTy ty)
-            = case lookupCtxt Nothing t (idris_datatypes i) of
+            = case lookupCtxt t (idris_datatypes i) of
                    [TI _ True _] -> True
                    _ -> False
-        | otherwise = False
+     cotype nt n ty = False
 
 calcTotality :: [Name] -> FC -> Name -> [([Name], Term, Term)]
                 -> Idris Totality
 calcTotality path fc n pats 
     = do i <- getIState
-         let opts = case lookupCtxt Nothing n (idris_flags i) of
+         let opts = case lookupCtxt n (idris_flags i) of
                             [fs] -> fs
                             _ -> []
          case mapMaybe (checkLHS i) (map (\ (_, l, r) -> l) pats) of
@@ -339,12 +241,12 @@
         updateContext (simplifyCasedef n)
         ctxt <- getContext
         i <- getIState
-        let opts = case lookupCtxt Nothing n (idris_flags i) of
+        let opts = case lookupCtxt n (idris_flags i) of
                             [fs] -> fs
                             _ -> []
         t' <- case t of 
                 Unchecked -> 
-                    case lookupDef Nothing n ctxt of
+                    case lookupDef n ctxt of
                         [CaseOp _ _ _ _ pats _ _ _ _] -> 
                             do t' <- if AssertTotal `elem` opts
                                         then return $ Total []
@@ -378,7 +280,7 @@
 
     warnPartial n t
        = do i <- getIState
-            case lookupDef Nothing n (tt_ctxt i) of
+            case lookupDef n (tt_ctxt i) of
                [x] -> do
                   iputStrLn $ show fc ++ ":Warning - " ++ show n ++ " is " ++ show t 
 --                                ++ "\n" ++ show x
@@ -407,8 +309,8 @@
 buildSCG :: (FC, Name) -> Idris ()
 buildSCG (_, n) = do
    ist <- getIState
-   case lookupCtxt Nothing n (idris_callgraph ist) of
-       [cg] -> case lookupDef Nothing n (tt_ctxt ist) of
+   case lookupCtxt n (idris_callgraph ist) of
+       [cg] -> case lookupDef n (tt_ctxt ist) of
            [CaseOp _ _ _ _ _ args sc _ _] -> 
                do logLvl 3 $ "Building SCG for " ++ show n ++ " from\n" 
                                 ++ show sc
@@ -442,17 +344,22 @@
       -- how the arguments relate - either Smaller or Unknown
       argRels :: Name -> [(Name, SizeChange)]
       argRels n = let ctxt = tt_ctxt ist
-                      [ty] = lookupTy Nothing n ctxt -- must exist!
+                      [ty] = lookupTy n ctxt -- must exist!
                       P _ nty _ = fst (unApply (getRetTy ty))
+                      co = case lookupCtxt nty (idris_datatypes ist) of
+                              [TI _ x _] -> x
+                              _ -> False
                       args = map snd (getArgTys ty) in
-                      map (getRel nty) (map (fst . unApply . getRetTy) args)
+                      map (getRel co nty) (map (fst . unApply . getRetTy) args)
         where
-          getRel ty (P _ n' _) | n' == ty = (n, Smaller)
-          getRel ty t = (n, Unknown)
+          getRel True _ _ = (n, Unknown) -- coinductive
+          getRel _ ty (P _ n' _) | n' == ty = (n, Smaller)
+          getRel _ ty t = (n, Unknown)
 
       scgAlt x vars szs (ConCase n _ args sc)
            -- all args smaller than top variable of x in sc
-           -- (as long as they are in the same type family)
+           -- (as long as they are in the same type family, and it's
+           -- not coinductive)
          | Just tvar <- lookup x vars
               = let arel = argRels n
                     szs' = zipWith (\arg (_,t) -> (arg, (x, t))) args arel 
@@ -503,7 +410,7 @@
 checkSizeChange :: Name -> Idris Totality
 checkSizeChange n = do
    ist <- getIState
-   case lookupCtxt Nothing n (idris_callgraph ist) of
+   case lookupCtxt n (idris_callgraph ist) of
        [cg] -> do let ms = mkMultiPaths ist [] (scg cg)
                   logLvl 5 ("Multipath for " ++ show n ++ ":\n" ++
                             "from " ++ show (scg cg) ++ "\n" ++
@@ -530,7 +437,7 @@
   where extend (nextf, args) 
            | (nextf, args) `elem` path = [ reverse ((nextf, args) : path) ]
            | [Unchecked] <- lookupTotal nextf (tt_ctxt ist) 
-               = case lookupCtxt Nothing nextf (idris_callgraph ist) of
+               = case lookupCtxt nextf (idris_callgraph ist) of
                     [ncg] -> mkMultiPaths ist ((nextf, args) : path) (scg ncg) 
                     _ -> [ reverse ((nextf, args) : path) ]
            | otherwise = [ reverse ((nextf, args) : path) ]
@@ -538,7 +445,7 @@
 --     do (nextf, args) <- cg
 --          if ((nextf, args) `elem` path)
 --             then return (reverse ((nextf, args) : path))
---             else case lookupCtxt Nothing nextf (idris_callgraph ist) of
+--             else case lookupCtxt nextf (idris_callgraph ist) of
 --                     [ncg] -> mkMultiPaths ist ((nextf, args) : path) (scg ncg) 
 --                     _ -> return (reverse ((nextf, args) : path))
 
@@ -562,15 +469,15 @@
 --             = Partial BelieveMe
     -- if we get to a constructor, it's fine as long as it's strictly positive
     tryPath desc path ((f, _) :es) arg
-        | [TyDecl (DCon _ _) _] <- lookupDef Nothing f (tt_ctxt ist)
+        | [TyDecl (DCon _ _) _] <- lookupDef f (tt_ctxt ist)
             = case lookupTotal f (tt_ctxt ist) of
                    [Total _] -> Unchecked -- okay so far
                    [Partial _] -> Partial (Other [f])
                    x -> error (show x)
-        | [TyDecl (TCon _ _) _] <- lookupDef Nothing f (tt_ctxt ist)
+        | [TyDecl (TCon _ _) _] <- lookupDef f (tt_ctxt ist)
             = Total []
-    tryPath desc path (e@(f, []) : es) arg
-        | e `elem` es = Partial (Mutual [f])
+    tryPath desc path (e@(f, args) : es) arg
+        | e `elem` es && allNothing args = Partial (Mutual [f])
     tryPath desc path (e@(f, nextargs) : es) arg
         | Just d <- lookup e path
             = if desc > 0 
@@ -587,7 +494,7 @@
                                    -- rest definitely terminates without
                                    -- any cycles with route so far,
                                    -- then we might yet be total
-                            case collapse (map (tryPath (-10000) ((e, desc):path) es)
+                            case collapse (map (tryPath (-10000) ((e, 0):path) es)
                                           [0..length nextargs - 1]) of
                                 Total _ -> return Unchecked
                                 x -> return x
@@ -606,6 +513,8 @@
         | [Total a] <- lookupTotal f (tt_ctxt ist) = Total a
         | [Partial _] <- lookupTotal f (tt_ctxt ist) = Partial (Other [f])
         | otherwise = Unchecked
+
+allNothing xs = null (collapseNothing (zip xs [0..]))
 
 collapseNothing ((Nothing, _) : xs) 
    = filter (\ (x, _) -> case x of
diff --git a/src/Idris/DataOpts.hs b/src/Idris/DataOpts.hs
--- a/src/Idris/DataOpts.hs
+++ b/src/Idris/DataOpts.hs
@@ -17,7 +17,7 @@
 forceArgs :: Name -> Type -> Idris ()
 forceArgs n t = do i <- getIState
                    let fargs = force i 0 t
-                   copt <- case lookupCtxt Nothing n (idris_optimisation i) of
+                   copt <- case lookupCtxt n (idris_optimisation i) of
                                  []     -> return $ Optimise False [] []
                                  (op:_) -> return op
                    let opts = addDef n (copt { forceable = fargs }) (idris_optimisation i)
@@ -38,7 +38,7 @@
 
     collapsibleIn i t
         | (P _ tn _, _) <- unApply t
-           = case lookupCtxt Nothing tn (idris_optimisation i) of
+           = case lookupCtxt tn (idris_optimisation i) of
                 [oi] -> collapsible oi
                 _ -> False
         | otherwise = False
@@ -68,7 +68,7 @@
     setCollapsible n
        = do i <- getIState
             iLOG $ show n ++ " collapsible"
-            case lookupCtxt Nothing n (idris_optimisation i) of
+            case lookupCtxt n (idris_optimisation i) of
                (oi:_) -> do let oi' = oi { collapsible = True }
                             let opts = addDef n oi' (idris_optimisation i)
                             putIState (i { idris_optimisation = opts })
@@ -79,15 +79,15 @@
 
     forceRec :: IState -> (Name, [Type]) -> Idris Bool
     forceRec i (n, ts)
-       = case lookupCtxt Nothing n (idris_optimisation i) of
+       = case lookupCtxt n (idris_optimisation i) of
             (oi:_) -> checkFR (forceable oi) 0 ts
             _ -> return False
     checkFR fs i [] = return True
     checkFR fs i (_ : xs) | i `elem` fs = checkFR fs (i + 1) xs
     checkFR fs i (t : xs)
         -- must be recursive or type is not collapsible
-        = do let rt = getRetTy t
-             if (ty `elem` freeNames rt) 
+        = do let (rtf, rta) = unApply $ getRetTy t
+             if (ty `elem` freeNames rtf) 
                then checkFR fs (i+1) xs
                else return False
 
@@ -161,7 +161,7 @@
         | (Var n, args) <- raw_unapply t -- MAGIC HERE
             = do args' <- mapM applyOpts args
                  i <- getIState
-                 case lookupCtxt Nothing n (idris_optimisation i) of
+                 case lookupCtxt n (idris_optimisation i) of
                     (oi:_) -> return $ applyDataOpt oi n args'
                     _ -> return (raw_apply (Var n) args')
         | otherwise = do f' <- applyOpts f
@@ -202,14 +202,14 @@
 instance Optimisable (TT Name) where
     applyOpts c@(P (DCon t arity) n _)
         = do i <- getIState
-             case lookupCtxt Nothing n (idris_optimisation i) of
+             case lookupCtxt n (idris_optimisation i) of
                  (oi:_) -> return $ applyDataOptRT oi n t arity []
                  _ -> return c
     applyOpts t@(App f a)
         | (c@(P (DCon t arity) n _), args) <- unApply t -- MAGIC HERE
             = do args' <- mapM applyOpts args
                  i <- getIState
-                 case lookupCtxt Nothing n (idris_optimisation i) of
+                 case lookupCtxt n (idris_optimisation i) of
                       (oi:_) -> do return $ applyDataOptRT oi n t arity args'
                       _ -> return (mkApp c args')
         | otherwise = do f' <- applyOpts f
@@ -224,7 +224,7 @@
 
     stripCollapsed (Bind n (PVar x) t) | (P _ ty _, _) <- unApply x
            = do i <- getIState
-                case lookupCtxt Nothing ty (idris_optimisation i) of
+                case lookupCtxt ty (idris_optimisation i) of
                   [oi] -> if collapsible oi
                              then do t' <- stripCollapsed t
                                      return (Bind n (PVar x) (instantiate Erased t'))
diff --git a/src/Idris/Delaborate.hs b/src/Idris/Delaborate.hs
--- a/src/Idris/Delaborate.hs
+++ b/src/Idris/Delaborate.hs
@@ -7,6 +7,7 @@
 
 import Idris.AbsSyntax
 import Core.TT
+import Core.Evaluate
 
 import Debug.Trace
 
@@ -15,54 +16,75 @@
 delab :: IState -> Term -> PTerm
 delab i tm = delab' i tm False
 
+delabTy :: IState -> Name -> PTerm
+delabTy i n 
+    = case lookupTy n (tt_ctxt i) of
+           (ty:_) -> case lookupCtxt n (idris_implicits i) of
+                         (imps:_) -> delabTy' i imps ty False
+                         _ -> delabTy' i [] ty False
+
 delab' :: IState -> Term -> Bool -> PTerm
-delab' ist tm fullname = de [] tm
+delab' i t f = delabTy' i [] t f
+
+delabTy' :: IState -> [PArg] -- ^ implicit arguments to type, if any
+          -> Term -> Bool -> PTerm
+delabTy' ist imps tm fullname = de [] imps tm
   where
     un = FC "(val)" 0
 
-    de env (App f a) = deFn env f [a]
-    de env (V i)     | i < length env = PRef un (snd (env!!i))
-                     | otherwise = PRef un (UN ("v" ++ show i ++ ""))
-    de env (P _ n _) | n == unitTy = PTrue un
-                     | n == unitCon = PTrue un
-                     | n == falseTy = PFalse un
-                     | Just n' <- lookup n env = PRef un n'
-                     | otherwise = PRef un (dens n)
-    de env (Bind n (Lam ty) sc) = PLam n (de env ty) (de ((n,n):env) sc)
-    de env (Bind n (Pi ty) sc)  = PPi expl n (de env ty) (de ((n,n):env) sc)
-    de env (Bind n (Let ty val) sc) 
-        = PLet n (de env ty) (de env val) (de ((n,n):env) sc)
-    de env (Bind n (Hole ty) sc) = de ((n, UN "[__]"):env) sc
-    de env (Bind n (Guess ty val) sc) = de ((n, UN "[__]"):env) sc
-    de env (Bind n _ sc) = de ((n,n):env) sc
-    de env (Constant i) = PConstant i
-    de env Erased = Placeholder
-    de env Impossible = Placeholder
-    de env (TType i) = PType 
+    de env _ (App f a) = deFn env f [a]
+    de env _ (V i)     | i < length env = PRef un (snd (env!!i))
+                       | otherwise = PRef un (UN ("v" ++ show i ++ ""))
+    de env _ (P _ n _) | n == unitTy = PTrue un
+                       | n == unitCon = PTrue un
+                       | n == falseTy = PFalse un
+                       | Just n' <- lookup n env = PRef un n'
+                       | otherwise = PRef un (dens n)
+    de env _ (Bind n (Lam ty) sc) 
+          = PLam n (de env [] ty) (de ((n,n):env) [] sc)
+    de env (PImp _ _ _ _ _:is) (Bind n (Pi ty) sc) 
+          = PPi impl n (de env [] ty) (de ((n,n):env) is sc)
+    de env (PConstraint _ _ _ _:is) (Bind n (Pi ty) sc) 
+          = PPi constraint n (de env [] ty) (de ((n,n):env) is sc)
+    de env (PTacImplicit _ _ _ tac _ _:is) (Bind n (Pi ty) sc) 
+          = PPi (tacimpl tac) n (de env [] ty) (de ((n,n):env) is sc)
+    de env _ (Bind n (Pi ty) sc) 
+          = PPi expl n (de env [] ty) (de ((n,n):env) [] sc)
+    de env _ (Bind n (Let ty val) sc) 
+        = PLet n (de env [] ty) (de env [] val) (de ((n,n):env) [] sc)
+    de env _ (Bind n (Hole ty) sc) = de ((n, UN "[__]"):env) [] sc
+    de env _ (Bind n (Guess ty val) sc) = de ((n, UN "[__]"):env) [] sc
+    de env _ (Bind n _ sc) = de ((n,n):env) [] sc
+    de env _ (Constant i) = PConstant i
+    de env _ Erased = Placeholder
+    de env _ Impossible = Placeholder
+    de env _ (TType i) = PType 
 
     dens x | fullname = x
-    dens ns@(NS n _) = case lookupCtxt Nothing n (idris_implicits ist) of
+    dens ns@(NS n _) = case lookupCtxt n (idris_implicits ist) of
                               [_] -> n -- just one thing
                               _ -> ns
     dens n = n
 
     deFn env (App f a) args = deFn env f (a:args)
-    deFn env (P _ n _) [l,r]     | n == pairTy  = PPair un (de env l) (de env r)
-                                 | n == eqCon   = PRefl un (de env r)
-                                 | n == UN "lazy" = de env r
+    deFn env (P _ n _) [l,r]     
+         | n == pairTy    = PPair un (de env [] l) (de env [] r)
+         | n == eqCon     = PRefl un (de env [] r)
+         | n == UN "lazy" = de env [] r
     deFn env (P _ n _) [ty, Bind x (Lam _) r]
-                                 | n == UN "Exists" 
-                                       = PDPair un (PRef un x) (de env ty)
-                                                   (de ((x,x):env) (instantiate (P Bound x ty) r))
-    deFn env (P _ n _) [_,_,l,r] | n == pairCon = PPair un (de env l) (de env r)
-                                 | n == eqTy    = PEq un (de env l) (de env r)
-                                 | n == UN "Ex_intro" = PDPair un (de env l) Placeholder
-                                                                  (de env r)
-    deFn env (P _ n _) args = mkPApp (dens n) (map (de env) args)
-    deFn env f args = PApp un (de env f) (map pexp (map (de env) args))
+         | n == UN "Exists" 
+               = PDPair un (PRef un x) (de env [] ty)
+                           (de ((x,x):env) [] (instantiate (P Bound x ty) r))
+    deFn env (P _ n _) [_,_,l,r] 
+         | n == pairCon = PPair un (de env [] l) (de env [] r)
+         | n == eqTy    = PEq un (de env [] l) (de env [] r)
+         | n == UN "Ex_intro" = PDPair un (de env [] l) Placeholder
+                                          (de env [] r)
+    deFn env (P _ n _) args = mkPApp (dens n) (map (de env []) args)
+    deFn env f args = PApp un (de env [] f) (map pexp (map (de env []) args))
 
     mkPApp n args 
-        | [imps] <- lookupCtxt Nothing n (idris_implicits ist)
+        | [imps] <- lookupCtxt n (idris_implicits ist)
             = PApp un (PRef un n) (zipWith imp (imps ++ repeat (pexp undefined)) args)
         | otherwise = PApp un (PRef un n) (map pexp args)
 
@@ -90,6 +112,13 @@
           "Can't convert " ++ showImp imps (delab i x) ++ " with " 
                  ++ showImp imps (delab i y) ++
                  if (opt_errContext (idris_options i)) then showSc i env else ""
+pshow i (NonFunctionType f ty)
+    = let imps = opt_showimp (idris_options i) in
+          showImp imps (delab i f) ++ " does not have a function type ("
+            ++ showImp imps (delab i ty) ++ ")"
+pshow i (CantIntroduce ty)
+    = let imps = opt_showimp (idris_options i) in
+          "Can't use lambda here: type is " ++ showImp imps (delab i ty)
 pshow i (InfiniteUnify x tm env)
     = "Unifying " ++ showbasic x ++ " and " ++ show (delab i tm) ++ 
       " would lead to infinite value" ++
@@ -109,7 +138,9 @@
     = "The return type of postulate " ++ show n ++ " is not collapsible"
 pshow i (AlreadyDefined n) = show n ++ " is already defined"
 pshow i (ProofSearchFail e) = pshow i e
+pshow i (NoRewriting tm) = "rewrite did not change type " ++ show (delab i tm)
 pshow i (At f e) = show f ++ ":" ++ pshow i e
+pshow i (ProviderError msg) = "Type provider error: " ++ msg
 
 showSc i [] = ""
 showSc i xs = "\n\nIn context:\n" ++ showSep "\n" (map showVar (reverse xs))
diff --git a/src/Idris/Docs.hs b/src/Idris/Docs.hs
--- a/src/Idris/Docs.hs
+++ b/src/Idris/Docs.hs
@@ -65,9 +65,9 @@
 getDocs :: Name -> Idris Doc
 getDocs n 
    = do i <- getIState
-        case lookupCtxt Nothing n (idris_classes i) of
+        case lookupCtxt n (idris_classes i) of
              [ci] -> docClass n ci
-             _ -> case lookupCtxt Nothing n (idris_datatypes i) of
+             _ -> case lookupCtxt n (idris_datatypes i) of
                        [ti] -> docData n ti
                        _ -> do fd <- docFun n
                                return (FunDoc fd)
@@ -81,7 +81,7 @@
 docClass :: Name -> ClassInfo -> Idris Doc
 docClass n ci
   = do i <- getIState
-       let docstr = case lookupCtxt Nothing n (idris_docstrings i) of
+       let docstr = case lookupCtxt n (idris_docstrings i) of
                          [str] -> str
                          _ -> ""
        mdocs <- mapM docFun (map fst (class_methods ci))
@@ -90,13 +90,13 @@
 docFun :: Name -> Idris FunDoc
 docFun n
   = do i <- getIState
-       let docstr = case lookupCtxt Nothing n (idris_docstrings i) of
+       let docstr = case lookupCtxt n (idris_docstrings i) of
                          [str] -> str
                          _ -> ""
-       let ty = case lookupTy Nothing n (tt_ctxt i) of
+       let ty = case lookupTy n (tt_ctxt i) of
                      (t : _) -> t
        let argnames = map fst (getArgTys ty)
-       let args = case lookupCtxt Nothing n (idris_implicits i) of
+       let args = case lookupCtxt n (idris_implicits i) of
                        [args] -> zip argnames args
                        _ -> []
        let infixes = idris_infixes i
diff --git a/src/Idris/ElabDecls.hs b/src/Idris/ElabDecls.hs
--- a/src/Idris/ElabDecls.hs
+++ b/src/Idris/ElabDecls.hs
@@ -11,11 +11,13 @@
 import Idris.ElabTerm
 import Idris.Coverage
 import Idris.DataOpts
+import Idris.Providers
 import Paths_idris
 
 import Core.TT
 import Core.Elaborate hiding (Tactic(..))
 import Core.Evaluate
+import Core.Execute
 import Core.Typecheck
 import Core.CaseTree
 
@@ -38,6 +40,7 @@
                     mapM (\(n, t) -> do (t', _) <- recheckC fc [] t
                                         return (n, t')) ns
 
+-- | Elaborate a top-level type declaration - for example, "foo : Int -> Int".
 elabType :: ElabInfo -> SyntaxInfo -> String ->
             FC -> FnOpts -> Name -> PTerm -> Idris ()
 elabType info syn doc fc opts n ty' = {- let ty' = piBind (params info) ty_in 
@@ -46,6 +49,7 @@
          ctxt <- getContext
          i <- getIState
          logLvl 3 $ show n ++ " pre-type " ++ showImp True ty'
+         ty' <- addUsingConstraints syn fc ty'
          ty' <- implicit syn n ty'
          let ty = addImpl i ty'
          logLvl 2 $ show n ++ " type " ++ showImp True ty
@@ -66,7 +70,7 @@
          let nty' = normalise ctxt [] nty
          let (t, _) = unApply (getRetTy nty')
          let corec = case t of
-                        P _ rcty _ -> case lookupCtxt Nothing rcty (idris_datatypes i) of
+                        P _ rcty _ -> case lookupCtxt rcty (idris_datatypes i) of
                                         [TI _ True _] -> True
                                         _ -> False
                         _ -> False
@@ -90,14 +94,14 @@
          -- make sure it's collapsible, so it is never needed at run time
          -- start by getting the elaborated type
          ctxt <- getContext
-         fty <- case lookupTy Nothing n ctxt of
+         fty <- case lookupTy n ctxt of
             [] -> tclift $ tfail $ (At fc (NoTypeDecl n)) -- can't happen!
             [ty] -> return ty
          ist <- getIState
          let (ap, _) = unApply (getRetTy (normalise ctxt [] fty))
          logLvl 5 $ "Checking collapsibility of " ++ show (ap, fty)
          let postOK = case ap of
-                            P _ tn _ -> case lookupCtxt Nothing tn
+                            P _ tn _ -> case lookupCtxt tn
                                                 (idris_optimisation ist) of
                                             [oi] -> collapsible oi
                                             _ -> False
@@ -118,11 +122,11 @@
          ((t', defer, is), log) <- tclift $ elaborate ctxt n (TType (UVal 0)) []
                                             (erun fc (build i info False n t))
          def' <- checkDef fc defer
-         addDeferred def'
+         addDeferredTyCon def'
          mapM_ (elabCaseBlock info) is
          (cty, _)  <- recheckC fc [] t'
          logLvl 2 $ "---> " ++ show cty
-         updateContext (addTyDecl n cty) -- temporary, to check cons
+         updateContext (addTyDecl n (TCon 0 0) cty) -- temporary, to check cons
 
 elabData info syn doc fc codata (PDatadecl n t_in dcons)
     = do iLOG (show fc)
@@ -134,17 +138,17 @@
          ((t', defer, is), log) <- tclift $ elaborate ctxt n (TType (UVal 0)) []
                                             (erun fc (build i info False n t))
          def' <- checkDef fc defer
-         addDeferred def'
+         addDeferredTyCon def'
          mapM_ (elabCaseBlock info) is
          (cty, _)  <- recheckC fc [] t'
          logLvl 2 $ "---> " ++ show cty
          -- temporary, to check cons
-         when undef $ updateContext (addTyDecl n cty) 
+         when undef $ updateContext (addTyDecl n (TCon 0 0) cty) 
          cons <- mapM (elabCon info syn n codata) dcons
          ttag <- getName
          i <- getIState
          let as = map (const Nothing) (getArgTys cty) 
-         let params = findParams (zip as (repeat True)) (map snd cons)
+         let params = findParams  (map snd cons)
          logLvl 2 $ "Parameters : " ++ show params
          putIState (i { idris_datatypes = addDef n (TI (map fst cons) codata params)
                                              (idris_datatypes i) })
@@ -158,43 +162,113 @@
   where 
         -- parameters are names which are unchanged across the structure,
         -- which appear exactly once in the return type of a constructor
-        findParams :: [(Maybe Name, Bool)] -> [Type] -> [Int]
-        findParams ps [] = mapMaybe (\ ((x, y), n) ->
-                                          if y then Just n else Nothing)
-                                    (zip ps [0..])
-        findParams ps (t : ts) = findParams (updateParams ps t) ts
 
-        updateParams ps (Bind n (Pi t) sc) 
-            = updateParams (updateParams ps (instantiate (P Bound n t) sc)) t
-        updateParams ps tm@(App f a)
-            | (P _ fn _, args) <- unApply tm
-               = if fn == n
-                    then updateParamsA ps args (tail args)
-                    else updateParams (updateParams ps f) a
-            | otherwise = updateParams (updateParams ps f) a
-        updateParams ps _ = ps
+        -- First, find all applications of the constructor, then check over
+        -- them for repeated arguments
 
-        updateParamsA ((mn, _) : ns) (p@(P _ n' _) : args) all
-             | n' `elem` concatMap freeNames all
-                  = (mn, False) : updateParamsA ns args (p : all)
-        updateParamsA ((Nothing, b) : ns) (p@(P _ n' _) : args) all
-             = (Just n', b) : updateParamsA ns args (p : all)
-        updateParamsA ((Just p, b) : ns) (tm@(P _ n' _) : args) all
-             = (Just n', b && p == n') : updateParamsA ns args (tm : all)
-        updateParamsA ((mn, _) : ns) (p : args) all
-             = (mn, False) : updateParamsA ns args (p : all)
-        updateParamsA ps args all = ps
+        findParams :: [Type] -> [Int]
+        findParams ts = let allapps = concatMap getDataApp ts in
+                            paramPos allapps
 
+        paramPos [] = []
+        paramPos (args : rest) 
+              = dropNothing $ keepSame (zip [0..] args) rest
+
+        dropNothing [] = []
+        dropNothing ((x, Nothing) : ts) = dropNothing ts
+        dropNothing ((x, _) : ts) = x : dropNothing ts
+
+        keepSame :: [(Int, Maybe Name)] -> [[Maybe Name]] -> 
+                    [(Int, Maybe Name)]
+        keepSame as [] = as
+        keepSame as (args : rest) = keepSame (update as args) rest
+          where
+            update [] _ = []
+            update _ [] = []
+            update ((n, Just x) : as) (Just x' : args)
+                | x == x' = (n, Just x) : update as args
+            update ((n, _) : as) (_ : args) = (n, Nothing) : update as args
+
+        getDataApp :: Type -> [[Maybe Name]]
+        getDataApp f@(App _ _)
+            | (P _ d _, args) <- unApply f
+                   = if (d == n) then [mParam args args] else []
+        getDataApp (Bind n (Pi t) sc)
+            = getDataApp t ++ getDataApp (instantiate (P Bound n t) sc)
+        getDataApp _ = []
+
+        -- keep the arguments which are single names, which don't appear
+        -- elsewhere 
+
+        mParam args [] = []
+        mParam args (P Bound n _ : rest)
+               | count n args == 1 
+                  = Just n : mParam args rest
+            where count n [] = 0
+                  count n (t : ts) 
+                       | n `elem` freeNames t = 1 + count n ts
+                       | otherwise = count n ts
+        mParam args (_ : rest) = Nothing : mParam args rest
+
+-- | Elaborate a type provider
+elabProvider :: ElabInfo -> SyntaxInfo -> FC -> Name -> PTerm -> PTerm -> Idris ()
+elabProvider info syn fc n ty tm
+    = do i <- getIState
+         -- Ensure that the experimental extension is enabled
+         unless (TypeProviders `elem` idris_language_extensions i) $
+           fail $ "Failed to define type provider \"" ++ show n ++
+                  "\".\nYou must turn on the TypeProviders extension."
+
+         ctxt <- getContext
+
+         -- First elaborate the expected type (and check that it's a type)
+         (ty', typ) <- elabVal toplevel False ty
+         unless (isTType typ) $
+           fail ("Expected a type, got " ++ show ty' ++ " : " ++ show typ)
+
+         -- Elaborate the provider term to TT and check that the type matches
+         (e, et) <- elabVal toplevel False tm
+         unless (isProviderOf ty' et) $
+           fail $ "Expected provider type IO (Provider (" ++
+                  show ty' ++ "))" ++ ", got " ++ show et ++ " instead."
+
+         -- Create the top-level type declaration
+         elabType info syn "" fc [] n ty
+
+         -- Execute the type provider and normalise the result
+         rhs <- execute e
+         let rhs' = normalise ctxt [] rhs
+         logLvl 1 $ "Normalised " ++ show n ++ "'s RHS to " ++ show rhs
+
+         -- Extract the provided term from the type provider
+         tm <- getProvided rhs'
+
+         -- Finally add a top-level definition of the provided term
+         elabClauses info fc [] n [PClause fc n (PRef fc n) [] (delab i tm) []]
+         logLvl 1 $ "Elaborated provider " ++ show n ++ " as: " ++ show tm
+
+    where isTType :: TT Name -> Bool
+          isTType (TType _) = True
+          isTType _ = False
+
+          isProviderOf :: TT Name -> TT Name -> Bool
+          isProviderOf tp prov
+            | (P _ (UN "IO") _, [prov']) <- unApply prov
+            , (P _ (NS (UN "Provider") ["Providers"]) _, [tp']) <- unApply prov'
+            , tp == tp' = True
+          isProviderOf _ _ = False
+
+
 elabRecord :: ElabInfo -> SyntaxInfo -> String -> FC -> Name -> 
               PTerm -> String -> Name -> PTerm -> Idris ()
 elabRecord info syn doc fc tyn ty cdoc cn cty
     = do elabData info syn doc fc False (PDatadecl tyn ty [(cdoc, cn, cty, fc)]) 
          cty' <- implicit syn cn cty
          i <- getIState
-         cty <- case lookupTy Nothing cn (tt_ctxt i) of
+         cty <- case lookupTy cn (tt_ctxt i) of
                     [t] -> return (delab i t)
                     _ -> fail "Something went inexplicably wrong"
-         cimp <- case lookupCtxt Nothing cn (idris_implicits i) of
+         cimp <- case lookupCtxt cn (idris_implicits i) of
                     [imps] -> return imps
          let ptys = getProjs [] (renameBs cimp cty)
          let ptys_u = getProjs [] cty
@@ -329,11 +403,13 @@
     mkLazy (PPi pl n ty sc) = PPi (pl { plazy = True }) n ty (mkLazy sc)
     mkLazy t = t
 
+-- | Elaborate a collection of left-hand and right-hand pairs - that is, a
+-- top-level definition.
 elabClauses :: ElabInfo -> FC -> FnOpts -> Name -> [PClause] -> Idris ()
 elabClauses info fc opts n_in cs = let n = liftname info n_in in  
       do ctxt <- getContext
          -- Check n actually exists, with no definition yet
-         let tys = lookupTy Nothing n ctxt
+         let tys = lookupTy n ctxt
          checkUndefined n ctxt
          unless (length tys > 1) $ do
            fty <- case tys of
@@ -350,7 +426,7 @@
            logLvl 5 $ "Checking collapsibility of " ++ show (ap, fty)
            -- FIXME: Really ought to only do this for total functions!
            let doNothing = case ap of
-                              P _ tn _ -> case lookupCtxt Nothing tn
+                              P _ tn _ -> case lookupCtxt tn
                                                   (idris_optimisation ist) of
                                               [oi] -> collapsible oi
                                               _ -> False
@@ -358,7 +434,7 @@
            solveDeferred n
            ist <- getIState
            when doNothing $ 
-              case lookupCtxt Nothing n (idris_optimisation ist) of
+              case lookupCtxt n (idris_optimisation ist) of
                  [oi] -> do let opts = addDef n (oi { collapsible = True }) 
                                            (idris_optimisation ist)
                             putIState (ist { idris_optimisation = opts })
@@ -392,14 +468,21 @@
                       then do missing <- genClauses fc n (map getLHS pdef) cs
                               -- missing <- genMissing n scargs sc  
                               missing' <- filterM (checkPossible info fc True n) missing
+                              let clhs = map getLHS pdef
                               logLvl 2 $ "Must be unreachable:\n" ++ 
                                           showSep "\n" (map (showImp True) missing') ++
                                          "\nAgainst: " ++
                                           showSep "\n" (map (\t -> showImp True (delab ist t)) (map getLHS pdef))
-                              return missing'
+                              -- filter out anything in missing' which is
+                              -- matched by any of clhs. This might happen since
+                              -- unification may force a variable to take a 
+                              -- particular form, rather than force a case
+                              -- to be impossible.
+                              return (filter (noMatch ist clhs) missing')
                       else return []
            let pcover = null pmissing
            logLvl 2 $ "Optimising patterns"
+           logLvl 5 $ show optpdef
            pdef' <- applyOpts optpdef 
            logLvl 2 $ "Optimised patterns"
            logLvl 5 $ show pdef'
@@ -428,8 +511,9 @@
            logLvl 3 $ "Optimised: " ++ show tree'
            ctxt <- getContext
            ist <- getIState
-           putIState (ist { idris_patdefs = addDef n pdef' (idris_patdefs ist) })
-           case lookupTy (namespace info) n ctxt of
+           putIState (ist { idris_patdefs = addDef n (pdef', pmissing) 
+                                                (idris_patdefs ist) })
+           case lookupTy n ctxt of
                [ty] -> do updateContext (addCasedef n (inlinable opts)
                                                        tcase knowncovering 
                                                        (AssertTotal `elem` opts)
@@ -440,7 +524,7 @@
                           totcheck (fc, n)
                           when (tot /= Unchecked) $ addIBC (IBCTotal n tot)
                           i <- getIState
-                          case lookupDef Nothing n (tt_ctxt i) of
+                          case lookupDef n (tt_ctxt i) of
                               (CaseOp _ _ _ _ _ scargs sc scargs' sc' : _) ->
                                   do let calls = findCalls sc' scargs'
                                      let used = findUsedArgs sc' scargs'
@@ -456,7 +540,11 @@
                [] -> return ()
            return ()
   where
-    checkUndefined n ctxt = case lookupDef Nothing n ctxt of
+    noMatch i cs tm = all (\x -> case matchClause i (delab' i x True) tm of
+                                      Right _ -> False
+                                      Left miss -> True) cs 
+
+    checkUndefined n ctxt = case lookupDef n ctxt of
                                  [] -> return ()
                                  [TyDecl _ _] -> return ()
                                  _ -> tclift $ tfail (At fc (AlreadyDefined n))
@@ -522,6 +610,7 @@
                   case recheck ctxt [] (forget lhs_tm) lhs_tm of
                        OK _ -> return True
                        _ -> return False
+
 --                   b <- inferredDiff fc (delab' i lhs_tm True) lhs
 --                   return (not b) -- then return (Just lhs_tm) else return Nothing
 --                   trace (show (delab' i lhs_tm True) ++ "\n" ++ show lhs) $ return (not b)
@@ -541,14 +630,14 @@
         -- pattern bindings
         i <- getIState
         -- get the parameters first, to pass through to any where block
-        let fn_ty = case lookupTy Nothing fname (tt_ctxt i) of
+        let fn_ty = case lookupTy fname (tt_ctxt i) of
                          [t] -> t
                          _ -> error "Can't happen (elabClause function type)"
-        let fn_is = case lookupCtxt Nothing fname (idris_implicits i) of
+        let fn_is = case lookupCtxt fname (idris_implicits i) of
                          [t] -> t
                          _ -> [] 
         let params = getParamsInType i [] fn_is fn_ty
-        let lhs = addImplPat i (propagateParams params lhs_in)
+        let lhs = addImplPat i (propagateParams params (stripLinear i lhs_in))
         logLvl 5 ("LHS: " ++ show fc ++ " " ++ showImp True lhs)
         logLvl 4 ("Fixed parameters: " ++ show params ++ " from " ++ show (fn_ty, fn_is))
         ((lhs', dlhs, []), _) <- 
@@ -648,7 +737,7 @@
         = getParamsInType i (n : env) is (instantiate (P Bound n t) sc)
     getParamsInType i env is tm@(App f a)
         | (P _ tn _, args) <- unApply tm 
-           = case lookupCtxt Nothing tn (idris_datatypes i) of
+           = case lookupCtxt tn (idris_datatypes i) of
                 [t] -> nub $ paramNames args env (param_pos t) ++
                              getParamsInType i env is f ++ 
                              getParamsInType i env is a
@@ -681,7 +770,7 @@
         -- Build the LHS as an "Infer", and pull out its type and
         -- pattern bindings
         i <- getIState
-        let lhs = addImpl i lhs_in
+        let lhs = addImplPat i lhs_in 
         logLvl 5 ("LHS: " ++ showImp True lhs)
         ((lhs', dlhs, []), _) <- 
             tclift $ elaborate ctxt (MN 0 "patLHS") infP []
@@ -779,18 +868,18 @@
 
     mkAux wname toplhs ns ns' (PClause fc n tm_in (w:ws) rhs wheres)
         = do i <- getIState
-             let tm = addImpl i tm_in
+             let tm = addImplPat i tm_in
              logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++ 
                                       showImp True toplhs)
              case matchClause i toplhs tm of
-                Left _ -> fail $ show fc ++ "with clause does not match top level"
+                Left f -> fail $ show fc ++ ":with clause does not match top level"
                 Right mvars -> 
                     do logLvl 3 ("Match vars : " ++ show mvars)
                        lhs <- updateLHS n wname mvars ns ns' (fullApp tm) w
                        return $ PClause fc wname lhs ws rhs wheres
     mkAux wname toplhs ns ns' (PWith fc n tm_in (w:ws) wval withs)
         = do i <- getIState
-             let tm = addImpl i tm_in
+             let tm = addImplPat i tm_in
              logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++ 
                                       showImp True toplhs)
              withs' <- mapM (mkAuxC wname toplhs ns ns') withs
@@ -858,7 +947,8 @@
          elabData info (syn { no_imp = no_imp syn ++ mnames }) doc fc False ddecl
          -- for each constraint, build a top level function to chase it
          logLvl 5 $ "Building functions"
-         let usyn = syn { using = ps ++ using syn }
+         let usyn = syn { using = map (\ (x,y) -> UImplicit x y) ps 
+                                      ++ using syn }
          fns <- mapM (cfun cn constraint usyn (map fst imethods)) constraints
          mapM_ (elabDecl EAll info) (concat fns)
          -- for each method, build a top level function
@@ -924,7 +1014,7 @@
              let conn = case con of
                             PRef _ n -> n
                             PApp _ (PRef _ n) _ -> n
-             let conn' = case lookupCtxtName Nothing conn (idris_classes i) of
+             let conn' = case lookupCtxtName conn (idris_classes i) of
                                 [(n, _)] -> n
                                 _ -> conn
              addInstance False conn' cfn
@@ -985,7 +1075,7 @@
                 [PDecl] -> Idris ()
 elabInstance info syn fc cs n ps t expn ds
     = do i <- getIState 
-         (n, ci) <- case lookupCtxtName (namespace info) n (idris_classes i) of
+         (n, ci) <- case lookupCtxtName n (idris_classes i) of
                        [c] -> return c
                        _ -> fail $ show fc ++ ":" ++ show n ++ " is not a type class"
          let constraint = PApp fc (PRef fc n) (map pexp ps)
@@ -1045,7 +1135,7 @@
     checkNotOverlapping i t n
      | take 2 (show n) == "@@" = return ()
      | otherwise
-        = case lookupTy Nothing n (tt_ctxt i) of
+        = case lookupTy n (tt_ctxt i) of
             [t'] -> let tret = getRetType t
                         tret' = getRetType (delab i t') in
                         case matchClause i tret' tret of
@@ -1082,7 +1172,7 @@
       | PRef _ n <- getTm p 
         = do ps' <- getWParams ps
              ctxt <- getContext
-             case lookupP Nothing n ctxt of
+             case lookupP n ctxt of
                 [] -> return (pimp n (PRef fc n) : ps')
                 _ -> return ps'
     getWParams (_ : ps) = getWParams ps
@@ -1217,7 +1307,7 @@
   | what /= ETypes
     = do iLOG $ "Elaborating clause " ++ show n
          i <- getIState -- get the type options too
-         let o' = case lookupCtxt Nothing n (idris_flags i) of
+         let o' = case lookupCtxt n (idris_flags i) of
                     [fs] -> fs
                     [] -> []
          elabClauses info f (o ++ o') n ps
@@ -1263,6 +1353,10 @@
          addIBC (IBCDSL n)
 elabDecl' what info (PDirective i) 
   | what /= EDefns = i
+elabDecl' what info (PProvider syn fc n tp tm)
+  | what /= EDefns
+    = do iLOG $ "Elaborating type provider " ++ show n
+         elabProvider info syn fc n tp tm
 elabDecl' _ _ _ = return () -- skipped this time 
 
 elabCaseBlock info d@(PClauses f o n ps) 
diff --git a/src/Idris/ElabTerm.hs b/src/Idris/ElabTerm.hs
--- a/src/Idris/ElabTerm.hs
+++ b/src/Idris/ElabTerm.hs
@@ -13,6 +13,7 @@
 import Control.Monad
 import Control.Monad.State
 import Data.List
+
 import Debug.Trace
 
 -- Data to pass to recursively called elaborators; e.g. for where blocks,
@@ -57,6 +58,7 @@
                                 resolveTC 7 fn ist) ivs
          probs <- get_probs
          tm <- get_term
+         ctxt <- get_context
          case probs of
             [] -> return ()
             ((_,_,_,e):es) -> lift (Error e)
@@ -94,9 +96,10 @@
         ElabD ()
 elab ist info pattern tcgen fn tm 
     = do elabE (False, False) tm -- (in argument, guarded)
+         end_unify
          when pattern -- convert remaining holes to pattern vars
               (do update_term orderPats
---                   tm <- get_term
+                  tm <- get_term
                   mkPat)
   where
     isph arg = case getTm arg of
@@ -122,6 +125,15 @@
                  trace ("Elaborating " ++ show t ++ " : " ++ show g ++ "\n\tin " ++ show tm) 
                     $ -} 
                   do t' <- insertCoerce ina t
+                     g <- goal
+                     tm <- get_term
+                     ps <- get_probs
+                     hs <- get_holes
+--                      trace ("Elaborating " ++ show t' ++ " in " ++ show g
+-- --                             ++ "\n" ++ show tm 
+--                             ++ "\nholes " ++ show hs
+--                             ++ "\nproblems " ++ show ps
+--                             ++ "\n-----------\n") $
                      elab' ina t'
 
     local f = do e <- get_env
@@ -199,19 +211,18 @@
                   = try' (elab' ina x) (trySeq' deferr xs) True
     elab' ina (PPatvar fc n) | pattern = patvar n
     elab' (ina, guarded) (PRef fc n) | pattern && not (inparamBlock n)
-                         = do ctxt <- get_context
-                              let iscon = isConName Nothing n ctxt
-                              let defined = case lookupTy Nothing n ctxt of
-                                                [] -> False
-                                                _ -> True
-                            -- this is to stop us resolve type classes recursively
-                              -- trace (show (n, guarded)) $
-                              if (tcname n && ina) then erun fc $ patvar n
-                                else if (defined && not guarded)
-                                        then do apply (Var n) []; solve
-                                        else try (do apply (Var n) []; solve)
-                                                 (patvar n)
-      where inparamBlock n = case lookupCtxtName Nothing n (inblock info) of
+        = do ctxt <- get_context
+             let defined = case lookupTy n ctxt of
+                               [] -> False
+                               _ -> True
+           -- this is to stop us resolve type classes recursively
+             -- trace (show (n, guarded)) $
+             if (tcname n && ina) then erun fc $ patvar n
+               else if (defined && not guarded)
+                       then do apply (Var n) []; solve
+                       else try (do apply (Var n) []; solve)
+                                (patvar n)
+      where inparamBlock n = case lookupCtxtName n (inblock info) of
                                 [] -> False
                                 _ -> True
     elab' ina f@(PInferRef fc n) = elab' ina (PApp fc f [])
@@ -221,6 +232,7 @@
                -- let sc' = mapPT (repN n n') sc
                ptm <- get_term
                g <- goal
+               checkPiGoal
                attack; intro (Just n); 
                -- trace ("------ intro " ++ show n ++ " ---- \n" ++ show ptm) 
                elabE (True, a) sc; solve
@@ -230,6 +242,7 @@
           = do hsin <- get_holes
                ptmin <- get_term
                tyn <- unique_hole (MN 0 "lamty")
+               checkPiGoal
                claim tyn RType
                attack
                ptm <- get_term
@@ -322,7 +335,7 @@
     elab' (ina, g) tm@(PApp fc (PRef _ f) args') 
        = do let args = {- case lookupCtxt f (inblock info) of
                           Just ps -> (map (pexp . (PRef fc)) ps ++ args')
-                          _ ->-} args'
+                          _ -> -} args'
 --             newtm <- mkSpecialised ist fc f (map getTm args') tm
             env <- get_env
             if (f `elem` map fst env && length args' == 1)
@@ -338,11 +351,11 @@
                     let isinf = f == inferCon || tcname f
                     -- if f is a type class, we need to know its arguments so that
                     -- we can unify with them
-                    case lookupCtxt Nothing f (idris_classes ist) of
+                    case lookupCtxt f (idris_classes ist) of
                         [] -> return ()
                         _ -> mapM_ setInjective (map getTm args')
                     ctxt <- get_context
-                    let guarded = isConName Nothing f ctxt
+                    let guarded = isConName f ctxt
                     ns <- apply (Var f) (map isph args)
                     ptm <- get_term
                     g <- goal
@@ -398,6 +411,23 @@
         | not pattern = do mapM_ (runTac False ist) ts
         | otherwise = elab' ina Placeholder
     elab' ina (PElabError e) = fail (pshow ist e)
+    elab' ina (PRewrite fc r sc) 
+        = do attack
+             tyn <- unique_hole (MN 0 "rty")
+             claim tyn RType
+             valn <- unique_hole (MN 0 "rval")
+             claim valn (Var tyn)
+             letn <- unique_hole (MN 0 "rewrite_rule")
+             letbind letn (Var tyn) (Var valn)  
+             focus valn
+             elab' ina r
+             compute
+             g <- goal
+             rewrite (Var letn)
+             g' <- goal
+             when (g == g') $ lift $ tfail (NoRewriting g)
+             elab' ina sc
+             solve
     elab' ina@(_, a) c@(PCase fc scr opts)
         = do attack
              tyn <- unique_hole (MN 0 "scty")
@@ -417,6 +447,8 @@
              -- fail $ "Not implemented " ++ show c ++ "\n" ++ show args
              -- elaborate case
              updateAux (newdef : )
+             -- if we haven't got the type yet, hopefully we'll get it later!
+             movelast tyn
              solve
         where mkCaseName (NS n ns) = NS (mkCaseName n) ns
               mkCaseName (UN x) = UN (x ++ "_case")
@@ -477,7 +509,6 @@
       where elabArg n t 
                 = do hs <- get_holes
                      tm <- get_term
-                     t' <- insertCoerce ina t
                      failed' <- -- trace (show (n, t, hs, tm)) $ 
                                 -- traceWhen (not (null cs)) (show ty ++ "\n" ++ showImp True t) $
                                 case n `elem` hs of
@@ -485,7 +516,7 @@
 --                                       if r
 --                                          then try (do focus n; elabE ina t; return failed)
 --                                                   (return ((n,(lazy, t)):failed))
-                                         do focus n; elab' ina t'; return failed
+                                         do focus n; elabE ina t; return failed
                                    False -> return failed
                      elabArgs ina failed fc r ns args
 
@@ -517,7 +548,7 @@
 pruneByType :: Term -> Context -> [PTerm] -> [PTerm]
 pruneByType (P _ n _) c as 
 -- if the goal type is polymorphic, keep e
-   | [] <- lookupTy Nothing n c = as
+   | [] <- lookupTy n c = as
    | otherwise 
        = let asV = filter (headIs True n) as 
              as' = filter (headIs False n) as in
@@ -533,8 +564,9 @@
     headIs _ _ _ = True -- keep if it's not an application
 
     typeHead var f f' 
-        = case lookupTy Nothing f' c of
-                       [ty] -> case unApply (getRetTy ty) of
+        = case lookupTy f' c of
+                       [ty] -> let ty' = normalise c [] ty in
+                                   case unApply (getRetTy ty') of
                                     (P _ ftyn _, _) -> ftyn == f
                                     (V _, _) -> var -- keep, variable
                                     _ -> False
@@ -565,7 +597,7 @@
 findInstances :: IState -> Term -> [Name]
 findInstances ist t 
     | (P _ n _, _) <- unApply t 
-        = case lookupCtxt Nothing n (idris_classes ist) of
+        = case lookupCtxt n (idris_classes ist) of
             [CI _ _ _ _ ins] -> ins
             _ -> []
     | otherwise = []
@@ -627,7 +659,7 @@
 --                 if (all boundVar ttypes) then resolveTC (depth - 1) fn insts ist 
 --                   else do
                    -- if there's a hole in the goal, don't even try
-                let imps = case lookupCtxtName Nothing n (idris_implicits ist) of
+                let imps = case lookupCtxtName n (idris_implicits ist) of
                                 [] -> []
                                 [args] -> map isImp (snd args) -- won't be overloaded!
                 ps <- get_probs
@@ -664,10 +696,12 @@
 collectDeferred t = return t
 
 -- Running tactics directly
+-- if a tactic adds unification problems, return an error
 
 runTac :: Bool -> IState -> PTactic -> ElabD ()
-runTac autoSolve ist tac = do env <- get_env
-                              runT (fmap (addImplBound ist (map fst env)) tac) 
+runTac autoSolve ist tac 
+    = do env <- get_env
+         no_errors $ runT (fmap (addImplBound ist (map fst env)) tac) 
   where
     runT (Intro []) = do g <- goal
                          attack; intro (bname g)
@@ -685,7 +719,7 @@
     runT (Exact tm) = do elab ist toplevel False False (MN 0 "tac") tm
                          when autoSolve solveAll
     runT (Refine fn [])   
-        = do (fn', imps) <- case lookupCtxtName Nothing fn (idris_implicits ist) of
+        = do (fn', imps) <- case lookupCtxtName fn (idris_implicits ist) of
                                     [] -> do a <- envArgs fn
                                              return (fn, a)
                                     -- FIXME: resolve ambiguities
@@ -744,22 +778,67 @@
     runT Solve = solve
     runT (Try l r) = do try' (runT l) (runT r) True
     runT (TSeq l r) = do runT l; runT r
-    runT (ReflectTac tm) = do attack -- let x : Tactic = tm in ...
-                              valn <- unique_hole (MN 0 "tacval")
-                              claim valn (Var tacticTy)
-                              tacn <- unique_hole (MN 0 "tacn")
-                              letbind tacn (Var tacticTy) (Var valn)
-                              focus valn
-                              elab ist toplevel False False (MN 0 "tac") tm
-                              (tm', ty') <- get_type_val (Var tacn)
-                              ctxt <- get_context
-                              env <- get_env
-                              let tactic = normalise ctxt env tm'
-                              runReflected tactic
---                               p <- get_term
---                               trace (show p ++ "\n\n") $ 
-                              return ()
-        where tacticTy = tacm "Tactic"
+    runT (ApplyTactic tm) = do tenv <- get_env -- store the environment
+                               tgoal <- goal -- store the goal
+                               attack -- let f : List (TTName, Binder TT) -> TT -> Tactic = tm in ...
+                               script <- unique_hole (MN 0 "script")
+                               claim script scriptTy
+                               scriptvar <- unique_hole (MN 0 "scriptvar" )
+                               letbind scriptvar scriptTy (Var script)
+                               focus script
+                               elab ist toplevel False False (MN 0 "tac") tm
+                               (script', _) <- get_type_val (Var scriptvar)
+                               -- now that we have the script apply
+                               -- it to the reflected goal and context
+                               restac <- unique_hole (MN 0 "restac")
+                               claim restac tacticTy
+                               focus restac
+                               fill (raw_apply (forget script') 
+                                               [reflectEnv tenv, reflect tgoal])
+                               restac' <- get_guess
+                               solve
+                               -- normalise the result in order to
+                               -- reify it
+                               ctxt <- get_context
+                               env <- get_env
+                               let tactic = normalise ctxt env restac'
+                               runReflected tactic
+        where tacticTy = Var (reflm "Tactic")
+              listTy = Var (NS (UN "List") ["List", "Prelude"])
+              scriptTy = (RBind (UN "__pi_arg") 
+                                (Pi (RApp listTy envTupleType))
+                                    (RBind (UN "__pi_arg1") 
+                                           (Pi (Var $ reflm "TT")) tacticTy))
+
+    runT (Reflect v) = do attack -- let x = reflect v in ...
+                          tyn <- unique_hole (MN 0 "letty")
+                          claim tyn RType
+                          valn <- unique_hole (MN 0 "letval")
+                          claim valn (Var tyn)
+                          letn <- unique_hole (MN 0 "letvar")
+                          letbind letn (Var tyn) (Var valn)
+                          focus valn
+                          elab ist toplevel False False (MN 0 "tac") v
+                          (value, _) <- get_type_val (Var letn)
+                          ctxt <- get_context
+                          env <- get_env
+                          let value' = hnf ctxt env value
+                          runTac autoSolve ist (Exact $ PQuote (reflect value'))
+    runT (Fill v) = do attack -- let x = fill x in ...
+                       tyn <- unique_hole (MN 0 "letty")
+                       claim tyn RType
+                       valn <- unique_hole (MN 0 "letval")
+                       claim valn (Var tyn)
+                       letn <- unique_hole (MN 0 "letvar")
+                       letbind letn (Var tyn) (Var valn)
+                       focus valn
+                       elab ist toplevel False False (MN 0 "tac") v
+                       (value, _) <- get_type_val (Var letn)
+                       ctxt <- get_context
+                       env <- get_env
+                       let value' = normalise ctxt env value
+                       rawValue <- reifyRaw value'
+                       runTac autoSolve ist (Exact $ PQuote rawValue)
     runT (GoalType n tac) = do g <- goal
                                case unApply g of
                                     (P _ n' _, _) -> 
@@ -769,25 +848,352 @@
                                     _ -> fail "Wrong goal type"
     runT x = fail $ "Not implemented " ++ show x
 
-    runReflected t = do t' <- reify t
+    runReflected t = do t' <- reify ist t
                         runTac autoSolve ist t'
-    tacm n = NS (UN n) ["Reflection", "Language"]
 
-    reify :: Term -> ElabD PTactic
-    reify (P _ n _) | n == tacm "Trivial" = return Trivial
-    reify (P _ n _) | n == tacm "Solve" = return Solve
-    reify f@(App _ _) 
-          | (P _ f _, args) <- unApply f = reifyAp f args
-    reify t = fail ("Unknown tactic " ++ show t)
+-- | Prefix a name with the "Reflection.Language" namespace
+reflm :: String -> Name
+reflm n = NS (UN n) ["Reflection", "Language"]
 
-    reifyAp t [l, r] | t == tacm "Try" = liftM2 Try (reify l) (reify r)
-    reifyAp t [Constant (Str x)] 
-                     | t == tacm "Refine" = return $ Refine (UN x) []
-    reifyAp t [l, r] | t == tacm "Seq" = liftM2 TSeq (reify l) (reify r)
-    reifyAp t [Constant (Str n), x] 
-                     | t == tacm "GoalType" = liftM (GoalType n) (reify x)
-    reifyAp f args = fail ("Unknown tactic " ++ show (f, args)) -- shouldn't happen
 
+-- | Reify tactics from their reflected representation
+reify :: IState -> Term -> ElabD PTactic
+reify _ (P _ n _) | n == reflm "Intros" = return Intros
+reify _ (P _ n _) | n == reflm "Trivial" = return Trivial
+reify _ (P _ n _) | n == reflm "Solve" = return Solve
+reify _ (P _ n _) | n == reflm "Compute" = return Compute
+reify ist t@(App _ _)
+          | (P _ f _, args) <- unApply t = reifyApp ist f args
+reify _ t = fail ("Unknown tactic " ++ show t)
+
+reifyApp :: IState -> Name -> [Term] -> ElabD PTactic
+reifyApp ist t [l, r] | t == reflm "Try" = liftM2 Try (reify ist l) (reify ist r)
+reifyApp _ t [x]
+           | t == reflm "Refine" = do n <- reifyTTName x
+                                      return $ Refine n []
+reifyApp ist t [l, r] | t == reflm "Seq" = liftM2 TSeq (reify ist l) (reify ist r)
+reifyApp ist t [Constant (Str n), x]
+             | t == reflm "GoalType" = liftM (GoalType n) (reify ist x)
+reifyApp _ t [Constant (Str n)]
+           | t == reflm "Intro" = return $ Intro [UN n]
+reifyApp ist t [t']   
+             | t == reflm "ApplyTactic" = liftM (ApplyTactic . delab ist) (reifyTT t')
+reifyApp ist t [t']
+             | t == reflm "Reflect" = liftM (Reflect . delab ist) (reifyTT t')
+reifyApp _ t [t']
+           | t == reflm "Fill" = liftM (Fill . PQuote) (reifyRaw t')
+reifyApp ist t [t']
+             | t == reflm "Exact" = liftM (Exact . delab ist) (reifyTT t')
+reifyApp ist t [x]
+             | t == reflm "Focus" = liftM Focus (reifyTTName x)
+reifyApp ist t [t']
+             | t == reflm "Rewrite" = liftM (Rewrite . delab ist) (reifyTT t')
+reifyApp ist t [n, t']
+             | t == reflm "LetTac" = do n'  <- reifyTTName n
+                                        t'' <- reifyTT t'
+                                        return $ LetTac n' (delab ist t')
+reifyApp ist t [n, tt', t']
+             | t == reflm "LetTacTy" = do n'   <- reifyTTName n
+                                          tt'' <- reifyTT tt'
+                                          t''  <- reifyTT t'
+                                          return $ LetTacTy n' (delab ist tt'') (delab ist t'')
+reifyApp _ f args = fail ("Unknown tactic " ++ show (f, args)) -- shouldn't happen
+
+-- | Reify terms from their reflected representation
+reifyTT :: Term -> ElabD Term
+reifyTT t@(App _ _)
+        | (P _ f _, args) <- unApply t = reifyTTApp f args
+reifyTT t@(P _ n _)
+        | n == reflm "Erased" = return $ Erased
+reifyTT t@(P _ n _)
+        | n == reflm "Impossible" = return $ Impossible
+reifyTT t = fail ("Unknown reflection term: " ++ show t)
+
+reifyTTApp :: Name -> [Term] -> ElabD Term
+reifyTTApp t [nt, n, x]
+           | t == reflm "P" = do nt' <- reifyTTNameType nt
+                                 n'  <- reifyTTName n
+                                 x'  <- reifyTT x
+                                 return $ P nt' n' x'
+reifyTTApp t [Constant (I i)]
+           | t == reflm "V" = return $ V i
+reifyTTApp t [n, b, x]
+           | t == reflm "Bind" = do n' <- reifyTTName n
+                                    b' <- reifyTTBinder reifyTT (reflm "TT") b
+                                    x' <- reifyTT x
+                                    return $ Bind n' b' x'
+reifyTTApp t [f, x]
+           | t == reflm "App" = do f' <- reifyTT f
+                                   x' <- reifyTT x
+                                   return $ App f' x'
+reifyTTApp t [c]
+           | t == reflm "TConst" = liftM Constant (reifyTTConst c)
+reifyTTApp t [t', Constant (I i)]
+           | t == reflm "Proj" = do t'' <- reifyTT t'
+                                    return $ Proj t'' i
+reifyTTApp t [tt]
+           | t == reflm "TType" = liftM TType (reifyTTUExp tt)
+reifyTTApp t args = fail ("Unknown reflection term: " ++ show (t, args))
+
+-- | Reify raw terms from their reflected representation
+reifyRaw :: Term -> ElabD Raw
+reifyRaw t@(App _ _)
+         | (P _ f _, args) <- unApply t = reifyRawApp f args
+reifyRaw t@(P _ n _)
+         | n == reflm "RType" = return $ RType
+reifyRaw t = fail ("Unknown reflection raw term: " ++ show t)
+
+reifyRawApp :: Name -> [Term] -> ElabD Raw
+reifyRawApp t [n]
+            | t == reflm "Var" = liftM Var (reifyTTName n)
+reifyRawApp t [n, b, x]
+            | t == reflm "RBind" = do n' <- reifyTTName n
+                                      b' <- reifyTTBinder reifyRaw (reflm "Raw") b
+                                      x' <- reifyRaw x
+                                      return $ RBind n' b' x'
+reifyRawApp t [f, x]
+            | t == reflm "RApp" = liftM2 RApp (reifyRaw f) (reifyRaw x)
+reifyRawApp t [t']
+            | t == reflm "RForce" = liftM RForce (reifyRaw t')
+reifyRawApp t [c]
+            | t == reflm "RConstant" = liftM RConstant (reifyTTConst c)
+reifyRawApp t args = fail ("Unknown reflection raw term: " ++ show (t, args))
+
+reifyTTName :: Term -> ElabD Name
+reifyTTName t@(App _ _)
+            | (P _ f _, args) <- unApply t = reifyTTNameApp f args
+reifyTTName t = fail ("Unknown reflection term name: " ++ show t)
+
+reifyTTNameApp :: Name -> [Term] -> ElabD Name
+reifyTTNameApp t [Constant (Str n)]
+               | t == reflm "UN" = return $ UN n
+reifyTTNameApp t [n, ns]
+               | t == reflm "NS" = do n'  <- reifyTTName n
+                                      ns' <- reifyTTNamespace ns
+                                      return $ NS n' ns'
+reifyTTNameApp t [Constant (I i), Constant (Str n)]
+               | t == reflm "MN" = return $ MN i n
+reifyTTNameApp t []
+               | t == reflm "NErased" = return NErased
+reifyTTNameApp t args = fail ("Unknown reflection term name: " ++ show (t, args))
+
+reifyTTNamespace :: Term -> ElabD [String]
+reifyTTNamespace t@(App _ _) 
+  = case unApply t of
+      (P _ f _, [Constant StrType]) 
+           | f == NS (UN "Nil") ["List", "Prelude"] -> return []
+      (P _ f _, [Constant StrType, Constant (Str n), ns])
+           | f == NS (UN "::")  ["List", "Prelude"] -> liftM (n:) (reifyTTNamespace ns)
+      _ -> fail ("Unknown reflection namespace arg: " ++ show t)
+reifyTTNamespace t = fail ("Unknown reflection namespace arg: " ++ show t)
+
+reifyTTNameType :: Term -> ElabD NameType
+reifyTTNameType t@(P _ n _) | n == reflm "Bound" = return $ Bound
+reifyTTNameType t@(P _ n _) | n == reflm "Ref" = return $ Ref
+reifyTTNameType t@(App _ _)
+  = case unApply t of
+      (P _ f _, [Constant (I tag), Constant (I num)])
+           | f == reflm "DCon" -> return $ DCon tag num
+           | f == reflm "TCon" -> return $ TCon tag num
+      _ -> fail ("Unknown reflection name type: " ++ show t)
+reifyTTNameType t = fail ("Unknown reflection name type: " ++ show t)
+
+reifyTTBinder :: (Term -> ElabD a) -> Name -> Term -> ElabD (Binder a)
+reifyTTBinder reificator binderType t@(App _ _)
+  = case unApply t of
+     (P _ f _, bt:args) | forget bt == Var binderType 
+       -> reifyTTBinderApp reificator f args
+     _ -> fail ("Mismatching binder reflection: " ++ show t)
+reifyTTBinder _ _ t = fail ("Unknown reflection binder: " ++ show t)
+
+reifyTTBinderApp :: (Term -> ElabD a) -> Name -> [Term] -> ElabD (Binder a)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "Lam" = liftM Lam (reif t)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "Pi" = liftM Pi (reif t)
+reifyTTBinderApp reif f [x, y]
+                      | f == reflm "Let" = liftM2 Let (reif x) (reif y)
+reifyTTBinderApp reif f [x, y]
+                      | f == reflm "NLet" = liftM2 NLet (reif x) (reif y)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "Hole" = liftM Hole (reif t)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "GHole" = liftM GHole (reif t)
+reifyTTBinderApp reif f [x, y]
+                      | f == reflm "Guess" = liftM2 Guess (reif x) (reif y)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "PVar" = liftM PVar (reif t)
+reifyTTBinderApp reif f [t]
+                      | f == reflm "PVTy" = liftM PVTy (reif t)
+reifyTTBinderApp _ f args = fail ("Unknown reflection binder: " ++ show (f, args))
+
+reifyTTConst :: Term -> ElabD Const
+reifyTTConst (P _ n _) | n == reflm "IType"    = return $ IType
+reifyTTConst (P _ n _) | n == reflm "BIType"   = return $ BIType
+reifyTTConst (P _ n _) | n == reflm "FlType"   = return $ FlType
+reifyTTConst (P _ n _) | n == reflm "ChType"   = return $ ChType
+reifyTTConst (P _ n _) | n == reflm "StrType"  = return $ StrType
+reifyTTConst (P _ n _) | n == reflm "B8Type"   = return $ B8Type
+reifyTTConst (P _ n _) | n == reflm "B16Type"  = return $ B16Type
+reifyTTConst (P _ n _) | n == reflm "B32Type"  = return $ B32Type
+reifyTTConst (P _ n _) | n == reflm "B64Type"  = return $ B64Type
+reifyTTConst (P _ n _) | n == reflm "PtrType"  = return $ PtrType
+reifyTTConst (P _ n _) | n == reflm "VoidType" = return $ VoidType
+reifyTTConst (P _ n _) | n == reflm "Forgot"   = return $ Forgot
+reifyTTConst t@(App _ _)
+             | (P _ f _, [arg]) <- unApply t   = reifyTTConstApp f arg
+reifyTTConst t = fail ("Unknown reflection constant: " ++ show t)
+
+reifyTTConstApp :: Name -> Term -> ElabD Const
+reifyTTConstApp f (Constant c@(I _))
+                | f == reflm "I"   = return $ c
+reifyTTConstApp f (Constant c@(BI _))
+                | f == reflm "BI"  = return $ c
+reifyTTConstApp f (Constant c@(Fl _))
+                | f == reflm "Fl"  = return $ c
+reifyTTConstApp f (Constant c@(I _))
+                | f == reflm "Ch"  = return $ c
+reifyTTConstApp f (Constant c@(Str _))
+                | f == reflm "Str" = return $ c
+reifyTTConstApp f (Constant c@(B8 _))
+                | f == reflm "B8"  = return $ c
+reifyTTConstApp f (Constant c@(B16 _))
+                | f == reflm "B16" = return $ c
+reifyTTConstApp f (Constant c@(B32 _))
+                | f == reflm "B32" = return $ c
+reifyTTConstApp f (Constant c@(B64 _))
+                | f == reflm "B64" = return $ c
+reifyTTConstApp f arg = fail ("Unknown reflection constant: " ++ show (f, arg))
+
+reifyTTUExp :: Term -> ElabD UExp
+reifyTTUExp t@(App _ _)
+  = case unApply t of
+      (P _ f _, [Constant (I i)]) | f == reflm "UVar" -> return $ UVar i
+      (P _ f _, [Constant (I i)]) | f == reflm "UVal" -> return $ UVal i
+      _ -> fail ("Unknown reflection type universe expression: " ++ show t)
+reifyTTUExp t = fail ("Unknown reflection type universe expression: " ++ show t)
+
+-- | Create a reflected call to a named function/constructor
+reflCall :: String -> [Raw] -> Raw
+reflCall funName args 
+  = raw_apply (Var (reflm funName)) args
+
+-- | Lift a term into its Language.Reflection.TT representation
+reflect :: Term -> Raw
+reflect (P nt n t) 
+  = reflCall "P" [reflectNameType nt, reflectName n, reflect t]
+reflect (V n) 
+  = reflCall "V" [RConstant (I n)]
+reflect (Bind n b x)
+  = reflCall "Bind" [reflectName n, reflectBinder b, reflect x]
+reflect (App f x)
+  = reflCall "App" [reflect f, reflect x]
+reflect (Constant c)
+  = reflCall "TConst" [reflectConstant c]
+reflect (Proj t i)
+  = reflCall "Proj" [reflect t, RConstant (I i)]
+reflect (Erased) = Var (reflm "Erased")
+reflect (Impossible) = Var (reflm "Impossible")
+reflect (TType exp) = reflCall "TType" [reflectUExp exp]
+
+reflectNameType :: NameType -> Raw
+reflectNameType (Bound) = Var (reflm "Bound")
+reflectNameType (Ref) = Var (reflm "Ref")
+reflectNameType (DCon x y) 
+  = reflCall "DCon" [RConstant (I x), RConstant (I y)]
+reflectNameType (TCon x y) 
+  = reflCall "TCon" [RConstant (I x), RConstant (I y)]
+
+reflectName :: Name -> Raw
+reflectName (UN str) 
+  = reflCall "UN" [RConstant (Str str)]
+reflectName (NS n ns)
+  = reflCall "NS" [ reflectName n
+                  , foldr (\ n s -> 
+                             raw_apply ( Var $ NS (UN "::") ["List", "Prelude"] )
+                                       [ RConstant StrType, RConstant (Str n), s ])
+                             ( raw_apply ( Var $ NS (UN "Nil") ["List", "Prelude"] )
+                                         [ RConstant StrType ])
+                             ns 
+                  ] 
+reflectName (MN i n) 
+  = reflCall "MN" [RConstant (I i), RConstant (Str n)]
+reflectName (NErased) = Var (reflm "NErased")
+
+reflectBinder :: Binder Term -> Raw
+reflectBinder (Lam t)
+   = reflCall "Lam" [Var (reflm "TT"), reflect t]
+reflectBinder (Pi t)
+   = reflCall "Pi" [Var (reflm "TT"), reflect t]
+reflectBinder (Let x y)
+   = reflCall "Let" [Var (reflm "TT"), reflect x, reflect y]
+reflectBinder (NLet x y)
+   = reflCall "NLet" [Var (reflm "TT"), reflect x, reflect y]
+reflectBinder (Hole t)
+   = reflCall "Hole" [Var (reflm "TT"), reflect t]
+reflectBinder (GHole t)
+   = reflCall "GHole" [Var (reflm "TT"), reflect t]
+reflectBinder (Guess x y)
+   = reflCall "Guess" [Var (reflm "TT"), reflect x, reflect y]
+reflectBinder (PVar t)
+   = reflCall "PVar" [Var (reflm "TT"), reflect t]
+reflectBinder (PVTy t)
+   = reflCall "PVTy" [Var (reflm "TT"), reflect t]
+
+reflectConstant :: Const -> Raw
+reflectConstant c@(I  _) = reflCall "I"  [RConstant c]
+reflectConstant c@(BI _) = reflCall "BI" [RConstant c]
+reflectConstant c@(Fl _) = reflCall "Fl" [RConstant c]
+reflectConstant c@(Ch _) = reflCall "Ch" [RConstant c]
+reflectConstant c@(Str _) = reflCall "Str" [RConstant c]
+reflectConstant (IType) = Var (reflm "IType")
+reflectConstant (BIType) = Var (reflm "BIType")
+reflectConstant (FlType) = Var (reflm "FlType")
+reflectConstant (ChType) = Var (reflm "ChType")
+reflectConstant (StrType) = Var (reflm "StrType")
+reflectConstant c@(B8 _) = reflCall "B8" [RConstant c]
+reflectConstant c@(B16 _) = reflCall "B16" [RConstant c]
+reflectConstant c@(B32 _) = reflCall "B32" [RConstant c]
+reflectConstant c@(B64 _) = reflCall "B64" [RConstant c]
+reflectConstant (B8Type) = Var (reflm "B8Type")
+reflectConstant (B16Type) = Var (reflm "B16Type")
+reflectConstant (B32Type) = Var (reflm "B32Type")
+reflectConstant (B64Type) = Var (reflm "B64Type")
+reflectConstant (PtrType) = Var (reflm "PtrType")
+reflectConstant (VoidType) = Var (reflm "VoidType")
+reflectConstant (Forgot) = Var (reflm "Forgot")
+
+reflectUExp :: UExp -> Raw
+reflectUExp (UVar i) = reflCall "UVar" [RConstant (I i)]
+reflectUExp (UVal i) = reflCall "UVal" [RConstant (I i)]
+
+-- | Reflect the environment of a proof into a List (TTName, Binder TT)
+reflectEnv :: Env -> Raw
+reflectEnv = foldr consToEnvList emptyEnvList
+  where
+    consToEnvList :: (Name, Binder Term) -> Raw -> Raw
+    consToEnvList (n, b) l
+      = raw_apply (Var (NS (UN "::") ["List", "Prelude"]))
+                  [ envTupleType
+                  , raw_apply (Var pairCon) [ (Var $ reflm "TTName")
+                                            , (RApp (Var $ reflm "Binder") 
+                                                    (Var $ reflm "TT"))
+                                            , reflectName n 
+                                            , reflectBinder b
+                                            ]
+                  , l
+                  ]
+
+    emptyEnvList :: Raw
+    emptyEnvList = raw_apply (Var (NS (UN "Nil") ["List", "Prelude"])) 
+                             [envTupleType]
+
+envTupleType :: Raw
+envTupleType 
+  = raw_apply (Var pairTy) [ (Var $ reflm "TTName") 
+                           , (RApp (Var $ reflm "Binder") (Var $ reflm "TT"))
+                           ]
+
 solveAll = try (do solve; solveAll) (return ())
 
 -- If the function application is specialisable, make a new
@@ -797,7 +1203,7 @@
 mkSpecialised :: IState -> FC -> Name -> [PTerm] -> PTerm -> ElabD PTerm
 mkSpecialised i fc n args def
     = do let tm' = def
-         case lookupCtxt Nothing n (idris_statics i) of
+         case lookupCtxt n (idris_statics i) of
            [] -> return tm'
            [as] -> if (not (or as)) then return tm' else
                        mkSpecDecl i n (zip args as) tm'
@@ -824,8 +1230,8 @@
     cg = idris_callgraph i
 
     staticFnNames tm | (P _ f _, as) <- unApply tm
-        = if not (isFnName Nothing f ctxt) then [] 
-             else case lookupCtxt Nothing f cg of
+        = if not (isFnName f ctxt) then [] 
+             else case lookupCtxt f cg of
                     [ns] -> f : f : [] --(ns \\ [f])
                     [] -> [f,f]
                     _ -> []
diff --git a/src/Idris/Error.hs b/src/Idris/Error.hs
--- a/src/Idris/Error.hs
+++ b/src/Idris/Error.hs
@@ -45,7 +45,7 @@
 ifail :: String -> Idris ()
 ifail str = throwIO (IErr str)
 
-ierror :: Err -> Idris ()
+ierror :: Err -> Idris a
 ierror err = do i <- getIState
                 throwIO (IErr $ pshow i err)
 
diff --git a/src/Idris/Help.hs b/src/Idris/Help.hs
new file mode 100644
--- /dev/null
+++ b/src/Idris/Help.hs
@@ -0,0 +1,50 @@
+module Idris.Help (CmdArg(..), help) where
+
+data CmdArg = ExprArg -- ^ The command takes an expression
+            | NameArg -- ^ The command takes a name
+            | FileArg -- ^ The command takes a file
+            | ModuleArg -- ^ The command takes a module name
+            | OptionArg -- ^ The command takes an option
+            | MetaVarArg -- ^ The command takes a metavariable
+            | NoArg -- ^ No completion (yet!?)
+            | SpecialHeaderArg -- ^ do not use
+
+instance Show CmdArg where
+    show ExprArg = "<expr>"
+    show NameArg = "<name>"
+    show FileArg = "<filename>"
+    show ModuleArg = "<module>"
+    show OptionArg = "<option>"
+    show MetaVarArg = "<metavar>"
+    show NoArg = ""
+    show SpecialHeaderArg = "Arguments"
+
+help :: [([String], CmdArg, String)]
+help =
+  [ (["<expr>"], NoArg, "Evaluate an expression"),
+    ([":t"], ExprArg, "Check the type of an expression"),
+    ([":miss", ":missing"], NameArg, "Show missing clauses"),
+    ([":i", ":info"], NameArg, "Display information about a type class"),
+    ([":total"], NameArg, "Check the totality of a name"),
+    ([":r",":reload"], NoArg, "Reload current file"),
+    ([":l",":load"], FileArg, "Load a new file"),
+    ([":cd"], FileArg, "Change working directory"),
+    ([":m",":module"], ModuleArg, "Import an extra module"), -- NOTE: dragons
+    ([":e",":edit"], NoArg, "Edit current file using $EDITOR or $VISUAL"),
+    ([":m",":metavars"], MetaVarArg, "Show remaining proof obligations (metavariables)"),
+    ([":p",":prove"], MetaVarArg, "Prove a metavariable"),
+    ([":a",":addproof"], NameArg, "Add proof to source file"),
+    ([":rmproof"], NameArg, "Remove proof from proof stack"),
+    ([":showproof"], NameArg, "Show proof"),
+    ([":proofs"], NoArg, "Show available proofs"),
+    ([":x"], ExprArg, "Execute IO actions resulting from an expression using the interpreter"),
+    ([":c",":compile"], FileArg, "Compile to an executable <filename>"),
+    ([":js", ":javascript"], FileArg, "Compile to JavaScript <filename>"),
+    ([":exec",":execute"], NoArg, "Compile to an executable and run"),
+    ([":dynamic"], FileArg, "Dynamically load a C library (similar to %dynamic)"),
+    ([":dynamic"], NoArg, "List dynamically loaded C libraries"),
+    ([":?",":h",":help"], NoArg, "Display this help text"),
+    ([":set"], OptionArg, "Set an option (errorcontext, showimplicits)"),
+    ([":unset"], OptionArg, "Unset an option"),
+    ([":q",":quit"], NoArg, "Exit the Idris system")
+  ]
diff --git a/src/Idris/IBC.hs b/src/Idris/IBC.hs
--- a/src/Idris/IBC.hs
+++ b/src/Idris/IBC.hs
@@ -18,10 +18,12 @@
 import System.FilePath
 import System.Directory
 
+import Debug.Trace
+
 import Paths_idris
 
 ibcVersion :: Word8
-ibcVersion = 27
+ibcVersion = 29
 
 data IBCFile = IBCFile { ver :: Word8,
                          sourcefile :: FilePath,
@@ -38,6 +40,7 @@
                          ibc_keywords :: [String],
                          ibc_objs :: [FilePath],
                          ibc_libs :: [String],
+                         ibc_dynamic_libs :: [String],
                          ibc_hdrs :: [String],
                          ibc_access :: [(Name, Accessibility)],
                          ibc_total :: [(Name, Totality)],
@@ -47,12 +50,13 @@
                          ibc_docstrings :: [(Name, String)],
                          ibc_coercions :: [Name]
                        }
+   deriving Show
 {-! 
 deriving instance Binary IBCFile 
 !-}
 
 initIBC :: IBCFile
-initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
+initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
 
 loadIBC :: FilePath -> Idris ()
 loadIBC fp = do iLOG $ "Loading ibc " ++ fp
@@ -81,28 +85,28 @@
                     mkIBC is f'
 
 ibc i (IBCFix d) f = return f { ibc_fixes = d : ibc_fixes f } 
-ibc i (IBCImp n) f = case lookupCtxt Nothing n (idris_implicits i) of
+ibc i (IBCImp n) f = case lookupCtxt n (idris_implicits i) of
                         [v] -> return f { ibc_implicits = (n,v): ibc_implicits f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCStatic n) f 
-                   = case lookupCtxt Nothing n (idris_statics i) of
+                   = case lookupCtxt n (idris_statics i) of
                         [v] -> return f { ibc_statics = (n,v): ibc_statics f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCClass n) f 
-                   = case lookupCtxt Nothing n (idris_classes i) of
+                   = case lookupCtxt n (idris_classes i) of
                         [v] -> return f { ibc_classes = (n,v): ibc_classes f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCInstance int n ins) f 
                    = return f { ibc_instances = (int,n,ins): ibc_instances f     }
 ibc i (IBCDSL n) f 
-                   = case lookupCtxt Nothing n (idris_dsls i) of
+                   = case lookupCtxt n (idris_dsls i) of
                         [v] -> return f { ibc_dsls = (n,v): ibc_dsls f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCData n) f 
-                   = case lookupCtxt Nothing n (idris_datatypes i) of
+                   = case lookupCtxt n (idris_datatypes i) of
                         [v] -> return f { ibc_datatypes = (n,v): ibc_datatypes f     }
                         _ -> fail "IBC write failed"
-ibc i (IBCOpt n) f = case lookupCtxt Nothing n (idris_optimisation i) of
+ibc i (IBCOpt n) f = case lookupCtxt n (idris_optimisation i) of
                         [v] -> return f { ibc_optimise = (n,v): ibc_optimise f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCSyntax n) f = return f { ibc_syntax = n : ibc_syntax f }
@@ -110,14 +114,15 @@
 ibc i (IBCImport n) f = return f { ibc_imports = n : ibc_imports f }
 ibc i (IBCObj n) f = return f { ibc_objs = n : ibc_objs f }
 ibc i (IBCLib n) f = return f { ibc_libs = n : ibc_libs f }
+ibc i (IBCDyLib n) f = return f {ibc_dynamic_libs = n : ibc_dynamic_libs f }
 ibc i (IBCHeader n) f = return f { ibc_hdrs = n : ibc_hdrs f }
-ibc i (IBCDef n) f = case lookupDef Nothing n (tt_ctxt i) of
+ibc i (IBCDef n) f = case lookupDef n (tt_ctxt i) of
                         [v] -> return f { ibc_defs = (n,v) : ibc_defs f     }
                         _ -> fail "IBC write failed"
-ibc i (IBCDoc n) f = case lookupCtxt Nothing n (idris_docstrings i) of
+ibc i (IBCDoc n) f = case lookupCtxt n (idris_docstrings i) of
                         [v] -> return f { ibc_docstrings = (n,v) : ibc_docstrings f }
                         _ -> fail "IBC write failed"
-ibc i (IBCCG n) f = case lookupCtxt Nothing n (idris_callgraph i) of
+ibc i (IBCCG n) f = case lookupCtxt n (idris_callgraph i) of
                         [v] -> return f { ibc_cg = (n,v) : ibc_cg f     }
                         _ -> fail "IBC write failed"
 ibc i (IBCCoercion n) f = return f { ibc_coercions = n : ibc_coercions f }
@@ -147,6 +152,7 @@
                pKeywords (ibc_keywords i)
                pObjs (ibc_objs i)
                pLibs (ibc_libs i)
+               pDyLibs (ibc_dynamic_libs i)
                pHdrs (ibc_hdrs i)
                pDefs (ibc_defs i)
                pAccess (ibc_access i)
@@ -242,6 +248,13 @@
 pLibs :: [String] -> Idris ()
 pLibs ls = mapM_ addLib ls
 
+pDyLibs :: [String] -> Idris ()
+pDyLibs ls = do res <- mapM (addDyLib . return) ls
+                mapM_ checkLoad res
+                return ()
+    where checkLoad (Left _) = return ()
+          checkLoad (Right err) = fail err
+
 pHdrs :: [String] -> Idris ()
 pHdrs hs = mapM_ addHdr hs
 
@@ -321,16 +334,21 @@
  
 instance Binary Name where
         put x
-          = case x of
-                UN x1 -> do putWord8 0
-                            put x1
-                NS x1 x2 -> do putWord8 1
+          = {-# SCC "putName" #-}
+            case x of
+                UN x1 -> {-# SCC "putUN" #-}
+                         do putWord8 0
+                            {-# SCC "putNString" #-} put x1
+                NS x1 x2 -> {-# SCC "putNS" #-}
+                            do putWord8 1
                                put x1
                                put x2
-                MN x1 x2 -> do putWord8 2
+                MN x1 x2 -> {-# SCC "putMN" #-}
+                            do putWord8 2
                                put x1
                                put x2
-                NErased -> putWord8 3
+                NErased -> {-# SCC "putNErased" #-}
+                         putWord8 3
         get
           = do i <- getWord8
                case i of
@@ -522,9 +540,10 @@
                    _ -> error "Corrupted binary data for NameType"
 
 
-instance (Binary n) => Binary (TT n) where
+instance {-(Binary n) =>-} Binary (TT Name) where
         put x
-          = case x of
+          = {-# SCC "putTT" #-} 
+            case x of
                 P x1 x2 x3 -> do putWord8 0
                                  put x1
                                  put x2
@@ -607,7 +626,8 @@
  
 instance Binary CaseAlt where
         put x
-          = case x of
+          = {-# SCC "putCaseAlt" #-} 
+            case x of
                 ConCase x1 x2 x3 x4 -> do putWord8 0
                                           put x1
                                           put x2
@@ -636,17 +656,16 @@
  
 instance Binary Def where
         put x
-          = case x of
+          = {-# SCC "putDef" #-} 
+            case x of
                 Function x1 x2 -> do putWord8 0
                                      put x1
                                      put x2
                 TyDecl x1 x2 -> do putWord8 1
                                    put x1
                                    put x2
-                Operator x1 x2 x3 -> do putWord8 2
-                                        put x1
-                                        put x2
-                                        put x3
+                -- all primitives just get added at the start, don't write
+                Operator x1 x2 x3 -> do return ()
                 CaseOp x1 x2 x3 x3a x4 x5 x6 x7 x8 -> 
                                                do putWord8 3
                                                   put x1
@@ -744,8 +763,9 @@
                    _ -> error "Corrupted binary data for Totality"
 
 instance Binary IBCFile where
-        put (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23)
-          = do put x1
+        put x@(IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24)
+         = {-# SCC "putIBCFile" #-} 
+            do put x1
                put x2
                put x3
                put x4
@@ -768,6 +788,7 @@
                put x21
                put x22
                put x23
+               put x24
         get
           = do x1 <- get
                if x1 == ibcVersion then 
@@ -793,7 +814,8 @@
                     x21 <- get
                     x22 <- get
                     x23 <- get
-                    return (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23)
+                    x24 <- get
+                    return (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24)
                   else return (initIBC { ver = x1 })
  
 instance Binary FnOpt where
@@ -1074,6 +1096,15 @@
                             return (PPostulate x1 x2 x3 x4 x5 x6)
                    _ -> error "Corrupted binary data for PDecl'"
 
+instance Binary Using where
+        put (UImplicit x1 x2) = do putWord8 0; put x1; put x2
+        put (UConstraint x1 x2) = do putWord8 1; put x1; put x2
+
+        get = do i <- getWord8
+                 case i of
+                    0 -> do x1 <- get; x2 <- get; return (UImplicit x1 x2)
+                    1 -> do x1 <- get; x2 <- get; return (UConstraint x1 x2)
+
 instance Binary SyntaxInfo where
         put (Syn x1 x2 x3 x4 x5 x6 x7 x8)
           = do put x1
@@ -1257,6 +1288,10 @@
                 PInferRef x1 x2 -> do putWord8 29
                                       put x1
                                       put x2
+                PRewrite x1 x2 x3 -> do putWord8 30
+                                        put x1
+                                        put x2
+                                        put x3
         get
           = do i <- getWord8
                case i of
@@ -1341,6 +1376,10 @@
                    29 -> do x1 <- get
                             x2 <- get
                             return (PInferRef x1 x2)
+                   30 -> do x1 <- get
+                            x2 <- get
+                            x3 <- get
+                            return (PRewrite x1 x2 x3)
                    _ -> error "Corrupted binary data for PTerm"
  
 instance (Binary t) => Binary (PTactic' t) where
@@ -1374,8 +1413,12 @@
                                  put x1
                                  put x2
                 Qed -> putWord8 15
-                ReflectTac x1 -> do putWord8 16
-                                    put x1
+                ApplyTactic x1 -> do putWord8 16
+                                     put x1
+                Reflect x1 -> do putWord8 17
+                                 put x1
+                Fill x1 -> do putWord8 18
+                              put x1                
         get
           = do i <- getWord8
                case i of
@@ -1408,7 +1451,11 @@
                             return (TSeq x1 x2)
                    15 -> return Qed
                    16 -> do x1 <- get
-                            return (ReflectTac x1)
+                            return (ApplyTactic x1)
+                   17 -> do x1 <- get
+                            return (Reflect x1)
+                   18 -> do x1 <- get
+                            return (Fill x1)
                    _ -> error "Corrupted binary data for PTactic'"
 
 
diff --git a/src/Idris/IdeSlave.hs b/src/Idris/IdeSlave.hs
new file mode 100644
--- /dev/null
+++ b/src/Idris/IdeSlave.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}
+
+module Idris.IdeSlave(parseMessage, convSExp, IdeSlaveCommand(..), sexpToCommand, toSExp, SExp(..)) where
+
+import Text.Printf
+import Numeric
+import Data.List
+-- import qualified Data.Text as T
+import Text.Parsec
+
+data SExp = SexpList [SExp]
+          | StringAtom String
+          | BoolAtom Bool
+          | IntegerAtom Integer
+          | SymbolAtom String
+          deriving ( Eq, Show )
+
+sExpToString :: SExp -> String
+sExpToString (StringAtom s)   = "\"" ++ escape s ++ "\""
+sExpToString (BoolAtom True)  = ":True"
+sExpToString (BoolAtom False) = ":False"
+sExpToString (IntegerAtom i)  = printf "%d" i
+sExpToString (SymbolAtom s)   = ":" ++ s
+sExpToString (SexpList l)     = "(" ++ intercalate " " (map sExpToString l) ++ ")"
+
+class SExpable a where
+  toSExp :: a -> SExp
+
+instance SExpable SExp where
+  toSExp a = a
+
+instance SExpable Bool where
+  toSExp True  = BoolAtom True
+  toSExp False = BoolAtom False
+
+instance SExpable String where
+  toSExp s = StringAtom s
+
+instance SExpable Integer where
+  toSExp n = IntegerAtom n
+
+instance SExpable Int where
+  toSExp n = IntegerAtom (toInteger n)
+
+instance (SExpable a) => SExpable (Maybe a) where
+  toSExp Nothing  = SexpList [SymbolAtom "Nothing"]
+  toSExp (Just a) = SexpList [SymbolAtom "Just", toSExp a]
+
+instance (SExpable a) => SExpable [a] where
+  toSExp l = SexpList (map toSExp l)
+
+instance (SExpable a, SExpable b) => SExpable (a, b) where
+  toSExp (l, r) = SexpList [toSExp l, toSExp r]
+
+instance (SExpable a, SExpable b, SExpable c) => SExpable (a, b, c) where
+  toSExp (l, m, n) = SexpList [toSExp l, toSExp m, toSExp n]
+
+escape :: String -> String
+escape = concatMap escapeChar
+  where
+    escapeChar '\\' = "\\\\"
+    escapeChar '"'  = "\\\""
+    escapeChar c    = [c]
+
+pSExp = do xs <- between (char '(') (char ')') (pSExp `sepBy` (char ' '))
+           return (SexpList xs)
+    <|> atom
+
+atom = do char ':'; x <- atomC; return x
+   <|> do char '"'; xs <- many quotedChar; char '"'; return (StringAtom xs)
+   <|> do ints <- many1 digit
+          case readDec ints of
+            ((num, ""):_) -> return (IntegerAtom (toInteger num))
+            _ -> return (StringAtom ints)
+
+atomC = do string "True"; return (BoolAtom True)
+    <|> do string "False"; return (BoolAtom False)
+    <|> do xs <- many (noneOf " \n\t\r\"()"); return (SymbolAtom xs)
+
+quotedChar = try (string "\\\\" >> return '\\')
+         <|> try (string "\\\"" >> return '"')
+         <|> noneOf "\""
+
+parseSExp :: String -> Either ParseError SExp
+parseSExp = parse pSExp "(unknown)"
+
+data IdeSlaveCommand = REPLCompletions String
+                     | Interpret String
+                     | LoadFile String
+  deriving Show
+
+sexpToCommand :: SExp -> Maybe IdeSlaveCommand
+sexpToCommand (SexpList (x:[]))                                             = sexpToCommand x
+sexpToCommand (SexpList [SymbolAtom "interpret", StringAtom cmd])           = Just (Interpret cmd)
+sexpToCommand (SexpList [SymbolAtom "repl-completions", StringAtom prefix]) = Just (REPLCompletions prefix)
+sexpToCommand (SexpList [SymbolAtom "load-file", StringAtom filename])      = Just (LoadFile filename)
+sexpToCommand _                                                         = Nothing
+
+parseMessage :: String -> (SExp, Integer)
+parseMessage x = case receiveString x of
+                      (SexpList [cmd, (IntegerAtom id)]) ->
+                        (cmd, id)
+
+receiveString :: String -> SExp
+receiveString x =
+  case readHex (take 6 x) of
+    ((num, ""):_) ->
+      let msg = drop 6 x in
+        if (length msg) /= (num - 1)
+           then error "bad input length"
+           else (case parseSExp msg of
+                      Left _ -> error "parse failure"
+                      Right r -> r)
+    _ -> error "readHex failed"
+
+convSExp :: SExpable a => String -> a -> Integer -> String
+convSExp pre s id =
+  let sex = SexpList [SymbolAtom pre, toSExp s, IntegerAtom id] in
+      let str = sExpToString sex in
+          (getHexLength str) ++ str
+
+getHexLength :: String -> String
+getHexLength s = printf "%06x" (1 + (length s))
diff --git a/src/Idris/Parser.hs b/src/Idris/Parser.hs
--- a/src/Idris/Parser.hs
+++ b/src/Idris/Parser.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
 -- | Parse the full Idris language.
 module Idris.Parser where
 
@@ -11,8 +11,11 @@
 import Idris.Coverage
 import Idris.IBC
 import Idris.Unlit
+import Idris.Providers
 import Paths_idris
 
+import Util.DynamicLinker
+
 import Core.CoreParser
 import Core.TT
 import Core.Evaluate
@@ -27,6 +30,7 @@
 import Data.List
 import Data.List.Split(splitOn)
 import Control.Monad.State
+import Control.Monad.Error
 import Debug.Trace
 import Data.Maybe
 import System.FilePath
@@ -213,6 +217,7 @@
 closeBlock :: IParser ()
 closeBlock = do ist <- getState
                 bs <- case brace_stack ist of
+                        []  -> eof >> return []
                         Nothing : xs -> (lchar '}' >> return xs) <|> (eof >> return [])
                         Just lvl : xs -> (do i   <- indent
                                              inp <- getInput
@@ -269,7 +274,7 @@
 pImport :: IParser String
 pImport = do reserved "import"; f <- identifier; option ';' (lchar ';')
              return (toPath f)
-  where toPath n = foldl1 (</>) $ splitOn "." n
+  where toPath n = foldl1' (</>) $ splitOn "." n
 
 -- | A program is a list of declarations, possibly with associated
 -- documentation strings.
@@ -338,7 +343,8 @@
     <|> pClass syn
     <|> pInstance syn
     <|> do d <- pDSL syn; return [d]
-    <|> pDirective
+    <|> pDirective syn
+    <|> pProvider syn
     <|> try (do reserved "import"; fp <- identifier
                 fail "imports must be at the top of file") 
 
@@ -465,7 +471,7 @@
 
 pUsing :: SyntaxInfo -> IParser [PDecl]
 pUsing syn = 
-    do reserved "using"; lchar '('; ns <- tyDeclList syn; lchar ')'
+    do reserved "using"; lchar '('; ns <- usingDeclList syn; lchar ')'
        openBlock
        let uvars = using syn
        ds <- many1 (pDecl (syn { using = uvars ++ ns }))
@@ -542,7 +548,7 @@
                 acc <- pAccessibility
                 reserved "class"; fc <- pfc; cons <- pConstList syn; n_in <- pName
                 let n = expandNS syn n_in
-                cs <- many1 carg
+                cs <- many carg
                 reserved "where"; openBlock 
                 ds <- many $ pFunDecl syn
                 closeBlock
@@ -563,7 +569,7 @@
                                 return (Just n))
                    cs <- pConstList syn
                    cn <- pName
-                   args <- many1 (pSimpleExpr syn)
+                   args <- many (pSimpleExpr syn)
                    let sc = PApp fc (PRef fc cn) (map pexp args)
                    let t = bindList (PPi constraint) (map (\x -> (MN 0 "c", x)) cs) sc
                    reserved "where"; openBlock 
@@ -605,9 +611,9 @@
      <|> try (pSimpleExpr syn)
      <|> pLambda syn
      <|> pLet syn
+     <|> pRewriteTerm syn
      <|> pPi syn 
      <|> pDoBlock syn
-     <|> pComprehension syn
     
 pExtensions :: SyntaxInfo -> [Syntax] -> IParser PTerm
 pExtensions syn rules = choice (map (try . pExt syn) (filter valid rules))
@@ -757,6 +763,7 @@
                     fc <- pfc
                     return (PInferRef fc x))
         <|> try (pList syn)
+        <|> try (pComprehension syn)
         <|> try (pAlt syn)
         <|> try (pIdiom syn)
         <|> try (do lchar '('
@@ -794,16 +801,30 @@
                   symbol "=>"; rhs <- pExpr syn
                   return (lhs, rhs)
 
+-- bit of a hack here. If the integer doesn't fit in an Int, treat it as a
+-- big integer, otherwise try fromInteger and the constants as alternatives.
+-- a better solution would be to fix fromInteger to work with Integer, as the
+-- name suggests, rather than Int
+
 modifyConst :: SyntaxInfo -> FC -> PTerm -> PTerm
-modifyConst syn fc (PConstant (I x)) 
+modifyConst syn fc (PConstant (BI x)) 
+    | not (fitsInt x) = PAlternative False 
+                           [PConstant (BI x),
+                            PApp fc (PRef fc (UN "fromInteger"))
+                                 [pexp (PConstant (I (fromInteger x)))]]
     | not (inPattern syn)
         = PAlternative False
-             [PApp fc (PRef fc (UN "fromInteger")) [pexp (PConstant (I x))],
-              PConstant (I x), PConstant (BI (toEnum x))]
+             [PApp fc (PRef fc (UN "fromInteger")) [pexp (PConstant (I (fromInteger x)))],
+              PConstant (I (fromInteger x)), PConstant (BI x)]
     | otherwise = PAlternative False
-                     [PConstant (I x), PConstant (BI (toEnum x))]
+                     [PConstant (I (fromInteger x)), PConstant (BI x)]
 modifyConst syn fc x = x
 
+fitsInt :: Integer -> Bool
+fitsInt x = let xInt :: Int = fromInteger x
+                xInteger :: Integer = toInteger xInt in
+                x == xInteger
+
 pList syn = do lchar '['; fc <- pfc; xs <- sepBy (pExpr syn) (lchar ','); lchar ']'
                return (mkList fc xs)
   where
@@ -861,7 +882,7 @@
               return (dslify i $ PApp fc f args)
   where
     dslify i (PApp fc (PRef _ f) [a])
-        | [d] <- lookupCtxt Nothing f (idris_dsls i)
+        | [d] <- lookupCtxt f (idris_dsls i)
             = desugar (syn { dsl_info = d }) i (getTm a)
     dslify i t = t
 
@@ -935,6 +956,14 @@
                         (PCase fc (PRef fc (MN i "lamp"))
                                 [(x, pmList xs sc)])
 
+pRewriteTerm syn = 
+                do reserved "rewrite"
+                   fc <- pfc
+                   prf <- pExpr syn
+                   reserved "in";  sc <- pExpr syn
+                   return (PRewrite fc 
+                             (PApp fc (PRef fc (UN "sym")) [pexp prf]) sc)
+
 pLet syn = try (do reserved "let"; n <- pName; 
                    ty <- option Placeholder (do lchar ':'; pExpr' syn)
                    lchar '='
@@ -947,7 +976,9 @@
                    return (PCase fc v [(pat, sc)]))
 
 pPi syn = 
-     try (do lazy <- option False (do lchar '|'; return True)
+     try (do lazy <- if implicitAllowed syn -- laziness is top level only
+                        then option False (do lchar '|'; return True)
+                        else return False
              st <- pStatic
              lchar '('; xt <- tyDeclList syn; lchar ')'
              doc <- option "" (pDocComment '^')
@@ -1001,6 +1032,19 @@
                          return [t])
              <|> return []
 
+usingDeclList syn 
+               = try (sepBy1 (usingDecl syn) (lchar ','))
+             <|> do ns <- sepBy1 pName (lchar ',')
+                    t <- pTSig (noImp syn)
+                    return (map (\x -> UImplicit x t) ns)
+
+usingDecl syn = try (do x <- pfName
+                        t <- pTSig (noImp syn)
+                        return (UImplicit x t))
+            <|> do c <- pfName
+                   xs <- many1 pfName
+                   return (UConstraint c xs)
+
 tyDeclList syn = try (sepBy1 (do x <- pfName
                                  t <- pTSig (noImp syn)
                                  return (x,t))
@@ -1092,8 +1136,7 @@
         <|> do reserved "Bits32"; return B32Type
         <|> do reserved "Bits64"; return B64Type
         <|> try (do f <- float;   return $ Fl f)
---         <|> try (do i <- natural; lchar 'L'; return $ BI i)
-        <|> try (do i <- natural; return $ I (fromInteger i))
+        <|> try (do i <- natural; return $ BI i)
         <|> try (do s <- strlit;  return $ Str s)
         <|> try (do c <- chlit;   return $ Ch c)
 
@@ -1334,7 +1377,8 @@
                    cargs <- many (pConstraintArg syn)
                    iargs <- many (pImplicitArg (syn { inPattern = True } ))
                    fc <- pfc
-                   args <- many (pArgExpr syn)
+                   args <- many (try (pImplicitArg (syn { inPattern = True } ))
+                                 <|> (fmap pexp (pArgExpr syn)))
                    wargs <- many (pWExpr syn)
                    rhs <- pRHS syn n
                    ist <- getState
@@ -1346,7 +1390,7 @@
                                              do pTerminator
                                                 return ([], [])]
                    let capp = PApp fc (PRef fc n) 
-                                (iargs ++ cargs ++ map pexp args)
+                                (iargs ++ cargs ++ args)
                    ist <- getState
                    setState (ist { lastParse = Just n })
                    return $ PClause fc n capp wargs rhs wheres)
@@ -1372,10 +1416,11 @@
                    cargs <- many (pConstraintArg syn)
                    iargs <- many (pImplicitArg (syn { inPattern = True } ))
                    fc <- pfc
-                   args <- many (pArgExpr syn)
+                   args <- many (try (pImplicitArg (syn { inPattern = True } )) 
+                                 <|> (fmap pexp (pArgExpr syn)))
                    wargs <- many (pWExpr syn)
                    let capp = PApp fc (PRef fc n) 
-                                (iargs ++ cargs ++ map pexp args)
+                                (iargs ++ cargs ++ args)
                    ist <- getState
                    setState (ist { lastParse = Just n })
                    reserved "with"
@@ -1455,35 +1500,51 @@
          closeBlock
          return (concat ds, map (\x -> (x, decoration syn x)) dns)
 
-pDirective :: IParser [PDecl]
-pDirective = try (do lchar '%'; reserved "lib"; lib <- strlit;
-                     return [PDirective (do addLib lib
-                                            addIBC (IBCLib lib))])
-         <|> try (do lchar '%'; reserved "link"; obj <- strlit;
-                     return [PDirective (do datadir <- liftIO getDataDir
-                                            o <- liftIO $ findInPath [".", datadir] obj
-                                            addIBC (IBCObj o)
-                                            addObjectFile o)])
-         <|> try (do lchar '%'; reserved "include"; hdr <- strlit;
-                     return [PDirective (do addHdr hdr
-                                            addIBC (IBCHeader hdr))])
-         <|> try (do lchar '%'; reserved "hide"; n <- iName []
-                     return [PDirective (do setAccessibility n Hidden
-                                            addIBC (IBCAccess n Hidden))])
-         <|> try (do lchar '%'; reserved "freeze"; n <- iName []
-                     return [PDirective (do setAccessibility n Frozen
-                                            addIBC (IBCAccess n Frozen))])
-         <|> try (do lchar '%'; reserved "access"; acc <- pAccessibility'
-                     return [PDirective (do i <- getIState
-                                            putIState (i { default_access = acc }))])
-         <|> try (do lchar '%'; reserved "default"; tot <- pTotality
-                     i <- getState
-                     setState (i { default_total = tot } )
-                     return [PDirective (do i <- getIState
-                                            putIState (i { default_total = tot }))])
-         <|> try (do lchar '%'; reserved "logging"; i <- natural;
-                     return [PDirective (setLogLevel (fromInteger i))])
+pDirective :: SyntaxInfo -> IParser [PDecl]
+pDirective syn = try (do lchar '%'; reserved "lib"; lib <- strlit;
+                         return [PDirective (do addLib lib
+                                                addIBC (IBCLib lib))])
+             <|> try (do lchar '%'; reserved "link"; obj <- strlit;
+                         return [PDirective (do datadir <- liftIO getDataDir
+                                                o <- liftIO $ findInPath [".", datadir] obj
+                                                addIBC (IBCObj o)
+                                                addObjectFile o)])
+             <|> try (do lchar '%'; reserved "include"; hdr <- strlit;
+                         return [PDirective (do addHdr hdr
+                                                addIBC (IBCHeader hdr))])
+             <|> try (do lchar '%'; reserved "hide"; n <- iName []
+                         return [PDirective (do setAccessibility n Hidden
+                                                addIBC (IBCAccess n Hidden))])
+             <|> try (do lchar '%'; reserved "freeze"; n <- iName []
+                         return [PDirective (do setAccessibility n Frozen
+                                                addIBC (IBCAccess n Frozen))])
+             <|> try (do lchar '%'; reserved "access"; acc <- pAccessibility'
+                         return [PDirective (do i <- getIState
+                                                putIState (i { default_access = acc }))])
+             <|> try (do lchar '%'; reserved "default"; tot <- pTotality
+                         i <- getState
+                         setState (i { default_total = tot } )
+                         return [PDirective (do i <- getIState
+                                                putIState (i { default_total = tot }))])
+             <|> try (do lchar '%'; reserved "logging"; i <- natural;
+                         return [PDirective (setLogLevel (fromInteger i))])
+             <|> try (do lchar '%'; reserved "dynamic"; libs <- sepBy1 strlit (lchar ',');
+                         return [PDirective (do added <- addDyLib libs
+                                                case added of
+                                                  Left lib -> addIBC (IBCDyLib (lib_name lib))
+                                                  Right msg ->
+                                                      fail $ msg)])
+             <|> try (do lchar '%'; reserved "language"; ext <- reserved "TypeProviders";
+                         return [PDirective (addLangExt TypeProviders)])
 
+pProvider :: SyntaxInfo -> IParser [PDecl]
+pProvider syn = do lchar '%'; reserved "provide";
+                   lchar '('; n <- pfName; t <- pTSig syn; lchar ')'
+                   fc <- pfc
+                   reserved "with"
+                   e <- pExpr syn
+                   return  [PProvider syn fc n t e]
+
 pTactic :: SyntaxInfo -> IParser PTactic
 pTactic syn = do reserved "intro"; ns <- sepBy pName (lchar ',')
                  return $ Intro ns
@@ -1510,9 +1571,15 @@
           <|> do reserved "exact"; t <- pExpr syn;
                  i <- getState
                  return $ Exact (desugar syn i t)
+          <|> do reserved "applyTactic"; t <- pExpr syn;
+                 i <- getState
+                 return $ ApplyTactic (desugar syn i t)
           <|> do reserved "reflect"; t <- pExpr syn;
                  i <- getState
-                 return $ ReflectTac (desugar syn i t)
+                 return $ Reflect (desugar syn i t)
+          <|> do reserved "fill"; t <- pExpr syn;
+                 i <- getState
+                 return $ Fill (desugar syn i t)
           <|> do reserved "try"; t <- pTactic syn;
                  lchar '|';
                  t1 <- pTactic syn
diff --git a/src/Idris/Primitives.hs b/src/Idris/Primitives.hs
--- a/src/Idris/Primitives.hs
+++ b/src/Idris/Primitives.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, PatternGuards #-}
 
 module Idris.Primitives(elabPrims) where
 
@@ -34,280 +34,73 @@
 
 primitives =
    -- operators
-  [Prim (UN "prim__addInt") (ty [IType, IType] IType) 2 (iBin (+))
-    (2, LPlus) total,
-   Prim (UN "prim__subInt") (ty [IType, IType] IType) 2 (iBin (-))
-     (2, LMinus) total,
-   Prim (UN "prim__mulInt") (ty [IType, IType] IType) 2 (iBin (*))
-     (2, LTimes) total,
-   Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin div)
-     (2, LDiv) partial,
-   Prim (UN "prim__modInt") (ty [IType, IType] IType) 2 (iBin mod)
-     (2, LMod) partial,
-   Prim (UN "prim__andInt") (ty [IType, IType] IType) 2 (iBin (.&.))
-     (2, LAnd) partial,
-   Prim (UN "prim__orInt") (ty [IType, IType] IType) 2 (iBin (.|.))
-     (2, LOr) partial,
-   Prim (UN "prim__xorInt") (ty [IType, IType] IType) 2 (iBin xor)
-     (2, LXOr) partial,
-   Prim (UN "prim__shLInt") (ty [IType, IType] IType) 2 (iBin shiftL)
-     (2, LSHL) partial,
-   Prim (UN "prim__shRInt") (ty [IType, IType] IType) 2 (iBin shiftR)
-     (2, LSHR) partial,
-   Prim (UN "prim__complInt") (ty [IType] IType) 1 (iUn complement)
-     (1, LCompl) partial,
-   Prim (UN "prim__eqInt")  (ty [IType, IType] IType) 2 (biBin (==))
-     (2, LEq) total,
-   Prim (UN "prim__ltInt")  (ty [IType, IType] IType) 2 (biBin (<))
-     (2, LLt) total,
-   Prim (UN "prim__lteInt") (ty [IType, IType] IType) 2 (biBin (<=))
-     (2, LLe) total,
-   Prim (UN "prim__gtInt")  (ty [IType, IType] IType) 2 (biBin (>))
-     (2, LGt) total,
-   Prim (UN "prim__gteInt") (ty [IType, IType] IType) 2 (biBin (>=))
-     (2, LGe) total,
-   Prim (UN "prim__eqChar")  (ty [ChType, ChType] IType) 2 (bcBin (==))
-     (2, LEq) total,
+  [Prim (UN "prim__eqChar")  (ty [ChType, ChType] IType) 2 (bcBin (==))
+     (2, LEq ITNative) total,
    Prim (UN "prim__ltChar")  (ty [ChType, ChType] IType) 2 (bcBin (<))
-     (2, LLt) total,
+     (2, LLt ITNative) total,
    Prim (UN "prim__lteChar") (ty [ChType, ChType] IType) 2 (bcBin (<=))
-     (2, LLe) total,
+     (2, LLe ITNative) total,
    Prim (UN "prim__gtChar")  (ty [ChType, ChType] IType) 2 (bcBin (>))
-     (2, LGt) total,
+     (2, LGt ITNative) total,
    Prim (UN "prim__gteChar") (ty [ChType, ChType] IType) 2 (bcBin (>=))
-     (2, LGe) total,
-
-   Prim (UN "prim__ltB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<))
-     (2, LB8Lt) total,
-   Prim (UN "prim__lteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<=))
-     (2, LB8Lte) total,
-   Prim (UN "prim__eqB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (==))
-     (2, LB8Eq) total,
-   Prim (UN "prim__gteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>))
-     (2, LB8Gte) total,
-   Prim (UN "prim__gtB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>=))
-     (2, LB8Gt) total,
-   Prim (UN "prim__addB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (+))
-     (2, LB8Plus) total,
-   Prim (UN "prim__subB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (-))
-     (2, LB8Minus) total,
-   Prim (UN "prim__mulB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (*))
-     (2, LB8Times) total,
-   Prim (UN "prim__udivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin div)
-     (2, LB8UDiv) partial,
-   Prim (UN "prim__sdivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin s8div)
-     (2, LB8SDiv) partial,
-   Prim (UN "prim__uremB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin rem)
-     (2, LB8URem) partial,
-   Prim (UN "prim__sremB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin s8rem)
-     (2, LB8SRem) partial,
-   Prim (UN "prim__shlB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> shiftL x (fromIntegral y)))
-     (2, LB8Shl) total,
-   Prim (UN "prim__lshrB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> shiftR x (fromIntegral y)))
-     (2, LB8AShr) total,
-   Prim (UN "prim__ashrB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> fromIntegral $
-                                                                           shiftR (fromIntegral x :: Int8)
-                                                                                  (fromIntegral y)))
-     (2, LB8LShr) total,
-   Prim (UN "prim__andB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (.&.))
-     (2, LB8And) total,
-   Prim (UN "prim__orB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (.|.))
-     (2, LB8Or) total,
-   Prim (UN "prim__xorB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin xor)
-     (2, LB8Xor) total,
-   Prim (UN "prim__complB8") (ty [B8Type] B8Type) 1 (b8Un complement)
-     (1, LB8Compl) total,
-   Prim (UN "prim__zextB8_16") (ty [B8Type] B16Type) 1 zext8_16
-     (1, LB8Z16) total,
-   Prim (UN "prim__zextB8_32") (ty [B8Type] B32Type) 1 zext8_32
-     (1, LB8Z32) total,
-   Prim (UN "prim__zextB8_64") (ty [B8Type] B64Type) 1 zext8_64
-     (1, LB8Z64) total,
-   Prim (UN "prim__sextB8_16") (ty [B8Type] B16Type) 1 sext8_16
-     (1, LB8Z16) total,
-   Prim (UN "prim__sextB8_32") (ty [B8Type] B32Type) 1 sext8_32
-     (1, LB8Z32) total,
-   Prim (UN "prim__sextB8_64") (ty [B8Type] B64Type) 1 sext8_64
-     (1, LB8Z64) total,
-
-   Prim (UN "prim__ltB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (<))
-     (2, LB16Lt) total,
-   Prim (UN "prim__lteB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (<=))
-     (2, LB16Lte) total,
-   Prim (UN "prim__eqB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (==))
-     (2, LB16Eq) total,
-   Prim (UN "prim__gteB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (>))
-     (2, LB16Gte) total,
-   Prim (UN "prim__gtB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (>=))
-     (2, LB16Gt) total,
-   Prim (UN "prim__addB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (+))
-     (2, LB16Plus) total,
-   Prim (UN "prim__subB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (-))
-     (2, LB16Minus) total,
-   Prim (UN "prim__mulB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (*))
-     (2, LB16Times) total,
-   Prim (UN "prim__udivB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin div)
-     (2, LB16UDiv) partial,
-   Prim (UN "prim__sdivB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin s16div)
-     (2, LB16SDiv) partial,
-   Prim (UN "prim__uremB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin rem)
-     (2, LB16URem) partial,
-   Prim (UN "prim__sremB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin s16rem)
-     (2, LB16SRem) partial,
-   Prim (UN "prim__shlB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> shiftL x (fromIntegral y)))
-     (2, LB16Shl) total,
-   Prim (UN "prim__lshrB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> shiftR x (fromIntegral y)))
-     (2, LB16AShr) total,
-   Prim (UN "prim__ashrB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> fromIntegral $
-                                                                                shiftR (fromIntegral x :: Int16)
-                                                                                       (fromIntegral y)))
-     (2, LB16LShr) total,
-   Prim (UN "prim__andB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (.&.))
-     (2, LB16And) total,
-   Prim (UN "prim__orB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (.|.))
-     (2, LB16Or) total,
-   Prim (UN "prim__xorB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin xor)
-     (2, LB16Xor) total,
-   Prim (UN "prim__complB16") (ty [B16Type] B16Type) 1 (b16Un complement)
-     (1, LB16Compl) total,
-   Prim (UN "prim__zextB16_32") (ty [B16Type] B32Type) 1 zext16_32
-     (1, LB16Z32) total,
-   Prim (UN "prim__zextB16_64") (ty [B16Type] B64Type) 1 zext16_64
-     (1, LB16Z64) total,
-   Prim (UN "prim__sextB16_32") (ty [B16Type] B32Type) 1 sext16_32
-     (1, LB16Z32) total,
-   Prim (UN "prim__sextB16_64") (ty [B16Type] B64Type) 1 sext16_64
-     (1, LB16Z64) total,
-   Prim (UN "prim__truncB16_8") (ty [B16Type] B8Type) 1 trunc16_8
-     (1, LB16T8) total,
+     (2, LGe ITNative) total,
 
-   Prim (UN "prim__ltB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (<))
-     (2, LB32Lt) total,
-   Prim (UN "prim__lteB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (<=))
-     (2, LB32Lte) total,
-   Prim (UN "prim__eqB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (==))
-     (2, LB32Eq) total,
-   Prim (UN "prim__gteB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (>))
-     (2, LB32Gte) total,
-   Prim (UN "prim__gtB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (>=))
-     (2, LB32Gt) total,
-   Prim (UN "prim__addB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (+))
-     (2, LB32Plus) total,
-   Prim (UN "prim__subB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (-))
-     (2, LB32Minus) total,
-   Prim (UN "prim__mulB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (*))
-     (2, LB32Times) total,
-   Prim (UN "prim__udivB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin div)
-     (2, LB32UDiv) partial,
-   Prim (UN "prim__sdivB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin s32div)
-     (2, LB32SDiv) partial,
-   Prim (UN "prim__uremB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin rem)
-     (2, LB32URem) partial,
-   Prim (UN "prim__sremB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin s32rem)
-     (2, LB32SRem) partial,
-   Prim (UN "prim__shlB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> shiftL x (fromIntegral y)))
-     (2, LB32Shl) total,
-   Prim (UN "prim__lshrB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> shiftR x (fromIntegral y)))
-     (2, LB32AShr) total,
-   Prim (UN "prim__ashrB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> fromIntegral $
-                                                                                shiftR (fromIntegral x :: Int32)
-                                                                                       (fromIntegral y)))
-     (2, LB32LShr) total,
-   Prim (UN "prim__andB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (.&.))
-     (2, LB32And) total,
-   Prim (UN "prim__orB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (.|.))
-     (2, LB32Or) total,
-   Prim (UN "prim__xorB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin xor)
-     (2, LB32Xor) total,
-   Prim (UN "prim__complB32") (ty [B32Type] B32Type) 1 (b32Un complement)
-     (1, LB32Compl) total,
-   Prim (UN "prim__zextB32_64") (ty [B32Type] B64Type) 1 zext32_64
-     (1, LB32Z64) total,
-   Prim (UN "prim__sextB32_64") (ty [B32Type] B64Type) 1 sext32_64
-     (1, LB32Z64) total,
-   Prim (UN "prim__truncB32_8") (ty [B32Type] B8Type) 1 trunc32_8
-     (1, LB32T8) total,
-   Prim (UN "prim__truncB32_16") (ty [B32Type] B16Type) 1 trunc32_16
-     (1, LB32T16) total,
+   iCoerce IT8 IT16 "zext" zext LZExt,
+   iCoerce IT8 IT32 "zext" zext LZExt,
+   iCoerce IT8 IT64 "zext" zext LZExt,
+   iCoerce IT8 ITBig "zext" zext LZExt,
+   iCoerce IT8 ITNative "zext" zext LZExt,
+   iCoerce IT16 IT32 "zext" zext LZExt,
+   iCoerce IT16 IT64 "zext" zext LZExt,
+   iCoerce IT16 ITBig "zext" zext LZExt,
+   iCoerce IT16 ITNative "zext" zext LZExt,
+   iCoerce IT32 IT64 "zext" zext LZExt,
+   iCoerce IT32 ITBig "zext" zext LZExt,
+   iCoerce IT32 ITNative "zext" zext LZExt,
+   iCoerce IT64 ITBig "zext" zext LZExt,
+   iCoerce ITNative ITBig "zext" zext LZExt,
+   iCoerce ITNative IT64 "zext" zext LZExt,
+   iCoerce ITNative IT32 "zext" zext LZExt,
+   iCoerce ITNative IT16 "zext" zext LZExt,
 
-   Prim (UN "prim__ltB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (<))
-     (2, LB64Lt) total,
-   Prim (UN "prim__lteB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (<=))
-     (2, LB64Lte) total,
-   Prim (UN "prim__eqB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (==))
-     (2, LB64Eq) total,
-   Prim (UN "prim__gteB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (>))
-     (2, LB64Gte) total,
-   Prim (UN "prim__gtB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (>=))
-     (2, LB64Gt) total,
-   Prim (UN "prim__addB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (+))
-     (2, LB64Plus) total,
-   Prim (UN "prim__subB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (-))
-     (2, LB64Minus) total,
-   Prim (UN "prim__mulB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (*))
-     (2, LB64Times) total,
-   Prim (UN "prim__udivB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin div)
-     (2, LB64UDiv) partial,
-   Prim (UN "prim__sdivB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin s64div)
-     (2, LB64SDiv) partial,
-   Prim (UN "prim__uremB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin rem)
-     (2, LB64URem) partial,
-   Prim (UN "prim__sremB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin s64rem)
-     (2, LB64SRem) partial,
-   Prim (UN "prim__shlB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> shiftL x (fromIntegral y)))
-     (2, LB64Shl) total,
-   Prim (UN "prim__lshrB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> shiftR x (fromIntegral y)))
-     (2, LB64AShr) total,
-   Prim (UN "prim__ashrB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> fromIntegral $
-                                                                                shiftR (fromIntegral x :: Int64)
-                                                                                       (fromIntegral y)))
-     (2, LB64LShr) total,
-   Prim (UN "prim__andB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (.&.))
-     (2, LB64And) total,
-   Prim (UN "prim__orB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (.|.))
-     (2, LB64Or) total,
-   Prim (UN "prim__xorB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin xor)
-     (2, LB64Xor) total,
-   Prim (UN "prim__complB64") (ty [B64Type] B64Type) 1 (b64Un complement)
-     (1, LB64Compl) total,
-   Prim (UN "prim__truncB64_8") (ty [B64Type] B8Type) 1 trunc64_8
-     (1, LB64T8) total,
-   Prim (UN "prim__truncB64_16") (ty [B64Type] B16Type) 1 trunc64_16
-     (1, LB64T16) total,
-   Prim (UN "prim__truncB64_32") (ty [B64Type] B32Type) 1 trunc64_32
-     (1, LB64T32) total,
+   iCoerce IT8 IT16 "sext" sext LSExt,
+   iCoerce IT8 IT32 "sext" sext LSExt,
+   iCoerce IT8 IT64 "sext" sext LSExt,
+   iCoerce IT8 ITBig "sext" sext LSExt,
+   iCoerce IT8 ITNative "sext" sext LSExt,
+   iCoerce IT16 IT32 "sext" sext LSExt,
+   iCoerce IT16 IT64 "sext" sext LSExt,
+   iCoerce IT16 ITBig "sext" sext LSExt,
+   iCoerce IT16 ITNative "sext" sext LSExt,
+   iCoerce IT32 IT64 "sext" sext LSExt,
+   iCoerce IT32 ITBig "sext" sext LSExt,
+   iCoerce IT32 ITNative "sext" sext LSExt,
+   iCoerce IT64 ITBig "sext" sext LSExt,
+   iCoerce ITNative ITBig "sext" sext LSExt,
+   iCoerce ITNative ITBig "sext" sext LSExt,
+   iCoerce ITNative IT64 "sext" sext LSExt,
+   iCoerce ITNative IT32 "sext" sext LSExt,
+   iCoerce ITNative IT16 "sext" sext LSExt,
 
-   Prim (UN "prim__intToB8") (ty [IType] B8Type) 1 intToBits8
-    (1, LIntB8) total,
-   Prim (UN "prim__intToB16") (ty [IType] B16Type) 1 intToBits16
-    (1, LIntB16) total,
-   Prim (UN "prim__intToB32") (ty [IType] B32Type) 1 intToBits32
-    (1, LIntB32) total,
-   Prim (UN "prim__intToB64") (ty [IType] B64Type) 1 intToBits64
-    (1, LIntB64) total,
-   Prim (UN "prim__B32ToInt") (ty [B32Type] IType) 1 bits32ToInt
-    (1, LB32Int) total,
+   iCoerce IT16 IT8 "trunc" trunc LTrunc,
+   iCoerce IT32 IT8 "trunc" trunc LTrunc,
+   iCoerce IT64 IT8 "trunc" trunc LTrunc,
+   iCoerce ITBig IT8 "trunc" trunc LTrunc,
+   iCoerce ITNative IT8 "trunc" trunc LTrunc,
+   iCoerce IT32 IT16 "trunc" trunc LTrunc,
+   iCoerce IT64 IT16 "trunc" trunc LTrunc,
+   iCoerce ITBig IT16 "trunc" trunc LTrunc,
+   iCoerce ITNative IT16 "trunc" trunc LTrunc,
+   iCoerce IT64 IT32 "trunc" trunc LTrunc,
+   iCoerce ITBig IT32 "trunc" trunc LTrunc,
+   iCoerce ITNative IT32 "trunc" trunc LTrunc,
+   iCoerce ITBig IT64 "trunc" trunc LTrunc,
+   iCoerce IT16 ITNative "trunc" trunc LTrunc,
+   iCoerce IT32 ITNative "trunc" trunc LTrunc,
+   iCoerce IT64 ITNative "trunc" trunc LTrunc,
+   iCoerce ITBig ITNative "trunc" trunc LTrunc,
+   iCoerce ITNative IT64 "trunc" trunc LTrunc,
 
-   Prim (UN "prim__addBigInt") (ty [BIType, BIType] BIType) 2 (bBin (+))
-    (2, LBPlus) total,
-   Prim (UN "prim__subBigInt") (ty [BIType, BIType] BIType) 2 (bBin (-))
-     (2, LBMinus) total,
-   Prim (UN "prim__mulBigInt") (ty [BIType, BIType] BIType) 2 (bBin (*))
-     (2, LBTimes) total,
-   Prim (UN "prim__divBigInt") (ty [BIType, BIType] BIType) 2 (bBin div)
-     (2, LBDiv) partial,
-   Prim (UN "prim__modBigInt") (ty [BIType, BIType] BIType) 2 (bBin mod)
-     (2, LBMod) partial,
-   Prim (UN "prim__eqBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (==))
-     (2, LBEq) total,
-   Prim (UN "prim__ltBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (<))
-     (2, LBLt) total,
-   Prim (UN "prim__lteBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (<=))
-     (2, LBLe) total,
-   Prim (UN "prim__gtBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (>))
-     (2, LBGt) total,
-   Prim (UN "prim__gtBigInt")  (ty [BIType, BIType] IType) 2 (bbBin (>=))
-     (2, LBGe) total,
    Prim (UN "prim__addFloat") (ty [FlType, FlType] FlType) 2 (fBin (+))
      (2, LFPlus) total,
    Prim (UN "prim__subFloat") (ty [FlType, FlType] FlType) 2 (fBin (-))
@@ -332,31 +125,17 @@
     (2, LStrEq) total,
    Prim (UN "prim__ltString") (ty [StrType, StrType] IType) 2 (bsBin (<))
     (2, LStrLt) total,
+   Prim (UN "prim_lenString") (ty [StrType] IType) 1 (p_strLen)
+    (1, LStrLen) total,
     -- Conversions
-   Prim (UN "prim__strToInt") (ty [StrType] IType) 1 (c_strToInt)
-     (1, LStrInt) total,
-   Prim (UN "prim__intToStr") (ty [IType] StrType) 1 (c_intToStr)
-     (1, LIntStr) total,
    Prim (UN "prim__charToInt") (ty [ChType] IType) 1 (c_charToInt)
-     (1, LChInt) total,
+     (1, LChInt ITNative) total,
    Prim (UN "prim__intToChar") (ty [IType] ChType) 1 (c_intToChar)
-     (1, LIntCh) total,
-   Prim (UN "prim__intToBigInt") (ty [IType] BIType) 1 (c_intToBigInt)
-     (1, LIntBig) total,
-   Prim (UN "prim__bigIntToInt") (ty [BIType] IType) 1 (c_bigIntToInt)
-     (1, LBigInt) total,
-   Prim (UN "prim__strToBigInt") (ty [StrType] BIType) 1 (c_strToBigInt)
-     (1, LStrBig) total,
-   Prim (UN "prim__bigIntToStr") (ty [BIType] StrType) 1 (c_bigIntToStr)
-     (1, LBigStr) total,
+     (1, LIntCh ITNative) total,
    Prim (UN "prim__strToFloat") (ty [StrType] FlType) 1 (c_strToFloat)
      (1, LStrFloat) total,
    Prim (UN "prim__floatToStr") (ty [FlType] StrType) 1 (c_floatToStr)
      (1, LFloatStr) total,
-   Prim (UN "prim__intToFloat") (ty [IType] FlType) 1 (c_intToFloat)
-     (1, LIntFloat) total,
-   Prim (UN "prim__floatToInt") (ty [FlType] IType) 1 (c_floatToInt)
-     (1, LFloatInt) total,
 
    Prim (UN "prim__floatExp") (ty [FlType] FlType) 1 (p_floatExp)
      (1, LFExp) total, 
@@ -400,8 +179,50 @@
     (0, LStdIn) partial,
    Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)
     (3, LNoOp) partial -- ahem
-  ]
+  ] ++ concatMap intOps [IT8, IT16, IT32, IT64, ITBig, ITNative]
 
+intOps ity =
+    [ iCmp ity "lt" (bCmp ity (<)) LLt total
+    , iCmp ity "lte" (bCmp ity (<=)) LLe total
+    , iCmp ity "eq" (bCmp ity (==)) LEq total
+    , iCmp ity "gte" (bCmp ity (>=)) LGe total
+    , iCmp ity "gt" (bCmp ity (>)) LGt total
+    , iBinOp ity "add" (bitBin ity (+)) LPlus total
+    , iBinOp ity "sub" (bitBin ity (-)) LMinus total
+    , iBinOp ity "mul" (bitBin ity (*)) LTimes total
+    , iBinOp ity "udiv" (bitBin ity div) LUDiv partial
+    , iBinOp ity "sdiv" (bsdiv ity) LSDiv partial
+    , iBinOp ity "urem" (bitBin ity rem) LURem partial
+    , iBinOp ity "srem" (bsrem ity) LSRem partial
+    , iBinOp ity "shl" (bitBin ity (\x y -> shiftL x (fromIntegral y))) LSHL total
+    , iBinOp ity "lshr" (bitBin ity (\x y -> shiftR x (fromIntegral y))) LLSHR total
+    , iBinOp ity "ashr" (bashr ity) LASHR total
+    , iBinOp ity "and" (bitBin ity (.&.)) LAnd total
+    , iBinOp ity "or" (bitBin ity (.|.)) LOr total
+    , iBinOp ity "xor" (bitBin ity (xor)) LXOr total
+    , iUnOp ity "compl" (bUn ity complement) LCompl total
+    , Prim (UN $ "prim__toStr" ++ intTyName ity) (ty [intTyToConst ity] StrType) 1 intToStr
+               (1, LIntStr ity) total
+    , Prim (UN $ "prim__fromStr" ++ intTyName ity) (ty [StrType] (intTyToConst ity)) 1 (strToInt ity)
+               (1, LStrInt ity) total
+    , Prim (UN $ "prim__toFloat" ++ intTyName ity) (ty [intTyToConst ity] FlType) 1 intToFloat
+               (1, LIntFloat ity) total
+    , Prim (UN $ "prim__fromFloat" ++ intTyName ity) (ty [FlType] (intTyToConst ity)) 1 (floatToInt ity)
+               (1, LFloatInt ity) total
+    ]
+
+intTyName :: IntTy -> String
+intTyName ITNative = "Int"
+intTyName ITBig = "BigInt"
+intTyName sized = "B" ++ show (intTyWidth sized)
+
+iCmp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty (replicate 2 $ intTyToConst ity) IType) 2 impl (2, irop ity) totality
+iBinOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty (replicate 2 $ intTyToConst ity) (intTyToConst ity)) 2 impl (2, irop ity) totality
+iUnOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty [intTyToConst ity] (intTyToConst ity)) 1 impl (1, irop ity) totality
+iCoerce from to op impl irop =
+    Prim (UN $ "prim__" ++ op ++ intTyName from ++ "_" ++ intTyName to)
+             (ty [intTyToConst from] (intTyToConst to)) 1 (impl from to) (1, irop from to) total
+
 p_believeMe [_,_,x] = Just x
 p_believeMe _ = Nothing
 
@@ -439,161 +260,127 @@
 sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))
 sBin _ _ = Nothing
 
-s8div :: Word8 -> Word8 -> Word8
-s8div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)
-
-s16div :: Word16 -> Word16 -> Word16
-s16div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)
-
-s32div :: Word32 -> Word32 -> Word32
-s32div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)
-
-s64div :: Word64 -> Word64 -> Word64
-s64div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)
-
-s8rem :: Word8 -> Word8 -> Word8
-s8rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)
-
-s16rem :: Word16 -> Word16 -> Word16
-s16rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)
-
-s32rem :: Word32 -> Word32 -> Word32
-s32rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)
-
-s64rem :: Word64 -> Word64 -> Word64
-s64rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)
-
-b8Bin op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))
-b8Bin _ _ = Nothing
-
-b8Un op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))
-b8Un _ _ = Nothing
-
-b16Bin op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))
-b16Bin _ _ = Nothing
-
-b16Un op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))
-b16Un _ _ = Nothing
-
-b32Bin op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))
-b32Bin _ _ = Nothing
-
-b32Un op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))
-b32Un _ _ = Nothing
-
-b64Bin op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))
-b64Bin _ _ = Nothing
-
-b64Un op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))
-b64Un _ _ = Nothing
-
-b8Cmp op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
-b8Cmp _ _ = Nothing
-
-b16Cmp op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
-b16Cmp _ _ = Nothing
-
-b32Cmp op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
-b32Cmp _ _ = Nothing
-
-b64Cmp op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
-b64Cmp _ _ = Nothing
-
-toB8 x = VConstant (B8 (fromIntegral x))
-toB16 x = VConstant (B16 (fromIntegral x))
-toB32 x = VConstant (B32 (fromIntegral x))
-toB64 x = VConstant (B64 (fromIntegral x))
-
-zext8_16 [VConstant (B8 x)] = Just $ toB16 x
-zext8_16 _ = Nothing
-
-zext8_32 [VConstant (B8 x)] = Just $ toB32 x
-zext8_32 _ = Nothing
-
-zext8_64 [VConstant (B8 x)] = Just $ toB64 x
-zext8_64 _ = Nothing
-
-sext8_16 [VConstant (B8 x)] = Just $ toB16 (fromIntegral x :: Int8)
-sext8_16 _ = Nothing
-
-sext8_32 [VConstant (B8 x)] = Just $ toB32 (fromIntegral x :: Int8)
-sext8_32 _ = Nothing
-
-sext8_64 [VConstant (B8 x)] = Just $ toB64 (fromIntegral x :: Int8)
-sext8_64 _ = Nothing
+bsrem IT8 [VConstant (B8 x), VConstant (B8 y)]
+    = Just $ VConstant (B8 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)))
+bsrem IT16 [VConstant (B16 x), VConstant (B16 y)]
+    = Just $ VConstant (B16 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)))
+bsrem IT32 [VConstant (B32 x), VConstant (B32 y)]
+    = Just $ VConstant (B32 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)))
+bsrem IT64 [VConstant (B64 x), VConstant (B64 y)]
+    = Just $ VConstant (B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)))
+bsrem ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `rem` y))
+bsrem _ _ = Nothing
 
-zext16_32 [VConstant (B16 x)] = Just $ toB32 x
-zext16_32 _ = Nothing
+bsdiv IT8 [VConstant (B8 x), VConstant (B8 y)]
+    = Just $ VConstant (B8 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)))
+bsdiv IT16 [VConstant (B16 x), VConstant (B16 y)]
+    = Just $ VConstant (B16 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)))
+bsdiv IT32 [VConstant (B32 x), VConstant (B32 y)]
+    = Just $ VConstant (B32 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)))
+bsdiv IT64 [VConstant (B64 x), VConstant (B64 y)]
+    = Just $ VConstant (B64 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)))
+bsdiv ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `div` y))
+bsdiv _ _ = Nothing
 
-zext16_64 [VConstant (B16 x)] = Just $ toB64 x
-zext16_64 _ = Nothing
+bashr IT8 [VConstant (B8 x), VConstant (B8 y)]
+    = Just $ VConstant (B8 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int8)))
+bashr IT16 [VConstant (B16 x), VConstant (B16 y)]
+    = Just $ VConstant (B16 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int16)))
+bashr IT32 [VConstant (B32 x), VConstant (B32 y)]
+    = Just $ VConstant (B32 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int32)))
+bashr IT64 [VConstant (B64 x), VConstant (B64 y)]
+    = Just $ VConstant (B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64)))
+bashr ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `shiftR` y))
+bashr _ _ = Nothing
 
-sext16_32 [VConstant (B16 x)] = Just $ toB32 (fromIntegral x :: Int16)
-sext16_32 _ = Nothing
+bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Value] -> Maybe Value
+bUn IT8  op [VConstant (B8  x)] = Just $ VConstant (B8  (op x))
+bUn IT16 op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))
+bUn IT32 op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))
+bUn IT64 op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))
+bUn ITBig op [VConstant (BI x)] = Just $ VConstant (BI (op x))
+bUn ITNative op [VConstant (I x)] = Just $ VConstant (I (op x))
+bUn _ _ _ = Nothing
 
-sext16_64 [VConstant (B16 x)] = Just $ toB64 (fromIntegral x :: Int16)
-sext16_64 _ = Nothing
+bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Value] -> Maybe Value
+bitBin IT8  op [VConstant (B8  x), VConstant (B8  y)] = Just $ VConstant (B8  (op x y))
+bitBin IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))
+bitBin IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))
+bitBin IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))
+bitBin ITBig op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (BI (op x y))
+bitBin ITNative op [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (op x y))
+bitBin _ _ _ = Nothing
 
-trunc16_8 [VConstant (B16 x)] = Just $ toB8 x
-trunc16_8 _ = Nothing
+bCmp :: IntTy -> (forall a. Ord a => a -> a -> Bool) -> [Value] -> Maybe Value
+bCmp IT8  op [VConstant (B8  x), VConstant (B8  y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp ITBig op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp ITNative op [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
+bCmp _ _ _ = Nothing
 
-zext32_64 [VConstant (B32 x)] = Just $ toB64 x
-zext32_64 _ = Nothing
+toInt IT8  x = VConstant (B8 (fromIntegral x))
+toInt IT16 x = VConstant (B16 (fromIntegral x))
+toInt IT32 x = VConstant (B32 (fromIntegral x))
+toInt IT64 x = VConstant (B64 (fromIntegral x))
+toInt ITBig x = VConstant (BI (fromIntegral x))
+toInt ITNative x = VConstant (I (fromIntegral x))
 
-sext32_64 [VConstant (B32 x)] = Just $ toB64 (fromIntegral x :: Int32)
-sext32_64 _ = Nothing
+intToInt IT8 out [VConstant (B8 x)] = Just $ toInt out x
+intToInt IT16 out [VConstant (B16 x)] = Just $ toInt out x
+intToInt IT32 out [VConstant (B32 x)] = Just $ toInt out x
+intToInt IT64 out [VConstant (B64 x)] = Just $ toInt out x
+intToInt ITBig out [VConstant (BI x)] = Just $ toInt out x
+intToInt ITNative out [VConstant (I x)] = Just $ toInt out x
+intToInt _ _ _ = Nothing
 
-trunc32_8 [VConstant (B32 x)] = Just $ toB8 x
-trunc32_8 _ = Nothing
+zext from ITBig val = intToInt from ITBig val
+zext ITBig _ _ = Nothing
+zext from to val
+    | intTyWidth from < intTyWidth to = intToInt from to val
+zext _ _ _ = Nothing
 
-trunc32_16 [VConstant (B32 x)] = Just $ toB16 x
-trunc32_16 _ = Nothing
+sext IT8  out [VConstant (B8  x)] = Just $ toInt out (fromIntegral x :: Int8)
+sext IT16 out [VConstant (B16 x)] = Just $ toInt out (fromIntegral x :: Int16)
+sext IT32 out [VConstant (B32 x)] = Just $ toInt out (fromIntegral x :: Int32)
+sext IT64 out [VConstant (B64 x)] = Just $ toInt out (fromIntegral x :: Int64)
+sext ITBig _ _ = Nothing
+sext from to val = intToInt from to val
 
-trunc64_8 [VConstant (B64 x)] = Just $ toB8 x
-trunc64_8 _ = Nothing
+trunc ITBig to val = intToInt ITBig to val
+trunc _ ITBig _ = Nothing
+trunc from to val | intTyWidth from > intTyWidth to = intToInt from to val
+trunc _ _ _ = Nothing
 
-trunc64_16 [VConstant (B64 x)] = Just $ toB16 x
-trunc64_16 _ = Nothing
+getInt :: [Value] -> Maybe Integer
+getInt [VConstant (B8 x)] = Just . toInteger $ x
+getInt [VConstant (B16 x)] = Just . toInteger $ x
+getInt [VConstant (B32 x)] = Just . toInteger $ x
+getInt [VConstant (B64 x)] = Just . toInteger $ x
+getInt [VConstant (I x)] = Just . toInteger $ x
+getInt [VConstant (BI x)] = Just x
+getInt _ = Nothing
 
-trunc64_32 [VConstant (B64 x)] = Just $ toB32 x
-trunc64_32 _ = Nothing
+intToStr val | Just i <- getInt val = Just $ VConstant (Str (show i))
+intToStr _ = Nothing
 
-intToBits8  [VConstant (I x)] = Just $ toB8 x
-intToBits8 _ = Nothing
-intToBits16 [VConstant (I x)] = Just $ toB16 x
-intToBits16 _ = Nothing
-intToBits32  [VConstant (I x)] = Just $ toB32 x
-intToBits32 _ = Nothing
-intToBits64 [VConstant (I x)] = Just $ toB64 x
-intToBits64 _ = Nothing
+strToInt ity [VConstant (Str x)] = case reads x of
+                                     [(n,"")] -> Just $ toInt ity (n :: Integer)
+                                     _ -> Just $ VConstant (I 0)
+strToInt _ _ = Nothing
 
-bits32ToInt [VConstant (B32 x)] = Just $ VConstant (I (fromIntegral x))
-bits32ToInt _ = Nothing
+intToFloat val | Just i <- getInt val = Just $ VConstant (Fl (fromIntegral i))
+intToFloat _ = Nothing
 
-c_intToStr [VConstant (I x)] = Just $ VConstant (Str (show x))
-c_intToStr _ = Nothing
-c_strToInt [VConstant (Str x)] = case reads x of
-                                    [(n,"")] -> Just $ VConstant (I n)
-                                    _ -> Just $ VConstant (I 0)
-c_strToInt _ = Nothing
+floatToInt ity [VConstant (Fl x)] = Just $ toInt ity (truncate x :: Integer)
+floatToInt _ _ = Nothing
 
 c_intToChar [VConstant (I x)] = Just $ VConstant (Ch (toEnum x))
 c_intToChar _ = Nothing
 c_charToInt [VConstant (Ch x)] = Just $ VConstant (I (fromEnum x))
 c_charToInt _ = Nothing
 
-c_intToBigInt [VConstant (I x)] = Just $ VConstant (BI (fromIntegral x))
-c_intToBigInt _ = Nothing
-c_bigIntToInt [VConstant (BI x)] = Just $ VConstant (I (fromInteger x))
-c_bigIntToInt _ = Nothing
-
-c_bigIntToStr [VConstant (BI x)] = Just $ VConstant (Str (show x))
-c_bigIntToStr _ = Nothing
-c_strToBigInt [VConstant (Str x)] = case reads x of
-                                        [(n,"")] -> Just $ VConstant (BI n)
-                                        _ -> Just $ VConstant (BI 0)
-c_strToBigInt _ = Nothing
-
 c_floatToStr [VConstant (Fl x)] = Just $ VConstant (Str (show x))
 c_floatToStr _ = Nothing
 c_strToFloat [VConstant (Str x)] = case reads x of
@@ -601,12 +388,6 @@
                                         _ -> Just $ VConstant (Fl 0)
 c_strToFloat _ = Nothing
 
-c_floatToInt [VConstant (Fl x)] = Just $ VConstant (I (truncate x))
-c_floatToInt _ = Nothing
-
-c_intToFloat [VConstant (I x)] = Just $ VConstant (Fl (fromIntegral x))
-c_intToFloat _ = Nothing
-
 p_fPrim f [VConstant (Fl x)] = Just $ VConstant (Fl (f x))
 p_fPrim f _ = Nothing
 
@@ -622,6 +403,8 @@
 p_floatFloor = p_fPrim (fromInteger . floor)
 p_floatCeil = p_fPrim (fromInteger . ceiling)
 
+p_strLen [VConstant (Str xs)] = Just $ VConstant (I (length xs))
+p_strLen _ = Nothing
 p_strHead [VConstant (Str (x:xs))] = Just $ VConstant (Ch x)
 p_strHead _ = Nothing
 p_strTail [VConstant (Str (x:xs))] = Just $ VConstant (Str xs)
diff --git a/src/Idris/Prover.hs b/src/Idris/Prover.hs
--- a/src/Idris/Prover.hs
+++ b/src/Idris/Prover.hs
@@ -20,12 +20,13 @@
 import Control.Monad.State
 
 import Util.Pretty
+import Debug.Trace
 
 prover :: Bool -> Name -> Idris ()
 prover lit x =
            do ctxt <- getContext
               i <- getIState
-              case lookupTy Nothing x ctxt of
+              case lookupTy x ctxt of
                   [t] -> if elem x (idris_metavars i)
                                then prove ctxt lit x t
                                else fail $ show x ++ " is not a metavariable"
@@ -59,6 +60,11 @@
          let tree = simpleCase False True CompileTime (FC "proof" 0) [([], P Ref n ty, tm)]
          logLvl 3 (show tree)
          (ptm, pty) <- recheckC (FC "proof" 0) [] tm
+         logLvl 5 ("Proof type: " ++ show pty ++ "\n" ++ 
+                   "Expected type:" ++ show ty)
+         case converts ctxt [] ty pty of
+              OK _ -> return ()
+              Error e -> ierror (CantUnify False ty pty e [] 0)
          ptm' <- applyOpts ptm
          updateContext (addCasedef n True False True False
                                  [Right (P Ref n ty, ptm)]
@@ -72,9 +78,9 @@
                                    fail (pshow i a)
 
 dumpState :: IState -> ProofState -> IO ()
-dumpState ist (PS nm [] _ _ tm _ _ _ _ _ _ _ _ _ _ _ _) =
+dumpState ist (PS nm [] _ _ tm _ _ _ _ _ _ _ _ _ _ _ _ _) =
   putStrLn . render $ pretty nm <> colon <+> text "No more goals."
-dumpState ist ps@(PS nm (h:hs) _ _ tm _ _ _ _ _ problems i _ _ ctxy _ _) = do
+dumpState ist ps@(PS nm (h:hs) _ _ tm _ _ _ _ _ _ problems i _ _ ctxy _ _) = do
   let OK ty  = goalAtFocus ps
   let OK env = envAtFocus ps
   putStrLn . render $
@@ -154,6 +160,7 @@
                               return (False, e, True, prf)
               Right tac -> do (_, e) <- elabStep e saveState
                               (_, st) <- elabStep e (runTac True i tac)
+--                               trace (show (problems (proof st))) $ 
                               return (True, st, False, prf ++ [step]))
            (\err -> do iputStrLn (show err)
                        return (False, e, False, prf))
diff --git a/src/Idris/Providers.hs b/src/Idris/Providers.hs
new file mode 100644
--- /dev/null
+++ b/src/Idris/Providers.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE PatternGuards #-}
+module Idris.Providers (providerTy, getProvided) where
+
+import Core.TT
+import Core.Evaluate
+import Core.Execute
+import Idris.AbsSyntax
+import Idris.AbsSyntaxTree
+import Idris.Error
+
+import Debug.Trace
+
+-- | Wrap a type provider in the type of type providers
+providerTy :: FC -> PTerm -> PTerm
+providerTy fc tm = PApp fc (PRef fc $ UN "Provider") [PExp 0 False tm ""]
+
+-- | Handle an error, if the type provider returned an error. Otherwise return the provided term.
+getProvided :: TT Name -> Idris (TT Name)
+getProvided tm | (P _ (UN "io_return") _, [tp, result]) <- unApply tm
+               , (P _ (NS (UN "Error") ["Providers"]) _, [_, err]) <- unApply result =
+                     case err of
+                       Constant (Str msg) -> ierror . ProviderError $ msg
+                       _ -> fail "Internal error in type provider, non-normalised error"
+               | (P _ (UN "io_return") _, [tp, result]) <- unApply tm
+               , (P _ (NS (UN "Provide") ["Providers"]) _, [_, res]) <- unApply result =
+                     return res
+               | otherwise = fail $ "Internal type provider error: result was not " ++
+                                    "IO (Provider a), or perhaps missing normalisation."
diff --git a/src/Idris/REPL.hs b/src/Idris/REPL.hs
--- a/src/Idris/REPL.hs
+++ b/src/Idris/REPL.hs
@@ -16,12 +16,16 @@
 import Idris.Coverage
 import Idris.UnusedArgs
 import Idris.Docs
+import Idris.Help
 import Idris.Completion
+import Idris.IdeSlave
 
 import Paths_idris
 import Util.System
+import Util.DynamicLinker
 
 import Core.Evaluate
+import Core.Execute (execute)
 import Core.ProofShell
 import Core.TT
 import Core.Constraints
@@ -50,16 +54,21 @@
 import Data.Char
 import Data.Version
 
+import Debug.Trace
+
 -- | Run the REPL
 repl :: IState -- ^ The initial state
      -> [FilePath] -- ^ The loaded modules
      -> InputT Idris ()
 repl orig mods
    = H.catch
-      (do let prompt = mkPrompt mods
-          x <- getInputLine (prompt ++ "> ")
+      (do let quiet = opt_quiet (idris_options orig)
+          let prompt = if quiet
+                          then ""
+                          else mkPrompt mods ++ "> "
+          x <- getInputLine prompt
           case x of
-              Nothing -> do lift $ iputStrLn "Bye bye"
+              Nothing -> do lift $ when (not quiet) (iputStrLn "Bye bye")
                             return ()
               Just input -> H.catch 
                               (do ms <- lift $ processInput input orig mods
@@ -72,6 +81,104 @@
          ctrlC e = do lift $ iputStrLn (show e)
                       repl orig mods
 
+-- | Run the IdeSlave
+ideslaveStart :: IState -> [FilePath] -> Idris ()
+ideslaveStart orig mods
+  = do i <- getIState
+       case idris_outputmode i of
+         IdeSlave n ->
+           when (mods /= []) (do liftIO $ putStrLn $ convSExp "set-prompt" (mkPrompt mods) n)
+       ideslave orig mods
+
+
+ideslave :: IState -> [FilePath] -> Idris ()
+ideslave orig mods
+  = do idrisCatch
+         (do l <- liftIO $ getLine
+             let (sexp, id) = parseMessage l
+             i <- getIState
+             putIState $ i { idris_outputmode = (IdeSlave id) }
+             case sexpToCommand sexp of
+               Just (Interpret cmd) ->
+                 do let fn = case mods of
+                                 (f:_) -> f
+                                 _ -> ""
+                    case parseCmd i cmd of
+                         Left err -> iFail $ show err
+                         Right cmd -> idrisCatch
+                                        (do ideslaveProcess fn cmd)
+                                        (\e -> do iFail $ show e)
+               Just (REPLCompletions str) ->
+                 do (unused, compls) <- replCompletion (reverse str, "")
+                    let good = SexpList [SymbolAtom "ok", toSExp (map replacement compls, reverse unused)]
+                    liftIO $ putStrLn $ convSExp "return" good id
+               Just (LoadFile filename) ->
+                 do clearErr
+                    putIState (orig { idris_options = idris_options i,
+                                      idris_outputmode = (IdeSlave id) })
+                    loadModule filename
+                    iucheck
+                    liftIO $ putStrLn $ convSExp "set-prompt" (mkPrompt [filename]) id
+                    -- report success! or failure!
+                    ideslave orig [filename]
+               Nothing -> do iFail "did not understand")
+         (\e -> do iFail $ show e)
+       ideslave orig mods
+
+ideslaveProcess :: FilePath -> Command -> Idris ()
+ideslaveProcess fn Help = process fn Help
+ideslaveProcess fn (ChangeDirectory f) = do process fn (ChangeDirectory f)
+                                            iResult "changed directory to"
+ideslaveProcess fn (Eval t) = process fn (Eval t)
+ideslaveProcess fn (ExecVal t) = process fn (ExecVal t)
+ideslaveProcess fn (Check (PRef x n)) = process fn (Check (PRef x n))
+ideslaveProcess fn (Check t) = process fn (Check t)
+ideslaveProcess fn (DocStr n) = process fn (DocStr n)
+ideslaveProcess fn Universes = process fn Universes
+ideslaveProcess fn (Defn n) = do process fn (Defn n)
+                                 iResult ""
+ideslaveProcess fn (TotCheck n) = process fn (TotCheck n)
+ideslaveProcess fn (DebugInfo n) = do process fn (DebugInfo n)
+                                      iResult ""
+ideslaveProcess fn (Info n) = process fn (Info n)
+ideslaveProcess fn (Search t) = process fn (Search t)
+ideslaveProcess fn (Spec t) = process fn (Spec t)
+-- RmProof and AddProof not supported!
+ideslaveProcess fn (ShowProof n') = process fn (ShowProof n')
+ideslaveProcess fn (Prove n') = process fn (Prove n')
+ideslaveProcess fn (HNF t) = process fn (HNF t)
+--ideslaveProcess fn TTShell = process fn TTShell -- need some prove mode!
+
+--that most likely does not work, since we need to wrap
+--input/output of the executed binary...
+ideslaveProcess fn Execute = do process fn Execute
+                                iResult ""
+ideslaveProcess fn (NewCompile f) = do process fn (NewCompile f)
+                                       iResult ""
+ideslaveProcess fn (Compile target f) = do process fn (Compile target f)
+                                           iResult ""
+ideslaveProcess fn (LogLvl i) = do process fn (LogLvl i)
+                                   iResult ""
+ideslaveProcess fn (Pattelab t) = process fn (Pattelab t)
+ideslaveProcess fn (Missing n) = process fn (Missing n)
+ideslaveProcess fn (DynamicLink l) = do process fn (DynamicLink l)
+                                        iResult ""
+ideslaveProcess fn ListDynamic = do process fn ListDynamic
+                                    iResult ""
+ideslaveProcess fn Metavars = process fn Metavars
+ideslaveProcess fn (SetOpt ErrContext) = do process fn (SetOpt ErrContext)
+                                            iResult ""
+ideslaveProcess fn (UnsetOpt ErrContext) = do process fn (UnsetOpt ErrContext)
+                                              iResult ""
+ideslaveProcess fn (SetOpt ShowImpl) = do process fn (SetOpt ShowImpl)
+                                          iResult ""
+ideslaveProcess fn (UnsetOpt ShowImpl) = do process fn (UnsetOpt ShowImpl)
+                                            iResult ""
+ideslaveProcess fn (SetOpt x) = process fn (SetOpt x)
+ideslaveProcess fn (UnsetOpt x) = process fn (UnsetOpt x)
+ideslaveProcess fn _ = iFail "command not recognized or not supported"
+
+
 -- | The prompt consists of the currently loaded modules, or "Idris" if there are none
 mkPrompt [] = "Idris"
 mkPrompt [x] = "*" ++ dropExtension x
@@ -85,6 +192,8 @@
 processInput :: String -> IState -> [FilePath] -> Idris (Maybe [FilePath])
 processInput cmd orig inputs
     = do i <- getIState
+         let opts = idris_options i
+         let quiet = opt_quiet opts
          let fn = case inputs of
                         (f:_) -> f
                         _ -> ""
@@ -109,7 +218,7 @@
                              return (Just inputs)
             Right Proofs -> do proofs orig
                                return (Just inputs)
-            Right Quit -> do iputStrLn "Bye bye"
+            Right Quit -> do when (not quiet) (iputStrLn "Bye bye")
                              return Nothing
             Right cmd  -> do idrisCatch (process fn cmd)
                                         (\e -> iputStrLn (show e))
@@ -119,7 +228,7 @@
 resolveProof n'
   = do i <- getIState
        ctxt <- getContext
-       n <- case lookupNames Nothing n' ctxt of
+       n <- case lookupNames n' ctxt of
                  [x] -> return x
                  [] -> return n'
                  ns -> fail $ pshow i (CantResolveAlts (map show ns))
@@ -163,112 +272,115 @@
 
 insertScript :: String -> [String] -> [String]
 insertScript prf [] = "\n---------- Proofs ----------" : "" : [prf]
-insertScript prf (p@"---------- Proofs ----------" : "" : xs) 
+insertScript prf (p@"---------- Proofs ----------" : "" : xs)
     = p : "" : prf : xs
 insertScript prf (x : xs) = x : insertScript prf xs
 
 process :: FilePath -> Command -> Idris ()
-process fn Help = iputStrLn displayHelp
-process fn (Eval t) 
+process fn Help = iResult displayHelp
+process fn (ChangeDirectory f)
+                 = do liftIO $ setCurrentDirectory f
+                      return ()
+process fn (Eval t)
                  = do (tm, ty) <- elabVal toplevel False t
                       ctxt <- getContext
-                      ist <- getIState 
+                      ist <- getIState
                       let tm' = normaliseAll ctxt [] tm
                       let ty' = normaliseAll ctxt [] ty
                       logLvl 3 $ "Raw: " ++ show (tm', ty')
                       imp <- impShow
-                      iputStrLn (showImp imp (delab ist tm') ++ " : " ++ 
-                                 showImp imp (delab ist ty'))
-process fn (ExecVal t) 
-                    = do (tm, ty) <- elabVal toplevel False t 
---                                         (PApp fc (PRef fc (NS (UN "print") ["Prelude"]))
---                                                           [pexp t])
-                         (tmpn, tmph) <- liftIO tempfile
-                         liftIO $ hClose tmph
-                         t <- target
-                         compile t tmpn tm
-                         liftIO $ system tmpn
-                         return ()
-    where fc = FC "(input)" 0 
-process fn (Check (PRef _ n))
+                      iResult (showImp imp (delab ist tm') ++ " : " ++
+                               showImp imp (delab ist ty'))
+process fn (ExecVal t)
                   = do ctxt <- getContext
                        ist <- getIState
+                       (tm, ty) <- elabVal toplevel False t
+--                       let tm' = normaliseAll ctxt [] tm
+                       let ty' = normaliseAll ctxt [] ty
+                       res <- execute tm
                        imp <- impShow
-                       case lookupTy Nothing n ctxt of
-                        ts@(_:_) -> mapM_ (\t -> iputStrLn $ show n ++ " : " ++
-                                                       showImp imp (delab ist t)) ts
-                        [] -> iputStrLn $ "No such variable " ++ show n
+                       iResult (showImp imp (delab ist res) ++ " : " ++
+                                showImp imp (delab ist ty'))
+process fn (Check (PRef _ n))
+   = do ctxt <- getContext
+        ist <- getIState
+        imp <- impShow
+        case lookupNames n ctxt of
+             ts@(_:_) -> do mapM_ (\n -> iputStrLn $ show n ++ " : " ++
+                                         showImp imp (delabTy ist n)) ts
+                            iResult ""
+             [] -> iFail $ "No such variable " ++ show n
 process fn (Check t) = do (tm, ty) <- elabVal toplevel False t
                           ctxt <- getContext
-                          ist <- getIState 
+                          ist <- getIState
                           imp <- impShow
                           let ty' = normaliseC ctxt [] ty
-                          iputStrLn (showImp imp (delab ist tm) ++ " : " ++ 
-                                    showImp imp (delab ist ty))
+                          iResult (showImp imp (delab ist tm) ++ " : " ++
+                                   showImp imp (delab ist ty))
 
 process fn (DocStr n) = do i <- getIState
-                           case lookupCtxtName Nothing n (idris_docstrings i) of
-                                [] -> iputStrLn $ "No documentation for " ++ show n
-                                ns -> mapM_ showDoc ns 
-    where showDoc (n, d) 
+                           case lookupCtxtName n (idris_docstrings i) of
+                                [] -> iFail $ "No documentation for " ++ show n
+                                ns -> do mapM_ showDoc ns
+                                         iResult ""
+    where showDoc (n, d)
              = do doc <- getDocs n
                   iputStrLn $ show doc
 process fn Universes = do i <- getIState
                           let cs = idris_constraints i
 --                        iputStrLn $ showSep "\n" (map show cs)
-                          liftIO $ print (map fst cs)
+                          iputStrLn $ show (map fst cs)
                           let n = length cs
                           iputStrLn $ "(" ++ show n ++ " constraints)"
                           case ucheck cs of
-                            Error e -> iputStrLn $ pshow i e
-                            OK _ -> iputStrLn "Universes OK"
+                            Error e -> iFail $ pshow i e
+                            OK _ -> iResult "Universes OK"
 process fn (Defn n) = do i <- getIState
                          iputStrLn "Compiled patterns:\n"
-                         liftIO $ print (lookupDef Nothing n (tt_ctxt i))
-                         case lookupCtxt Nothing n (idris_patdefs i) of
+                         iputStrLn $ show (lookupDef n (tt_ctxt i))
+                         case lookupCtxt n (idris_patdefs i) of
                             [] -> return ()
-                            [d] -> do iputStrLn "Original definiton:\n"
-                                      mapM_ (printCase i) d
+                            [(d, _)] -> do iputStrLn "Original definiton:\n"
+                                           mapM_ (printCase i) d
                          case lookupTotal n (tt_ctxt i) of
                             [t] -> iputStrLn (showTotal t i)
                             _ -> return ()
-    where printCase i (_, lhs, rhs) 
-             = do liftIO $ putStr $ showImp True (delab i lhs)
-                  liftIO $ putStr " = "
-                  liftIO $ putStrLn $ showImp True (delab i rhs)
+    where printCase i (_, lhs, rhs)
+             = do iputStrLn (showImp True (delab i lhs) ++ " = " ++
+                             showImp True (delab i rhs))
 process fn (TotCheck n) = do i <- getIState
                              case lookupTotal n (tt_ctxt i) of
-                                [t] -> iputStrLn (showTotal t i)
-                                _ -> return ()
-process fn (DebugInfo n) 
+                                [t] -> iResult (showTotal t i)
+                                _ -> do iFail ""
+                                        return ()
+process fn (DebugInfo n)
    = do i <- getIState
-        let oi = lookupCtxtName Nothing n (idris_optimisation i)
+        let oi = lookupCtxtName n (idris_optimisation i)
         when (not (null oi)) $ iputStrLn (show oi)
-        let si = lookupCtxt Nothing n (idris_statics i)
+        let si = lookupCtxt n (idris_statics i)
         when (not (null si)) $ iputStrLn (show si)
-        let di = lookupCtxt Nothing n (idris_datatypes i)
+        let di = lookupCtxt n (idris_datatypes i)
         when (not (null di)) $ iputStrLn (show di)
-        let d = lookupDef Nothing n (tt_ctxt i)
-        when (not (null d)) $ liftIO $
-           do print (head d)
-        let cg = lookupCtxtName Nothing n (idris_callgraph i)
+        let d = lookupDef n (tt_ctxt i)
+        when (not (null d)) $ iputStrLn (show (head d))
+        let cg = lookupCtxtName n (idris_callgraph i)
         findUnusedArgs (map fst cg)
         i <- getIState
-        let cg' = lookupCtxtName Nothing n (idris_callgraph i)
+        let cg' = lookupCtxtName n (idris_callgraph i)
         sc <- checkSizeChange n
         iputStrLn $ "Size change: " ++ show sc
         when (not (null cg')) $ do iputStrLn "Call graph:\n"
                                    iputStrLn (show cg')
 process fn (Info n) = do i <- getIState
-                         case lookupCtxt Nothing n (idris_classes i) of
+                         case lookupCtxt n (idris_classes i) of
                               [c] -> classInfo c
-                              _ -> iputStrLn "Not a class"
-process fn (Search t) = iputStrLn "Not implemented"
+                              _ -> iFail "Not a class"
+process fn (Search t) = iFail "Not implemented"
 process fn (Spec t) = do (tm, ty) <- elabVal toplevel False t
                          ctxt <- getContext
                          ist <- getIState
                          let tm' = simplify ctxt True [] {- (idris_statics ist) -} tm
-                         iputStrLn (show (delab ist tm'))
+                         iResult (show (delab ist tm'))
 
 process fn (RmProof n')
   = do i <- getIState
@@ -286,8 +398,17 @@
                                  let ms = idris_metavars i
                                  putIState $ i { idris_metavars = n : ms }
 
-process fn (AddProof prf)
-  = do let fb = fn ++ "~"
+process fn' (AddProof prf)
+  = do fn <- do
+         ex <- liftIO $ doesFileExist fn'
+         let fnExt = fn' <.> "idr"
+         exExt <- liftIO $ doesFileExist fnExt
+         if ex
+            then return fn'
+            else if exExt
+                    then return fnExt
+                    else fail $ "Neither \""++fn'++"\" nor \""++fnExt++"\" exist"
+       let fb = fn ++ "~"
        liftIO $ copyFile fn fb -- make a backup in case something goes wrong!
        prog <- liftIO $ readFile fb
        i <- getIState
@@ -311,13 +432,13 @@
        n <- resolveProof n'
        let proofs = proof_list i
        case lookup n proofs of
-            Nothing -> iputStrLn "No proof to show"
-            Just p  -> iputStrLn $ showProof False n p
+            Nothing -> iFail "No proof to show"
+            Just p  -> iResult $ showProof False n p
 
 process fn (Prove n')
      = do ctxt <- getContext
           ist <- getIState
-          n <- case lookupNames Nothing n' ctxt of
+          n <- case lookupNames n' ctxt of
                     [x] -> return x
                     [] -> return n'
                     ns -> fail $ pshow ist (CantResolveAlts (map show ns))
@@ -332,13 +453,13 @@
                          ctxt <- getContext
                          ist <- getIState
                          let tm' = hnf ctxt [] tm
-                         iputStrLn (show (delab ist tm'))
+                         iResult (show (delab ist tm'))
 process fn TTShell  = do ist <- getIState
                          let shst = initState (tt_ctxt ist)
                          runShell shst
                          return ()
-process fn Execute = do (m, _) <- elabVal toplevel False 
-                                        (PApp fc 
+process fn Execute = do (m, _) <- elabVal toplevel False
+                                        (PApp fc
                                            (PRef fc (UN "run__IO"))
                                            [pexp $ PRef fc (NS (UN "main") ["Main"])])
 --                                      (PRef (FC "main" 0) (NS (UN "main") ["main"]))
@@ -348,38 +469,51 @@
                         compile t tmpn m
                         liftIO $ system tmpn
                         return ()
-  where fc = FC "main" 0                     
-process fn (NewCompile f) 
+  where fc = FC "main" 0
+process fn (NewCompile f)
      = do (m, _) <- elabVal toplevel False
                       (PApp fc (PRef fc (UN "run__IO"))
                           [pexp $ PRef fc (NS (UN "main") ["Main"])])
           compileEpic f m
-  where fc = FC "main" 0                     
-process fn (Compile target f) 
+  where fc = FC "main" 0
+process fn (Compile target f)
       = do (m, _) <- elabVal toplevel False
                        (PApp fc (PRef fc (UN "run__IO"))
                        [pexp $ PRef fc (NS (UN "main") ["Main"])])
            compile target f m
-  where fc = FC "main" 0                     
-process fn (LogLvl i) = setLogLevel i 
+  where fc = FC "main" 0
+process fn (LogLvl i) = setLogLevel i
 -- Elaborate as if LHS of a pattern (debug command)
-process fn (Pattelab t) 
+process fn (Pattelab t)
      = do (tm, ty) <- elabVal toplevel True t
-          iputStrLn $ show tm ++ "\n\n : " ++ show ty
+          iResult $ show tm ++ "\n\n : " ++ show ty
 
-process fn (Missing n) = do i <- getIState
-                            case lookupDef Nothing n (tt_ctxt i) of
-                                [CaseOp _ _ _ _ _ args t _ _]
-                                    -> do tms <- genMissing n args t
-                                          iputStrLn (showSep "\n" (map (showImp True) tms))
-                                [] -> iputStrLn $ show n ++ " undefined"
-                                _ -> iputStrLn $ "Ambiguous name"
-process fn Metavars 
+process fn (Missing n)
+    = do i <- getIState
+         case lookupCtxt n (idris_patdefs i) of
+                  [] -> return ()
+                  [(_, tms)] ->
+                       iResult (showSep "\n" (map (showImp True) tms))
+                  _ -> iFail $ "Ambiguous name"
+process fn (DynamicLink l) = do i <- getIState
+                                let lib = trim l
+                                handle <- lift $ tryLoadLib lib
+                                case handle of
+                                  Nothing -> iFail $ "Could not load dynamic lib \"" ++ l ++ "\""
+                                  Just x -> do let libs = idris_dynamic_libs i
+                                               putIState $ i { idris_dynamic_libs = x:libs }
+    where trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+process fn ListDynamic = do i <- getIState
+                            iputStrLn "Dynamic libraries:"
+                            showLibs $ idris_dynamic_libs i
+    where showLibs []                = return ()
+          showLibs ((Lib name _):ls) = do iputStrLn $ "\t" ++ name; showLibs ls
+process fn Metavars
                  = do ist <- getIState
                       let mvs = idris_metavars ist \\ primDefs
                       case mvs of
-                        [] -> iputStrLn "No global metavariables to solve"
-                        _ -> iputStrLn $ "Global metavariables:\n\t" ++ show mvs
+                        [] -> iFail "No global metavariables to solve"
+                        _ -> iResult $ "Global metavariables:\n\t" ++ show mvs
 process fn NOP      = return ()
 
 process fn (SetOpt   ErrContext) = setErrContext True
@@ -387,8 +521,8 @@
 process fn (SetOpt ShowImpl)     = setImpShow True
 process fn (UnsetOpt ShowImpl)   = setImpShow False
 
-process fn (SetOpt _) = iputStrLn "Not a valid option"
-process fn (UnsetOpt _) = iputStrLn "Not a valid option"
+process fn (SetOpt _) = iFail "Not a valid option"
+process fn (UnsetOpt _) = iFail "Not a valid option"
 
 
 classInfo :: ClassInfo -> Idris ()
@@ -397,6 +531,7 @@
                   iputStrLn ""
                   iputStrLn "Instances:\n"
                   mapM_ dumpInstance (class_instances ci)
+                  iResult ""
 
 dumpMethod :: (Name, (FnOpts, PTerm)) -> Idris ()
 dumpMethod (n, (_, t)) = iputStrLn $ show n ++ " : " ++ show t
@@ -405,7 +540,7 @@
 dumpInstance n = do i <- getIState
                     ctxt <- getContext
                     imp <- impShow
-                    case lookupTy Nothing n ctxt of
+                    case lookupTy n ctxt of
                          ts -> mapM_ (\t -> iputStrLn $ showImp imp (delab i t)) ts
 
 showTotal t@(Partial (Other ns)) i
@@ -418,8 +553,9 @@
 displayHelp = let vstr = showVersion version in
               "\nIdris version " ++ vstr ++ "\n" ++
               "--------------" ++ map (\x -> '-') vstr ++ "\n\n" ++
+              concatMap cmdInfo helphead ++
               concatMap cmdInfo help
-  where cmdInfo (cmds, args, text) = "   " ++ col 16 12 (showSep " " cmds) args text 
+  where cmdInfo (cmds, args, text) = "   " ++ col 16 12 (showSep " " cmds) (show args) text 
         col c1 c2 l m r = 
             l ++ take (c1 - length l) (repeat ' ') ++ 
             m ++ take (c2 - length m) (repeat ' ') ++ r ++ "\n"
@@ -434,66 +570,47 @@
 
 parseArgs :: [String] -> [Opt]
 parseArgs [] = []
-parseArgs ("--log":lvl:ns)      = OLogging (read lvl) : (parseArgs ns)
-parseArgs ("--noprelude":ns)    = NoPrelude : (parseArgs ns)
-parseArgs ("--check":ns)        = NoREPL : (parseArgs ns)
-parseArgs ("-o":n:ns)           = NoREPL : Output n : (parseArgs ns)
-parseArgs ("-no":n:ns)          = NoREPL : NewOutput n : (parseArgs ns)
-parseArgs ("--typecase":ns)     = TypeCase : (parseArgs ns)
-parseArgs ("--typeintype":ns)   = TypeInType : (parseArgs ns)
-parseArgs ("--total":ns)        = DefaultTotal : (parseArgs ns)
-parseArgs ("--partial":ns)      = DefaultPartial : (parseArgs ns)
-parseArgs ("--warnpartial":ns)  = WarnPartial : (parseArgs ns)
-parseArgs ("--nocoverage":ns)   = NoCoverage : (parseArgs ns)
-parseArgs ("--errorcontext":ns) = ErrContext : (parseArgs ns)
-parseArgs ("--help":ns)         = Usage : (parseArgs ns)
-parseArgs ("--link":ns)         = ShowLibs : (parseArgs ns)
-parseArgs ("--libdir":ns)       = ShowLibdir : (parseArgs ns)
-parseArgs ("--include":ns)      = ShowIncs : (parseArgs ns)
-parseArgs ("--version":ns)      = Ver : (parseArgs ns)
-parseArgs ("--verbose":ns)      = Verbose : (parseArgs ns)
-parseArgs ("--ibcsubdir":n:ns)  = IBCSubDir n : (parseArgs ns)
-parseArgs ("-i":n:ns)           = ImportDir n : (parseArgs ns)
-parseArgs ("--warn":ns)         = WarnOnly : (parseArgs ns)
-parseArgs ("--package":n:ns)    = Pkg n : (parseArgs ns)
-parseArgs ("-p":n:ns)           = Pkg n : (parseArgs ns)
-parseArgs ("--build":n:ns)      = PkgBuild n : (parseArgs ns)
-parseArgs ("--install":n:ns)    = PkgInstall n : (parseArgs ns)
-parseArgs ("--clean":n:ns)      = PkgClean n : (parseArgs ns)
-parseArgs ("--bytecode":n:ns)   = NoREPL : BCAsm n : (parseArgs ns)
-parseArgs ("--fovm":n:ns)       = NoREPL : FOVM n : (parseArgs ns)
-parseArgs ("-S":ns)             = OutputTy Raw : (parseArgs ns)
-parseArgs ("-c":ns)             = OutputTy Object : (parseArgs ns)
-parseArgs ("--dumpdefuns":n:ns) = DumpDefun n : (parseArgs ns)
-parseArgs ("--dumpcases":n:ns)  = DumpCases n : (parseArgs ns)
-parseArgs ("--target":n:ns)     = UseTarget (parseTarget n) : (parseArgs ns)
-parseArgs (n:ns)                = Filename n : (parseArgs ns)
+parseArgs ("--quiet":ns)         = Quiet : (parseArgs ns)
+parseArgs ("--ideslave":ns)      = Ideslave : (parseArgs ns)
+parseArgs ("--log":lvl:ns)       = OLogging (read lvl) : (parseArgs ns)
+parseArgs ("--noprelude":ns)     = NoPrelude : (parseArgs ns)
+parseArgs ("--check":ns)         = NoREPL : (parseArgs ns)
+parseArgs ("-o":n:ns)            = NoREPL : Output n : (parseArgs ns)
+parseArgs ("-no":n:ns)           = NoREPL : NewOutput n : (parseArgs ns)
+parseArgs ("--typecase":ns)      = TypeCase : (parseArgs ns)
+parseArgs ("--typeintype":ns)    = TypeInType : (parseArgs ns)
+parseArgs ("--total":ns)         = DefaultTotal : (parseArgs ns)
+parseArgs ("--partial":ns)       = DefaultPartial : (parseArgs ns)
+parseArgs ("--warnpartial":ns)   = WarnPartial : (parseArgs ns)
+parseArgs ("--nocoverage":ns)    = NoCoverage : (parseArgs ns)
+parseArgs ("--errorcontext":ns)  = ErrContext : (parseArgs ns)
+parseArgs ("--help":ns)          = Usage : (parseArgs ns)
+parseArgs ("--link":ns)          = ShowLibs : (parseArgs ns)
+parseArgs ("--libdir":ns)        = ShowLibdir : (parseArgs ns)
+parseArgs ("--include":ns)       = ShowIncs : (parseArgs ns)
+parseArgs ("--version":ns)       = Ver : (parseArgs ns)
+parseArgs ("--verbose":ns)       = Verbose : (parseArgs ns)
+parseArgs ("--ibcsubdir":n:ns)   = IBCSubDir n : (parseArgs ns)
+parseArgs ("-i":n:ns)            = ImportDir n : (parseArgs ns)
+parseArgs ("--warn":ns)          = WarnOnly : (parseArgs ns)
+parseArgs ("--package":n:ns)     = Pkg n : (parseArgs ns)
+parseArgs ("-p":n:ns)            = Pkg n : (parseArgs ns)
+parseArgs ("--build":n:ns)       = PkgBuild n : (parseArgs ns)
+parseArgs ("--install":n:ns)     = PkgInstall n : (parseArgs ns)
+parseArgs ("--clean":n:ns)       = PkgClean n : (parseArgs ns)
+parseArgs ("--bytecode":n:ns)    = NoREPL : BCAsm n : (parseArgs ns)
+parseArgs ("--fovm":n:ns)        = NoREPL : FOVM n : (parseArgs ns)
+parseArgs ("-S":ns)              = OutputTy Raw : (parseArgs ns)
+parseArgs ("-c":ns)              = OutputTy Object : (parseArgs ns)
+parseArgs ("--dumpdefuns":n:ns)  = DumpDefun n : (parseArgs ns)
+parseArgs ("--dumpcases":n:ns)   = DumpCases n : (parseArgs ns)
+parseArgs ("--target":n:ns)      = UseTarget (parseTarget n) : (parseArgs ns)
+parseArgs ("-XTypeProviders":ns) = Extension TypeProviders : (parseArgs ns)
+parseArgs (n:ns)                 = Filename n : (parseArgs ns)
 
-help =
-  [ (["Command"], "Arguments", "Purpose"),
-    ([""], "", ""),
-    (["<expr>"], "", "Evaluate an expression"),
-    ([":t"], "<expr>", "Check the type of an expression"),
-    ([":miss", ":missing"], "<name>", "Show missing clauses"),
-    ([":i", ":info"], "<name>", "Display information about a type class"),
-    ([":total"], "<name>", "Check the totality of a name"),
-    ([":r",":reload"], "", "Reload current file"),
-    ([":l",":load"], "<filename>", "Load a new file"),
-    ([":m",":module"], "<module>", "Import an extra module"),
-    ([":e",":edit"], "", "Edit current file using $EDITOR or $VISUAL"),
-    ([":m",":metavars"], "", "Show remaining proof obligations (metavariables)"),
-    ([":p",":prove"], "<name>", "Prove a metavariable"),
-    ([":a",":addproof"], "<name>", "Add proof to source file"),
-    ([":rmproof"], "<name>", "Remove proof from proof stack"),
-    ([":showproof"], "<name>", "Show proof"),
-    ([":proofs"], "", "Show available proofs"),
-    ([":c",":compile"], "<filename>", "Compile to an executable <filename>"),
-    ([":js", ":javascript"], "<filename>", "Compile to JavaScript <filename>"),
-    ([":exec",":execute"], "", "Compile to an executable and run"),
-    ([":?",":h",":help"], "", "Display this help text"),
-    ([":set"], "<option>", "Set an option (errorcontext, showimplicits)"),
-    ([":unset"], "<option>", "Unset an option"),
-    ([":q",":quit"], "", "Exit the Idris system")
+helphead =
+  [ (["Command"], SpecialHeaderArg, "Purpose"),
+    ([""], NoArg, "")
   ]
 
 
@@ -507,6 +624,8 @@
 idrisMain :: [Opt] -> Idris ()
 idrisMain opts =
     do let inputs = opt getFile opts
+       let quiet = Quiet `elem` opts
+       let idesl = Ideslave `elem` opts
        let runrepl = not (NoREPL `elem` opts)
        let output = opt getOutput opts
        let newoutput = opt getNewOutput opts
@@ -523,7 +642,10 @@
                    xs -> last xs
        when (DefaultTotal `elem` opts) $ do i <- getIState
                                             putIState (i { default_total = True })
+       mapM_ addLangExt (opt getLanguageExt opts)
        setREPL runrepl
+       setQuiet quiet
+       setIdeSlave idesl
        setVerbose runrepl
        setCmdLine opts
        setOutputTy outty
@@ -542,12 +664,13 @@
          [] -> setIBCSubDir ""
          (d:_) -> setIBCSubDir d
        setImportDirs importdirs
+
        addPkgDir "base"
        mapM_ addPkgDir pkgdirs
        elabPrims
        when (not (NoPrelude `elem` opts)) $ do x <- loadModule "Prelude"
                                                return ()
-       when runrepl $ iputStrLn banner
+       when (runrepl && not quiet && not idesl) $ iputStrLn banner
        ist <- getIState
        mods <- mapM loadModule inputs
        ok <- noErrors
@@ -557,7 +680,8 @@
        when ok $ case newoutput of
                     [] -> return ()
                     (o:_) -> process "" (NewCompile o)  
-       when runrepl $ runInputT replSettings $ repl ist inputs
+       when (runrepl && not idesl) $ runInputT replSettings $ repl ist inputs
+       when (idesl) $ ideslaveStart ist inputs
        ok <- noErrors
        when (not ok) $ liftIO (exitWith (ExitFailure 1))
   where
@@ -621,8 +745,12 @@
 getOutputTy (OutputTy t) = Just t
 getOutputTy _ = Nothing
 
+getLanguageExt :: Opt -> Maybe LanguageExt
+getLanguageExt (Extension e) = Just e
+getLanguageExt _ = Nothing
+
 opt :: (Opt -> Maybe a) -> [Opt] -> [a]
-opt = mapMaybe 
+opt = mapMaybe
 
 ver = showVersion version
 
diff --git a/src/Idris/REPLParser.hs b/src/Idris/REPLParser.hs
--- a/src/Idris/REPLParser.hs
+++ b/src/Idris/REPLParser.hs
@@ -45,16 +45,19 @@
    <|> try (do cmd ["showproof"]; n <- pName; eof; return (ShowProof n))
    <|> try (do cmd ["log"]; i <- natural; eof; return (LogLvl (fromIntegral i)))
    <|> try (do cmd ["l", "load"]; f <- getInput; return (Load f))
+   <|> try (do cmd ["cd"]; f <- getInput; return (ChangeDirectory f))
    <|> try (do cmd ["spec"]; t <- pFullExpr defaultSyntax; return (Spec t))
    <|> try (do cmd ["hnf"]; t <- pFullExpr defaultSyntax; return (HNF t))
    <|> try (do cmd ["doc"]; n <- pfName; eof; return (DocStr n))
-   <|> try (do cmd ["d", "def"]; n <- pfName; eof; return (Defn n))
+   <|> try (do cmd ["d", "def"]; many1 (char ' ') ; n <- pfName; eof; return (Defn n))
    <|> try (do cmd ["total"]; do n <- pfName; eof; return (TotCheck n))
    <|> try (do cmd ["t", "type"]; do t <- pFullExpr defaultSyntax; return (Check t))
    <|> try (do cmd ["u", "universes"]; eof; return Universes)
    <|> try (do cmd ["di", "dbginfo"]; n <- pfName; eof; return (DebugInfo n))
    <|> try (do cmd ["i", "info"]; n <- pfName; eof; return (Info n))
    <|> try (do cmd ["miss", "missing"]; n <- pfName; eof; return (Missing n))
+   <|> try (do cmd ["dynamic"]; eof; return ListDynamic)
+   <|> try (do cmd ["dynamic"]; l <- getInput; return (DynamicLink l))
    <|> try (do cmd ["set"]; o <-pOption; return (SetOpt o))
    <|> try (do cmd ["unset"]; o <-pOption; return (UnsetOpt o))
    <|> try (do cmd ["s", "search"]; t <- pFullExpr defaultSyntax; return (Search t))
@@ -63,7 +66,7 @@
    <|> do t <- pFullExpr defaultSyntax; return (Eval t)
    <|> do eof; return NOP
 
- where toPath n = foldl1 (</>) $ splitOn "." n
+ where toPath n = foldl1' (</>) $ splitOn "." n
 
 pOption :: IParser Opt
 pOption = do discard (symbol "errorcontext"); return ErrContext
diff --git a/src/Idris/UnusedArgs.hs b/src/Idris/UnusedArgs.hs
--- a/src/Idris/UnusedArgs.hs
+++ b/src/Idris/UnusedArgs.hs
@@ -15,7 +15,7 @@
 traceUnused :: Name -> Idris ()
 traceUnused n 
    = do i <- getIState
-        case lookupCtxt Nothing n (idris_callgraph i) of 
+        case lookupCtxt n (idris_callgraph i) of 
           [CGInfo args calls scg usedns _] ->
                 do let argpos = zip args [0..]
                    let fargs = concatMap (getFargpos calls) argpos
@@ -39,7 +39,7 @@
    | otherwise 
        = do logLvl 5 $ (show ((g, j) : path)) 
             i <- getIState
-            case lookupCtxt Nothing g (idris_callgraph i) of
+            case lookupCtxt g (idris_callgraph i) of
                [CGInfo args calls scg usedns unused] ->
                   if (j >= length args) 
                     then -- overapplied, assume used
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -29,6 +29,7 @@
 import Idris.Error
 
 import Util.System ( getLibFlags, getIdrisLibDir, getIncFlags )
+import Util.DynamicLinker
 
 import Pkg.Package
 
@@ -78,6 +79,7 @@
            "--------------" ++ map (\x -> '-') ver ++ "\n" ++
            "Usage: idris [input file] [options]\n" ++
            "Options:\n" ++
+           "\t--quiet           Quiet mode (for editors)\n" ++
            "\t--check           Type check only\n" ++
            "\t-o [file]         Specify output filename\n" ++
            "\t-i [dir]          Add directory to the list of import paths\n" ++
@@ -89,7 +91,10 @@
            "\t--log [level]     Type debugging log level\n" ++
            "\t-S                Do no further compilation of code generator output\n" ++
            "\t-c                Compile to object files rather than an executable\n" ++
+           "\t--ideslave        Ideslave mode (for editors; in/ouput wrapped in s-expressions)\n" ++
            "\t--libdir          Show library install directory and exit\n" ++
            "\t--link            Show C library directories and exit (for C linking)\n" ++
            "\t--include         Show C include directories and exit (for C linking)\n" ++
            "\t--target [target] Type the target: C, Java, bytecode, javascript, node\n"
+
+
diff --git a/src/Pkg/Package.hs b/src/Pkg/Package.hs
--- a/src/Pkg/Package.hs
+++ b/src/Pkg/Package.hs
@@ -71,7 +71,7 @@
 buildMods opts ns = do let f = map (toPath . show) ns
                        idris (map Filename f ++ opts) 
                        return ()
-    where toPath n = foldl1 (</>) $ splitOn "." n
+    where toPath n = foldl1' (</>) $ splitOn "." n
 
 testLib :: Bool -> String -> String -> IO Bool
 testLib warn p f 
@@ -93,7 +93,7 @@
 rmIBC m = rmFile $ toIBCFile m 
              
 toIBCFile (UN n) = n ++ ".ibc"
-toIBCFile (NS n ns) = foldl1 (</>) (reverse (toIBCFile n : ns))
+toIBCFile (NS n ns) = foldl1' (</>) (reverse (toIBCFile n : ns))
 
 installIBC :: String -> Name -> IO ()
 installIBC p m = do let f = toIBCFile m
@@ -105,7 +105,7 @@
                     copyFile f (destdir </> takeFileName f)
                     return ()
     where getDest (UN n) = ""
-          getDest (NS n ns) = foldl1 (</>) (reverse (getDest n : ns))
+          getDest (NS n ns) = foldl1' (</>) (reverse (getDest n : ns))
 
 installObj :: String -> String -> IO ()
 installObj p o = do d <- getDataDir
diff --git a/src/Util/DynamicLinker.hs b/src/Util/DynamicLinker.hs
new file mode 100644
--- /dev/null
+++ b/src/Util/DynamicLinker.hs
@@ -0,0 +1,63 @@
+-- | Platform-specific dynamic linking support. Add new platforms to this file
+-- through conditional compilation.
+{-# LANGUAGE ExistentialQuantification, CPP #-}
+module Util.DynamicLinker where
+
+import Foreign.LibFFI
+import Foreign.Ptr (nullPtr, FunPtr, nullFunPtr,castPtrToFunPtr)
+import System.Directory
+#ifndef WINDOWS
+import System.Posix.DynamicLinker
+#else
+import System.Win32.DLL
+import System.Win32.Types
+type DL = HMODULE
+#endif
+
+hostDynamicLibExt :: String
+#ifdef LINUX
+hostDynamicLibExt = "so"
+#elif MACOSX
+hostDynamicLibExt = "dylib"
+#elif WINDOWS
+hostDynamicLibExt = "dll"
+#endif
+
+data ForeignFun = forall a. Fun { fun_name :: String
+                                , fun_handle :: FunPtr a
+                                }
+
+data DynamicLib = Lib { lib_name :: String
+                      , lib_handle :: DL
+                      }
+
+#ifndef WINDOWS
+tryLoadLib :: String -> IO (Maybe DynamicLib)
+tryLoadLib lib = do exactName <- doesFileExist lib
+                    let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
+                    handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]
+                    if undl handle == nullPtr
+                      then return Nothing
+                      else return . Just $ Lib lib handle
+
+
+tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
+tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
+                            if cFn == nullFunPtr
+                               then return Nothing
+                               else return . Just $ Fun fn cFn
+#else
+tryLoadLib :: String -> IO (Maybe DynamicLib)
+tryLoadLib lib = do exactName <- doesFileExist lib
+                    let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
+                    handle <- loadLibrary filename
+                    if handle == nullPtr
+                        then return Nothing
+                        else return . Just $ Lib lib handle
+
+tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
+tryLoadFn fn (Lib _ h) = do cFn <- getProcAddress h fn
+                            if cFn == nullPtr
+                                then return Nothing
+                                else return . Just $ Fun fn (castPtrToFunPtr cFn)
+#endif
diff --git a/src/Util/System.hs b/src/Util/System.hs
--- a/src/Util/System.hs
+++ b/src/Util/System.hs
@@ -1,13 +1,20 @@
 {-# LANGUAGE CPP #-}
-module Util.System(tempfile,environment,getCC,
-                   getLibFlags,getIdrisLibDir,getIncFlags,rmFile) where
+module Util.System(tempfile,withTempdir,environment,getCC,
+                   getLibFlags,getIdrisLibDir,getIncFlags,rmFile,
+                   getMvn,getExecutablePom,catchIO) where
 
 -- System helper functions.
-
-import System.Directory (getTemporaryDirectory, removeFile)
+import Control.Monad (when)
+import Distribution.Text (display)
+import System.Directory (getTemporaryDirectory
+                        , removeFile
+                        , removeDirectoryRecursive
+                        , createDirectoryIfMissing
+                        )
 import System.FilePath ((</>), addTrailingPathSeparator, normalise)
 import System.Environment
 import System.IO
+import System.IO.Error
 #if MIN_VERSION_base(4,0,0)
 import Control.Exception as CE
 #endif
@@ -17,20 +24,44 @@
 #if MIN_VERSION_base(4,0,0)
 catchIO :: IO a -> (IOError -> IO a) -> IO a
 catchIO = CE.catch
+
+throwIO :: IOError -> IO a
+throwIO = CE.throw
 #else
 catchIO = catch
+throwIO = throw
 #endif
 
+
+
 getCC :: IO String
 getCC = do env <- environment "IDRIS_CC"
            case env of
                 Nothing -> return "gcc"
                 Just cc -> return cc
 
+getMvn :: IO String
+getMvn = do env <- environment "IDRIS_MVN"
+            case env of
+              Nothing  -> return "mvn"
+              Just mvn -> return mvn
+
 tempfile :: IO (FilePath, Handle)
 tempfile = do dir <- getTemporaryDirectory
               openTempFile (normalise dir) "idris"
 
+withTempdir :: String -> (FilePath -> IO a) -> IO a
+withTempdir subdir callback 
+  = do dir <- getTemporaryDirectory
+       let tmpDir = (normalise dir) </> subdir
+       removeLater <- catchIO (createDirectoryIfMissing True tmpDir >> return True)
+                              (\ ioError -> if isAlreadyExistsError ioError then return False 
+                                            else throw ioError
+                              )
+       result <- callback tmpDir
+       when removeLater $ removeDirectoryRecursive tmpDir
+       return result
+                       
 environment :: String -> IO (Maybe String)
 environment x = catchIO (do e <- getEnv x
                             return (Just e))
@@ -51,3 +82,6 @@
 
 getIncFlags = do dir <- getDataDir
                  return $ "-I" ++ dir </> "rts"
+
+getExecutablePom = do dir <- getDataDir
+                      return $ dir </> "executable_pom.xml"
diff --git a/tutorial/examples/wheres.idr b/tutorial/examples/wheres.idr
new file mode 100644
--- /dev/null
+++ b/tutorial/examples/wheres.idr
@@ -0,0 +1,14 @@
+module wheres
+
+even : Nat -> Bool 
+even O = True 
+even (S k) = odd k where 
+  odd O = False 
+  odd (S k) = even k 
+
+test : List Nat
+test = [c (S 1), c O, d (S O)]
+  where c x = 42 + x
+        d y = c (y + 1 + z y)
+              where z w = y + w
+