diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-.PHONY: build configure doc install linecount nodefault pinstall lib_clean relib test_c test
+.PHONY: build configure doc install linecount nodefault pinstall lib_clean relib test_c test lib_doc lib_doc_clean
 
 include config.mk
 -include custom.mk
@@ -45,6 +45,11 @@
 doc: dist/setup-config
 	$(CABAL) haddock --hyperlink-source --html --hoogle --html-location="http://hackage.haskell.org/packages/archive/\$$pkg/latest/doc/html" --haddock-options="--title Idris"
 
+lib_doc:
+	$(MAKE) -C libs IDRIS=../../dist/build/idris/idris doc
+
+lib_doc_clean:
+	$(MAKE) -C libs IDRIS=../../dist/build/idris/idris doc_clean
 
 dist/setup-config:
 	$(CABAL) configure $(CABALFLAGS)
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -13,8 +13,9 @@
 import Distribution.PackageDescription
 import Distribution.Text
 
+import System.Environment
 import System.Exit
-import System.FilePath ((</>), splitDirectories)
+import System.FilePath ((</>), splitDirectories,isAbsolute)
 import System.Directory
 import qualified System.FilePath.Posix as Px
 import System.Process
@@ -70,6 +71,12 @@
       Just False -> False
       Nothing -> False
 
+isFreestanding :: S.ConfigFlags -> Bool
+isFreestanding flags =
+  case lookup (FlagName "freestanding") (S.configConfigurationsFlags flags) of
+    Just True -> True
+    Just False -> False
+    Nothing -> False
 -- -----------------------------------------------------------------------------
 -- Clean
 
@@ -98,12 +105,12 @@
 -- Put the Git hash into a module for use in the program
 -- For release builds, just put the empty string in the module
 generateVersionModule verbosity dir release = do
-  hash <- gitHash
-  let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
-  putStrLn $ "Generating " ++ versionModulePath ++
+    hash <- gitHash
+    let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
+    putStrLn $ "Generating " ++ versionModulePath ++
              if release then " for release" else (" for prerelease " ++ hash)
-  createDirectoryIfMissingVerbose verbosity True dir
-  rewriteFile versionModulePath (versionModuleContents hash)
+    createDirectoryIfMissingVerbose verbosity True dir
+    rewriteFile versionModulePath (versionModuleContents hash)
 
   where versionModuleContents h = "module Version_idris where\n\n" ++
                                   "gitHash :: String\n" ++
@@ -111,9 +118,38 @@
                                     then "gitHash = \"\"\n"
                                     else "gitHash = \"-git:" ++ h ++ "\"\n"
 
+-- Generate a module that contains the lib path for a freestanding Idris
+generateTargetModule verbosity dir targetDir = do
+    absPath <- return $ isAbsolute targetDir
+    let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
+    putStrLn $ "Generating " ++ targetModulePath
+    createDirectoryIfMissingVerbose verbosity True dir
+    rewriteFile targetModulePath (versionModuleContents absPath targetDir)
+            where versionModuleContents absolute td = "module Target_idris where\n\n" ++
+                                    "import System.FilePath\n" ++
+                                    "import System.Environment\n" ++
+                                    "getDataDir :: IO String\n" ++
+                                    if absolute
+                                        then "getDataDir = return \"" ++ td ++ "\"\n"
+                                        else "getDataDir = do \n" ++
+                                             "   expath <- getExecutablePath\n" ++
+                                             "   execDir <- return $ dropFileName expath\n" ++
+                                             "   return $ execDir ++ \"" ++ td ++ "\"\n"
+                                    ++ "getDataFileName :: FilePath -> IO FilePath\n"
+                                    ++ "getDataFileName name = do\n"
+                                    ++ "   dir <- getDataDir\n"
+                                    ++ "   return (dir ++ \"/\" ++ name)"
+
+
 idrisConfigure _ flags _ local = do
       configureRTS
       generateVersionModule verbosity (autogenModulesDir local) (isRelease (configFlags local))
+      when (isFreestanding $ configFlags local) (do
+                targetDir <- lookupEnv "IDRIS_INSTALL_DIR"
+                case targetDir of
+                     Just d -> generateTargetModule verbosity (autogenModulesDir local) d
+                     Nothing -> error $ "Trying to build freestanding without a target directory."
+                                  ++ " Set it by defining IDRIS_INSTALL_DIR.")
    where
       verbosity = S.fromFlag $ S.configVerbosity flags
       version   = pkgVersion . package $ localPkgDescr local
@@ -128,12 +164,16 @@
   let dir = S.fromFlag (S.sDistDirectory flags)
   let verb = S.fromFlag (S.sDistVerbosity flags)
   generateVersionModule verb ("src") True
+  generateTargetModule verb "src" "./libs"
   preSDist simpleUserHooks args flags
 
 idrisPostSDist args flags desc lbi = do
   Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
-                              putStrLn $ "Removing generated module " ++ file
-                              removeFile file)
+                              let targetFile = "src" </> "Target_idris" Px.<.> "hs"
+                              putStrLn $ "Removing generated modules:\n "
+                                        ++ file ++ "\n" ++ targetFile
+                              removeFile file
+                              removeFile targetFile)
              (\e -> let e' = (e :: SomeException) in return ())
   postSDist simpleUserHooks args flags desc lbi
 
@@ -166,6 +206,7 @@
 
       gmpflag False = []
       gmpflag True = ["GMP=-DIDRIS_GMP"]
+
 
 
 -- -----------------------------------------------------------------------------
diff --git a/config.mk b/config.mk
--- a/config.mk
+++ b/config.mk
@@ -1,6 +1,6 @@
 CC              ?=cc
 CABAL           :=cabal
-CFLAGS          :=-O2 -Wall $(CFLAGS)
+CFLAGS          :=-O2 -Wall -DHAS_PTHREAD $(CFLAGS)
 #CABALFLAGS	:=
 ## Disable building of Effects
 #CABALFLAGS :=-f NoEffects
@@ -35,4 +35,3 @@
 	SHLIB_SUFFIX    :=.so
 endif
 endif
-
diff --git a/idris.cabal b/idris.cabal
--- a/idris.cabal
+++ b/idris.cabal
@@ -1,5 +1,5 @@
 Name:           idris
-Version:        0.9.13.1
+Version:        0.9.14
 License:        BSD3
 License-file:   LICENSE
 Author:         Edwin Brady
@@ -100,11 +100,6 @@
                        libs/effects/Effect/*.idr
                        libs/effects/*.idr
 
-                       libs/oldeffects/Makefile
-                       libs/oldeffects/oldeffects.ipkg
-                       libs/oldeffects/Effect/*.idr
-                       libs/oldeffects/*.idr
-
                        llvm/*.c
                        llvm/Makefile
 
@@ -131,9 +126,6 @@
                        test/reg007/run
                        test/reg007/*.lidr
                        test/reg007/expected
-                       test/reg008/run
-                       test/reg008/*.idr
-                       test/reg008/expected
                        test/reg009/run
                        test/reg009/*.lidr
                        test/reg009/expected
@@ -237,14 +229,18 @@
                        test/reg042/run
                        test/reg042/*.idr
                        test/reg042/expected
-                       test/reg043/run
-                       test/reg043/expected
                        test/reg044/run
                        test/reg044/*.idr
                        test/reg044/expected
                        test/reg045/run
                        test/reg045/*.idr
                        test/reg045/expected
+                       test/reg046/run
+                       test/reg046/*.idr
+                       test/reg046/expected
+                       test/reg047/run
+                       test/reg047/*.idr
+                       test/reg047/expected
 
                        test/basic001/run
                        test/basic001/*.idr
@@ -289,6 +285,9 @@
                        test/dsl002/test
                        test/dsl002/*.idr
                        test/dsl002/expected
+                       test/dsl003/run
+                       test/dsl003/*.idr
+                       test/dsl003/expected
 
                        test/effects001/run
                        test/effects001/*.idr
@@ -417,6 +416,17 @@
                        test/proof004/*.idr
                        test/proof004/expected
 
+                       test/quasiquote001/run
+                       test/quasiquote001/*.idr
+                       test/quasiquote001/expected
+                       test/quasiquote002/run
+                       test/quasiquote002/*.idr
+                       test/quasiquote002/expected
+                       test/quasiquote003/run
+                       test/quasiquote003/*.idr
+                       test/quasiquote003/expected
+
+
                        test/records001/run
                        test/records001/*.idr
                        test/records001/expected
@@ -513,10 +523,16 @@
   Default:      True
   manual:       True
 
+Flag freestanding
+  Description:  Build an Idris that doesn't use cabal
+  Default:      False
+  manual:       True
+
 Library
   hs-source-dirs: src
   Exposed-modules:
-                  Idris.Core.CaseTree
+                  Idris.Core.Binary
+                , Idris.Core.CaseTree
                 , Idris.Core.Constraints
                 , Idris.Core.DeepSeq
                 , Idris.Core.Elaborate
@@ -544,6 +560,7 @@
                 , Idris.Docs
                 , Idris.Docstrings
                 , Idris.ElabDecls
+                , Idris.ElabQuasiquote
                 , Idris.ElabTerm
                 , Idris.Erasure
                 , Idris.Error
@@ -580,6 +597,7 @@
                 , IRTS.CodegenCommon
                 , IRTS.CodegenJava
                 , IRTS.CodegenJavaScript
+                , IRTS.JavaScript.AST
                 , IRTS.Compiler
                 , IRTS.Defunctionalise
                 , IRTS.DumpBC
@@ -613,6 +631,7 @@
                 , annotated-wl-pprint >= 0.5.3
                 , ansi-terminal
                 , ansi-wl-pprint
+                , base64-bytestring
                 , binary
                 , blaze-html >= 0.6.1.3
                 , blaze-markup >= 0.5.2.1 && < 0.7.0.0
@@ -622,6 +641,7 @@
                 , directory
                 , directory >= 1.2
                 , filepath
+                , fingertree >= 0.1
                 , haskeline >= 0.7
                 , language-java >= 0.2.6
                 , lens >= 4.1.1
@@ -680,6 +700,9 @@
   if flag(curses)
      build-depends: hscurses
      cpp-options:   -DCURSES
+  if flag(freestanding)
+     other-modules: Target_idris
+     cpp-options:   -DFREESTANDING
 
 Executable idris
   Main-is:        Main.hs
diff --git a/jsrts/Runtime-browser.js b/jsrts/Runtime-browser.js
--- a/jsrts/Runtime-browser.js
+++ b/jsrts/Runtime-browser.js
@@ -1,14 +1,14 @@
-var __IDRRT__print = function(s) {
+var i$putStr = function(s) {
   console.log(s);
 };
 
 
-var __IDRRT__systemInfo = function(index) {
-    switch(index) {
-        case 0:
-            return "javascript";
-        case 1:
-            return navigator.platform;
-    }
-    return "";
+var i$systemInfo = function(index) {
+  switch(index) {
+    case 0:
+      return "javascript";
+    case 1:
+      return navigator.platform;
+  }
+  return "";
 }
diff --git a/jsrts/Runtime-common.js b/jsrts/Runtime-common.js
--- a/jsrts/Runtime-common.js
+++ b/jsrts/Runtime-common.js
@@ -1,51 +1,91 @@
 /** @constructor */
-var __IDRRT__Type = function(type) {
-  this.type = type;
-};
+var i$VM = function() {
+  this.valstack = [];
+  this.valstack_top = 0;
+  this.valstack_base = 0;
 
-var __IDRRT__Int = new __IDRRT__Type('Int');
-var __IDRRT__Char = new __IDRRT__Type('Char');
-var __IDRRT__String = new __IDRRT__Type('String');
-var __IDRRT__Integer = new __IDRRT__Type('Integer');
-var __IDRRT__Float = new __IDRRT__Type('Float');
-var __IDRRT__Ptr = new __IDRRT__Type('Pointer');
-var __IDRRT__Forgot = new __IDRRT__Type('Forgot');
+  this.ret = null;
 
-var __IDRRT__ffiWrap = function(fid) {
-  return function(){
+  this.callstack = [];
+}
+
+var i$vm;
+var i$valstack;
+var i$valstack_top;
+var i$valstack_base;
+var i$ret;
+var i$callstack;
+
+/** @constructor */
+var i$CON = function(tag,args,app,ev) {
+  this.tag = tag;
+  this.args = args;
+  this.app = app;
+  this.ev = ev;
+}
+
+var i$SCHED = function(vm) {
+  i$vm = vm;
+  i$valstack = vm.valstack;
+  i$valstack_top = vm.valstack_top;
+  i$valstack_base = vm.valstack_base;
+  i$ret = vm.ret;
+  i$callstack = vm.callstack;
+}
+
+var i$SLIDE = function(args) {
+  for (var i = 0; i < args; ++i)
+    i$valstack[i$valstack_base + i] = i$valstack[i$valstack_top + i];
+}
+
+var i$PROJECT = function(val,loc,arity) {
+  for (var i = 0; i < arity; ++i)
+    i$valstack[i$valstack_base + i + loc] = val.args[i];
+}
+
+var i$CALL = function(fun,args) {
+  i$callstack.push(args);
+  i$callstack.push(fun);
+}
+
+var i$ffiWrap = function(fid,oldbase,myoldbase) {
+  return function() {
+    i$callstack = [];
+
     var res = fid;
-    var i = 0;
-    var arg;
-    while (res instanceof __IDRRT__Con){
-      arg = arguments[i];
-      res = __IDRRT__tailcall(function(){
-        return __IDR__mAPPLY0(res, arg);
-      });
-      ++i;
+
+    for(var i = 0; i < arguments.length; ++i) {
+      while (res instanceof i$CON) {
+        i$valstack_top += 1;
+        i$valstack[i$valstack_top] = res;
+        i$valstack[i$valstack_top + 1] = arguments[i];
+        i$SLIDE(2);
+        i$valstack_top = i$valstack_base + 2;
+        i$CALL(_idris__123_APPLY0_125_,[oldbase])
+        while (i$callstack.length) {
+          var func = i$callstack.pop();
+          var args = i$callstack.pop();
+          func.apply(this,args);
+        }
+        res = i$ret;
+      }
     }
-    return res;
-  }
-};
 
-var __IDRRT__tailcall = function(k) {
-  var ret = k();
-  while (ret instanceof __IDRRT__Cont)
-    ret = ret.k();
+    i$callstack = i$vm.callstack;
 
-  return ret;
-};
+    return i$ret;
+  }
+}
 
-var __IDRRT__charCode = function(str) {
-  var type = typeof str;
-  if (type == "string")
+var i$charCode = function(str) {
+  if (typeof str == "string")
     return str.charCodeAt(0);
   else
     return str;
 }
 
-var __IDRRT__fromCharCode = function(chr) {
-  var type = typeof chr;
-  if (type == "string")
+var i$fromCharCode = function(chr) {
+  if (typeof chr == "string")
     return chr;
   else
     return String.fromCharCode(chr);
diff --git a/jsrts/Runtime-node.js b/jsrts/Runtime-node.js
--- a/jsrts/Runtime-node.js
+++ b/jsrts/Runtime-node.js
@@ -1,17 +1,17 @@
-var __IDRRT__print = (function() {
+var i$putStr = (function() {
   var util = require('util');
   return function(s) {
     util.print(s);
   };
 })();
 
-var __IDRRT__systemInfo = function(index) {
-    var os = require('os')
+var i$systemInfo = function(index) {
+  var os = require('os')
     switch(index) {
-        case 0:
-            return "node";
-        case 1:
-            return os.platform();
+      case 0:
+        return "node";
+      case 1:
+        return os.platform();
     }
-    return "";
+  return "";
 }
diff --git a/jsrts/jsbn/jsbn.js b/jsrts/jsbn/jsbn.js
--- a/jsrts/jsbn/jsbn.js
+++ b/jsrts/jsbn/jsbn.js
@@ -1,4 +1,4 @@
-var __IDRRT__bigInt = (function() {
+var i$bigInt = (function() {
 // Copyright (c) 2005  Tom Wu
 // All Rights Reserved.
 // See "LICENSE" for details.
@@ -1234,5 +1234,5 @@
 }
 })();
 
-var __IDRRT__ZERO = __IDRRT__bigInt("0");
-var __IDRRT__ONE = __IDRRT__bigInt("1");
+var i$ZERO = i$bigInt("0");
+var i$ONE = i$bigInt("1");
diff --git a/libs/Makefile b/libs/Makefile
--- a/libs/Makefile
+++ b/libs/Makefile
@@ -13,5 +13,16 @@
 	$(MAKE) -C prelude clean
 	$(MAKE) -C base clean
 	$(MAKE) -C effects clean
-        
-.PHONY: build install clean
+
+doc:
+	$(MAKE)	-C prelude doc 	
+	$(MAKE)	-C base doc 	
+	$(MAKE)	-C effects doc 	
+
+doc_clean:
+	$(MAKE)	-C prelude doc_clean
+	$(MAKE)	-C base doc_clean 	
+	$(MAKE)	-C effects  doc_clean	
+
+
+.PHONY: build install clean doc doc_clean
diff --git a/libs/base/Data/HVect.idr b/libs/base/Data/HVect.idr
--- a/libs/base/Data/HVect.idr
+++ b/libs/base/Data/HVect.idr
@@ -5,68 +5,67 @@
 %access public
 %default total
 
-using (k : Nat, ts : Vect k Type)
-  ||| Heterogeneous vectors where the type index gives, element-wise,
-  ||| the types of the contents.
-  data HVect : Vect k Type -> Type where
-    Nil : HVect []
-    (::) : t -> HVect ts -> HVect (t::ts)
+||| Heterogeneous vectors where the type index gives, element-wise,
+||| the types of the contents.
+data HVect : Vect k Type -> Type where
+  Nil : HVect []
+  (::) : t -> HVect ts -> HVect (t::ts)
 
-  ||| Extract an element from an HVect
-  index : (i : Fin k) -> HVect ts -> index i ts
-  index fZ (x::xs) = x
-  index (fS j) (x::xs) = index j xs
+||| Extract an element from an HVect
+index : (i : Fin k) -> HVect ts -> index i ts
+index fZ (x::xs) = x
+index (fS j) (x::xs) = index j xs
 
-  deleteAt : {us : Vect (S l) Type} -> (i : Fin (S l)) -> HVect us -> HVect (deleteAt i us)
-  deleteAt fZ (x::xs) = xs
-  deleteAt {l = S m} (fS j) (x::xs) = x :: deleteAt j xs
-  deleteAt {l = Z}   (fS j) (x::xs) = absurd j
-  deleteAt _ [] impossible
+deleteAt : (i : Fin (S l)) -> HVect us -> HVect (deleteAt i us)
+deleteAt fZ (x::xs) = xs
+deleteAt {l = S m} (fS j) (x::xs) = x :: deleteAt j xs
+deleteAt {l = Z}   (fS j) (x::xs) = absurd j
+deleteAt _ [] impossible
 
-  replaceAt : (i : Fin k) -> t -> HVect ts -> HVect (replaceAt i t ts)
-  replaceAt fZ y (x::xs) = y::xs
-  replaceAt (fS j) y (x::xs) = x :: replaceAt j y xs
+replaceAt : (i : Fin k) -> t -> HVect ts -> HVect (replaceAt i t ts)
+replaceAt fZ y (x::xs) = y::xs
+replaceAt (fS j) y (x::xs) = x :: replaceAt j y xs
 
-  updateAt : (i : Fin k) -> (index i ts -> t) -> HVect ts -> HVect (replaceAt i t ts)
-  updateAt fZ f (x::xs) = f x :: xs
-  updateAt (fS j) f (x::xs) = x :: updateAt j f xs
+updateAt : (i : Fin k) -> (index i ts -> t) -> HVect ts -> HVect (replaceAt i t ts)
+updateAt fZ f (x::xs) = f x :: xs
+updateAt (fS j) f (x::xs) = x :: updateAt j f xs
 
-  ||| Append two `HVect`s.
-  (++) : {us : Vect l Type} -> HVect ts -> HVect us -> HVect (ts ++ us)
-  (++) [] ys = ys
-  (++) (x::xs) ys = x :: (xs ++ ys)
+||| Append two `HVect`s.
+(++) : HVect ts -> HVect us -> HVect (ts ++ us)
+(++) [] ys = ys
+(++) (x::xs) ys = x :: (xs ++ ys)
 
-  instance Eq (HVect []) where
-    [] == [] = True
+instance Eq (HVect []) where
+  [] == [] = True
 
-  instance (Eq t, Eq (HVect ts)) => Eq (HVect (t::ts)) where
-    (x::xs) == (y::ys) = x == y && xs == ys
+instance (Eq t, Eq (HVect ts)) => Eq (HVect (t::ts)) where
+  (x::xs) == (y::ys) = x == y && xs == ys
 
-  class Shows (k : Nat) (ts : Vect k Type) where
-    shows : HVect ts -> Vect k String
+class Shows (k : Nat) (ts : Vect k Type) where
+  shows : HVect ts -> Vect k String
 
-  instance Shows Z [] where
-    shows [] = []
+instance Shows Z [] where
+  shows [] = []
 
-  instance (Show t, Shows k ts) => Shows (S k) (t::ts) where
-    shows (x::xs) = show x :: shows xs
+instance (Show t, Shows k ts) => Shows (S k) (t::ts) where
+  shows (x::xs) = show x :: shows xs
 
-  instance (Shows k ts) => Show (HVect ts) where
-    show xs = show (shows xs)
+instance (Shows k ts) => Show (HVect ts) where
+  show xs = "[" ++ (pack . intercalate [','] . map unpack . toList $ shows xs) ++ "]"
 
-  ||| Extract an arbitrary element of the correct type.
-  ||| @ t the goal type
-  get : {default tactics { applyTactic findElem 100; solve; } p : Elem t ts} -> HVect ts -> t
-  get {p = Here} (x::xs) = x
-  get {p = There p'} (x::xs) = get {p = p'} xs
+||| Extract an arbitrary element of the correct type.
+||| @ t the goal type
+get : {default tactics { search 100; } p : Elem t ts} -> HVect ts -> t
+get {p = Here} (x::xs) = x
+get {p = There p'} (x::xs) = get {p = p'} xs
 
-  ||| Replace an element with the correct type.
-  put : {default tactics { applyTactic findElem 100; solve; } p : Elem t ts} -> t -> HVect ts -> HVect ts
-  put {p = Here} y (x::xs) = y :: xs
-  put {p = There p'} y (x::xs) = x :: put {p = p'} y xs
+||| Replace an element with the correct type.
+put : {default tactics { search 100; } p : Elem t ts} -> t -> HVect ts -> HVect ts
+put {p = Here} y (x::xs) = y :: xs
+put {p = There p'} y (x::xs) = x :: put {p = p'} y xs
 
-  ||| Replace an element with the correct type.
-  update : {default tactics { applyTactic findElem 100; solve; } p : Elem t ts} -> (t -> u) -> HVect ts -> HVect (replaceByElem ts p u)
-  update {p = Here} f (x::xs) = f x :: xs
-  update {p = There p'} f (x::xs) = x :: update {p = p'} f xs
+||| Update an element with the correct type.
+update : {default tactics { search 100; } p : Elem t ts} -> (t -> u) -> HVect ts -> HVect (replaceByElem ts p u)
+update {p = Here} f (x::xs) = f x :: xs
+update {p = There p'} f (x::xs) = x :: update {p = p'} f xs
 
diff --git a/libs/base/Data/List.idr b/libs/base/Data/List.idr
--- a/libs/base/Data/List.idr
+++ b/libs/base/Data/List.idr
@@ -2,30 +2,29 @@
 
 %access public
 
-using (xs : List a)
-  ||| A proof that some element is found in a list
-  data Elem : a -> List a -> Type where
-       Here : Elem x (x :: xs)
-       There : Elem x xs -> Elem x (y :: xs)
+||| A proof that some element is found in a list
+data Elem : a -> List a -> Type where
+     Here : Elem x (x :: xs)
+     There : Elem x xs -> Elem x (y :: xs)
 
-  instance Uninhabited (Elem {a} x []) where
-       uninhabited Here impossible
-       uninhabited (There p) impossible
+instance Uninhabited (Elem {a} x []) where
+     uninhabited Here impossible
+     uninhabited (There p) impossible
 
-  ||| Is the given element a member of the given list.
-  |||
-  ||| @x The element to be tested.
-  ||| @xs The list to be checked against
-  isElem : DecEq a => (x : a) -> (xs : List a) -> Dec (Elem x xs)
-  isElem x [] = No absurd
-  isElem x (y :: xs) with (decEq x y)
-    isElem x (x :: xs) | (Yes refl) = Yes Here
-    isElem x (y :: xs) | (No contra) with (isElem x xs)
-      isElem x (y :: xs) | (No contra) | (Yes prf) = Yes (There prf)
-      isElem x (y :: xs) | (No contra) | (No f) = No (mkNo contra f)
-        where
-          mkNo : {xs' : List a} ->
-                 ((x' = y') -> _|_) -> (Elem x' xs' -> _|_) ->
-                 Elem x' (y' :: xs') -> _|_
-          mkNo f g Here = f refl
-          mkNo f g (There x) = g x
+||| Is the given element a member of the given list.
+|||
+||| @x The element to be tested.
+||| @xs The list to be checked against
+isElem : DecEq a => (x : a) -> (xs : List a) -> Dec (Elem x xs)
+isElem x [] = No absurd
+isElem x (y :: xs) with (decEq x y)
+  isElem x (x :: xs) | (Yes refl) = Yes Here
+  isElem x (y :: xs) | (No contra) with (isElem x xs)
+    isElem x (y :: xs) | (No contra) | (Yes prf) = Yes (There prf)
+    isElem x (y :: xs) | (No contra) | (No f) = No (mkNo contra f)
+      where
+        mkNo : {xs' : List a} ->
+               ((x' = y') -> _|_) -> (Elem x' xs' -> _|_) ->
+               Elem x' (y' :: xs') -> _|_
+        mkNo f g Here = f refl
+        mkNo f g (There x) = g x
diff --git a/libs/base/Data/Vect.idr b/libs/base/Data/Vect.idr
--- a/libs/base/Data/Vect.idr
+++ b/libs/base/Data/Vect.idr
@@ -9,11 +9,10 @@
 -- Elem
 --------------------------------------------------------------------------------
 
-using (xs : Vect k a)
-  ||| A proof that some element is found in a vector
-  data Elem : a -> Vect k a -> Type where
-    Here : Elem x (x::xs)
-    There : Elem x xs -> Elem x (y::xs)
+||| A proof that some element is found in a vector
+data Elem : a -> Vect k a -> Type where
+     Here : Elem x (x::xs)
+     There : Elem x xs -> Elem x (y::xs)
 
 ||| Nothing can be in an empty Vect
 noEmptyElem : {x : a} -> Elem x [] -> _|_
diff --git a/libs/base/Language/Reflection.idr b/libs/base/Language/Reflection.idr
--- a/libs/base/Language/Reflection.idr
+++ b/libs/base/Language/Reflection.idr
@@ -192,8 +192,10 @@
             -- ^ focus a named hole
             | Rewrite TT
             -- ^ rewrite using the reflected rep. of a equality proof
-            | Induction TTName
+            | Induction TT
             -- ^ do induction on the particular expression
+            | Case TT
+            -- ^ do case analysis on particular expression
             | LetTac TTName TT
             -- ^ name a reflected term
             | LetTacTy TTName TT TT
diff --git a/libs/base/Makefile b/libs/base/Makefile
--- a/libs/base/Makefile
+++ b/libs/base/Makefile
@@ -1,15 +1,22 @@
 IDRIS := idris
+PKG := base
 
 build:
-	$(IDRIS) --build base.ipkg
+	$(IDRIS) --build ${PKG}.ipkg
 
 install: 
-	$(IDRIS) --install base.ipkg
+	$(IDRIS) --install ${PKG}.ipkg
 
 clean:
-	$(IDRIS) --clean base.ipkg
+	$(IDRIS) --clean ${PKG}.ipkg
 
 rebuild: clean build
+
+doc:
+	${IDRIS} --mkdoc ${PKG}.ipkg
+
+doc_clean:
+	rm -rf ${PKG}_doc
 
 linecount:
 	find . -name '*.idr' | xargs wc -l
diff --git a/libs/base/Network/Socket.idr b/libs/base/Network/Socket.idr
--- a/libs/base/Network/Socket.idr
+++ b/libs/base/Network/Socket.idr
@@ -1,10 +1,10 @@
 -- Time to do this properly.
 -- Low-Level C Sockets bindings for Idris. Used by higher-level, cleverer things.
 -- (C) SimonJF, MIT Licensed, 2014
-module Network.Socket
+module IdrisNet.Socket
 
 %include C "idris_net.h"
-%include C "sys/types.h" -- Pushing my luck, might need to re-export everything
+%include C "sys/types.h" 
 %include C "sys/socket.h" 
 %include C "netdb.h"
 
@@ -54,6 +54,12 @@
   toCode Datagram   = 2
   toCode Raw        = 3
 
+
+data RecvStructPtr = RSPtr Ptr
+data RecvfromStructPtr = RFPtr Ptr
+data BufPtr = BPtr Ptr
+data SockaddrPtr = SAPtr Ptr
+
 -- Protocol Number. Generally good enough to just set it to 0.
 ProtocolNumber : Type
 ProtocolNumber = Int
@@ -88,17 +94,36 @@
 EAGAIN : Int 
 EAGAIN = 11
 
--- Allocates an amount of memory given by the ByteLength parameter.
--- Used to allocate a mutable pointer to be given to the Recv functions.
-private
-alloc : ByteLength -> IO Ptr
-alloc bl = mkForeign (FFun "idrnet_malloc" [FInt] FPtr) bl
+-- TODO: Expand to non-string payloads
+record UDPRecvData : Type where
+  MkUDPRecvData : 
+    (remote_addr : SocketAddress) ->
+    (remote_port : Port) ->
+    (recv_data : String) ->
+    (data_len : Int) ->
+    UDPRecvData
 
+record UDPAddrInfo : Type where
+  MkUDPAddrInfo : 
+    (remote_addr : SocketAddress) ->
+    (remote_port : Port) ->
+    UDPAddrInfo
+
 -- Frees a given pointer
-private
-free : Ptr -> IO ()
-free ptr = mkForeign (FFun "idrnet_free" [FPtr] FUnit) ptr
+public
+sock_free : BufPtr -> IO ()
+sock_free (BPtr ptr) = mkForeign (FFun "idrnet_free" [FPtr] FUnit) ptr
 
+public
+sockaddr_free : SockaddrPtr -> IO ()
+sockaddr_free (SAPtr ptr) = mkForeign (FFun "idrnet_free" [FPtr] FUnit) ptr
+
+-- Allocates an amount of memory given by the ByteLength parameter.
+-- Used to allocate a mutable pointer to be given to the Recv functions.
+public
+sock_alloc : ByteLength -> IO BufPtr
+sock_alloc bl = map BPtr $ mkForeign (FFun "idrnet_malloc" [FInt] FPtr) bl
+
 record Socket : Type where
   MkSocket : (descriptor : SocketDescriptor) ->
              (family : SocketFamily) ->
@@ -123,12 +148,17 @@
 close : Socket -> IO ()
 close sock = mkForeign (FFun "close" [FInt] FUnit) (descriptor sock)
 
+private
+saString : (Maybe SocketAddress) -> String
+saString (Just sa) = show sa
+saString Nothing = ""
+
 -- Binds a socket to the given socket address and port.
 -- Returns 0 on success, an error code otherwise.
-bind : Socket -> SocketAddress -> Port -> IO Int
+bind : Socket -> (Maybe SocketAddress) -> Port -> IO Int
 bind sock addr port = do
   bind_res <- (mkForeign (FFun "idrnet_bind" [FInt, FInt, FInt, FString, FInt] FInt) 
-                           (descriptor sock) (toCode $ family sock) (toCode $ socketType sock) (show addr) port)
+                           (descriptor sock) (toCode $ family sock) (toCode $ socketType sock) (saString addr) port)
   if bind_res == (-1) then -- error
     getErrno
   else return 0 -- Success
@@ -152,11 +182,10 @@
   else return 0
 
 -- Parses a textual representation of an IPv4 address into a SocketAddress
-private
 parseIPv4 : String -> SocketAddress
 parseIPv4 str = case splitted of
-                     (i1 :: i2 :: i3 :: i4 :: _) => IPv4Addr i1 i2 i3 i4
-                     _ => InvalidAddress
+                  (i1 :: i2 :: i3 :: i4 :: _) => IPv4Addr i1 i2 i3 i4
+                  _ => InvalidAddress
   where toInt' : String -> Integer
         toInt' = cast
         toInt : String -> Int
@@ -166,32 +195,30 @@
 
 
 -- Retrieves a socket address from a sockaddr pointer
-private
-getSockAddr : Ptr -> IO SocketAddress
-getSockAddr ptr = do
+getSockAddr : SockaddrPtr -> IO SocketAddress
+getSockAddr (SAPtr ptr) = do
   addr_family_int <- mkForeign (FFun "idrnet_sockaddr_family" [FPtr] FInt) ptr
-  -- FIXME: Is this really a safe assertion? Depends where the Ptr came
-  -- from!
-  assert_total $ case getSocketFamily addr_family_int of
+ -- putStrLn $ "Addr family int: " ++ (show addr_family_int)
+  -- ASSUMPTION: Foreign call returns a valid int
+  assert_total (case getSocketFamily addr_family_int of
     Just AF_INET => do
       ipv4_addr <- mkForeign (FFun "idrnet_sockaddr_ipv4" [FPtr] FString) ptr
       return $ parseIPv4 ipv4_addr
     Just AF_INET6 => return IPv6Addr
-    Just AF_UNSPEC => return IPv6Addr -- FIXME: Horrible hack
+    Just AF_UNSPEC => return InvalidAddress)
 
--- Accepts a connection from a listening socket.
 accept : Socket -> IO (Either SocketError (Socket, SocketAddress))
 accept sock = do
   -- We need a pointer to a sockaddr structure. This is then passed into
   -- idrnet_accept and populated. We can then query it for the SocketAddr and free it.
-  sockaddr_ptr <- mkForeign (FFun "idrnet_create_sockaddr" [] FPtr) 
+  sockaddr_ptr <- mkForeign (FFun "idrnet_create_sockaddr" [] FPtr)
   accept_res <- mkForeign (FFun "idrnet_accept" [FInt, FPtr] FInt) (descriptor sock) sockaddr_ptr
   if accept_res == (-1) then
     map Left getErrno
   else do
     let (MkSocket _ fam ty p_num) = sock
-    sockaddr <- getSockAddr sockaddr_ptr
-    free sockaddr_ptr
+    sockaddr <- getSockAddr (SAPtr sockaddr_ptr)
+    sockaddr_free (SAPtr sockaddr_ptr)
     return $ Right ((MkSocket accept_res fam ty p_num), sockaddr)
 
 send : Socket -> String -> IO (Either SocketError ByteLength)
@@ -202,11 +229,13 @@
   else
     return $ Right send_res
 
-private
-freeRecvStruct : Ptr -> IO ()
-freeRecvStruct p = mkForeign (FFun "idrnet_free_recv_struct" [FPtr] FUnit) p
 
+freeRecvStruct : RecvStructPtr -> IO ()
+freeRecvStruct (RSPtr p) = mkForeign (FFun "idrnet_free_recv_struct" [FPtr] FUnit) p
 
+freeRecvfromStruct : RecvfromStructPtr -> IO ()
+freeRecvfromStruct (RFPtr p) = mkForeign (FFun "idrnet_free_recvfrom_struct" [FPtr] FUnit) p
+
 recv : Socket -> Int -> IO (Either SocketError (String, ByteLength))
 recv sock len = do
   -- Firstly make the request, get some kind of recv structure which
@@ -215,32 +244,106 @@
   recv_res <- mkForeign (FFun "idrnet_get_recv_res" [FPtr] FInt) recv_struct_ptr
   if recv_res == (-1) then do
     errno <- getErrno
-    freeRecvStruct recv_struct_ptr
+    freeRecvStruct (RSPtr recv_struct_ptr)
     return $ Left errno
   else 
     if recv_res == 0 then do
-       freeRecvStruct recv_struct_ptr
+       freeRecvStruct (RSPtr recv_struct_ptr)
        return $ Left 0
     else do
        payload <- mkForeign (FFun "idrnet_get_recv_payload" [FPtr] FString) recv_struct_ptr
-       freeRecvStruct recv_struct_ptr
+       freeRecvStruct (RSPtr recv_struct_ptr)
        return $ Right (payload, recv_res)
 
 
 -- Sends the data in a given memory location
-sendBuf : Socket -> Ptr -> ByteLength -> IO (Either SocketError ByteLength)
-sendBuf sock ptr len = do
+sendBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
+sendBuf sock (BPtr ptr) len = do
   send_res <- mkForeign (FFun "idrnet_send_buf" [FInt, FPtr, FInt] FInt) (descriptor sock) ptr len
   if send_res == (-1) then
     map Left getErrno
   else 
     return $ Right send_res
 
-recvBuf : Socket -> Ptr -> ByteLength -> IO (Either SocketError ByteLength)
-recvBuf sock ptr len = do
+recvBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
+recvBuf sock (BPtr ptr) len = do
   recv_res <- mkForeign (FFun "idrnet_recv_buf" [FInt, FPtr, FInt] FInt) (descriptor sock) ptr len
   if (recv_res == (-1)) then
     map Left getErrno
   else
     return $ Right recv_res
+
+sendTo : Socket -> SocketAddress -> Port -> String -> IO (Either SocketError ByteLength)
+sendTo sock addr p dat = do
+  sendto_res <- mkForeign (FFun "idrnet_sendto" [FInt, FString, FString, FInt, FInt] FInt)
+                            (descriptor sock) dat (show addr) p (toCode $ family sock)
+  if sendto_res == (-1) then
+    map Left getErrno
+  else
+    return $ Right sendto_res
+
+
+sendToBuf : Socket -> SocketAddress -> Port -> BufPtr -> ByteLength -> IO (Either SocketError ByteLength)
+sendToBuf sock addr p (BPtr dat) len = do
+  sendto_res <- mkForeign (FFun "idrnet_sendto_buf" [FInt, FPtr, FInt, FString, FInt, FInt] FInt)
+                            (descriptor sock) dat len (show addr) p (toCode $ family sock)
+  if sendto_res == (-1) then
+    map Left getErrno
+  else
+    return $ Right sendto_res
+
+
+foreignGetRecvfromPayload : RecvfromStructPtr -> IO String
+foreignGetRecvfromPayload (RFPtr p) = mkForeign (FFun "idrnet_get_recvfrom_payload" [FPtr] FString) p
+
+foreignGetRecvfromAddr : RecvfromStructPtr -> IO SocketAddress
+foreignGetRecvfromAddr (RFPtr p) = do
+  sockaddr_ptr <- map SAPtr $ mkForeign (FFun "idrnet_get_recvfrom_sockaddr" [FPtr] FPtr) p
+  getSockAddr sockaddr_ptr
+
+
+foreignGetRecvfromPort : RecvfromStructPtr -> IO Port
+foreignGetRecvfromPort (RFPtr p) = do
+  sockaddr_ptr <- mkForeign (FFun "idrnet_get_recvfrom_sockaddr" [FPtr] FPtr) p
+  port <- mkForeign (FFun "idrnet_sockaddr_ipv4_port" [FPtr] FInt) sockaddr_ptr
+  return port
+
+recvFrom : Socket -> ByteLength -> IO (Either SocketError (UDPAddrInfo, String, ByteLength))
+recvFrom sock bl = do
+  recv_ptr <- mkForeign (FFun "idrnet_recvfrom" [FInt, FInt] FPtr) 
+                (descriptor sock) bl
+  let recv_ptr' = RFPtr recv_ptr
+  if !(nullPtr recv_ptr) then -- ! notation = monadic bind shortcut, not "not"
+    map Left getErrno
+  else do
+    result <- mkForeign (FFun "idrnet_get_recvfrom_res" [FPtr] FInt) recv_ptr
+    if result == -1 then do
+      freeRecvfromStruct recv_ptr'
+      map Left getErrno
+    else do
+      payload <- foreignGetRecvfromPayload recv_ptr'
+      port <- foreignGetRecvfromPort recv_ptr'
+      addr <- foreignGetRecvfromAddr recv_ptr'
+      freeRecvfromStruct recv_ptr'
+      return $ Right (MkUDPAddrInfo addr port, payload, result)
+
+
+recvFromBuf : Socket -> BufPtr -> ByteLength -> IO (Either SocketError (UDPAddrInfo, ByteLength))
+recvFromBuf sock (BPtr ptr) bl = do
+  recv_ptr <- mkForeign (FFun "idrnet_recvfrom_buf" [FInt, FPtr, FInt] FPtr) (descriptor sock) ptr bl
+  let recv_ptr' = RFPtr recv_ptr
+  if !(nullPtr recv_ptr) then -- ! notation = monadic bind shortcut, not "not"
+    map Left getErrno
+  else do
+    result <- mkForeign (FFun "idrnet_get_recvfrom_res" [FPtr] FInt) recv_ptr
+    if result == -1 then do
+      freeRecvfromStruct recv_ptr'
+      map Left getErrno
+    else do
+      port <- foreignGetRecvfromPort recv_ptr'
+      addr <- foreignGetRecvfromAddr recv_ptr'
+      freeRecvfromStruct recv_ptr'
+      return $ Right (MkUDPAddrInfo addr port, result + 1)
+
+  
 
diff --git a/libs/base/System.idr b/libs/base/System.idr
--- a/libs/base/System.idr
+++ b/libs/base/System.idr
@@ -80,3 +80,6 @@
 usleep : Int -> IO ()
 usleep i = mkForeign (FFun "usleep" [FInt] FUnit) i
 
+system : String -> IO Int
+system cmd = mkForeign (FFun "system" [FString] FInt) cmd
+
diff --git a/libs/effects/Effect/Exception.idr b/libs/effects/Effect/Exception.idr
--- a/libs/effects/Effect/Exception.idr
+++ b/libs/effects/Effect/Exception.idr
@@ -26,7 +26,7 @@
 EXCEPTION : Type -> EFFECT
 EXCEPTION t = MkEff () (Exception t)
 
-raise : a -> { [EXCEPTION a ] } Eff m b 
+raise : a -> { [EXCEPTION a ] } Eff b 
 raise err = call $ Raise err
 
 
diff --git a/libs/effects/Effect/File.idr b/libs/effects/Effect/File.idr
--- a/libs/effects/Effect/File.idr
+++ b/libs/effects/Effect/File.idr
@@ -105,24 +105,24 @@
        -> (m : Mode)
        -> { [FILE_IO ()] ==> [FILE_IO (if result
                                           then OpenFile m
-                                          else ())] } Eff e Bool
+                                          else ())] } Eff Bool
 open f m = call $ Open f m
 
 
 ||| Close a file.
-close : { [FILE_IO (OpenFile m)] ==> [FILE_IO ()] } Eff e ()
+close : { [FILE_IO (OpenFile m)] ==> [FILE_IO ()] } Eff ()
 close = call $ Close
 
 ||| Read a line from the file.
-readLine : { [FILE_IO (OpenFile Read)] } Eff e String 
+readLine : { [FILE_IO (OpenFile Read)] } Eff String 
 readLine = call $ ReadLine
 
 ||| Write a line to a file.
-writeLine : String -> { [FILE_IO (OpenFile Write)] } Eff e ()
+writeLine : String -> { [FILE_IO (OpenFile Write)] } Eff ()
 writeLine str = call $ WriteLine str
 
 ||| End of file?
-eof : { [FILE_IO (OpenFile Read)] } Eff e Bool 
+eof : { [FILE_IO (OpenFile Read)] } Eff Bool 
 eof = call $ EOF
 
 -- --------------------------------------------------------------------- [ EOF ]
diff --git a/libs/effects/Effect/Memory.idr b/libs/effects/Effect/Memory.idr
--- a/libs/effects/Effect/Memory.idr
+++ b/libs/effects/Effect/Memory.idr
@@ -101,7 +101,7 @@
 RAW_MEMORY t = MkEff t RawMemory
 
 allocate : (n : Nat) -> 
-           Eff m () [RAW_MEMORY ()] (\v => [RAW_MEMORY (MemoryChunk n 0)])
+           Eff () [RAW_MEMORY ()] (\v => [RAW_MEMORY (MemoryChunk n 0)])
 allocate size = call $ Allocate size
 
 initialize : {i : Nat} ->
@@ -109,18 +109,18 @@
              Bits8 ->
              (size : Nat) ->
              so (i + size <= n) ->
-             Eff m () [RAW_MEMORY (MemoryChunk n i)] 
+             Eff () [RAW_MEMORY (MemoryChunk n i)] 
                        (\v => [RAW_MEMORY (MemoryChunk n (i + size))])
 initialize c size prf = call $ Initialize c size prf
 
-free : Eff m () [RAW_MEMORY (MemoryChunk n i)] (\v => [RAW_MEMORY ()])
+free : Eff () [RAW_MEMORY (MemoryChunk n i)] (\v => [RAW_MEMORY ()])
 free = call Free
 
 peek : {i : Nat} ->
        (offset : Nat) ->
        (size : Nat) ->
        so (offset + size <= i) ->
-       { [RAW_MEMORY (MemoryChunk n i)] } Eff m (Vect size Bits8) 
+       { [RAW_MEMORY (MemoryChunk n i)] } Eff (Vect size Bits8) 
 peek offset size prf = call $ Peek offset size prf
 
 poke : {n : Nat} ->
@@ -128,12 +128,12 @@
        (offset : Nat) ->
        Vect size Bits8 ->
        so (offset <= i && offset + size <= n) ->
-       Eff m () [RAW_MEMORY (MemoryChunk n i)] 
+       Eff () [RAW_MEMORY (MemoryChunk n i)] 
               (\v => [RAW_MEMORY (MemoryChunk n (max i (offset + size)))])
 poke offset content prf = call $ Poke offset content prf
 
 private
-getRawPtr : { [RAW_MEMORY (MemoryChunk n i)] } Eff m (MemoryChunk n i) 
+getRawPtr : { [RAW_MEMORY (MemoryChunk n i)] } Eff (MemoryChunk n i) 
 getRawPtr = call $ GetRawPtr
 
 private
@@ -146,7 +146,7 @@
         (size : Nat) ->
         so (dst_offset <= dst_init && dst_offset + size <= dst_size) ->
         so (src_offset + size <= src_init) ->
-        Eff m () [RAW_MEMORY (MemoryChunk dst_size dst_init)]
+        Eff () [RAW_MEMORY (MemoryChunk dst_size dst_init)]
                (\v => [RAW_MEMORY (MemoryChunk dst_size (max dst_init (dst_offset + size)))])
 move' src_ptr dst_offset src_offset size dst_bounds src_bounds
   = call $ Move src_ptr dst_offset src_offset size dst_bounds src_bounds
@@ -162,7 +162,7 @@
        (size : Nat) ->
        so (dst_offset <= dst_init && dst_offset + size <= dst_size) ->
        so (src_offset + size <= src_init) ->
-       Eff m ()
+       Eff ()
               [ Dst ::: RAW_MEMORY (MemoryChunk dst_size dst_init)
               , Src ::: RAW_MEMORY (MemoryChunk src_size src_init)]
               (\v =>
diff --git a/libs/effects/Effect/Random.idr b/libs/effects/Effect/Random.idr
--- a/libs/effects/Effect/Random.idr
+++ b/libs/effects/Effect/Random.idr
@@ -17,14 +17,14 @@
 RND = MkEff Integer Random
 
 ||| Generates a random Integer in a given range
-rndInt : Integer -> Integer -> { [RND] } Eff m Integer
+rndInt : Integer -> Integer -> { [RND] } Eff Integer
 rndInt lower upper = do v <- call $ getRandom
                         return (v `prim__sremBigInt` (upper - lower) + lower)
 
 ||| Generate a random number in Fin (S `k`)
 ||| 
 ||| Note that rndFin k takes values 0, 1, ..., k.
-rndFin : (k : Nat) -> { [RND] } Eff m (Fin (S k))
+rndFin : (k : Nat) -> { [RND] } Eff (Fin (S k))
 rndFin k = do let v = assert_total $ !(call getRandom) `prim__sremBigInt` (cast (S k))
               return (toFin v)
  where toFin : Integer -> Fin (S k) 
@@ -33,15 +33,15 @@
                       Nothing => toFin (assert_smaller x (x - cast (S k)))
 
 ||| Select a random element from a vector
-rndSelect' : Vect (S k) a -> { [RND] } Eff IO a
+rndSelect' : Vect (S k) a -> { [RND] } Eff a
 rndSelect' {k} xs = return (Vect.index !(rndFin k)  xs)
 
 ||| Select a random element from a list, or Nothing if the list is empty
-rndSelect : List a -> { [RND] } Eff IO (Maybe a)
+rndSelect : List a -> { [RND] } Eff (Maybe a)
 rndSelect []      = return Nothing
 rndSelect (x::xs) = return (Just !(rndSelect' (x::(fromList xs))))
 
 ||| Sets the random seed
-srand : Integer -> { [RND] } Eff m ()
+srand : Integer -> { [RND] } Eff ()
 srand n = call $ setSeed n
 
diff --git a/libs/effects/Effect/Select.idr b/libs/effects/Effect/Select.idr
--- a/libs/effects/Effect/Select.idr
+++ b/libs/effects/Effect/Select.idr
@@ -18,6 +18,6 @@
 SELECT : EFFECT
 SELECT = MkEff () Selection
 
-select : List a -> { [SELECT] } Eff m a 
+select : List a -> { [SELECT] } Eff a 
 select xs = call $ Select xs
 
diff --git a/libs/effects/Effect/State.idr b/libs/effects/Effect/State.idr
--- a/libs/effects/Effect/State.idr
+++ b/libs/effects/Effect/State.idr
@@ -8,30 +8,30 @@
   Get :      { a }       State a
   Put : b -> { a ==> b } State () 
 
-using (m : Type -> Type)
-  instance Handler State m where
+-- using (m : Type -> Type)
+instance Handler State m where
      handle st Get     k = k st st
      handle st (Put n) k = k () n
 
 STATE : Type -> EFFECT
 STATE t = MkEff t State
 
-get : { [STATE x] } Eff m x
+get : { [STATE x] } Eff x
 get = call $ Get
 
-put : x -> { [STATE x] } Eff m () 
+put : x -> { [STATE x] } Eff () 
 put val = call $ Put val
 
-putM : y -> { [STATE x] ==> [STATE y] } Eff m () 
+putM : y -> { [STATE x] ==> [STATE y] } Eff () 
 putM val = call $ Put val
 
-update : (x -> x) -> { [STATE x] } Eff m () 
+update : (x -> x) -> { [STATE x] } Eff () 
 update f = put (f !get)
 
-updateM : (x -> y) -> { [STATE x] ==> [STATE y] } Eff m () 
+updateM : (x -> y) -> { [STATE x] ==> [STATE y] } Eff () 
 updateM f = putM (f !get)
 
-locally : x -> ({ [STATE x] } Eff m t) -> { [STATE y] } Eff m t 
+locally : x -> ({ [STATE x] } Eff t) -> { [STATE y] } Eff t 
 locally newst prog = do st <- get
                         putM newst
                         val <- prog
diff --git a/libs/effects/Effect/StdIO.idr b/libs/effects/Effect/StdIO.idr
--- a/libs/effects/Effect/StdIO.idr
+++ b/libs/effects/Effect/StdIO.idr
@@ -39,22 +39,22 @@
 STDIO = MkEff () StdIO
 
 ||| Write a string to standard output.
-putStr : String -> { [STDIO] } Eff e ()
+putStr : String -> { [STDIO] } Eff ()
 putStr s = call $ PutStr s
 
 ||| Write a character to standard output.
-putChar : Char -> { [STDIO] } Eff e ()
+putChar : Char -> { [STDIO] } Eff ()
 putChar c = call $ PutCh c
 
 ||| Write a string to standard output, terminating with a newline.
-putStrLn : String -> { [STDIO] } Eff e ()
+putStrLn : String -> { [STDIO] } Eff ()
 putStrLn s = putStr (s ++ "\n")
 
 ||| Read a string from standard input.
-getStr : { [STDIO] } Eff e String
+getStr : { [STDIO] } Eff String
 getStr = call $ GetStr
 
 ||| Read a character from standard input.
-getChar : { [STDIO] } Eff e Char
+getChar : { [STDIO] } Eff Char
 getChar = call $ GetCh
 
diff --git a/libs/effects/Effect/System.idr b/libs/effects/Effect/System.idr
--- a/libs/effects/Effect/System.idr
+++ b/libs/effects/Effect/System.idr
@@ -11,28 +11,33 @@
      Args : { () } System (List String)
      Time : { () } System Int
      GetEnv : String -> { () } System (Maybe String)
+     CSystem : String -> { () } System Int
 
 instance Handler System IO where
     handle () Args k = do x <- getArgs; k x ()
     handle () Time k = do x <- time; k x ()
     handle () (GetEnv s) k = do x <- getEnv s; k x ()
+    handle () (CSystem s) k = do x <- system s; k x ()
 
 instance Handler System (IOExcept a) where
     handle () Args k = do x <- ioe_lift getArgs; k x ()
     handle () Time k = do x <- ioe_lift time; k x ()
     handle () (GetEnv s) k = do x <- ioe_lift $ getEnv s; k x ()
+    handle () (CSystem s) k = do x <- ioe_lift $ system s; k x ()
 
 --- The Effect and associated functions
 
 SYSTEM : EFFECT
 SYSTEM = MkEff () System
 
-getArgs : Handler System e => { [SYSTEM] } Eff e (List String)
+getArgs : { [SYSTEM] } Eff (List String)
 getArgs = call Args
 
-time : Handler System e => { [SYSTEM] } Eff e Int
+time : { [SYSTEM] } Eff Int
 time = call Time
 
-getEnv : Handler System e => String -> { [SYSTEM] } Eff e (Maybe String)
+getEnv : String -> { [SYSTEM] } Eff (Maybe String)
 getEnv s = call $ GetEnv s
 
+system : String -> { [SYSTEM] } Eff Int
+system s = call $ CSystem s
diff --git a/libs/effects/Effects.idr b/libs/effects/Effects.idr
--- a/libs/effects/Effects.idr
+++ b/libs/effects/Effects.idr
@@ -10,7 +10,7 @@
 %access public
 -- ----------------------------------------------------------------- [ Effects ]
 ||| The Effect type describes effectful computations.
-||| 
+|||
 ||| This type is parameterised by:
 ||| + The input resource.
 ||| + The return type of the computation.
@@ -28,11 +28,11 @@
 ||| underlying computation context `m` for execution.
 class Handler (e : Effect) (m : Type -> Type) where
   ||| How to handle the effect.
-  ||| 
+  |||
   ||| @ r The resource being handled.
   ||| @ eff The effect to be applied.
   ||| @ k The continuation to pass the result of the effect
-  covering handle : (r : res) -> (eff : e t res resk) -> 
+  covering handle : (r : res) -> (eff : e t res resk) ->
                     (k : ((x : t) -> resk x -> m a)) -> m a
 
 ||| Get the resource type (handy at the REPL to find out about an effect)
@@ -48,28 +48,27 @@
 syntax "{" [inst] "}" [eff] = eff inst (\result => inst)
 
 -- The state transition is dependent on a result `b`, a bound variable.
-syntax "{" [inst] "==>" "{" {b} "}" [outst] "}" [eff] 
+syntax "{" [inst] "==>" "{" {b} "}" [outst] "}" [eff]
        = eff inst (\b => outst)
 
 --- A simple state transition
 syntax "{" [inst] "==>" [outst] "}" [eff] = eff inst (\result => outst)
 
 -- --------------------------------------- [ Properties and Proof Construction ]
-using (xs : List a, ys : List a)
-  data SubList : List a -> List a -> Type where
-       SubNil : SubList {a} [] []
-       Keep   : SubList xs ys -> SubList (x :: xs) (x :: ys)
-       Drop   : SubList xs ys -> SubList xs (x :: ys)
+data SubList : List a -> List a -> Type where
+     SubNil : SubList [] []
+     Keep   : SubList xs ys -> SubList (x :: xs) (x :: ys)
+     Drop   : SubList xs ys -> SubList xs (x :: ys)
 
-  subListId : SubList xs xs
-  subListId {xs = Nil} = SubNil
-  subListId {xs = x :: xs} = Keep subListId
+subListId : SubList xs xs
+subListId {xs = Nil} = SubNil
+subListId {xs = x :: xs} = Keep subListId
 
 namespace Env
   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 : Effect -> Type ->
                List EFFECT -> Type where
      Here : EffElem x a (MkEff a x :: xs)
@@ -129,71 +128,62 @@
 relabel {xs = (MkEff a e :: xs)} l (v :: vs) = (l := v) :: relabel l vs
 
 -- ------------------------------------------------- [ The Language of Effects ]
-||| Definition of an Effect.
-||| 
-||| @ m The computation context
+||| Definition of a language of effectful programs.
+|||
 ||| @ x The return type of the result.
 ||| @ es The list of allowed side-effects.
 ||| @ ce Function to compute a new list of allowed side-effects.
-data Eff : (m : Type -> Type)
-           -> (x : Type)
+data Eff : (x : Type)
            -> (es : List EFFECT)
            -> (ce : x -> List EFFECT) -> Type where
-     value    : a -> Eff m a xs (\v => xs)
-     with_val : (val : a) -> Eff m () xs (\v => xs' val) ->
-                Eff m a xs xs'
-     ebind    : Eff m a xs xs' -> 
-                ((val : a) -> Eff m b (xs' val) xs'') -> Eff m b xs xs''
+     value    : a -> Eff a xs (\v => xs)
+     with_val : (val : a) -> Eff () xs (\v => xs' val) ->
+                Eff a xs xs'
+     ebind    : Eff a xs xs' ->
+                ((val : a) -> Eff b (xs' val) xs'') -> Eff b xs xs''
      callP    : (prf : EffElem e a xs) ->
                 (eff : e t a b) ->
-                Eff m t xs (\v => updateResTy v xs prf eff)
+                Eff t xs (\v => updateResTy v xs prf eff)
 
      liftP    : (prf : SubList ys xs) ->
-                Eff m t ys ys' -> Eff m t xs (\v => updateWith (ys' v) xs prf)
-     newInit  : Handler e m =>
-                res -> 
-                Eff m a (MkEff res e :: xs) (\v => (MkEff res' e :: xs')) ->
-                Eff m a xs (\v => xs')
-     catch    : Catchable m err =>
-                Eff m a xs xs' -> (err -> Eff m a xs xs') ->
-                Eff m a xs xs'
+                Eff t ys ys' -> Eff t xs (\v => updateWith (ys' v) xs prf)
 
-     (:-)     : (l : ty) -> 
-                Eff m t [x] xs' -> -- [x] (\v => xs) -> 
-                Eff m t [l ::: x] (\v => map (l :::) (xs' v))
+     (:-)     : (l : ty) ->
+                Eff t [x] xs' -> -- [x] (\v => xs) ->
+                Eff t [l ::: x] (\v => map (l :::) (xs' v))
 
-(>>=)   : Eff m a xs xs' -> 
-          ((val : a) -> Eff m b (xs' val) xs'') -> Eff m b xs xs''
-(>>=) = ebind 
+(>>=)   : Eff a xs xs' ->
+          ((val : a) -> Eff b (xs' val) xs'') -> Eff b xs xs''
+(>>=) = ebind
 
 -- namespace SimpleBind
---   (>>=) : Eff m a xs (\v => xs) -> 
+--   (>>=) : Eff m a xs (\v => xs) ->
 --           ((val : a) -> Eff m b xs xs') -> Eff m b xs xs'
---   (>>=) = ebind 
+--   (>>=) = ebind
 
 ||| Run a subprogram which results in an effect state the same as the input.
-staticEff : Eff m a xs (\v => xs) -> Eff m a xs (\v => xs)
+staticEff : Eff a xs (\v => xs) -> Eff a xs (\v => xs)
 staticEff = id
 
 ||| Explicitly give the expected set of result effects for an effectful
 ||| operation.
-toEff : .(xs' : List EFFECT) -> Eff m a xs (\v => xs') -> Eff m a xs (\v => xs')
+toEff : .(xs' : List EFFECT) -> Eff a xs (\v => xs') -> Eff a xs (\v => xs')
 toEff xs' = id
 
-return : a -> Eff m a xs (\v => xs)
+return : a -> Eff a xs (\v => xs)
 return x = value x
 
 -- ------------------------------------------------------ [ for idiom brackets ]
 
 infixl 2 <$>
 
-pure : a -> Eff m a xs (\v => xs)
+pure : a -> Eff a xs (\v => xs)
 pure = value
 
 syntax pureM [val] = with_val val (pure ())
 
-(<$>) : Eff m (a -> b) xs (\v => xs) -> 
-        Eff m a xs (\v => xs) -> Eff m b xs (\v => xs)
+(<$>) : Eff (a -> b) xs (\v => xs) ->
+        Eff a xs (\v => xs) -> Eff b xs (\v => xs)
 (<$>) prog v = do fn <- prog
                   arg <- v
                   return (fn arg)
@@ -213,20 +203,15 @@
 -- Q: Instead of m b, implement as StateT (Env m xs') m b, so that state
 -- updates can be propagated even through failing computations?
 
-eff : Env m xs -> Eff m a xs xs' -> ((x : a) -> Env m (xs' x) -> m b) -> m b
+eff : Env m xs -> Eff a xs xs' -> ((x : a) -> Env m (xs' x) -> m b) -> m b
 eff env (value x) k = k x env
-eff env (with_val x prog) k = eff env prog (\p', env' => k x env') 
+eff env (with_val x prog) k = eff env prog (\p', env' => k x env')
 eff env (prog `ebind` c) k
    = eff env prog (\p', env' => eff env' (c p') k)
 eff env (callP prf effP) k = execEff env prf effP k
 eff env (liftP prf effP) k
    = let env' = dropEnv env prf in
          eff env' effP (\p', envk => k p' (rebuildEnv envk prf env))
-eff env (newInit r prog) k
-   = eff (r :: env) prog (\p' => \ (v :: envk) => k p' envk)
-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
@@ -251,61 +236,78 @@
        (eff : e t a b) ->
        {default tactics { search 100; }
           prf : EffElem e a xs} ->
-      Eff m t xs (\v => updateResTy v xs prf eff)
+      Eff t xs (\v => updateResTy v xs prf eff)
 call e {prf} = callP prf e
 
 implicit
-lift : Eff m t ys ys' ->
+lift : Eff t ys ys' ->
        {default tactics { search 100; }
           prf : SubList ys xs} ->
-       Eff m t xs (\v => updateWith (ys' v) xs prf)
+       Eff t xs (\v => updateWith (ys' v) xs prf)
 lift e {prf} = liftP prf e
 
 
-new : Handler e m =>
-      {default default r : res} -> 
-      Eff m a (MkEff res e :: xs) (\v => (MkEff res' e :: xs')) ->
-      Eff m a xs (\v => xs')
-new {r} e = newInit r e
-
 -- --------------------------------------------------------- [ Running Effects ]
-
-||| Run an effectful program
-run : Applicative m => {default MkDefaultEnv env : Env m xs} -> Eff m a xs xs' -> m a
+||| Run an effectful program.
+|||
+||| The content (`m`) in which to run the program is taken from the
+||| environment in which the program is called. The `env` argument is
+||| implicit and initialised automatically.
+|||
+||| @prog The effectful program to run.
+run : Applicative m => {default MkDefaultEnv env : Env m xs}
+    -> (prog : Eff a xs xs') -> m a
 run {env} prog = eff env prog (\r, env => pure r)
 
-runPure : {default MkDefaultEnv env : Env id xs} -> Eff id a xs xs' -> a
+||| Run an effectful program in the identity context.
+|||
+||| A helper function useful for when the given context is 'pure'.
+||| The `env` argument is implicit and initialised automatically.
+|||
+||| @prog The effectful program to run.
+runPure : {default MkDefaultEnv env : Env id xs} -> (prog : Eff a xs xs') -> a
 runPure {env} prog = eff env prog (\r, env => r)
 
-runInit : Applicative m => Env m xs -> Eff m a xs xs' -> m a
+||| Run an effectful program in a given context `m` with a default value for the environment.
+|||
+||| This is useful for when there is no default environment for the given context.
+|||
+||| @env The environment to use.
+||| @prog The effectful program to run.
+runInit : Applicative m => (env : Env m xs) -> (prog : Eff a xs xs') -> m a
 runInit env prog = eff env prog (\r, env => pure r)
 
-runPureInit : Env id xs -> Eff id a xs xs' -> a
+||| Run an effectful program with a given default value for the environment.
+|||
+||| A helper function useful for when the given context is 'pure' and there is no default environment.
+|||
+||| @env The environment to use.
+||| @prog The effectful program to run.
+runPureInit : (env : Env id xs) -> (prog : Eff a xs xs') -> a
 runPureInit env prog = eff env prog (\r, env => r)
 
-runWith : (a -> m a) -> Env m xs -> Eff m a xs xs' -> m a
+runWith : (a -> m a) -> Env m xs -> Eff a xs xs' -> m a
 runWith inj env prog = eff env prog (\r, env => inj r)
 
-runEnv : Applicative m => Env m xs -> Eff m a xs xs' -> 
+runEnv : Applicative m => Env m xs -> Eff a xs xs' ->
          m (x : a ** Env m (xs' x))
 runEnv env prog = eff env prog (\r, env => pure (r ** env))
 
 -- ----------------------------------------------- [ some higher order things ]
 
-mapE : Applicative m => (a -> {xs} Eff m b) -> List a -> {xs} Eff m (List b)
+mapE : (a -> {xs} Eff b) -> List a -> {xs} Eff (List b)
 mapE f []        = pure []
 mapE f (x :: xs) = [| f x :: mapE f xs |]
 
 
-mapVE : Applicative m => 
-          (a -> {xs} Eff m b) -> 
-          Vect n a -> 
-          {xs} Eff m (Vect n b)
+mapVE : (a -> {xs} Eff b) ->
+        Vect n a ->
+        {xs} Eff (Vect n b)
 mapVE f []        = pure []
 mapVE f (x :: xs) = [| f x :: mapVE f xs |]
 
 
-when : Applicative m => Bool -> Lazy ({xs} Eff m ()) -> {xs} Eff m ()
+when : Bool -> Lazy ({xs} Eff ()) -> {xs} Eff ()
 when True  e = Force e
 when False e = pure ()
 
diff --git a/libs/oldeffects/Effect/Exception.idr b/libs/oldeffects/Effect/Exception.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/Exception.idr
+++ /dev/null
@@ -1,40 +0,0 @@
-module Effect.Exception
-
-import Effects
-import System
-import Control.IOExcept
-
-data Exception : Type -> Type -> Type -> Type -> Type where
-     Raise : a -> Exception a () () b
-
-instance Handler (Exception a) Maybe where
-     handle _ (Raise e) k = Nothing
-
-instance Show a => Handler (Exception a) IO where
-     handle _ (Raise e) k = do print e
-                               believe_me (exit 1)
-
-instance Handler (Exception a) (IOExcept a) where
-     handle _ (Raise e) k = ioM (return (Left e))
-
-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
-raise err = Raise err
-
-
-
-
-
-
-
--- TODO: Catching exceptions mid program?
--- probably need to invoke a new interpreter
-
--- possibly add a 'handle' to the Eff language so that an alternative
--- handler can be introduced mid interpretation?
-
diff --git a/libs/oldeffects/Effect/File.idr b/libs/oldeffects/Effect/File.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/File.idr
+++ /dev/null
@@ -1,69 +0,0 @@
-module Effect.File
-
-import Effects
-import Control.IOExcept
-
-data OpenFile : Mode -> Type where
-     FH : File -> OpenFile m
-
-data FileIO : Effect where
-     Open  : String -> (m : Mode) -> FileIO () (Either () (OpenFile m)) Bool
-     Close :                         FileIO (OpenFile m) () ()
-
-     ReadLine  :           FileIO (OpenFile Read)  (OpenFile Read) String
-     WriteLine : String -> FileIO (OpenFile Write) (OpenFile Write) ()
-     EOF       :           FileIO (OpenFile Read)  (OpenFile Read) Bool
-
-
-instance Handler FileIO IO where
-    handle () (Open fname m) k = do h <- openFile fname m
-                                    valid <- validFile h
-                                    if valid then k (Right (FH h)) True
-                                             else k (Left ()) False
-    handle (FH h) Close      k = do closeFile h
-                                    k () ()
-    handle (FH h) ReadLine        k = do str <- fread h
-                                         k (FH h) str
-    handle (FH h) (WriteLine str) k = do fwrite h str
-                                         k (FH h) ()
-    handle (FH h) EOF             k = do e <- feof h
-                                         k (FH h) e
-
-instance Handler FileIO (IOExcept String) where
-    handle () (Open fname m) k
-       = do h <- ioe_lift (openFile fname m)
-            valid <- ioe_lift (validFile h)
-            if valid then k (Right (FH h)) True
-                     else k (Left ()) False
-    handle (FH h) Close           k = do ioe_lift (closeFile h); k () ()
-    handle (FH h) ReadLine        k = do str <- ioe_lift (fread h)
-                                         k (FH h) str
-    handle (FH h) (WriteLine str) k = do ioe_lift (fwrite h str)
-                                         k (FH h) ()
-    handle (FH h) EOF             k = do e <- ioe_lift (feof h)
-                                         k (FH h) e
-
-FILE_IO : Type -> EFFECT
-FILE_IO t = MkEff t FileIO
-
-open : Handler FileIO e =>
-       String -> (m : Mode) -> EffM e [FILE_IO ()]
-                                      [FILE_IO (Either () (OpenFile m))] Bool
-open f m = Open f m
-
-close : Handler FileIO e =>
-        EffM e [FILE_IO (OpenFile m)] [FILE_IO ()] ()
-close = Close
-
-readLine : Handler FileIO e => Eff e [FILE_IO (OpenFile Read)] String
-readLine = ReadLine
-
-writeLine : Handler FileIO e => String -> Eff e [FILE_IO (OpenFile Write)] ()
-writeLine str = WriteLine str
-
-eof : Handler FileIO e => Eff e [FILE_IO (OpenFile Read)] Bool
-eof = EOF
-
-
-
-
diff --git a/libs/oldeffects/Effect/Memory.idr b/libs/oldeffects/Effect/Memory.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/Memory.idr
+++ /dev/null
@@ -1,169 +0,0 @@
-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 size Bits8)
-     Poke       :  (offset : Nat) ->
-                  (Vect size Bits8) ->
-                  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) (fromInteger $ 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, FByte, FInt] FUnit)
-              ptr (fromInteger $ cast offset) c (fromInteger $ 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 (fromInteger $ cast dest_offset) (fromInteger $ cast src_offset) (fromInteger $ cast size)
-
-private
-do_peek : Ptr -> Nat -> (size : Nat) -> IO (Vect size Bits8)
-do_peek _   _       Z = return (Prelude.Vect.Nil)
-do_peek ptr offset (S n)
-  = do b <- mkForeign (FFun "idris_peek" [FPtr, FInt] FByte) ptr (fromInteger $ cast offset)
-       bs <- do_peek ptr (S offset) n
-       Prelude.Monad.return (Prelude.Vect.(::) b bs)
-
-private
-do_poke : Ptr -> Nat -> Vect size Bits8 -> IO ()
-do_poke _   _      []     = return ()
-do_poke ptr offset (b::bs)
-  = do mkForeign (FFun "idris_poke" [FPtr, FInt, FByte] FUnit) ptr (fromInteger $ 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 (CH ptr) (Initialize {i} c size _) k
-    = ioe_lift (do_memset ptr i 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 size Bits8)
-peek offset size prf = Peek offset size prf
-
-poke : {n : Nat} ->
-       {i : Nat} ->
-       (offset : Nat) ->
-       Vect size Bits8 ->
-       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/libs/oldeffects/Effect/Monad.idr b/libs/oldeffects/Effect/Monad.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/Monad.idr
+++ /dev/null
@@ -1,21 +0,0 @@
-module Effect.Monad
-
-import Effects
-
--- Eff is a monad too, so we can happily use it in a monad transformer.
-
-using (xs : List EFFECT, m : Type -> Type)
-  instance Functor (EffM m xs xs) where
-    map f prog = do t <- prog
-                    value (f t)
-
-  instance Applicative (EffM m xs xs) where
-    pure = value
-    (<$>) f a = do f' <- f
-                   a' <- a
-                   value (f' a')
-
-  instance Monad (EffM m xs xs) where
-    (>>=) = ebind
-
-
diff --git a/libs/oldeffects/Effect/Random.idr b/libs/oldeffects/Effect/Random.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/Random.idr
+++ /dev/null
@@ -1,25 +0,0 @@
-module Effect.Random
-
-import Effects
-
-data Random : Type -> Type -> Type -> Type where
-     getRandom : Random Integer Integer Integer
-     setSeed   : Integer -> Random Integer Integer ()
-
-using (m : Type -> Type)
-  instance Handler Random m where
-     handle seed getRandom k
-              = let seed' = (1664525 * seed + 1013904223) `prim__sremBigInt` (pow 2 32) in
-                    k seed' seed'
-     handle seed (setSeed n) k = k n ()
-
-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)
-
-srand : Integer -> Eff m [RND] ()
-srand n = setSeed n
-
diff --git a/libs/oldeffects/Effect/Select.idr b/libs/oldeffects/Effect/Select.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/Select.idr
+++ /dev/null
@@ -1,23 +0,0 @@
-module Effect.Select
-
-import Effects
-
-data Selection : Effect where
-     Select : List a -> Selection () () a
-
-instance Handler Selection Maybe where
-     handle _ (Select xs) k = tryAll xs where
-         tryAll [] = Nothing
-         tryAll (x :: xs) = case k () x of
-                                 Nothing => tryAll xs
-                                 Just v => Just v
-
-instance Handler Selection List where
-     handle r (Select xs) k = concatMap (k r) xs
-
-SELECT : EFFECT
-SELECT = MkEff () Selection
-
-select : List a -> Eff m [SELECT] a
-select xs = Select xs
-
diff --git a/libs/oldeffects/Effect/State.idr b/libs/oldeffects/Effect/State.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/State.idr
+++ /dev/null
@@ -1,40 +0,0 @@
-module Effect.State
-
-import Effects
-
-%access public
-
-data State : Effect where
-     Get :      State a a a
-     Put : b -> State a b ()
-
-using (m : Type -> Type)
-  instance Handler State m where
-     handle st Get     k = k st st
-     handle st (Put n) k = k n ()
-
-STATE : Type -> EFFECT
-STATE t = MkEff t State
-
-get : Eff m [STATE x] x
-get = Get
-
-put : x -> Eff m [STATE x] ()
-put val = Put val
-
-putM : y -> EffM m [STATE x] [STATE y] ()
-putM val = Put val
-
-update : (x -> x) -> Eff m [STATE x] ()
-update f = put (f !get)
-
-updateM : (x -> y) -> EffM m [STATE x] [STATE y] ()
-updateM f = putM (f !get)
-
-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/libs/oldeffects/Effect/StdIO.idr b/libs/oldeffects/Effect/StdIO.idr
deleted file mode 100644
--- a/libs/oldeffects/Effect/StdIO.idr
+++ /dev/null
@@ -1,60 +0,0 @@
-module Effect.StdIO
-
-import Effects
-import Control.IOExcept
-
-data StdIO : Effect where
-     PutStr : String -> StdIO () () ()
-     GetStr : StdIO () () String
-
-instance Handler StdIO IO where
-    handle () (PutStr s) k = do putStr s; k () ()
-    handle () GetStr     k = do x <- getLine; k () x
-
-instance Handler StdIO (IOExcept a) where
-    handle () (PutStr s) k = do ioe_lift (putStr s); k () ()
-    handle () GetStr     k = do x <- ioe_lift getLine; k () x
-
--- Handle effects in a pure way, for simulating IO for unit testing/proof
-
-data IOStream a = MkStream (List String -> (a, List String))
-
-instance Handler StdIO IOStream where
-    handle () (PutStr s) k
-       = MkStream (\x => case k () () of
-                         MkStream f => let (res, str) = f x in
-                                           (res, s :: str))
-    handle {a} () GetStr k
-       = MkStream (\x => case x of
-                              [] => cont "" []
-                              (t :: ts) => cont t ts)
-        where
-            cont : String -> List String -> (a, List String)
-            cont t ts = case k () t of
-                             MkStream f => f ts
-
---- The Effect and associated functions
-
-STDIO : EFFECT
-STDIO = MkEff () StdIO
-
-putStr : Handler StdIO e => String -> Eff e [STDIO] ()
-putStr s = PutStr s
-
-putStrLn : Handler StdIO e => String -> Eff e [STDIO] ()
-putStrLn s = putStr (s ++ "\n")
-
-getStr : Handler StdIO e => Eff e [STDIO] String
-getStr = GetStr
-
-mkStrFn : Env IOStream xs ->
-          Eff IOStream xs a ->
-          List String -> (a, List String)
-mkStrFn {a} env p input = case mkStrFn' of
-                               MkStream f => f input
-  where injStream : a -> IOStream a
-        injStream v = MkStream (\x => (v, []))
-        mkStrFn' : IOStream a
-        mkStrFn' = runWith injStream env p
-
-
diff --git a/libs/oldeffects/Effects.idr b/libs/oldeffects/Effects.idr
deleted file mode 100644
--- a/libs/oldeffects/Effects.idr
+++ /dev/null
@@ -1,308 +0,0 @@
-module Effects
-
-import Language.Reflection
-import Control.Catchable
-
-%access public
-
----- Effects
-
-Effect : Type
-Effect = Type -> Type -> Type -> Type
-
-%error_reverse
-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
-
----- Properties and proof construction
-
-using (xs : List a, ys : List a)
-  data SubList : List a -> List a -> Type where
-       SubNil : SubList {a} [] []
-       Keep   : SubList xs ys -> SubList (x :: xs) (x :: ys)
-       Drop   : SubList xs ys -> SubList xs (x :: ys)
-
-  subListId : SubList xs xs
-  subListId {xs = Nil} = SubNil
-  subListId {xs = x :: xs} = Keep subListId
-
-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 EFFECT -> Type where
-     Here : EffElem x a (MkEff a x :: xs)
-     There : EffElem x a xs -> EffElem x a (y :: xs)
-
--- make an environment corresponding to a sub-list
-dropEnv : Env m ys -> SubList xs ys -> Env m xs
-dropEnv [] SubNil = []
-dropEnv (v :: vs) (Keep rest) = v :: dropEnv vs rest
-dropEnv (v :: vs) (Drop rest) = dropEnv vs rest
-
-updateWith : (ys' : List a) -> (xs : List a) ->
-             SubList ys xs -> List a
-updateWith (y :: ys) (x :: xs) (Keep rest) = y :: updateWith ys xs rest
-updateWith ys        (x :: xs) (Drop rest) = x :: updateWith ys xs rest
-updateWith []        []        SubNil      = []
-updateWith (y :: ys) []        SubNil      = y :: ys
-updateWith []        (x :: xs) (Keep rest) = []
-
--- put things back, replacing old with new in the sub-environment
-rebuildEnv : Env m ys' -> (prf : SubList ys xs) ->
-             Env m xs -> Env m (updateWith ys' xs prf)
-rebuildEnv []        SubNil      env = env
-rebuildEnv (x :: xs) (Keep rest) (y :: env) = x :: rebuildEnv xs rest env
-rebuildEnv xs        (Drop rest) (y :: env) = y :: rebuildEnv xs rest env
-rebuildEnv (x :: xs) SubNil      [] = x :: xs
-
----- The Effect EDSL itself ----
-
--- some proof automation
-
-%reflection
-reflectListEffElem : List a -> Tactic
-reflectListEffElem [] = Refine "Here" `Seq` Solve
-reflectListEffElem (x :: xs)
-     = Try (Refine "Here" `Seq` Solve)
-           (Refine "There" `Seq` (Solve `Seq` reflectListEffElem xs))
--- TMP HACK! FIXME!
--- The evaluator needs a 'function case' to know its a reflection function
--- until we propagate that information! Without this, the _ case won't get
--- matched. 
-reflectListEffElem (x ++ y) = Refine "Here" `Seq` Solve
-reflectListEffElem _ = Refine "Here" `Seq` Solve
-
-%reflection
-reflectSubList : List a -> Tactic
-reflectSubList [] = Refine "SubNil" `Seq` Solve
-reflectSubList (x :: xs)
-     = Try (Refine "subListId" `Seq` Solve)
-           (Try (Refine "Keep" `Seq` (Solve `Seq` reflectSubList xs))
-                (Refine "Drop" `Seq` (Solve `Seq` reflectSubList xs)))
-reflectSubList (x ++ y) = Refine "subListId" `Seq` Solve
-reflectSubList _ = Refine "subListId" `Seq` Solve
-
-%reflection
-reflectEff : (P : Type) -> Tactic
-reflectEff (EffElem m a xs)
-     = reflectListEffElem xs `Seq` Solve
-reflectEff (SubList xs ys)
-     = reflectSubList ys `Seq` Solve
-
-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
-
-updateResTyImm : (xs : List EFFECT) -> EffElem e a xs -> Type ->
-                 List EFFECT
-updateResTyImm (MkEff a e :: xs) Here b = (MkEff b e) :: xs
-updateResTyImm (x :: xs)    (There p) b = x :: updateResTyImm xs p b
-
-infix 5 :::, :-, :=
-
-data LRes : lbl -> Type -> Type where
-     (:=) : (x : lbl) -> res -> LRes x res
-
-(:::) : lbl -> EFFECT -> EFFECT
-(:::) {lbl} x (MkEff r eff) = MkEff (LRes x r) eff
-
-private
-unlabel : {l : ty} -> Env m [l ::: x] -> Env m [x]
-unlabel {m} {x = MkEff a eff} [l := v] = [v]
-
-private
-relabel : (l : ty) -> Env m [x] -> Env m [l ::: x]
-relabel {x = MkEff a eff} l [v] = [l := v]
-
--- the language of Effects
-
-data EffM : (m : Type -> Type) ->
-            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  : (prf : EffElem e a xs) ->
-               (eff : e a b t) ->
-               EffM m xs (updateResTy xs prf eff) t
-     lift    : (prf : SubList ys xs) ->
-               EffM m ys ys' t -> EffM m xs (updateWith ys' xs prf) t
-     new     : Handler e m =>
-               res -> EffM m (MkEff res e :: xs) (MkEff res' e :: xs') a ->
-               EffM m xs xs' a
-     test    : (prf : EffElem e (Either l r) xs) ->
-               EffM m (updateResTyImm xs prf l) xs' t ->
-               EffM m (updateResTyImm xs prf r) xs' t ->
-               EffM m xs xs' t
-     test_lbl : {x : lbl} ->
-                (prf : EffElem e (LRes x (Either l r)) xs) ->
-                EffM m (updateResTyImm xs prf (LRes x l)) xs' t ->
-                EffM m (updateResTyImm xs prf (LRes x r)) xs' t ->
-                EffM m xs xs' t
-     catch   : Catchable m err =>
-               EffM m xs xs' a -> (err -> EffM m xs xs' a) ->
-               EffM m xs xs' a
-     (:-)    : (l : ty) -> EffM m [x] [y] t -> EffM m [l ::: x] [l ::: y] t
-
-syntax [tag] ":!" [val] = !(tag :- val)
-
---   Eff : List (EFFECT m) -> Type -> Type
-
--- For making proofs implicitly for 'test' and 'test_lbl'
-
-syntax if_valid then [e] else [t] =
-  test (tactics { byReflection reflectEff; }) t e
-
-syntax if_valid [lbl] then [e] else [t] =
-  test_lbl {x=lbl} (tactics { byReflection reflectEff; }) t e
-
-syntax if_error then [t] else [e] =
-  test (tactics { byReflection reflectEff; }) t e
-
-syntax if_error [lbl] then [t] else [e] =
-  test_lbl {x=lbl} (tactics { byReflection reflectEff; }) t e
-
--- These may read better in some contexts
-
-syntax if_right then [e] else [t] =
-  test (tactics { byReflection reflectEff; }) t e
-
-syntax if_right [lbl] then [e] else [t] =
-  test_lbl {x=lbl} (tactics { byReflection reflectEff; }) t e
-
-syntax if_left then [t] else [e] =
-  test (tactics { byReflection reflectEff; }) t e
-
-syntax if_left [lbl] then [t] else [e] =
-  test_lbl {x=lbl} (tactics { byReflection reflectEff; }) t e
-
-
--- for 'do' notation
-
-return : a -> EffM m xs xs a
-return x = value x
-
-(>>=) : EffM m xs xs' a -> (a -> EffM m xs' xs'' b) -> EffM m xs xs'' b
-(>>=) = ebind
-
--- for idiom brackets
-
-infixl 2 <$>
-
-pure : a -> EffM m xs xs a
-pure = value
-
-(<$>) : EffM m xs xs (a -> b) -> EffM m xs xs a -> EffM m xs xs b
-(<$>) prog v = do fn <- prog
-                  arg <- v
-                  return (fn arg)
-
--- an interpreter
-
-private
-execEff : Env m xs -> (p : EffElem e res xs) ->
-          (eff : e res b a) ->
-          (Env m (updateResTy xs p eff) -> a -> m t) -> m t
-execEff (val :: env) Here eff' k
-    = handle val eff' (\res, v => k (res :: env) v)
-execEff {e} {res} {b} {a} (val :: env) (There p) eff k
-    = execEff {e} {res} {b} {a} env p eff (\env', v => k (val :: env') v)
-
-private
-testEff : Env m xs -> (p : EffElem e (Either l r) xs) ->
-          (Env m (updateResTyImm xs p l) -> m b) ->
-          (Env m (updateResTyImm xs p r) -> m b) ->
-          m b
-testEff (Left err :: env) Here lk rk = lk (err :: env)
-testEff (Right ok :: env) Here lk rk = rk (ok :: env)
-testEff (val :: env) (There p) lk rk
-   = testEff env p (\envk => lk (val :: envk))
-                   (\envk => rk (val :: envk))
-
-private
-testEffLbl : {x : lblTy} ->
-             Env m xs -> (p : EffElem e (LRes x (Either l r)) xs) ->
-             (Env m (updateResTyImm xs p (LRes x l)) -> m b) ->
-             (Env m (updateResTyImm xs p (LRes x r)) -> m b) ->
-             m b
-testEffLbl ((lbl := Left err) :: env) Here lk rk = lk ((lbl := err) :: env)
-testEffLbl ((lbl := Right ok) :: env) Here lk rk = rk ((lbl := ok) :: env)
-testEffLbl (val :: env) (There p) lk rk
-   = testEffLbl env p (\envk => lk (val :: envk))
-                      (\envk => rk (val :: envk))
-
--- Q: Instead of m b, implement as StateT (Env m xs') m b, so that state
--- updates can be propagated even through failing computations?
-
-eff : Env m xs -> EffM m xs xs' a -> (Env m xs' -> a -> m b) -> m b
-eff env (value x) k = k env x
-eff env (prog `ebind` c) k
-   = eff env prog (\env', p' => eff env' (c p') k)
-eff env (effect prf effP) k = execEff env prf effP k
-eff env (lift prf effP) k
-   = let env' = dropEnv env prf in
-         eff env' effP (\envk, p' => k (rebuildEnv envk prf env) p')
-eff env (new r prog) k
-   = eff (r :: env) prog (\(v :: envk), p' => k envk p')
-eff env (test prf l r) k
-   = testEff env prf (\envk => eff envk l k) (\envk => eff envk r k)
-eff env (test_lbl prf l r) k
-   = testEffLbl env prf (\envk => eff envk l k) (\envk => eff envk r k)
-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 env in
-         eff env' prog (\envk, p' => k (relabel l envk) p')
-
-implicit
-lift' : EffM m ys ys' t ->
-        {default tactics { byReflection reflectEff; }
-           prf : SubList ys xs} ->
-        EffM m xs (updateWith ys' xs prf) t
-lift' e {prf} = lift prf e
-
-implicit
-effect' : {a, b: _} -> {e : Effect} ->
-          (eff : e a b t) ->
-          {default tactics { byReflection reflectEff; }
-             prf : EffElem e a xs} ->
-         EffM m xs (updateResTy xs prf eff) t
-effect' e {prf} = effect prf e
-
-
-run : Applicative m => Env m xs -> EffM m xs xs' a -> m a
-run env prog = eff env prog (\env, r => pure r)
-
-runEnv : Applicative m => Env m xs -> EffM m xs xs' a -> m (Env m xs', a)
-runEnv env prog = eff env prog (\env, r => pure (env, r))
-
-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 EFFECT -> Type -> Type
-Eff m xs t = EffM m xs xs t
-
--- some higher order things
-
-mapE : Applicative m => (a -> Eff m xs b) -> List a -> Eff m xs (List b)
-mapE f []        = pure []
-mapE f (x :: xs) = [| f x :: mapE f xs |]
-
-when : Applicative m => Bool -> Lazy (Eff m xs ()) -> Eff m xs ()
-when True  e = e
-when False e = pure ()
diff --git a/libs/oldeffects/Makefile b/libs/oldeffects/Makefile
deleted file mode 100644
--- a/libs/oldeffects/Makefile
+++ /dev/null
@@ -1,14 +0,0 @@
-IDRIS     := idris
-
-build:
-	$(IDRIS) --build oldeffects.ipkg
-
-clean:
-	$(IDRIS) --clean oldeffects.ipkg
-
-install:
-	$(IDRIS) --install oldeffects.ipkg
-
-rebuild: clean build
-
-.PHONY: build clean install rebuild
diff --git a/libs/oldeffects/oldeffects.ipkg b/libs/oldeffects/oldeffects.ipkg
deleted file mode 100644
--- a/libs/oldeffects/oldeffects.ipkg
+++ /dev/null
@@ -1,8 +0,0 @@
-package oldeffects
-
-opts    = "--nobasepkgs -i ../prelude -i ../base"
-modules = Effects, 
-          Effect.Exception, Effect.File, Effect.State,
-          Effect.Random, Effect.StdIO, Effect.Select,
-          Effect.Memory, Effect.Monad
-
diff --git a/libs/prelude/Builtins.idr b/libs/prelude/Builtins.idr
--- a/libs/prelude/Builtins.idr
+++ b/libs/prelude/Builtins.idr
@@ -15,6 +15,14 @@
 ||| For 'symbol syntax. 'foo becomes Symbol_ "foo"
 data Symbol_ : String -> Type where
 
+-- Eq_ : a -> a -> Type
+-- Eq_ x y = (=) _ _ x y
+ 
+infix 5 ~=~
+
+(~=~) : a -> b -> Type
+(~=~) x y = (=) _ _ x y
+
 -- ------------------------------------------------------ [ For rewrite tactic ]
 ||| Perform substitution in a term according to some equality.
 |||
diff --git a/libs/prelude/Makefile b/libs/prelude/Makefile
--- a/libs/prelude/Makefile
+++ b/libs/prelude/Makefile
@@ -1,17 +1,24 @@
 IDRIS := idris
+PKG   := prelude
 
 build:
-	$(IDRIS) --build prelude.ipkg
+	$(IDRIS) --build ${PKG}.ipkg
 
 install: 
-	$(IDRIS) --install prelude.ipkg
+	$(IDRIS) --install ${PKG}.ipkg
 
 clean:
-	$(IDRIS) --clean prelude.ipkg
+	$(IDRIS) --clean ${PKG}.ipkg
 
 rebuild: clean build
 
 linecount:
 	find . -name '*.idr' | xargs wc -l
 
-.PHONY: build install clean rebuild linecount
+doc:
+	$(IDRIS) --mkdoc ${PKG}.ipkg
+
+doc_clean:
+	rm -rf ${PKG}_doc
+
+.PHONY: build install clean rebuild linecount doc
diff --git a/libs/prelude/Prelude/Algebra.idr b/libs/prelude/Prelude/Algebra.idr
--- a/libs/prelude/Prelude/Algebra.idr
+++ b/libs/prelude/Prelude/Algebra.idr
@@ -177,7 +177,7 @@
   total meetSemilatticeMeetIsIdempotent  : (e : a)       -> meet e e = e
 
 ||| Sets equipped with a binary operation that is commutative, associative and
-||| idempotent and supplied with a neutral element.  Must satisfy the following
+||| idempotent and supplied with a unitary element.  Must satisfy the following
 ||| laws:
 |||
 ||| + Associativity of join:
@@ -186,8 +186,8 @@
 |||     forall a b,   join a b          == join b a
 ||| + Idempotency of join:
 |||     forall a,     join a a          == a
-||| + Bottom:
-|||     forall a,     join a bottom     == bottom
+||| + Bottom (Unitary Element):
+|||     forall a,     join a bottom     == a
 |||
 |||  Join semilattices capture the notion of sets with a "least upper bound"
 |||  equipped with a "bottom" element.
@@ -195,10 +195,10 @@
   bottom  : a
 
 class (VerifiedJoinSemilattice a, BoundedJoinSemilattice a) => VerifiedBoundedJoinSemilattice a where
-  total boundedJoinSemilatticeBottomIsBottom : (e : a) -> join e bottom = bottom
+  total boundedJoinSemilatticeBottomIsBottom : (e : a) -> join e bottom = e
 
 ||| Sets equipped with a binary operation that is commutative, associative and
-||| idempotent and supplied with a neutral element.  Must satisfy the following
+||| idempotent and supplied with a unitary element.  Must satisfy the following
 ||| laws:
 |||
 ||| + Associativity of meet:
@@ -207,8 +207,8 @@
 |||     forall a b,   meet a b          == meet b a
 ||| + Idempotency of meet:
 |||     forall a,     meet a a          == a
-||| +  Top:
-|||     forall a,     meet a top        == top
+||| +  Top (Unitary Element):
+|||     forall a,     meet a top        == a
 |||
 ||| Meet semilattices capture the notion of sets with a "greatest lower bound"
 ||| equipped with a "top" element.
@@ -216,7 +216,7 @@
   top : a
 
 class (VerifiedMeetSemilattice a, BoundedMeetSemilattice a) => VerifiedBoundedMeetSemilattice a where
-  total boundedMeetSemilatticeTopIsTop : (e : a) -> meet e top = top
+  total boundedMeetSemilatticeTopIsTop : (e : a) -> meet e top = e
 
 ||| Sets equipped with two binary operations that are both commutative,
 ||| associative and idempotent, along with absorbtion laws for relating the two
diff --git a/libs/prelude/Prelude/Bool.idr b/libs/prelude/Prelude/Bool.idr
--- a/libs/prelude/Prelude/Bool.idr
+++ b/libs/prelude/Prelude/Bool.idr
@@ -5,7 +5,7 @@
 import Prelude.Uninhabited
 
 ||| Boolean Data Type
-data Bool = False | True
+%case data Bool = False | True
 
 ||| The underlying implementation of the if ... then ... else ... syntax
 ||| @ b the condition on the if
diff --git a/libs/prelude/Prelude/Classes.idr b/libs/prelude/Prelude/Classes.idr
--- a/libs/prelude/Prelude/Classes.idr
+++ b/libs/prelude/Prelude/Classes.idr
@@ -124,6 +124,13 @@
                   GT
 
 
+instance Ord Bool where
+    compare True True = EQ
+    compare False False = EQ
+    compare False True = LT
+    compare True False = GT
+
+
 instance (Ord a, Ord b) => Ord (a, b) where
   compare (xl, xr) (yl, yr) =
     if xl /= yl
diff --git a/libs/prelude/Prelude/List.idr b/libs/prelude/Prelude/List.idr
--- a/libs/prelude/Prelude/List.idr
+++ b/libs/prelude/Prelude/List.idr
@@ -557,6 +557,12 @@
   []        => []
   _ :: xs'  => tails xs'
 
+splitOn : Eq a => a -> List a -> List (List a)
+splitOn a = split (== a)
+
+replaceOn : Eq a => a -> a -> List a -> List a
+replaceOn a b l = map (\c => if c == a then b else c) l
+
 --------------------------------------------------------------------------------
 -- Predicates
 --------------------------------------------------------------------------------
@@ -578,6 +584,9 @@
 
 isSuffixOf : Eq a => List a -> List a -> Bool
 isSuffixOf = isSuffixOfBy (==)
+
+isInfixOf : Eq a => List a -> List a -> Bool
+isInfixOf n h = any (isPrefixOf n) (tails h)
 
 --------------------------------------------------------------------------------
 -- Sorting
diff --git a/libs/prelude/Prelude/Nat.idr b/libs/prelude/Prelude/Nat.idr
--- a/libs/prelude/Prelude/Nat.idr
+++ b/libs/prelude/Prelude/Nat.idr
@@ -110,6 +110,22 @@
 total GT : Nat -> Nat -> Type
 GT left right = LT right left
 
+||| A successor is never less than or equal zero
+succNotLTEzero : Not (S m `LTE` Z)
+succNotLTEzero lteZero impossible
+
+||| If two numbers are ordered, their predecessors are too
+fromLteSucc : (S m `LTE` S n) -> (m `LTE` n)
+fromLteSucc (lteSucc x) = x
+
+||| A decision procedure for `LTE`
+isLTE : (m, n : Nat) -> Dec (m `LTE` n)
+isLTE Z n = Yes lteZero
+isLTE (S k) Z = No succNotLTEzero
+isLTE (S k) (S j) with (isLTE k j)
+  isLTE (S k) (S j) | (Yes prf) = Yes (lteSucc prf)
+  isLTE (S k) (S j) | (No contra) = No (contra . fromLteSucc)
+
 ||| Boolean test than one Nat is less than or equal to another
 total lte : Nat -> Nat -> Bool
 lte Z        right     = True
@@ -130,19 +146,15 @@
 
 ||| Find the least of two natural numbers
 total minimum : Nat -> Nat -> Nat
-minimum left right =
-  if lte left right then
-    left
-  else
-    right
+minimum Z m = Z
+minimum (S n) Z = Z
+minimum (S n) (S m) = S (minimum n m)
 
 ||| Find the greatest of two natural numbers
 total maximum : Nat -> Nat -> Nat
-maximum left right =
-  if lte left right then
-    right
-  else
-    left
+maximum Z m = m
+maximum (S n) Z = S n
+maximum (S n) (S m) = S (maximum n m)
 
 --------------------------------------------------------------------------------
 -- Type class instances
@@ -312,7 +324,25 @@
 lcm Z _ = Z
 lcm x y = divNat (x * y) (gcd x y)
 
+
 --------------------------------------------------------------------------------
+-- An informative comparison view 
+--------------------------------------------------------------------------------
+data CmpNat : Nat -> Nat -> Type where
+     cmpLT : (y : _) -> CmpNat x (x + S y)
+     cmpEQ : CmpNat x x
+     cmpGT : (x : _) -> CmpNat (y + S x) y
+
+total cmp : (x, y : Nat) -> CmpNat x y
+cmp Z Z     = cmpEQ
+cmp Z (S k) = cmpLT _
+cmp (S k) Z = cmpGT _
+cmp (S x) (S y) with (cmp x y)
+  cmp (S x) (S (x + (S k))) | cmpLT k = cmpLT k
+  cmp (S x) (S x)           | cmpEQ   = cmpEQ
+  cmp (S (y + (S k))) (S y) | cmpGT k = cmpGT k
+
+--------------------------------------------------------------------------------
 -- Properties
 --------------------------------------------------------------------------------
 
@@ -601,8 +631,40 @@
 lteSuccZeroFalse (S n) = refl
 
 -- Minimum and maximum
+total maximumAssociative : (l,c,r : Nat) -> maximum l (maximum c r) = maximum (maximum l c) r
+maximumAssociative Z c r = refl
+maximumAssociative (S k) Z r = refl
+maximumAssociative (S k) (S j) Z = refl
+maximumAssociative (S k) (S j) (S i) = rewrite maximumAssociative k j i in refl
+
+total maximumCommutative : (l, r : Nat) -> maximum l r = maximum r l
+maximumCommutative Z Z = refl
+maximumCommutative Z (S k) = refl
+maximumCommutative (S k) Z = refl
+maximumCommutative (S k) (S j) = rewrite maximumCommutative k j in refl
+
+total maximumIdempotent : (n : Nat) -> maximum n n = n
+maximumIdempotent Z = refl
+maximumIdempotent (S k) = cong (maximumIdempotent k)
+
+total minimumAssociative : (l,c,r : Nat) -> minimum l (minimum c r) = minimum (minimum l c) r
+minimumAssociative Z c r = refl
+minimumAssociative (S k) Z r = refl
+minimumAssociative (S k) (S j) Z = refl
+minimumAssociative (S k) (S j) (S i) = rewrite minimumAssociative k j i in refl
+
+total minimumCommutative : (l, r : Nat) -> minimum l r = minimum r l
+minimumCommutative Z Z = refl
+minimumCommutative Z (S k) = refl
+minimumCommutative (S k) Z = refl
+minimumCommutative (S k) (S j) = rewrite minimumCommutative k j in refl
+
+total minimumIdempotent : (n : Nat) -> minimum n n = n
+minimumIdempotent Z = refl
+minimumIdempotent (S k) = cong (minimumIdempotent k)
+
 total minimumZeroZeroRight : (right : Nat) -> minimum 0 right = Z
-minimumZeroZeroRight Z         = refl
+minimumZeroZeroRight Z = refl
 minimumZeroZeroRight (S right) = minimumZeroZeroRight right
 
 total minimumZeroZeroLeft : (left : Nat) -> minimum left 0 = Z
@@ -618,15 +680,6 @@
   let inductiveHypothesis = minimumSuccSucc left right in
     ?minimumSuccSuccStepCase
 
-total minimumCommutative : (left : Nat) -> (right : Nat) ->
-  minimum left right = minimum right left
-minimumCommutative Z        Z         = refl
-minimumCommutative Z        (S right) = refl
-minimumCommutative (S left) Z         = refl
-minimumCommutative (S left) (S right) =
-  let inductiveHypothesis = minimumCommutative left right in
-    ?minimumCommutativeStepCase
-
 total maximumZeroNRight : (right : Nat) -> maximum Z right = right
 maximumZeroNRight Z         = refl
 maximumZeroNRight (S right) = refl
@@ -644,15 +697,22 @@
   let inductiveHypothesis = maximumSuccSucc left right in
     ?maximumSuccSuccStepCase
 
-total maximumCommutative : (left : Nat) -> (right : Nat) ->
-  maximum left right = maximum right left
-maximumCommutative Z        Z         = refl
-maximumCommutative (S left) Z         = refl
-maximumCommutative Z        (S right) = refl
-maximumCommutative (S left) (S right) =
-  let inductiveHypothesis = maximumCommutative left right in
-    ?maximumCommutativeStepCase
+total sucMaxL : (l : Nat) -> maximum (S l) l = (S l)
+sucMaxL Z = refl
+sucMaxL (S l) = cong (sucMaxL l)
 
+total sucMaxR : (l : Nat) -> maximum l (S l) = (S l)
+sucMaxR Z = refl
+sucMaxR (S l) = cong (sucMaxR l)
+
+total sucMinL : (l : Nat) -> minimum (S l) l = l
+sucMinL Z = refl
+sucMinL (S l) = cong (sucMinL l)
+
+total sucMinR : (l : Nat) -> minimum l (S l) = l
+sucMinR Z = refl
+sucMinR (S l) = cong (sucMinR l)
+
 -- div and mod
 total modZeroZero : (n : Nat) -> mod 0 n = Z
 modZeroZero Z     = refl
@@ -818,25 +878,9 @@
     trivial;
 }
 
-maximumCommutativeStepCase = proof {
-    intros;
-    rewrite (boolElimSuccSucc (lte left right) right left);
-    rewrite (boolElimSuccSucc (lte right left) left right);
-    rewrite inductiveHypothesis;
-    trivial;
-}
-
 maximumSuccSuccStepCase = proof {
     intros;
     rewrite sym (boolElimSuccSucc (lte left right) (S right) (S left));
-    trivial;
-}
-
-minimumCommutativeStepCase = proof {
-    intros;
-    rewrite (boolElimSuccSucc (lte left right) left right);
-    rewrite (boolElimSuccSucc (lte right left) right left);
-    rewrite inductiveHypothesis;
     trivial;
 }
 
diff --git a/libs/prelude/Prelude/Stream.idr b/libs/prelude/Prelude/Stream.idr
--- a/libs/prelude/Prelude/Stream.idr
+++ b/libs/prelude/Prelude/Stream.idr
@@ -72,6 +72,7 @@
 ||| Fold a Stream corecursively. Since there is no Nil, no initial value is used.
 ||| @ f the combining function
 ||| @ xs the Stream to fold up
+partial -- the recursive call isn't guarded!
 foldr : (f : a -> Inf b -> b) -> (xs : Stream a) -> b
 foldr f (x :: xs) = f x (foldr f xs)
 
@@ -85,9 +86,10 @@
 ||| Produce a Stream of (corecursive) right folds of tails of the given Stream
 ||| @ f the combining function
 ||| @ xs the Stream to fold up
--- Reusing the head of the corecursion in the obvious way doesn’t productivity check
+-- Reusing the head of the corecursion in the obvious way doesn't productivity check
+partial -- and the call to foldr isn't guarded anyway!
 scanr : (f : a -> Inf b -> b) -> (xs : Stream a) -> Stream b
-scanr f (x :: Delay xs) = f x (foldr f xs) :: scanr f xs
+scanr f (x :: xs) = f x (foldr f xs) :: scanr f xs
 
 ||| Produce a Stream repeating a sequence
 ||| @ xs the sequence to repeat
diff --git a/libs/prelude/Prelude/Strings.idr b/libs/prelude/Prelude/Strings.idr
--- a/libs/prelude/Prelude/Strings.idr
+++ b/libs/prelude/Prelude/Strings.idr
@@ -271,4 +271,16 @@
   strToLower ""             | StrNil = ""
   strToLower (strCons c cs) | (StrCons c cs) =
     strCons (toUpper c) (toUpper (assert_smaller (strCons c cs) cs ))
+   
+--------------------------------------------------------------------------------
+-- Predicates
+--------------------------------------------------------------------------------
 
+isPrefixOf : String -> String -> Bool
+isPrefixOf a b = isPrefixOf (unpack a) (unpack b)
+
+isSuffixOf : String -> String -> Bool
+isSuffixOf a b = isSuffixOf (unpack a) (unpack b)
+
+isInfixOf : String -> String -> Bool
+isInfixOf a b = isInfixOf (unpack a) (unpack b)
diff --git a/libs/prelude/Prelude/Vect.idr b/libs/prelude/Prelude/Vect.idr
--- a/libs/prelude/Prelude/Vect.idr
+++ b/libs/prelude/Prelude/Vect.idr
@@ -100,17 +100,15 @@
 
 ||| Get the first m elements of a Vect
 ||| @ m the number of elements to take
-take : {n : Nat} -> (m : Fin (S n)) -> Vect n a -> Vect (cast m) a
-take (fS k) []      = FinZElim k
-take fZ     _       = []
-take (fS k) (x::xs) = x :: take k xs
+take : (n : Nat) -> Vect (n + m) a -> Vect n a
+take Z xs = []
+take (S k) (x :: xs) = x :: take k xs
 
 ||| Remove the first m elements of a Vect
 ||| @ m the number of elements to remove
-drop : (m : Fin (S n)) -> Vect n a -> Vect (n - cast m) a
-drop (fS k) []      = FinZElim k
-drop fZ     xs      ?= xs
-drop (fS k) (x::xs) = drop k xs
+drop : (n : Nat) -> Vect (n + m) a -> Vect m a
+drop Z xs = xs
+drop (S k) (x :: xs) = drop k xs
 
 --------------------------------------------------------------------------------
 -- Transformations
@@ -407,7 +405,7 @@
 ||| It is equivalent to (take n xs, drop n xs)
 ||| @ m   the index to split at
 ||| @ xs  the Vect to split in two
-splitAt : {n : Nat} -> (m : Fin (S n)) -> (xs : Vect n a) -> (Vect (cast m) a, Vect (n - cast m) a)
+splitAt : (n : Nat) -> (xs : Vect (n + m) a) -> (Vect n a, Vect m a)
 splitAt n xs = (take n xs, drop n xs)
 
 --------------------------------------------------------------------------------
@@ -488,12 +486,6 @@
 --------------------------------------------------------------------------------
 -- Proofs
 --------------------------------------------------------------------------------
-
-Prelude.Vect.drop_lemma_1 = proof {
-  intros;
-  rewrite sym (minusZeroRight n);
-  trivial;
-}
 
 Prelude.Vect.reverse'_lemma_1 = proof {
     intros;
diff --git a/llvm/Makefile b/llvm/Makefile
--- a/llvm/Makefile
+++ b/llvm/Makefile
@@ -1,13 +1,14 @@
 include ../config.mk
 
-CFLAGS:=-Wextra -fPIC -Wno-unused-parameter $(CFLAGS)
+PKG_CONFIG_CFLAGS:=$(shell (pkg-config --version >/dev/null 2>&1) && pkg-config --cflags bdw-gc)
+CFLAGS:=-Wextra -fPIC -Wno-unused-parameter $(PKG_CONFIG_CFLAGS) $(CFLAGS)
 SOURCES=defs.c
 OBJECTS=$(SOURCES:.c=.o)
 LIB=libidris_rts.a
 
 build: $(SOURCES) $(LIB)
 
-$(LIB): $(OBJECTS) 
+$(LIB): $(OBJECTS)
 	ar r $@ $(OBJECTS)
 	ranlib $@
 
diff --git a/rts/idris_gc.c b/rts/idris_gc.c
--- a/rts/idris_gc.c
+++ b/rts/idris_gc.c
@@ -103,7 +103,14 @@
         free(vm->heap.old);
 
     vm->heap.heap = newheap;
-    vm->heap.next = newheap;
+#ifdef FORCE_ALIGNMENT
+    if (((i_int)(vm->heap.heap)&1) == 1) {
+        vm->heap.next = newheap + 1;
+    } else
+#endif
+    {
+        vm->heap.next = newheap;
+    }
     vm->heap.end  = newheap + vm->heap.size;
 
     VAL* root;
@@ -111,10 +118,12 @@
     for(root = vm->valstack; root < vm->valstack_top; ++root) {
         *root = copy(vm, *root);
     }
+
+#ifdef HAS_PTHREAD
     for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {
         *root = copy(vm, *root);
     }
-    
+#endif
     vm->ret = copy(vm, vm->ret);
     vm->reg1 = copy(vm, vm->reg1);
 
diff --git a/rts/idris_heap.c b/rts/idris_heap.c
--- a/rts/idris_heap.c
+++ b/rts/idris_heap.c
@@ -16,7 +16,14 @@
     }
 
     h->heap = mem;
-    h->next = h->heap;
+#ifdef FORCE_ALIGNMENT
+    if (((i_int)(h->heap)&1) == 1) {
+        h->next = h->heap + 1;
+    } else
+#endif
+    {
+        h->next = h->heap;
+    }
     h->end  = h->heap + heap_size;
 
     h->size   = heap_size;
diff --git a/rts/idris_net.c b/rts/idris_net.c
--- a/rts/idris_net.c
+++ b/rts/idris_net.c
@@ -1,6 +1,7 @@
 // C-Side of the Idris network library
 // (C) Simon Fowler, 2014
 // MIT Licensed. Have fun!
+#include "idris_net.h"
 #include <errno.h>
 #include <netdb.h>
 #include <stdbool.h>
@@ -12,8 +13,22 @@
 #include <netinet/in.h>
 #include <arpa/inet.h>
 
-#include "idris_net.h"
+void buf_htonl(void* buf, int len) {
+    int* buf_i = (int*) buf;
+    int i;
+    for (i = 0; i < (len / sizeof(int)) + 1; i++) {
+        buf_i[i] = htonl(buf_i[i]);
+    }
+}
 
+void buf_ntohl(void* buf, int len) {
+    int* buf_i = (int*) buf;
+    int i;
+    for (i = 0; i < (len / sizeof(int)) + 1; i++) {
+        buf_i[i] = ntohl(buf_i[i]);
+    }
+}
+
 void* idrnet_malloc(int size) {
     return malloc(size);
 }
@@ -22,9 +37,12 @@
     free(ptr);
 }
 
-int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port) {
+// We call this from quite a few functions. Given a textual host and an int port,
+// populates a struct addrinfo. 
+int idrnet_getaddrinfo(struct addrinfo** address_res, char* host, int port, 
+                       int family, int socket_type) {
+
     struct addrinfo hints;
-    struct addrinfo* address_res;
     // Convert port into string
     char str_port[8];
     sprintf(str_port, "%d", port);
@@ -38,43 +56,42 @@
     // then we want to instruct the C library to fill in the IP automatically
     if (strlen(host) == 0) {
         hints.ai_flags = AI_PASSIVE; // fill in IP automatically
-    }
+        return getaddrinfo(NULL, str_port, &hints, address_res);
+    } 
+    return getaddrinfo(host, str_port, &hints, address_res);
 
-    int addr_res = getaddrinfo(host, str_port, &hints, &address_res);
+}
+
+int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port) {
+    struct addrinfo* address_res;
+    int addr_res = idrnet_getaddrinfo(&address_res, host, port, family, socket_type);
     if (addr_res == -1) {
+        //printf("Lib err: bind getaddrinfo\n");
         return -1;
     }
 
     int bind_res = bind(sockfd, address_res->ai_addr, address_res->ai_addrlen);
     if (bind_res == -1) {
+        //freeaddrinfo(address_res);
+        //printf("Lib err: bind\n");
         return -1;
     } 
-
     return 0;
 }
 
 int idrnet_connect(int sockfd, int family, int socket_type, char* host, int port) {
-    char str_port[8];
-    sprintf(str_port, "%d", port);
-    struct addrinfo hints;
     struct addrinfo* remote_host;
-
-    // Set up hints structure for getaddrinfo
-    memset(&hints, 0, sizeof(hints));
-    hints.ai_family = family;
-    hints.ai_socktype = socket_type;
-
-    // Get info about the remote host (DNS lookup etc)
-    int addr_res = getaddrinfo(host, str_port, &hints, &remote_host);
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, socket_type);
     if (addr_res == -1) {
         return -1;
     }
 
     int connect_res = connect(sockfd, remote_host->ai_addr, remote_host->ai_addrlen);
     if (connect_res == -1) {
+        freeaddrinfo(remote_host);
         return -1;
     }
-
+    freeaddrinfo(remote_host);
     return 0;
 }
 
@@ -88,9 +105,15 @@
     struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
     char* ip_addr = (char*) malloc(sizeof(char) * INET_ADDRSTRLEN);
     inet_ntop(AF_INET, &(addr->sin_addr), ip_addr, INET_ADDRSTRLEN);
+    //printf("Lib: ip_addr: %s\n", ip_addr);
     return ip_addr;
 }
 
+int idrnet_sockaddr_ipv4_port(void* sockaddr) {
+    struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
+    return ((int) ntohs(addr->sin_port));  
+}
+
 void* idrnet_create_sockaddr() {
     return malloc(sizeof(struct sockaddr_storage));
 }
@@ -108,33 +131,43 @@
 }
 
 int idrnet_send_buf(int sockfd, void* data, int len) {
-    return send(sockfd, data, len, 0);
+    void* buf_cpy = malloc(len);
+    memset(buf_cpy, 0, len);
+    memcpy(buf_cpy, data, len);
+    buf_htonl(buf_cpy, len);
+    int res = send(sockfd, buf_cpy, len, 0);
+    free(buf_cpy);
+    return res;
 }
 
 void* idrnet_recv(int sockfd, int len) {
     idrnet_recv_result* res_struct = 
         (idrnet_recv_result*) malloc(sizeof(idrnet_recv_result));
-
     char* buf = malloc(len + 1);
+    memset(buf, 0, len + 1);
     int recv_res = recv(sockfd, buf, len, 0);
     res_struct->result = recv_res;
     
     if (recv_res > 0) { // Data was received
         buf[recv_res + 1] = 0x00; // Null-term, so Idris can interpret it
     }
-    res_struct->payload = (void*) buf;
+    res_struct->payload = buf;
     return (void*) res_struct;
 }
 
 int idrnet_recv_buf(int sockfd, void* buf, int len) {
-    return recv(sockfd, buf, len, 0);
+    int recv_res = recv(sockfd, buf, len, 0);
+    if (recv_res != -1) {
+        buf_ntohl(buf, len);
+    }
+    return recv_res;
 }
 
 int idrnet_get_recv_res(void* res_struct) {
     return (((idrnet_recv_result*) res_struct)->result);
 }
 
-void* idrnet_get_recv_payload(void* res_struct) {
+char* idrnet_get_recv_payload(void* res_struct) {
     return (((idrnet_recv_result*) res_struct)->payload);
 }
 
@@ -150,4 +183,138 @@
 int idrnet_errno() {
     return errno;
 }
+
+
+int idrnet_sendto(int sockfd, char* data, char* host, int port, int family) {
+
+    struct addrinfo* remote_host;
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
+    if (addr_res == -1) {
+        return -1;
+    } 
+
+    int send_res = sendto(sockfd, data, strlen(data), 0, 
+                        remote_host->ai_addr, remote_host->ai_addrlen);
+    freeaddrinfo(remote_host);
+    return send_res;
+}
+
+int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family) {
+
+    struct addrinfo* remote_host;
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
+    if (addr_res == -1) {
+        //printf("lib err: sendto getaddrinfo \n");
+        return -1;
+    } 
+
+    buf_htonl(buf, buf_len);
+
+    int send_res = sendto(sockfd, buf, buf_len, 0, 
+                        remote_host->ai_addr, remote_host->ai_addrlen);
+    if (send_res == -1) {
+        perror("lib err: sendto \n");
+    }
+    //freeaddrinfo(remote_host);
+    return send_res;
+}
+
+
+
+void* idrnet_recvfrom(int sockfd, int len) {
+/*
+ * int recvfrom(int sockfd, void *buf, int len, unsigned int flags,
+             struct sockaddr *from, int *fromlen); 
+*/
+    // Allocate the required structures, and nuke them
+    struct sockaddr_storage* remote_addr = 
+        (struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
+    char* buf = (char*) malloc(len + 1);
+    idrnet_recvfrom_result* ret = 
+        (idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
+    memset(remote_addr, 0, sizeof(struct sockaddr_storage));
+    memset(buf, 0, len + 1);
+    memset(ret, 0, sizeof(idrnet_recvfrom_result));
+    socklen_t fromlen = sizeof(struct sockaddr_storage);
+
+    int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
+    ret->result = recv_res;
+    // Check for failure...
+    if (recv_res == -1) { 
+        free(buf);
+        free(remote_addr);
+    } else {
+        // If data was received, process and populate
+        ret->result = recv_res;
+        ret->remote_addr = remote_addr;
+        // Ensure the last byte is NULL, since in this mode we're sending strings
+        buf[len] = 0x00;
+        ret->payload = (void*) buf;
+    }
+
+    return ret;
+}
+
+
+void* idrnet_recvfrom_buf(int sockfd, void* buf, int len) {
+    // Allocate the required structures, and nuke them
+    struct sockaddr_storage* remote_addr = 
+        (struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
+    idrnet_recvfrom_result* ret = 
+        (idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
+    memset(remote_addr, 0, sizeof(struct sockaddr_storage));
+    memset(ret, 0, sizeof(idrnet_recvfrom_result));
+    socklen_t fromlen = 0;
+
+    int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
+    // Check for failure... But don't free the buffer! Not our job.
+    ret->result = recv_res;
+    if (recv_res == -1) { 
+        free(remote_addr);
+    }
+    // Payload will be NULL -- since it's been put into the user-specified buffer. We
+    // still need the return struct to get our hands on the remote address, though.
+    if (recv_res > 0) {
+        buf_ntohl(buf, len);
+        ret->payload = NULL;
+        ret->remote_addr = remote_addr;
+    }
+    return ret;
+}
+
+int idrnet_get_recvfrom_res(void* res_struct) {
+    return (((idrnet_recvfrom_result*) res_struct)->result);
+}
+
+char* idrnet_get_recvfrom_payload(void* res_struct) {
+    return (((idrnet_recvfrom_result*) res_struct)->payload);
+}
+
+void* idrnet_get_recvfrom_sockaddr(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    return recv_struct->remote_addr;
+}
+
+int idrnet_get_recvfrom_port(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    if (recv_struct->remote_addr != NULL) {
+        struct sockaddr_in* remote_addr_in = 
+            (struct sockaddr_in*) recv_struct->remote_addr;
+        return ((int) ntohs(remote_addr_in->sin_port));
+    }
+    return -1;
+}
+
+void idrnet_free_recvfrom_struct(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    if (recv_struct != NULL) {
+        if (recv_struct->payload != NULL) {
+            free(recv_struct->payload);
+        }
+        if (recv_struct->remote_addr != NULL) {
+            free(recv_struct->remote_addr);
+        }
+    }
+}
+
 
diff --git a/rts/idris_net.h b/rts/idris_net.h
--- a/rts/idris_net.h
+++ b/rts/idris_net.h
@@ -1,11 +1,22 @@
 #ifndef IDRISNET_H
 #define IDRISNET_H
 
+struct sockaddr_storage;
+struct addrinfo;
+
 typedef struct idrnet_recv_result {
     int result;
     void* payload;
 } idrnet_recv_result;
 
+// Same type of thing as idrnet_recv_result, but for UDP, so stores some 
+// address information
+typedef struct idrnet_recvfrom_result {
+    int result;
+    void* payload;
+    struct sockaddr_storage* remote_addr;
+} idrnet_recvfrom_result;
+
 // Memory management functions
 void* idrnet_malloc(int size);
 void idrnet_free(void* ptr);
@@ -22,6 +33,7 @@
 // Accessor functions for struct_sockaddr
 int idrnet_sockaddr_family(void* sockaddr);
 char* idrnet_sockaddr_ipv4(void* sockaddr);
+int idrnet_sockaddr_ipv4_port(void* sockaddr);
 void* idrnet_create_sockaddr();
 
 // Accept
@@ -37,8 +49,29 @@
 // Receives directly into a buffer
 int idrnet_recv_buf(int sockfd, void* buf, int len);
 
+// UDP Send
+int idrnet_sendto(int sockfd, char* data, char* host, int port, int family);
+int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family);
+
+
+// UDP Receive
+void* idrnet_recvfrom(int sockfd, int len);
+void* idrnet_recvfrom_buf(int sockfd, void* buf, int len);
+
 // Receive structure accessors
 int idrnet_get_recv_res(void* res_struct);
-void* idrnet_get_recv_payload(void* res_struct);
+char* idrnet_get_recv_payload(void* res_struct);
 void idrnet_free_recv_struct(void* res_struct);
+
+// Recvfrom structure accessors
+int idrnet_get_recvfrom_res(void* res_struct);
+char* idrnet_get_recvfrom_payload(void* res_struct);
+void* idrnet_get_recvfrom_sockaddr(void* res_struct);
+void idrnet_free_recvfrom_struct(void* res_struct);
+
+
+int idrnet_getaddrinfo(struct addrinfo** address_res, char* host, 
+    int port, int family, int socket_type);
+
+
 #endif
diff --git a/rts/idris_rts.c b/rts/idris_rts.c
--- a/rts/idris_rts.c
+++ b/rts/idris_rts.c
@@ -1,10 +1,11 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
-#include <unistd.h>
 #include <stdarg.h>
 #include <assert.h>
+#ifdef HAS_PTHREAD
 #include <pthread.h>
+#endif
 
 #include "idris_rts.h"
 #include "idris_gc.h"
@@ -30,7 +31,7 @@
 
     vm->ret = NULL;
     vm->reg1 = NULL;
-
+#ifdef HAS_PTHREAD
     vm->inbox = malloc(1024*sizeof(VAL));
     memset(vm->inbox, 0, 1024*sizeof(VAL));
     vm->inbox_end = vm->inbox + 1024;
@@ -53,7 +54,7 @@
 
     vm->max_threads = max_threads;
     vm->processes = 0;
-
+#endif
     STATS_LEAVE_INIT(vm->stats)
     return vm;
 }
@@ -61,14 +62,16 @@
 Stats terminate(VM* vm) {
     Stats stats = vm->stats;
     STATS_ENTER_EXIT(stats)
-
+#ifdef HAS_PTHREAD
     free(vm->inbox);
+#endif
     free(vm->valstack);
     free_heap(&(vm->heap));
-
+#ifdef HAS_PTHREAD
     pthread_mutex_destroy(&(vm -> inbox_lock));
     pthread_mutex_destroy(&(vm -> inbox_block));
     pthread_cond_destroy(&(vm -> inbox_waiting));
+#endif
     free(vm);
 
     STATS_LEAVE_EXIT(stats)
@@ -79,18 +82,21 @@
     if (!(vm->heap.next + size < vm->heap.end)) {
         idris_gc(vm);
     }
-
+#ifdef HAS_PTHREAD
     int lock = vm->processes > 0;
     if (lock) { // We only need to lock if we're in concurrent mode
        pthread_mutex_lock(&vm->alloc_lock); 
     }
+#endif
 }
 
 void idris_doneAlloc(VM* vm) {
+#ifdef HAS_PTHREAD
     int lock = vm->processes > 0;
     if (lock) { // We only need to lock if we're in concurrent mode
        pthread_mutex_unlock(&vm->alloc_lock); 
     }
+#endif
 }
 
 int space(VM* vm, size_t size) {
@@ -99,16 +105,18 @@
 
 void* allocate(VM* vm, size_t size, int outerlock) {
 //    return malloc(size);
+#ifdef HAS_PTHREAD
     int lock = vm->processes > 0 && !outerlock;
 
     if (lock) { // not message passing
        pthread_mutex_lock(&vm->alloc_lock); 
     }
+#endif
 
     if ((size & 7)!=0) {
 	size = 8 + ((size >> 3) << 3);
     }
-    
+
     size_t chunk_size = size + sizeof(size_t);
 
     if (vm->heap.next + chunk_size < vm->heap.end) {
@@ -120,16 +128,19 @@
         assert(vm->heap.next <= vm->heap.end);
 
         memset(ptr, 0, size);
-
+#ifdef HAS_PTHREAD
         if (lock) { // not message passing
            pthread_mutex_unlock(&vm->alloc_lock); 
         }
+#endif
         return ptr;
     } else {
         idris_gc(vm);
+#ifdef HAS_PTHREAD
         if (lock) { // not message passing
            pthread_mutex_unlock(&vm->alloc_lock); 
         }
+#endif
         return allocate(vm, size, 0);
     }
 
@@ -187,7 +198,7 @@
     return cl;
 }
 
-VAL MKMPTR(VM* vm, void* ptr, int size) {
+VAL MKMPTR(VM* vm, void* ptr, size_t size) {
     Closure* cl = allocate(vm, sizeof(Closure) +
                                sizeof(ManagedPtr) + size, 0);
     SETTY(cl, MANAGEDPTR);
@@ -222,7 +233,7 @@
     return cl;
 }
 
-VAL MKMPTRc(VM* vm, void* ptr, int size) {
+VAL MKMPTRc(VM* vm, void* ptr, size_t size) {
     Closure* cl = allocate(vm, sizeof(Closure) +
                                sizeof(ManagedPtr) + size, 1);
     SETTY(cl, MANAGEDPTR);
@@ -760,6 +771,7 @@
     VAL arg;
 } ThreadData;
 
+#ifdef HAS_PTHREAD
 void* runThread(void* arg) {
     ThreadData* td = (ThreadData*)arg;
     VM* vm = td->vm;
@@ -949,7 +961,7 @@
 
     return msg;
 }
-
+#endif
 int __idris_argc;
 char **__idris_argv;
 
diff --git a/rts/idris_rts.h b/rts/idris_rts.h
--- a/rts/idris_rts.h
+++ b/rts/idris_rts.h
@@ -4,9 +4,10 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
-#include <unistd.h>
 #include <stdarg.h>
+#ifdef HAS_PTHREAD
 #include <pthread.h>
+#endif
 #include <stdint.h>
 
 #include "idris_heap.h"
@@ -23,13 +24,13 @@
 typedef struct Closure *VAL;
 
 typedef struct {
-    int tag_arity;
+    uint32_t tag_arity;
     VAL args[];
 } con;
 
 typedef struct {
     VAL str;
-    int offset;
+    size_t offset;
 } StrOffset;
 
 typedef struct {
@@ -49,7 +50,10 @@
 typedef struct Closure {
 // Use top 16 bits of ty for saying which heap value is in
 // Bottom 16 bits for closure type
-    ClosureType ty;
+//
+// NOTE: ty can not have type ClosureType because ty must be a
+// uint32_t but enum is platform dependent
+    uint32_t ty;
     union {
         con c;
         int i;
@@ -73,7 +77,7 @@
     VAL* stack_max;
     
     Heap heap;
-
+#ifdef HAS_PTHREAD
     pthread_mutex_t inbox_lock;
     pthread_mutex_t inbox_block;
     pthread_mutex_t alloc_lock;
@@ -87,7 +91,7 @@
 
     int processes; // Number of child processes
     int max_threads; // maximum number of threads to run in parallel
-    
+#endif
     Stats stats;
 
     VAL ret;
@@ -170,7 +174,7 @@
 VAL MKFLOAT(VM* vm, double val);
 VAL MKSTR(VM* vm, const char* str);
 VAL MKPTR(VM* vm, void* ptr);
-VAL MKMPTR(VM* vm, void* ptr, int size);
+VAL MKMPTR(VM* vm, void* ptr, size_t size);
 VAL MKB8(VM* vm, uint8_t b);
 VAL MKB16(VM* vm, uint16_t b);
 VAL MKB32(VM* vm, uint32_t b);
@@ -181,7 +185,7 @@
 VAL MKSTROFFc(VM* vm, StrOffset* off);
 VAL MKSTRc(VM* vm, char* str);
 VAL MKPTRc(VM* vm, void* ptr);
-VAL MKMPTRc(VM* vm, void* ptr, int size);
+VAL MKMPTRc(VM* vm, void* ptr, size_t size);
 VAL MKBUFFERc(VM* vm, Buffer* buf);
 
 char* GETSTROFF(VAL stroff);
@@ -208,7 +212,7 @@
 #define allocCon(cl, vm, t, a, o) \
   cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*a, o); \
   SETTY(cl, CON); \
-  cl->info.c.tag_arity = ((t) << 8) + (a);
+  cl->info.c.tag_arity = ((t) << 8) | (a);
 
 void* vmThread(VM* callvm, func f, VAL arg);
 
diff --git a/rts/windows/idris_net.c b/rts/windows/idris_net.c
--- a/rts/windows/idris_net.c
+++ b/rts/windows/idris_net.c
@@ -177,7 +177,7 @@
     return (((idrnet_recv_result*) res_struct)->result);
 }
 
-void* idrnet_get_recv_payload(void* res_struct) {
+char* idrnet_get_recv_payload(void* res_struct) {
     return (((idrnet_recv_result*) res_struct)->payload);
 }
 
diff --git a/src/IRTS/CodegenC.hs b/src/IRTS/CodegenC.hs
--- a/src/IRTS/CodegenC.hs
+++ b/src/IRTS/CodegenC.hs
@@ -7,7 +7,6 @@
 import IRTS.System
 import IRTS.CodegenCommon
 import Idris.Core.TT
-import Paths_idris
 import Util.System
 
 import Numeric
@@ -68,6 +67,7 @@
              let gcc = comp ++ " " ++
                        gccDbg dbg ++ " " ++
                        gccFlags ++
+                       " -DHAS_PTHREAD " ++
                        " -I. " ++ objs ++ " -x c " ++
                        (if (exec == Executable) then "" else " -c ") ++
                        " " ++ tmpn ++
diff --git a/src/IRTS/CodegenJava.hs b/src/IRTS/CodegenJava.hs
--- a/src/IRTS/CodegenJava.hs
+++ b/src/IRTS/CodegenJava.hs
@@ -169,7 +169,7 @@
   ++ "if test -n \"$JAVA_HOME\"; then\n"
   ++ "  java=\"$JAVA_HOME/bin/java\"\n"
   ++ "fi\n"
-  ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\""
+  ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\"\n"
   ++ "exit 1\n"
 
 -----------------------------------------------------------------------
@@ -312,6 +312,7 @@
                             , ImportDecl True idrisPrelude True
                             , ImportDecl False bigInteger False
                             , ImportDecl False runtimeException False
+                            , ImportDecl False byteBuffer False
                             ] ++ otherHdrs
                           )
                           <$> mkTypeDecl clsName globalInit defs
@@ -320,6 +321,7 @@
     idrisPrelude = J.Name $ map Ident ["org", "idris", "rts", "Prelude"]
     bigInteger = J.Name $ map Ident ["java", "math", "BigInteger"]
     runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]
+    byteBuffer = J.Name $ map Ident ["java", "nio", "ByteBuffer"]
     otherHdrs = map ( (\ name -> ImportDecl False name False)
                       . J.Name
                       . map (Ident . T.unpack)
@@ -386,9 +388,7 @@
     "main"
     [FormalParam [] (array stringType) False (VarId $ Ident "args")]
     $ Block [ BlockStmt . ExpStmt
-              $ call "idris_initArgs" [ (threadType ~> "currentThread") []
-                                      , jConst "args"
-                                      ]
+              $ call "idris_initArgs" [ jConst "args" ]
             , BlockStmt . ExpStmt $ call (mangle' (sMN 0 "runMain")) []
             ]
 
@@ -484,6 +484,8 @@
   (mkThread arg) >>= ppExp pp
 mkExp pp (SOp LPar [arg]) =
   (Nothing <>@! arg) >>= ppExp pp
+mkExp pp (SOp LRegisterPtr [ptr, i]) =
+  (Nothing <>@! ptr) >>= ppExp pp
 mkExp pp (SOp LNoOp args) =
   (Nothing <>@! (last args)) >>= ppExp pp
 mkExp pp (SOp LNullPtr args) =
@@ -707,6 +709,7 @@
 mkConstant c@(StrType   ) = ClassLit (Just $ stringType)
 mkConstant c@(PtrType   ) = ClassLit (Just $ objectType)
 mkConstant c@(ManagedPtrType) = ClassLit (Just $ objectType)
+mkConstant c@(BufferType) = ClassLit (Just $ bufferType)
 mkConstant c@(VoidType  ) = ClassLit (Just $ voidType)
 mkConstant c@(Forgot    ) = ClassLit (Just $ objectType)
 
@@ -744,7 +747,7 @@
 
 mkPrimitiveFunction :: PrimFn -> [LVar] -> CodeGeneration Exp
 mkPrimitiveFunction op args =
-  (\ args -> (primFnType ~> opName op) args)
+  (\ args -> (primFnType ~> opName op) (endiannessArguments op ++ args))
   <$> sequence (zipWith (\ a t -> (Just t) <>@! a) args (sourceTypes op))
 
 mkThread :: LVar -> CodeGeneration Exp
diff --git a/src/IRTS/CodegenJavaScript.hs b/src/IRTS/CodegenJavaScript.hs
--- a/src/IRTS/CodegenJavaScript.hs
+++ b/src/IRTS/CodegenJavaScript.hs
@@ -1,2641 +1,1324 @@
 {-# LANGUAGE PatternGuards #-}
-
-module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
-
-import Idris.AbsSyntax hiding (TypeCase)
-import IRTS.Bytecode
-import IRTS.Lang
-import IRTS.Simplified
-import IRTS.CodegenCommon
-import Idris.Core.TT
-import Paths_idris
-import Util.System
-
-import Control.Arrow
-import Control.Applicative ((<$>), (<*>), pure)
-import Data.Char
-import Numeric
-import Data.List
-import Data.Maybe
-import Data.Word
-import System.IO
-import System.Directory
-
-
-idrNamespace :: String
-idrNamespace    = "__IDR__"
-idrRTNamespace  = "__IDRRT__"
-idrLTNamespace  = "__IDRLT__"
-idrCTRNamespace = "__IDRCTR__"
-
-
-data JSTarget = Node | JavaScript deriving Eq
-
-
-data JSType = JSIntTy
-            | JSStringTy
-            | JSIntegerTy
-            | JSFloatTy
-            | JSCharTy
-            | JSPtrTy
-            | JSForgotTy
-            deriving Eq
-
-
-data JSInteger = JSBigZero
-               | JSBigOne
-               | JSBigInt Integer
-               deriving Eq
-
-
-data JSNum = JSInt Int
-           | JSFloat Double
-           | JSInteger JSInteger
-           deriving Eq
-
-
-data JSWord = JSWord8 Word8
-            | JSWord16 Word16
-            | JSWord32 Word32
-            | JSWord64 Word64
-            deriving Eq
-
-
-data JSAnnotation = JSConstructor deriving Eq
-
-
-instance Show JSAnnotation where
-  show JSConstructor = "constructor"
-
-
-data JS = JSRaw String
-        | JSIdent String
-        | JSFunction [String] JS
-        | JSType JSType
-        | JSSeq [JS]
-        | JSReturn JS
-        | JSApp JS [JS]
-        | JSNew String [JS]
-        | JSError String
-        | JSBinOp String JS JS
-        | JSPreOp String JS
-        | JSPostOp String JS
-        | JSProj JS String
-        | JSVar LVar
-        | JSNull
-        | JSThis
-        | JSTrue
-        | JSFalse
-        | JSArray [JS]
-        | JSString String
-        | JSNum JSNum
-        | JSWord JSWord
-        | JSAssign JS JS
-        | JSAlloc String (Maybe JS)
-        | JSIndex JS JS
-        | JSCond [(JS, JS)]
-        | JSTernary JS JS JS
-        | JSParens JS
-        | JSWhile JS JS
-        | JSFFI String [JS]
-        | JSAnnotation JSAnnotation JS
-        | JSNoop
-        deriving Eq
-
-
-data FFI = FFICode Char | FFIArg Int | FFIError String
-
-
-ffi :: String -> [String] -> String
-ffi code args = let parsed = ffiParse code in
-                    case ffiError parsed of
-                         Just err -> error err
-                         Nothing  -> renderFFI parsed args
-  where
-    ffiParse :: String -> [FFI]
-    ffiParse ""           = []
-    ffiParse ['%']        = [FFIError $ "FFI - Invalid positional argument"]
-    ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss
-    ffiParse ('%':s:ss)
-      | isDigit s =
-         FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)
-      | otherwise =
-          [FFIError $ "FFI - Invalid positional argument"]
-    ffiParse (s:ss) = FFICode s : ffiParse ss
-
-
-    ffiError :: [FFI] -> Maybe String
-    ffiError []                 = Nothing
-    ffiError ((FFIError s):xs)  = Just s
-    ffiError (x:xs)             = ffiError xs
-
-
-    renderFFI :: [FFI] -> [String] -> String
-    renderFFI [] _ = ""
-    renderFFI ((FFICode c) : fs) args = c : renderFFI fs args
-    renderFFI ((FFIArg i) : fs) args
-      | i < length args && i >= 0 = args !! i ++ renderFFI fs args
-      | otherwise = error "FFI - Argument index out of bounds"
-
-
-compileJS :: JS -> String
-compileJS JSNoop = ""
-
-compileJS (JSAnnotation annotation js) =
-  "/** @" ++ show annotation ++ " */\n" ++ compileJS js
-
-compileJS (JSFFI raw args) =
-  ffi raw (map compileJS args)
-
-compileJS (JSRaw code) =
-  code
-
-compileJS (JSIdent ident) =
-  ident
-
-compileJS (JSFunction args body) =
-     "function("
-   ++ intercalate "," args
-   ++ "){\n"
-   ++ compileJS body
-   ++ "\n}"
-
-compileJS (JSType ty)
-  | JSIntTy     <- ty = idrRTNamespace ++ "Int"
-  | JSStringTy  <- ty = idrRTNamespace ++ "String"
-  | JSIntegerTy <- ty = idrRTNamespace ++ "Integer"
-  | JSFloatTy   <- ty = idrRTNamespace ++ "Float"
-  | JSCharTy    <- ty = idrRTNamespace ++ "Char"
-  | JSPtrTy     <- ty = idrRTNamespace ++ "Ptr"
-  | JSForgotTy  <- ty = idrRTNamespace ++ "Forgot"
-
-compileJS (JSSeq seq) =
-  intercalate ";\n" (map compileJS seq)
-
-compileJS (JSReturn val) =
-  "return " ++ compileJS val
-
-compileJS (JSApp lhs rhs)
-  | JSFunction {} <- lhs =
-    concat ["(", compileJS lhs, ")(", args, ")"]
-  | otherwise =
-    concat [compileJS lhs, "(", args, ")"]
-  where args :: String
-        args = intercalate "," $ map compileJS rhs
-
-compileJS (JSNew name args) =
-  "new " ++ name ++ "(" ++ intercalate "," (map compileJS args) ++ ")"
-
-compileJS (JSError exc) =
-  "throw new Error(\"" ++ exc ++ "\")"
-
-compileJS (JSBinOp op lhs rhs) =
-  compileJS lhs ++ " " ++ op ++ " " ++ compileJS rhs
-
-compileJS (JSPreOp op val) =
-  op ++ compileJS val
-
-compileJS (JSProj obj field)
-  | JSFunction {} <- obj =
-    concat ["(", compileJS obj, ").", field]
-  | JSAssign {} <- obj =
-    concat ["(", compileJS obj, ").", field]
-  | otherwise =
-    compileJS obj ++ '.' : field
-
-compileJS (JSVar var) =
-  translateVariableName var
-
-compileJS JSNull =
-  "null"
-
-compileJS JSThis =
-  "this"
-
-compileJS JSTrue =
-  "true"
-
-compileJS JSFalse =
-  "false"
-
-compileJS (JSArray elems) =
-  "[" ++ intercalate "," (map compileJS elems) ++ "]"
-
-compileJS (JSString str) =
-  "\"" ++ str ++ "\""
-
-compileJS (JSNum num)
-  | JSInt i                <- num = show i
-  | JSFloat f              <- num = show f
-  | JSInteger JSBigZero    <- num = "__IDRRT__ZERO"
-  | JSInteger JSBigOne     <- num = "__IDRRT__ONE"
-  | JSInteger (JSBigInt i) <- num = show i
-
-compileJS (JSAssign lhs rhs) =
-  compileJS lhs ++ "=" ++ compileJS rhs
-
-compileJS (JSAlloc name val) =
-  "var " ++ name ++ maybe "" ((" = " ++) . compileJS) val
-
-compileJS (JSIndex lhs rhs) =
-  compileJS lhs ++ "[" ++ compileJS rhs ++ "]"
-
-compileJS (JSCond branches) =
-  intercalate " else " $ map createIfBlock branches
-  where
-    createIfBlock (JSNoop, e) =
-         "{\n"
-      ++ compileJS e
-      ++ ";\n}"
-    createIfBlock (cond, e) =
-         "if (" ++ compileJS cond ++") {\n"
-      ++ compileJS e
-      ++ ";\n}"
-
-compileJS (JSTernary cond true false) =
-  let c = compileJS cond
-      t = compileJS true
-      f = compileJS false in
-      "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
-
-compileJS (JSParens js) =
-  "(" ++ compileJS js ++ ")"
-
-compileJS (JSWhile cond body) =
-     "while (" ++ compileJS cond ++ ") {\n"
-  ++ compileJS body
-  ++ "\n}"
-
-compileJS (JSWord word)
-  | JSWord8  b <- word = "new Uint8Array([" ++ show b ++ "])"
-  | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"
-  | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"
-  | JSWord64 b <- word = idrRTNamespace ++ "bigInt(\"" ++ show b ++ "\")"
-
-
-jsTailcall :: JS -> JS
-jsTailcall call =
-  jsCall (idrRTNamespace ++ "tailcall") [
-    JSFunction [] (JSReturn call)
-  ]
-
-
-jsCall :: String -> [JS] -> JS
-jsCall fun = JSApp (JSIdent fun)
-
-
-jsMeth :: JS -> String -> [JS] -> JS
-jsMeth obj meth =
-  JSApp (JSProj obj meth)
-
-
-jsInstanceOf :: JS -> JS -> JS
-jsInstanceOf = JSBinOp "instanceof"
-
-
-jsEq :: JS -> JS -> JS
-jsEq = JSBinOp "=="
-
-jsNotEq :: JS -> JS -> JS
-jsNotEq = JSBinOp "!="
-
-jsAnd :: JS -> JS -> JS
-jsAnd = JSBinOp "&&"
-
-
-jsOr :: JS -> JS -> JS
-jsOr = JSBinOp "||"
-
-
-jsType :: JS
-jsType = JSIdent $ idrRTNamespace ++ "Type"
-
-
-jsCon :: JS
-jsCon = JSIdent $ idrRTNamespace ++ "Con"
-
-
-jsTag :: JS -> JS
-jsTag obj = JSProj obj "tag"
-
-
-jsTypeTag :: JS -> JS
-jsTypeTag obj = JSProj obj "type"
-
-
-jsBigInt :: JS -> JS
-jsBigInt (JSString "0") = JSNum $ JSInteger JSBigZero
-jsBigInt (JSString "1") = JSNum $ JSInteger JSBigOne
-jsBigInt val = JSApp (JSIdent $ idrRTNamespace ++ "bigInt") [val]
-
-
-jsVar :: Int -> String
-jsVar = ("__var_" ++) . show
-
-
-jsLet :: String -> JS -> JS -> JS
-jsLet name value body =
-  JSApp (
-    JSFunction [name] (
-      JSReturn body
-    )
-  ) [value]
-
-
-jsError :: String -> JS
-jsError err = JSApp (JSFunction [] (JSError err)) []
-
-jsUnPackBits :: JS -> JS
-jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
-
-
-jsPackUBits8 :: JS -> JS
-jsPackUBits8 js = JSNew "Uint8Array" [JSArray [js]]
-
-jsPackUBits16 :: JS -> JS
-jsPackUBits16 js = JSNew "Uint16Array" [JSArray [js]]
-
-jsPackUBits32 :: JS -> JS
-jsPackUBits32 js = JSNew "Uint32Array" [JSArray [js]]
-
-jsPackSBits8 :: JS -> JS
-jsPackSBits8 js = JSNew "Int8Array" [JSArray [js]]
-
-jsPackSBits16 :: JS -> JS
-jsPackSBits16 js = JSNew "Int16Array" [JSArray [js]]
-
-jsPackSBits32 :: JS -> JS
-jsPackSBits32 js = JSNew "Int32Array" [JSArray [js]]
-
-
-foldJS :: (JS -> a) -> (a -> a -> a) -> a -> JS -> a
-foldJS tr add acc js =
-  fold js
-  where
-    fold js
-      | JSFunction args body <- js =
-          add (tr js) (fold body)
-      | JSSeq seq            <- js =
-          add (tr js) $ foldl' add acc (map fold seq)
-      | JSReturn ret         <- js =
-          add (tr js) (fold ret)
-      | JSApp lhs rhs        <- js =
-          add (tr js) $ add (fold lhs) (foldl' add acc $ map fold rhs)
-      | JSNew _ args         <- js =
-          add (tr js) $ foldl' add acc $ map fold args
-      | JSBinOp _ lhs rhs    <- js =
-          add (tr js) $ add (fold lhs) (fold rhs)
-      | JSPreOp _ val        <- js =
-          add (tr js) $ fold val
-      | JSPostOp _ val       <- js =
-          add (tr js) $ fold val
-      | JSProj obj _         <- js =
-          add (tr js) (fold obj)
-      | JSArray vals         <- js =
-          add (tr js) $ foldl' add acc $ map fold vals
-      | JSAssign lhs rhs     <- js =
-          add (tr js) $ add (fold lhs) (fold rhs)
-      | JSIndex lhs rhs      <- js =
-          add (tr js) $ add (fold lhs) (fold rhs)
-      | JSAlloc _ val        <- js =
-          add (tr js) $ fromMaybe acc $ fmap fold val
-      | JSTernary c t f      <- js =
-          add (tr js) $ add (fold c) (add (fold t) (fold f))
-      | JSParens val         <- js =
-          add (tr js) $ fold val
-      | JSCond conds         <- js =
-          add (tr js) $ foldl' add acc $ map (uncurry add . (fold *** fold)) conds
-      | JSWhile cond body    <- js =
-          add (tr js) $ add (fold cond) (fold body)
-      | JSFFI raw args       <- js =
-          add (tr js) $ foldl' add acc $ map fold args
-      | JSAnnotation a js    <- js =
-          add (tr js) $ fold js
-      | otherwise                  =
-          tr js
-
-
-transformJS :: (JS -> JS) -> JS -> JS
-transformJS tr js =
-  transformHelper js
-  where
-    transformHelper :: JS -> JS
-    transformHelper js
-      | JSFunction args body <- js = JSFunction args $ tr body
-      | JSSeq seq            <- js = JSSeq $ map tr seq
-      | JSReturn ret         <- js = JSReturn $ tr ret
-      | JSApp lhs rhs        <- js = JSApp (tr lhs) $ map tr rhs
-      | JSNew con args       <- js = JSNew con $ map tr args
-      | JSBinOp op lhs rhs   <- js = JSBinOp op (tr lhs) (tr rhs)
-      | JSPreOp op val       <- js = JSPreOp op (tr val)
-      | JSPostOp op val      <- js = JSPostOp op (tr val)
-      | JSProj obj field     <- js = JSProj (tr obj) field
-      | JSArray vals         <- js = JSArray $ map tr vals
-      | JSAssign lhs rhs     <- js = JSAssign (tr lhs) (tr rhs)
-      | JSAlloc var val      <- js = JSAlloc var $ fmap tr val
-      | JSIndex lhs rhs      <- js = JSIndex (tr lhs) (tr rhs)
-      | JSCond conds         <- js = JSCond $ map (tr *** tr) conds
-      | JSTernary c t f      <- js = JSTernary (tr c) (tr t) (tr f)
-      | JSParens val         <- js = JSParens $ tr val
-      | JSWhile cond body    <- js = JSWhile (tr cond) (tr body)
-      | JSFFI raw args       <- js = JSFFI raw (map tr args)
-      | JSAnnotation a js    <- js = JSAnnotation a (tr js)
-      | otherwise                  = js
-
-
-moveJSDeclToTop :: String -> [JS] -> [JS]
-moveJSDeclToTop decl js = move ([], js)
-  where
-    move :: ([JS], [JS]) -> [JS]
-    move (front, js@(JSAnnotation _ (JSAlloc name _)):back)
-      | name == decl = js : front ++ back
-
-    move (front, js@(JSAlloc name _):back)
-      | name == decl = js : front ++ back
-
-    move (front, js:back) =
-      move (front ++ [js], back)
-
-
-jsSubst :: JS -> JS -> JS -> JS
-jsSubst var new old
-  | var == old = new
-
-jsSubst (JSIdent var) new (JSVar old)
-  | var == translateVariableName old = new
-  | otherwise                        = JSVar old
-
-jsSubst var new old@(JSIdent _)
-  | var == old = new
-  | otherwise  = old
-
-jsSubst var new (JSArray fields) =
-  JSArray (map (jsSubst var new) fields)
-
-jsSubst var new (JSNew con vals) =
-  JSNew con $ map (jsSubst var new) vals
-
-jsSubst (JSIdent var) new (JSApp (JSProj (JSFunction args body) "apply") vals)
-  | var `notElem` args =
-      JSApp (JSProj (JSFunction args (jsSubst (JSIdent var) new body)) "apply") (
-        map (jsSubst (JSIdent var) new) vals
-      )
-  | otherwise =
-      JSApp (JSProj (JSFunction args body) "apply") (
-        map (jsSubst (JSIdent var) new) vals
-      )
-
-jsSubst (JSIdent var) new (JSApp (JSFunction [arg] body) vals)
-  | var /= arg =
-      JSApp (JSFunction [arg] (
-        jsSubst (JSIdent var) new body
-      )) $ map (jsSubst (JSIdent var) new) vals
-  | otherwise =
-      JSApp (JSFunction [arg] (
-        body
-      )) $ map (jsSubst (JSIdent var) new) vals
-
-jsSubst var new js = transformJS (jsSubst var new) js
-
-
-removeAllocations :: JS -> JS
-removeAllocations (JSSeq body) =
-  let opt = removeHelper (map removeAllocations body) in
-      case opt of
-           [ret] -> ret
-           _     -> JSSeq opt
-  where
-    removeHelper :: [JS] -> [JS]
-    removeHelper [js] = [js]
-    removeHelper ((JSAlloc name (Just val@(JSIdent _))):js) =
-      map (jsSubst (JSIdent name) val) (removeHelper js)
-    removeHelper (j:js) = j : removeHelper js
-
-removeAllocations js = transformJS removeAllocations js
-
-
-isJSConstant :: JS -> Bool
-isJSConstant js
-  | JSString _   <- js = True
-  | JSNum _      <- js = True
-  | JSType _     <- js = True
-  | JSNull       <- js = True
-  | JSArray vals <- js = all isJSConstant vals
-
-  | JSApp (JSIdent "__IDRRT__bigInt") _ <- js = True
-
-  | otherwise = False
-
-isJSConstantConstructor :: [String] -> JS -> Bool
-isJSConstantConstructor constants js
-  | isJSConstant js =
-      True
-  | JSArray vals <- js =
-      all (isJSConstantConstructor constants) vals
-  | JSNew "__IDRRT__Con" args <- js =
-      all (isJSConstantConstructor constants) args
-  | JSIndex (JSProj (JSIdent name) "vars") (JSNum _) <- js
-  , name `elem` constants =
-      True
-  | JSIdent name <- js
-  , name `elem` constants =
-      True
-  | otherwise = False
-
-
-inlineJS :: JS -> JS
-inlineJS = inlineAssign . inlineError . inlineApply . inlineCaseMatch . inlineJSLet
-  where
-    inlineJSLet :: JS -> JS
-    inlineJSLet (JSApp (JSFunction [arg] (JSReturn ret)) [val])
-      | opt <- inlineJSLet val =
-          inlineJS $ jsSubst (JSIdent arg) opt ret
-
-    inlineJSLet js = transformJS inlineJSLet js
-
-
-    inlineCaseMatch (JSReturn (JSApp (JSFunction ["cse"] body) [val]))
-      | opt <- inlineCaseMatch val =
-          inlineCaseMatch $ jsSubst (JSIdent "cse") opt body
-
-    inlineCaseMatch js = transformJS inlineCaseMatch js
-
-
-    inlineApply js
-      | JSApp (
-          JSProj (JSFunction args (JSReturn body)) "apply"
-        ) [JSThis, JSProj var "vars"] <- js =
-          inlineApply $ inlineApply' var args body 0
-      | JSReturn (JSApp  (
-          JSProj (JSFunction args body@(JSCond _)) "apply"
-        ) [JSThis, JSProj var "vars"]) <- js =
-          inlineApply $ inlineApply' var args body 0
-      where
-        inlineApply' _   []     body _ = body
-        inlineApply' var (a:as) body n =
-          inlineApply' var as (
-            jsSubst (JSIdent a) (
-              JSIndex (JSProj var "vars") (JSNum (JSInt n))
-            ) body
-          ) (n + 1)
-
-    inlineApply js = transformJS inlineApply js
-
-
-    inlineError (JSReturn (JSApp (JSFunction [] error@(JSError _)) [])) =
-      inlineError error
-
-    inlineError js = transformJS inlineError js
-
-
-    inlineAssign (JSAssign lhs rhs)
-      | JSVar _ <- lhs
-      , JSVar _ <- rhs
-      , lhs == rhs =
-          lhs
-
-    inlineAssign (JSAssign lhs rhs)
-      | JSIdent _ <- lhs
-      , JSIdent _ <- rhs
-      , lhs == rhs =
-          lhs
-
-    inlineAssign js = transformJS inlineAssign js
-
-
-removeEval :: [JS] -> [JS]
-removeEval js =
-  let (ret, isReduced) = checkEval js in
-      if isReduced
-          then removeEvalApp ret
-          else ret
-  where
-    removeEvalApp js = catMaybes (map removeEvalApp' js)
-      where
-        removeEvalApp' :: JS -> Maybe JS
-        removeEvalApp' (JSAlloc "__IDR__mEVAL0" _) = Nothing
-        removeEvalApp' js = Just $ transformJS match js
-          where
-            match (JSApp (JSIdent "__IDR__mEVAL0") [val]) = val
-            match js = transformJS match js
-
-    checkEval :: [JS] -> ([JS], Bool)
-    checkEval js = foldr f ([], False) $ map checkEval' js
-      where
-        f :: (Maybe JS, Bool) -> ([JS], Bool) -> ([JS], Bool)
-        f (Just js, isReduced) (ret, b) = (js : ret, isReduced || b)
-        f (Nothing, isReduced) (ret, b) = (ret, isReduced || b)
-
-
-        checkEval' :: JS -> (Maybe JS, Bool)
-        checkEval' (JSAlloc "__IDRLT__EVAL" (Just (JSApp (JSFunction [] (
-            JSSeq [ _
-                  , JSReturn (JSIdent "t")
-                  ]
-          )) []))) = (Nothing, True)
-
-        checkEval' js = (Just js, False)
-
-
-reduceJS :: [JS] -> [JS]
-reduceJS js = moveJSDeclToTop "__IDRRT__Con" $ reduceLoop [] ([], js)
-
-
-funName :: JS -> String
-funName (JSAlloc fun _) = fun
-
-
-elimDeadLoop :: [JS] -> [JS]
-elimDeadLoop js
-  | ret <- deadEvalApplyCases js
-  , ret /= js = elimDeadLoop ret
-  | otherwise = js
-
-
-deadEvalApplyCases :: [JS] -> [JS]
-deadEvalApplyCases js =
-  let tags = sort $ nub $ concatMap (getTags) js in
-      map (removeHelper tags) js
-      where
-        getTags :: JS -> [Int]
-        getTags = foldJS match (++) []
-          where
-            match js
-              | JSNew "__IDRRT__Con" [JSNum (JSInt tag), _] <- js = [tag]
-              | otherwise                                         = []
-
-
-        removeHelper :: [Int] -> JS -> JS
-        removeHelper tags (JSAlloc fun (Just (
-            JSApp (JSFunction [] (JSSeq seq)) []))
-          ) =
-            (JSAlloc fun (Just (
-              JSApp (JSFunction [] (JSSeq $ remover tags seq)) []))
-            )
-
-        removeHelper _ js = js
-
-
-        remover :: [Int] -> [JS] -> [JS]
-        remover tags (
-            j@(JSAssign ((JSIndex (JSIdent "t") (JSNum (JSInt tag)))) _):js
-          )
-          | tag `notElem` tags = remover tags js
-
-        remover tags (j:js) = j : remover tags js
-        remover _    []     = []
-
-
-initConstructors :: [JS] -> [JS]
-initConstructors js =
-    let tags = nub $ sort $ concat (map getTags js) in
-        rearrangePrelude $ map createConstant tags ++ replaceConstructors tags js
-      where
-        rearrangePrelude :: [JS] -> [JS]
-        rearrangePrelude = moveJSDeclToTop $ idrRTNamespace ++ "Con"
-
-
-        getTags :: JS -> [Int]
-        getTags = foldJS match (++) []
-          where
-            match js
-              | JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray []] <- js = [tag]
-              | otherwise                                                  = []
-
-
-        replaceConstructors :: [Int] -> [JS] -> [JS]
-        replaceConstructors tags js = map (replaceHelper tags) js
-          where
-            replaceHelper :: [Int] -> JS -> JS
-            replaceHelper tags (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray []])
-              | tag `elem` tags = JSIdent (idrCTRNamespace ++ show tag)
-
-            replaceHelper tags js = transformJS (replaceHelper tags) js
-
-
-        createConstant :: Int -> JS
-        createConstant tag =
-          JSAlloc (idrCTRNamespace ++ show tag) (Just (
-            JSNew (idrRTNamespace ++ "Con") [JSNum (JSInt tag), JSArray []]
-          ))
-
-
-removeIDs :: [JS] -> [JS]
-removeIDs js =
-  case partition isID js of
-       ([], rest)  -> rest
-       (ids, rest) -> removeIDs $ map (removeIDCall (map idFor ids)) rest
-  where isID :: JS -> Bool
-        isID (JSAlloc _ (Just (JSFunction _ (JSSeq body))))
-          | JSReturn (JSVar _) <- last body = True
-
-        isID _ = False
-
-
-        idFor :: JS -> (String, Int)
-        idFor (JSAlloc fun (Just (JSFunction _ (JSSeq body))))
-          | JSReturn (JSVar (Loc pos)) <- last body = (fun, pos)
-
-
-        removeIDCall :: [(String, Int)] -> JS -> JS
-        removeIDCall ids (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-                           JSReturn (JSApp (JSIdent fun) args)
-                         )])
-          | Just pos <- lookup fun ids
-          , pos < length args  = removeIDCall ids (args !! pos)
-
-        removeIDCall ids (JSNew _ [JSFunction [] (
-                           JSReturn (JSApp (JSIdent fun) args)
-                         )])
-          | Just pos <- lookup fun ids
-          , pos < length args = removeIDCall ids (args !! pos)
-
-        removeIDCall ids js@(JSApp id@(JSIdent fun) args)
-          | Just pos <- lookup fun ids
-          , pos < length args  = removeIDCall ids (args !! pos)
-
-        removeIDCall ids js = transformJS (removeIDCall ids) js
-
-
-inlineFunction :: String -> [String] -> JS -> JS -> JS
-inlineFunction fun args body js = inline' js
-  where
-    inline' :: JS -> JS
-    inline' (JSApp (JSIdent name) vals)
-      | name == fun =
-          let (js, phs) = insertPlaceHolders args body in
-              inline' $ foldr (uncurry jsSubst) js (zip phs vals)
-
-    inline' js = transformJS inline' js
-
-    insertPlaceHolders :: [String] -> JS -> (JS, [JS])
-    insertPlaceHolders args body = insertPlaceHolders' args body []
-      where
-        insertPlaceHolders' :: [String] -> JS -> [JS] -> (JS, [JS])
-        insertPlaceHolders' (a:as) body ph
-          | (body', ph') <- insertPlaceHolders' as body ph =
-              let phvar = JSIdent $ "__PH_" ++ show (length ph') in
-                  (jsSubst (JSIdent a) phvar body', phvar : ph')
-
-        insertPlaceHolders' [] body ph = (body, ph)
-
-
-inlineFunctions :: [JS] -> [JS]
-inlineFunctions js =
-  inlineHelper ([], js)
-  where
-    inlineHelper :: ([JS], [JS]) -> [JS]
-    inlineHelper (front , (JSAlloc fun (Just (JSFunction args body))):back)
-      | countAll fun front + countAll fun back == 0 =
-         inlineHelper (front, back)
-      | Just new <- inlineAble (
-            countAll fun front + countAll fun back
-          ) fun args body =
-              let f = map (inlineFunction fun args new) in
-                  inlineHelper (f front, f back)
-
-    inlineHelper (front, next:back) = inlineHelper (front ++ [next], back)
-    inlineHelper (front, [])        = front
-
-
-    inlineAble :: Int -> String -> [String] -> JS -> Maybe JS
-    inlineAble 1 fun args (JSReturn body)
-      | nonRecur fun body =
-          if all (<= 1) (map ($ body) (map countIDOccurences args))
-             then Just body
-             else Nothing
-
-    inlineAble _ _ _ _ = Nothing
-
-
-    nonRecur :: String -> JS -> Bool
-    nonRecur name body = countInvokations name body == 0
-
-
-    countAll :: String -> [JS] -> Int
-    countAll name js = sum $ map (countInvokations name) js
-
-
-    countIDOccurences :: String -> JS -> Int
-    countIDOccurences name = foldJS match (+) 0
-      where
-        match :: JS -> Int
-        match js
-          | JSIdent ident <- js
-          , name == ident = 1
-          | otherwise     = 0
-
-
-    countInvokations :: String -> JS -> Int
-    countInvokations name = foldJS match (+) 0
-      where
-        match :: JS -> Int
-        match js
-          | JSApp (JSIdent ident) _ <- js
-          , name == ident = 1
-          | JSNew con _             <- js
-          , name == con   = 1
-          | otherwise     = 0
-
-
-reduceContinuations :: JS -> JS
-reduceContinuations = inlineTC . reduceJS
-  where
-    reduceJS :: JS -> JS
-    reduceJS (JSNew "__IDRRT__Cont" [JSFunction [] (
-        JSReturn js@(JSNew "__IDRRT__Cont" [JSFunction [] body])
-      )]) = reduceJS js
-
-    reduceJS js = transformJS reduceJS js
-
-
-    inlineTC :: JS -> JS
-    inlineTC js
-      | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-            JSReturn (JSNew "__IDRRT__Cont" [JSFunction [] (
-              JSReturn ret@(JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-                  JSReturn (JSNew "__IDRRT__Cont" _)
-              )])
-            )])
-          )] <- js = inlineTC ret
-
-    inlineTC js = transformJS inlineTC js
-
-
-
-
-reduceConstant :: JS -> JS
-reduceConstant
-  (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-    JSReturn (JSApp (JSIdent "__IDR__mEVAL0") [val])
-  )])
-  | JSNum num          <- val = val
-  | JSBinOp op lhs rhs <- val =
-      JSParens $ JSBinOp op (reduceConstant lhs) (reduceConstant rhs)
-
-  | JSApp (JSProj lhs op) [rhs] <- val
-  , op `elem` [ "subtract"
-              , "add"
-              , "multiply"
-              , "divide"
-              , "mod"
-              , "equals"
-              , "lesser"
-              , "lesserOrEquals"
-              , "greater"
-              , "greaterOrEquals"
-              ] = val
-
-reduceConstant (JSApp ident [(JSParens js)]) =
-  JSApp ident [reduceConstant js]
-
-reduceConstant js = transformJS reduceConstant js
-
-
-reduceConstants :: JS -> JS
-reduceConstants js
-  | ret <- reduceConstant js
-  , ret /= js = reduceConstants ret
-  | otherwise = js
-
-
-elimDuplicateEvals :: JS -> JS
-elimDuplicateEvals (JSAlloc fun (Just (JSFunction args (JSSeq seq)))) =
-  JSAlloc fun $ Just (JSFunction args $ JSSeq (elimHelper seq))
-  where
-    elimHelper :: [JS] -> [JS]
-    elimHelper (j@(JSAlloc var (Just val)):js) =
-      j : map (jsSubst val (JSIdent var)) (elimHelper js)
-    elimHelper (j:js) =
-      j : elimHelper js
-    elimHelper [] = []
-
-elimDuplicateEvals js = js
-
-
-optimizeRuntimeCalls :: String -> String -> [JS] -> [JS]
-optimizeRuntimeCalls fun tc js =
-  optTC tc : map optHelper js
-  where
-    optHelper :: JS -> JS
-    optHelper (JSApp (JSIdent "__IDRRT__tailcall") [
-        JSFunction [] (JSReturn (JSApp (JSIdent n) args))
-      ])
-      | n == fun = JSApp (JSIdent tc) $ map optHelper args
-
-    optHelper js = transformJS optHelper js
-
-
-    optTC :: String -> JS
-    optTC tc@"__IDRRT__EVALTC" =
-      JSAlloc tc (Just $ JSFunction ["arg0"] (
-        JSSeq [ JSAlloc "ret" $ Just (
-                  JSTernary (
-                    (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
-                    (hasProp "__IDRLT__EVAL" "arg0")
-                  ) (JSApp
-                      (JSIndex
-                        (JSIdent "__IDRLT__EVAL")
-                        (JSProj (JSIdent "arg0") "tag")
-                      )
-                      [JSIdent "arg0"]
-                  ) (JSIdent "arg0")
-                )
-              , JSWhile (JSIdent "ret" `jsInstanceOf` (JSIdent "__IDRRT__Cont")) (
-                  JSAssign (JSIdent "ret") (
-                    JSApp (JSProj (JSIdent "ret") "k") []
-                  )
-                )
-              , JSReturn $ JSIdent "ret"
-              ]
-      ))
-
-    optTC tc@"__IDRRT__APPLYTC" =
-      JSAlloc tc (Just $ JSFunction ["fn0", "arg0"] (
-        JSSeq [ JSAlloc "ret" $ Just (
-                  JSTernary (
-                    (JSIdent "fn0" `jsInstanceOf` jsCon) `jsAnd`
-                    (hasProp "__IDRLT__APPLY" "fn0")
-                  ) (JSApp
-                      (JSIndex
-                        (JSIdent "__IDRLT__APPLY")
-                        (JSProj (JSIdent "fn0") "tag")
-                      )
-                      [JSIdent "fn0", JSIdent "arg0", JSIdent "fn0"]
-                  ) JSNull
-                )
-              , JSWhile (JSIdent "ret" `jsInstanceOf` (JSIdent "__IDRRT__Cont")) (
-                  JSAssign (JSIdent "ret") (
-                    JSApp (JSProj (JSIdent "ret") "k") []
-                  )
-                )
-              , JSReturn $ JSIdent "ret"
-              ]
-      ))
-
-
-    hasProp :: String -> String -> JS
-    hasProp table var =
-      JSIndex (JSIdent table) (JSProj (JSIdent var) "tag")
-
-
-unfoldLookupTable :: [JS] -> [JS]
-unfoldLookupTable input =
-  let (evals, evalunfold)   = unfoldLT "__IDRLT__EVAL" input
-      (applys, applyunfold) = unfoldLT "__IDRLT__APPLY" evalunfold
-      js                    = applyunfold in
-      adaptRuntime $ expandCons evals applys js
-  where
-    adaptRuntime :: [JS] -> [JS]
-    adaptRuntime =
-      adaptEvalTC . adaptApplyTC . adaptEval . adaptApply . adaptCon
-
-
-    adaptApply :: [JS] -> [JS]
-    adaptApply js = adaptApply' [] js
-      where
-        adaptApply' :: [JS] -> [JS] -> [JS]
-        adaptApply' front ((JSAlloc "__IDR__mAPPLY0" (Just _)):back) =
-          front ++ (new:back)
-
-        adaptApply' front (next:back) =
-          adaptApply' (front ++ [next]) back
-
-        adaptApply' front [] = front
-
-        new =
-          JSAlloc "__IDR__mAPPLY0" (Just $ JSFunction ["mfn0", "marg0"] (JSReturn $
-              JSTernary (
-                (JSIdent "mfn0" `jsInstanceOf` jsCon) `jsAnd`
-                (JSProj (JSIdent "mfn0") "app")
-              ) (JSApp
-                  (JSProj (JSIdent "mfn0") "app")
-                  [JSIdent "mfn0", JSIdent "marg0"]
-              ) JSNull
-            )
-          )
-
-
-    adaptApplyTC :: [JS] -> [JS]
-    adaptApplyTC js = adaptApplyTC' [] js
-      where
-        adaptApplyTC' :: [JS] -> [JS] -> [JS]
-        adaptApplyTC' front ((JSAlloc "__IDRRT__APPLYTC" (Just _)):back) =
-          front ++ (new:back)
-
-        adaptApplyTC' front (next:back) =
-          adaptApplyTC' (front ++ [next]) back
-
-        adaptApplyTC' front [] = front
-
-        new =
-          JSAlloc "__IDRRT__APPLYTC" (Just $ JSFunction ["mfn0", "marg0"] (
-            JSSeq [ JSAlloc "ret" $ Just (
-                      JSTernary (
-                        (JSIdent "mfn0" `jsInstanceOf` jsCon) `jsAnd`
-                        (JSProj (JSIdent "mfn0") "app")
-                      ) (JSApp
-                          (JSProj (JSIdent "mfn0") "app")
-                          [JSIdent "mfn0", JSIdent "marg0"]
-                      ) JSNull
-                    )
-                  , JSWhile (JSIdent "ret" `jsInstanceOf` (JSIdent "__IDRRT__Cont")) (
-                      JSAssign (JSIdent "ret") (
-                        JSApp (JSProj (JSIdent "ret") "k") []
-                      )
-                    )
-                  , JSReturn $ JSIdent "ret"
-                  ]
-          ))
-
-
-    adaptEval :: [JS] -> [JS]
-    adaptEval js = adaptEval' [] js
-      where
-        adaptEval' :: [JS] -> [JS] -> [JS]
-        adaptEval' front ((JSAlloc "__IDR__mEVAL0" (Just _)):back) =
-          front ++ (new:back)
-
-        adaptEval' front (next:back) =
-          adaptEval' (front ++ [next]) back
-
-        adaptEval' front [] = front
-
-        new =
-          JSAlloc "__IDR__mEVAL0" (Just $ JSFunction ["marg0"] (JSReturn $
-              JSTernary (
-                (JSIdent "marg0" `jsInstanceOf` jsCon) `jsAnd`
-                (JSProj (JSIdent "marg0") "eval")
-              ) (JSApp
-                  (JSProj (JSIdent "marg0") "eval")
-                  [JSIdent "marg0"]
-              ) (JSIdent "marg0")
-            )
-          )
-
-
-    adaptEvalTC :: [JS] -> [JS]
-    adaptEvalTC js = adaptEvalTC' [] js
-      where
-        adaptEvalTC' :: [JS] -> [JS] -> [JS]
-        adaptEvalTC' front ((JSAlloc "__IDRRT__EVALTC" (Just _)):back) =
-          front ++ (new:back)
-
-        adaptEvalTC' front (next:back) =
-          adaptEvalTC' (front ++ [next]) back
-
-        adaptEvalTC' front [] = front
-
-        new =
-          JSAlloc "__IDRRT__EVALTC" (Just $ JSFunction ["marg0"] (
-            JSSeq [ JSAlloc "ret" $ Just (
-                      JSTernary (
-                        (JSIdent "marg0" `jsInstanceOf` jsCon) `jsAnd`
-                        (JSProj (JSIdent "marg0") "eval")
-                      ) (JSApp
-                          (JSProj (JSIdent "marg0") "eval")
-                          [JSIdent "marg0"]
-                      ) (JSIdent "marg0")
-                    )
-                  , JSWhile (JSIdent "ret" `jsInstanceOf` (JSIdent "__IDRRT__Cont")) (
-                      JSAssign (JSIdent "ret") (
-                        JSApp (JSProj (JSIdent "ret") "k") []
-                      )
-                    )
-                  , JSReturn $ JSIdent "ret"
-                  ]
-          ))
-
-
-    adaptCon js =
-      adaptCon' [] js
-      where
-        adaptCon' front ((JSAnnotation _ (JSAlloc "__IDRRT__Con" _)):back) =
-          front ++ (new:back)
-
-        adaptCon' front (next:back) =
-          adaptCon' (front ++ [next]) back
-
-        adaptCon' front [] = front
-
-
-        new =
-          JSAnnotation JSConstructor $
-            JSAlloc "__IDRRT__Con" (Just $
-              JSFunction newArgs (
-                JSSeq (map newVar newArgs)
-              )
-            )
-          where
-            newVar var = JSAssign (JSProj JSThis var) (JSIdent var)
-            newArgs = ["tag", "eval", "app", "vars"]
-
-
-    unfoldLT :: String -> [JS] -> ([Int], [JS])
-    unfoldLT lt js =
-      let (table, code) = extractLT lt js
-          expanded      = expandLT lt table in
-          (map fst expanded, map snd expanded ++ code)
-
-
-    expandCons :: [Int] -> [Int] -> [JS] -> [JS]
-    expandCons evals applys js =
-      map expandCons' js
-      where
-        expandCons' :: JS -> JS
-        expandCons' (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray args])
-          | evalid  <- getId "__IDRLT__EVAL"  tag evals
-          , applyid <- getId "__IDRLT__APPLY" tag applys =
-              JSNew "__IDRRT__Con" [ JSNum (JSInt tag)
-                                   , maybe JSNull JSIdent evalid
-                                   , maybe JSNull JSIdent applyid
-                                   , JSArray (map expandCons' args)
-                                   ]
-
-        expandCons' js = transformJS expandCons' js
-
-
-        getId :: String -> Int -> [Int] -> Maybe String
-        getId lt tag entries
-          | tag `elem` entries = Just $ ltIdentifier lt tag
-          | otherwise          = Nothing
-
-
-    ltIdentifier :: String -> Int -> String
-    ltIdentifier "__IDRLT__EVAL"  id = idrLTNamespace ++ "EVAL" ++ show id
-    ltIdentifier "__IDRLT__APPLY" id = idrLTNamespace ++ "APPLY" ++ show id
-
-
-    extractLT :: String -> [JS] -> (JS, [JS])
-    extractLT lt js =
-      extractLT' ([], js)
-        where
-          extractLT' :: ([JS], [JS]) -> (JS, [JS])
-          extractLT' (front, js@(JSAlloc fun _):back)
-            | fun == lt = (js, front ++ back)
-
-          extractLT' (front, js:back) = extractLT' (front ++ [js], back)
-          extractLT' (front, back)    = (JSNoop, front ++ back)
-
-
-    expandLT :: String -> JS -> [(Int, JS)]
-    expandLT lt (
-        JSAlloc _ (Just (JSApp (JSFunction [] (JSSeq seq)) []))
-      ) = catMaybes (map expandEntry seq)
-          where
-            expandEntry :: JS -> Maybe (Int, JS)
-            expandEntry (JSAssign (JSIndex _ (JSNum (JSInt id))) body) =
-              Just $ (id, JSAlloc (ltIdentifier lt id) (Just body))
-
-            expandEntry js = Nothing
-
-    expandLT lt JSNoop = []
-
-
-removeInstanceChecks :: JS -> JS
-removeInstanceChecks (JSCond conds) =
-  removeNoopConds $ JSCond $ eliminateDeadBranches $ map (
-    removeHelper *** removeInstanceChecks
-  ) conds
-  where
-    removeHelper (
-        JSBinOp "&&" (JSBinOp "instanceof" _ (JSIdent "__IDRRT__Con")) check
-      ) = removeHelper check
-    removeHelper js = js
-
-
-    eliminateDeadBranches ((JSTrue, cond):_) = [(JSNoop, cond)]
-    eliminateDeadBranches [(_, js)]         = [(JSNoop, js)]
-    eliminateDeadBranches (x:xs)            = x : eliminateDeadBranches xs
-    eliminateDeadBranches []                = []
-
-
-    removeNoopConds :: JS -> JS
-    removeNoopConds (JSCond [(JSNoop, js)]) = js
-    removeNoopConds js                      = js
-
-removeInstanceChecks js = transformJS removeInstanceChecks js
-
-
-reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
-reduceLoop reduced (cons, program) =
-  case partition findConstructors program of
-       ([], js)           -> cons ++ js
-       (candidates, rest) ->
-         let names = reduced ++ map funName candidates in
-             reduceLoop names (
-               cons ++ map reduce candidates, map (reduceCall names) rest
-             )
-  where findConstructors :: JS -> Bool
-        findConstructors js
-          | (JSAlloc fun (Just (JSFunction _ (JSSeq body)))) <- js =
-              reducable $ last body
-          | otherwise = False
-          where reducable :: JS -> Bool
-                reducable js
-                  | JSReturn ret   <- js = reducable ret
-                  | JSNew _ args   <- js = and $ map reducable args
-                  | JSArray fields <- js = and $ map reducable fields
-                  | JSNum _        <- js = True
-                  | JSNull         <- js = True
-                  | JSIdent _      <- js = True
-                  | otherwise            = False
-
-
-        reduce :: JS -> JS
-        reduce (JSAlloc fun (Just (JSFunction _ (JSSeq body))))
-          | JSReturn js <- last body = (JSAlloc fun (Just js))
-
-        reduce js = js
-
-
-        reduceCall :: [String] -> JS -> JS
-        reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-                          JSReturn (JSApp id@(JSIdent ret) _)
-                        )])
-          | ret `elem` funs = id
-
-        reduceCall funs js@(JSApp id@(JSIdent fun) _)
-          | fun `elem` funs = id
-
-        reduceCall funs js = transformJS (reduceCall funs) js
-
-
-extractLocalConstructors :: [JS] -> [JS]
-extractLocalConstructors js =
-  concatMap extractLocalConstructors' js
-  where
-    globalCons :: [String]
-    globalCons = concatMap (getGlobalCons) js
-
-
-    extractLocalConstructors' :: JS -> [JS]
-    extractLocalConstructors' js@(JSAlloc fun (Just (JSFunction args body))) =
-      addCons cons [foldr (uncurry jsSubst) js (reverse cons)]
-      where
-        cons :: [(JS, JS)]
-        cons = zipWith genName (foldJS match (++) [] body) [1..]
-          where
-            genName :: JS -> Int -> (JS, JS)
-            genName js id =
-              (js, JSIdent $ idrCTRNamespace ++ fun ++ "_" ++ show id)
-
-            match :: JS -> [JS]
-            match js
-              | JSNew "__IDRRT__Con" args <- js
-              , all isConstant args = [js]
-              | otherwise           = []
-
-
-        addCons :: [(JS, JS)] -> [JS] -> [JS]
-        addCons [] js = js
-        addCons (con@(_, name):cons) js
-          | sum (map (countOccur name) js) > 0 =
-              addCons cons ((allocCon con) : js)
-          | otherwise =
-              addCons cons js
-
-
-        countOccur :: JS -> JS -> Int
-        countOccur ident js = foldJS match (+) 0 js
-          where
-            match :: JS -> Int
-            match js
-              | js == ident = 1
-              | otherwise   = 0
-
-
-        allocCon :: (JS, JS) -> JS
-        allocCon (js, JSIdent name) =
-          JSAlloc name (Just js)
-
-
-        isConstant :: JS -> Bool
-        isConstant js
-          | JSNew "__IDRRT__Con" args <- js
-          , all isConstant args =
-              True
-          | otherwise =
-              isJSConstantConstructor globalCons js
-
-    extractLocalConstructors' js = [js]
-
-
-    getGlobalCons :: JS -> [String]
-    getGlobalCons js = foldJS match (++) [] js
-      where
-        match :: JS -> [String]
-        match js
-          | (JSAlloc name (Just (JSNew "__IDRRT__Con" _))) <- js =
-              [name]
-          | otherwise =
-              []
-
-
-evalCons :: [JS] -> [JS]
-evalCons js =
-  map (collapseCont . collapseTC . expandProj . evalCons') js
-  where
-    cons :: [(String, JS)]
-    cons = concatMap getGlobalCons js
-
-    evalCons' :: JS -> JS
-    evalCons' js = transformJS match js
-      where
-        match :: JS -> JS
-        match (JSApp (JSIdent "__IDRRT__EVALTC") [arg])
-          | JSIdent name                     <- arg
-          , Just (JSNew _ [_, JSNull, _, _]) <- lookupConstructor name cons =
-              arg
-
-        match (JSApp (JSIdent "__IDR__mEVAL0") [arg])
-          | JSIdent name                     <- arg
-          , Just (JSNew _ [_, JSNull, _, _]) <- lookupConstructor name cons =
-              arg
-
-        match js = transformJS match js
-
-
-    lookupConstructor :: String -> [(String, JS)] -> Maybe JS
-    lookupConstructor ctr cons
-      | Just (JSIdent name)  <- lookup ctr cons = lookupConstructor name cons
-      | Just con@(JSNew _ _) <- lookup ctr cons = Just con
-      | otherwise                               = Nothing
-
-
-    expandProj :: JS -> JS
-    expandProj js = transformJS match js
-      where
-        match :: JS -> JS
-        match (
-            JSIndex (
-              JSProj (JSIdent name) "vars"
-            ) (
-              JSNum (JSInt idx)
-            )
-          )
-          | Just (JSNew _ [_, _, _, JSArray args]) <- lookup name cons =
-              args !! idx
-
-        match js = transformJS match js
-
-
-    collapseTC :: JS -> JS
-    collapseTC js = transformJS match js
-      where
-        match :: JS -> JS
-        match (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
-            JSReturn (JSIdent name)
-          )])
-          | Just _ <- lookup name cons = (JSIdent name)
-
-        match js = transformJS match js
-
-
-    collapseCont :: JS -> JS
-    collapseCont js = transformJS match js
-      where
-        match :: JS -> JS
-        match (JSNew "__IDRRT__Cont" [JSFunction [] (
-            JSReturn ret@(JSNew "__IDRRT__Cont" [JSFunction [] _])
-          )]) = collapseCont ret
-
-
-        match (JSNew "__IDRRT__Cont" [JSFunction [] (
-            JSReturn (JSIdent name)
-          )]) = JSIdent name
-
-        match (JSNew "__IDRRT__Cont" [JSFunction [] (
-            JSReturn ret@(JSNew "__IDRRT__Con" [_, _, _, JSArray args])
-          )])
-          | all collapsable args = ret
-          where
-            collapsable :: JS -> Bool
-            collapsable (JSIdent _) = True
-            collapsable js          = isJSConstantConstructor (map fst cons) js
-
-
-        match js = transformJS match js
-
-
-elimConds :: [JS] -> [JS]
-elimConds js =
-  let (conds, rest) = partition isCond js in
-      foldl' eraseCond rest conds
-  where
-    isCond :: JS -> Bool
-    isCond (JSAlloc
-      fun (Just (JSFunction args (JSCond
-          [ (JSBinOp "==" (JSNum (JSInt tag)) (JSProj (JSIdent _) "tag"), JSReturn t)
-          , (JSNoop, JSReturn f)
-          ])))
-      )
-      | isJSConstant t && isJSConstant f =
-          True
-
-      | JSIdent _ <- t
-      , JSIdent _ <- f =
-          True
-
-    isCond (JSAlloc
-      fun (Just (JSFunction args (JSCond
-        [ (JSBinOp "==" (JSIdent _) c, JSReturn t)
-        , (JSNoop, JSReturn f)
-        ])))
-      )
-      | isJSConstant t && isJSConstant f && isJSConstant c =
-          True
-
-      | JSIdent _ <- t
-      , JSIdent _ <- f
-      , isJSConstant c =
-          True
-
-    isCond _ = False
-
-
-    eraseCond :: [JS] -> JS -> [JS]
-    eraseCond js (JSAlloc
-      fun (Just (JSFunction args (JSCond
-                  [ (c, JSReturn t)
-                  , (_, JSReturn f)
-                  ])
-                )
-      )) = map (inlineFunction fun args (JSTernary c t f)) js
-
-
-removeUselessCons :: [JS] -> [JS]
-removeUselessCons js =
-  let (cons, rest) = partition isUseless js in
-      foldl' eraseCon rest cons
-  where
-    isUseless :: JS -> Bool
-    isUseless (JSAlloc fun (Just JSNull))      = True
-    isUseless (JSAlloc fun (Just (JSIdent _))) = True
-    isUseless _                                = False
-
-
-    eraseCon :: [JS] -> JS -> [JS]
-    eraseCon js (JSAlloc fun (Just val))  = map (jsSubst (JSIdent fun) val) js
-
-
-getGlobalCons :: JS -> [(String, JS)]
-getGlobalCons js = foldJS match (++) [] js
-  where
-    match :: JS -> [(String, JS)]
-    match js
-      | (JSAlloc name (Just con@(JSNew "__IDRRT__Con" _))) <- js =
-          [(name, con)]
-      | (JSAlloc name (Just con@(JSIdent _))) <- js =
-          [(name, con)]
-      | otherwise =
-          []
-
-
-getIncludes :: [FilePath] -> IO [String]
-getIncludes = mapM readFile
-
-codegenJavaScript :: CodeGenerator
-codegenJavaScript ci = codegenJS_all JavaScript (simpleDecls ci)
-                              (includes ci) (outputFile ci) (outputType ci)
-
-codegenNode :: CodeGenerator
-codegenNode ci = codegenJS_all Node (simpleDecls ci)
-                        (includes ci) (outputFile ci) (outputType ci)
-
-codegenJS_all
-  :: JSTarget
-  -> [(Name, SDecl)]
-  -> [FilePath]
-  -> FilePath
-  -> OutputType
-  -> IO ()
-codegenJS_all target definitions includes filename outputType = do
-  let (header, rt) = case target of
-                               Node ->
-                                 ("#!/usr/bin/env node\n", "-node")
-                               JavaScript ->
-                                 ("", "-browser")
-  included   <- getIncludes includes
-  path       <- (++) <$> getDataDir <*> (pure "/jsrts/")
-  idrRuntime <- readFile $ path ++ "Runtime-common.js"
-  tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]
-  jsbn       <- readFile $ path ++ "jsbn/jsbn.js"
-  writeFile filename $ header ++ (
-      intercalate "\n" $ included ++ runtime jsbn idrRuntime tgtRuntime ++ functions
-    )
-
-  setPermissions filename (emptyPermissions { readable   = True
-                                            , executable = target == Node
-                                            , writable   = True
-                                            })
-  where
-    def :: [(String, SDecl)]
-    def = map (first translateNamespace) definitions
-
-
-    checkForBigInt :: [JS] -> Bool
-    checkForBigInt js = occur
-      where
-        occur :: Bool
-        occur = or $ map (foldJS match (||) False) js
-
-        match :: JS -> Bool
-        match (JSIdent "__IDRRT__bigInt") = True
-        match (JSWord (JSWord64 _))       = True
-        match (JSNum (JSInteger _))       = True
-        match js                          = False
-
-
-    runtime :: String -> String -> String -> [String]
-    runtime jsbn idrRuntime tgtRuntime =
-      if checkForBigInt optimized
-         then [jsbn, idrRuntime, tgtRuntime]
-         else [idrRuntime, tgtRuntime]
-
-
-    optimized :: [JS]
-    optimized = translate >>> optimize $ def
-      where
-        translate p =
-          prelude ++ concatMap translateDeclaration p ++ [mainLoop, invokeLoop]
-        optimize p  =
-          foldl' (flip ($)) p opt
-
-        opt =
-          [ removeEval
-          , map inlineJS
-          , removeIDs
-          , reduceJS
-          , map reduceConstants
-          , initConstructors
-          , map removeAllocations
-          , elimDeadLoop
-          , map elimDuplicateEvals
-          , optimizeRuntimeCalls "__IDR__mEVAL0" "__IDRRT__EVALTC"
-          , optimizeRuntimeCalls "__IDR__mAPPLY0" "__IDRRT__APPLYTC"
-          , map removeInstanceChecks
-          , inlineFunctions
-          , map reduceContinuations
-          , extractLocalConstructors
-          , unfoldLookupTable
-          , evalCons
-          , elimConds
-          , removeUselessCons
-          ]
-
-    functions :: [String]
-    functions = map compileJS optimized
-
-    prelude :: [JS]
-    prelude =
-      [ JSAnnotation JSConstructor $
-          JSAlloc (idrRTNamespace ++ "Cont") (Just $ JSFunction ["k"] (
-            JSAssign (JSProj JSThis "k") (JSIdent "k")
-          ))
-      , JSAnnotation JSConstructor $
-          JSAlloc (idrRTNamespace ++ "Con") (Just $ JSFunction ["tag", "vars"] (
-            JSSeq [ JSAssign (JSProj JSThis "tag") (JSIdent "tag")
-                  , JSAssign (JSProj JSThis "vars") (JSIdent "vars")
-                  ]
-          ))
-      ]
-
-    mainLoop :: JS
-    mainLoop =
-        JSAlloc "main" $ Just $ JSFunction [] (
-          case target of
-              Node       -> mainFun
-              JavaScript -> JSCond [ (exists document `jsAnd` isReady, mainFun)
-                                   , (exists window, windowMainFun)
-                                   , (JSTrue, mainFun)
-                                   ]
-      )
-      where
-        exists :: JS -> JS
-        exists js = (JSPreOp "typeof " js) `jsNotEq` JSString "undefined"
-
-        mainFun :: JS
-        mainFun = jsTailcall $ jsCall runMain []
-
-        window :: JS
-        window = JSIdent "window"
-
-        document :: JS
-        document = JSIdent "document"
-
-        windowMainFun :: JS
-        windowMainFun = jsMeth window "addEventListener" [
-            JSString "DOMContentLoaded"
-            , JSFunction [] ( mainFun )
-            , JSFalse
-            ]
-
-        isReady :: JS
-        isReady = JSParens $ readyState `jsEq` JSString "complete" `jsOr` readyState `jsEq` JSString "loaded"
-
-        readyState :: JS
-        readyState = JSProj (JSIdent "document") "readyState"
-
-
-        runMain :: String
-        runMain = idrNamespace ++ translateName (sMN 0 "runMain")
-
-
-    invokeLoop :: JS
-    invokeLoop  = jsCall "main" []
-
-
-translateIdentifier :: String -> String
-translateIdentifier =
-  replaceReserved . concatMap replaceBadChars
-  where replaceBadChars :: Char -> String
-        replaceBadChars c
-          | ' ' <- c  = "_"
-          | '_' <- c  = "__"
-          | isDigit c = '_' : show (ord c)
-          | not (isLetter c && isAscii c) = '_' : show (ord c)
-          | otherwise = [c]
-        replaceReserved s
-          | s `elem` reserved = '_' : s
-          | otherwise         = s
-
-
-        reserved = [ "break"
-                   , "case"
-                   , "catch"
-                   , "continue"
-                   , "debugger"
-                   , "default"
-                   , "delete"
-                   , "do"
-                   , "else"
-                   , "finally"
-                   , "for"
-                   , "function"
-                   , "if"
-                   , "in"
-                   , "instanceof"
-                   , "new"
-                   , "return"
-                   , "switch"
-                   , "this"
-                   , "throw"
-                   , "try"
-                   , "typeof"
-                   , "var"
-                   , "void"
-                   , "while"
-                   , "with"
-
-                   , "class"
-                   , "enum"
-                   , "export"
-                   , "extends"
-                   , "import"
-                   , "super"
-
-                   , "implements"
-                   , "interface"
-                   , "let"
-                   , "package"
-                   , "private"
-                   , "protected"
-                   , "public"
-                   , "static"
-                   , "yield"
-                   ]
-
-
-translateNamespace :: Name -> String
-translateNamespace (UN _)    = idrNamespace
-translateNamespace (NS _ ns) = idrNamespace ++ concatMap (translateIdentifier . str) ns
-translateNamespace (MN _ _)  = idrNamespace
-translateNamespace (SN name) = idrNamespace ++ translateSpecialName name
-translateNamespace NErased   = idrNamespace
-
-
-translateName :: Name -> String
-translateName (UN name)   = 'u' : translateIdentifier (str name)
-translateName (NS name _) = 'n' : translateName name
-translateName (MN i name) = 'm' : translateIdentifier (str name) ++ show i
-translateName (SN name)   = 's' : translateSpecialName name
-translateName NErased     = "e"
-
-
-translateSpecialName :: SpecialName -> String
-translateSpecialName name
-  | WhereN i m n  <- name =
-    'w' : translateName m ++ translateName n ++ show i
-  | InstanceN n s <- name =
-    'i' : translateName n ++ concatMap (translateIdentifier . str) s
-  | ParentN n s   <- name =
-    'p' : translateName n ++ translateIdentifier (str s)
-  | MethodN n     <- name =
-    'm' : translateName n
-  | CaseN n       <- name =
-    'c' : translateName n
-
-
-translateConstant :: Const -> JS
-translateConstant (I i)                    = JSNum (JSInt i)
-translateConstant (Fl f)                   = JSNum (JSFloat f)
-translateConstant (Ch c)                   = JSString $ translateChar c
-translateConstant (Str s)                  = JSString $ concatMap translateChar s
-translateConstant (AType (ATInt ITNative)) = JSType JSIntTy
-translateConstant StrType                  = JSType JSStringTy
-translateConstant (AType (ATInt ITBig))    = JSType JSIntegerTy
-translateConstant (AType ATFloat)          = JSType JSFloatTy
-translateConstant (AType (ATInt ITChar))   = JSType JSCharTy
-translateConstant PtrType                  = JSType JSPtrTy
-translateConstant Forgot                   = JSType JSForgotTy
-translateConstant (BI i)                   = jsBigInt $ JSString (show i)
-translateConstant (B8 b)                   = JSWord (JSWord8 b)
-translateConstant (B16 b)                  = JSWord (JSWord16 b)
-translateConstant (B32 b)                  = JSWord (JSWord32 b)
-translateConstant (B64 b)                  = JSWord (JSWord64 b)
-translateConstant c =
-  jsError $ "Unimplemented Constant: " ++ show c
-
-
-translateChar :: Char -> String
-translateChar ch
-  | '\a'   <- ch       = "\\u0007"
-  | '\b'   <- ch       = "\\b"
-  | '\f'   <- ch       = "\\f"
-  | '\n'   <- ch       = "\\n"
-  | '\r'   <- ch       = "\\r"
-  | '\t'   <- ch       = "\\t"
-  | '\v'   <- ch       = "\\v"
-  | '\SO'  <- ch       = "\\u000E"
-  | '\DEL' <- ch       = "\\u007F"
-  | '\\'   <- ch       = "\\\\"
-  | '\"'   <- ch       = "\\\""
-  | '\''   <- ch       = "\\\'"
-  | ch `elem` asciiTab = "\\u00" ++ fill (showIntAtBase 16 intToDigit (ord ch) "")
-  | otherwise          = [ch]
-  where
-    fill :: String -> String
-    fill s = if length s == 1
-                then '0' : s
-                else s
-
-    asciiTab =
-      ['\NUL', '\SOH', '\STX', '\ETX', '\EOT', '\ENQ', '\ACK', '\BEL',
-       '\BS',  '\HT',  '\LF',  '\VT',  '\FF',  '\CR',  '\SO',  '\SI',
-       '\DLE', '\DC1', '\DC2', '\DC3', '\DC4', '\NAK', '\SYN', '\ETB',
-       '\CAN', '\EM',  '\SUB', '\ESC', '\FS',  '\GS',  '\RS',  '\US']
-
-
-translateDeclaration :: (String, SDecl) -> [JS]
-translateDeclaration (path, SFun name params stackSize body)
-  | (MN _ ap)             <- name
-  , (SChkCase var cases) <- body
-  , ap == txt "APPLY" =
-      [ lookupTable "APPLY" [] var cases
-      , jsDecl $ JSFunction ["mfn0", "marg0"] (JSReturn $
-          JSTernary (
-            (JSIdent "mfn0" `jsInstanceOf` jsCon) `jsAnd`
-            (hasProp (idrLTNamespace ++ "APPLY") "mfn0")
-          ) (JSApp
-              (JSIndex
-                (JSIdent (idrLTNamespace ++ "APPLY"))
-                (JSProj (JSIdent "mfn0") "tag")
-              )
-              [JSIdent "mfn0", JSIdent "marg0"]
-          ) JSNull
-        )
-      ]
-
-  | (MN _ ev)            <- name
-  , (SChkCase var cases) <- body
-  , ev == txt "EVAL" =
-      [ lookupTable "EVAL" [] var cases
-      , jsDecl $ JSFunction ["marg0"] (JSReturn $
-          JSTernary (
-            (JSIdent "marg0" `jsInstanceOf` jsCon) `jsAnd`
-            (hasProp (idrLTNamespace ++ "EVAL") "marg0")
-          ) (JSApp
-              (JSIndex
-                (JSIdent (idrLTNamespace ++ "EVAL"))
-                (JSProj (JSIdent "marg0") "tag")
-              )
-              [JSIdent "marg0"]
-          ) (JSIdent "marg0")
-        )
-      ]
-  | otherwise =
-    let fun = translateExpression body in
-        [jsDecl $ jsFun fun]
-
-  where
-    hasProp :: String -> String -> JS
-    hasProp table var =
-      JSIndex (JSIdent table) (JSProj (JSIdent var) "tag")
-
-
-    caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
-    caseFun aux var cse =
-      let (JSReturn c) = translateCase (Just (translateVariableName var)) cse in
-          jsFunAux aux c
-
-
-    getTag :: SAlt -> Maybe Int
-    getTag (SConCase _ tag _ _ _) = Just tag
-    getTag _                      = Nothing
-
-
-    lookupTable :: String -> [(LVar, String)] -> LVar -> [SAlt] -> JS
-    lookupTable table aux var cases =
-      JSAlloc (idrLTNamespace ++ table) $ Just (
-        JSApp (JSFunction [] (
-          JSSeq $ [
-            JSAlloc "t" $ Just (JSArray [])
-          ] ++ assignEntries (catMaybes $ map (lookupEntry aux var) cases) ++ [
-            JSReturn (JSIdent "t")
-          ]
-        )) []
-      )
-      where
-        assignEntries :: [(Int, JS)] -> [JS]
-        assignEntries entries =
-          map (\(tag, fun) ->
-            JSAssign (JSIndex (JSIdent "t") (JSNum $ JSInt tag)) fun
-          ) entries
-
-
-        lookupEntry :: [(LVar, String)] ->  LVar -> SAlt -> Maybe (Int, JS)
-        lookupEntry aux var alt = do
-          tag <- getTag alt
-          return (tag, caseFun aux var alt)
-
-
-    jsDecl :: JS -> JS
-    jsDecl = JSAlloc (path ++ translateName name) . Just
-
-
-    jsFun body = jsFunAux [] body
-
-
-    jsFunAux :: [(LVar, String)] -> JS -> JS
-    jsFunAux aux body =
-      JSFunction (p ++ map snd aux) (
-        JSSeq $
-        zipWith assignVar [0..] p ++
-        map assignAux aux ++
-        [JSReturn body]
-      )
-      where
-        assignVar :: Int -> String -> JS
-        assignVar n s = JSAlloc (jsVar n)  (Just $ JSIdent s)
-
-
-        assignAux :: (LVar, String) -> JS
-        assignAux (Loc var, val) =
-          JSAlloc (jsVar var) (Just $ JSIdent val)
-
-
-        p :: [String]
-        p = map translateName params
-
-
-translateVariableName :: LVar -> String
-translateVariableName (Loc i) =
-  jsVar i
-
-
-translateExpression :: SExp -> JS
-translateExpression (SLet name value body) =
-  jsLet (translateVariableName name) (
-    translateExpression value
-  ) (translateExpression body)
-
-translateExpression (SConst cst) =
-  translateConstant cst
-
-translateExpression (SV var) =
-  JSVar var
-
-translateExpression (SApp tc name vars)
-  | False <- tc =
-    jsTailcall $ translateFunctionCall name vars
-  | True <- tc =
-    JSNew (idrRTNamespace ++ "Cont") [JSFunction [] (
-      JSReturn $ translateFunctionCall name vars
-    )]
-  where
-    translateFunctionCall name vars =
-      jsCall (translateNamespace name ++ translateName name) (map JSVar vars)
-
-translateExpression (SOp op vars)
-  | LNoOp <- op = JSVar (last vars)
-
-  | (LZExt (ITFixed IT8) ITNative)  <- op = jsUnPackBits $ JSVar (last vars)
-  | (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ JSVar (last vars)
-  | (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ JSVar (last vars)
-
-  | (LZExt _ ITBig)        <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
-  | (LPlus (ATInt ITBig))  <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "add" [rhs]
-  | (LMinus (ATInt ITBig)) <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "subtract" [rhs]
-  | (LTimes (ATInt ITBig)) <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "multiply" [rhs]
-  | (LSDiv (ATInt ITBig))  <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "divide" [rhs]
-  | (LSRem (ATInt ITBig))  <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "mod" [rhs]
-  | (LEq (ATInt ITBig))    <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "equals" [rhs]
-  | (LSLt (ATInt ITBig))   <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "lesser" [rhs]
-  | (LSLe (ATInt ITBig))   <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "lesserOrEquals" [rhs]
-  | (LSGt (ATInt ITBig))   <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "greater" [rhs]
-  | (LSGe (ATInt ITBig))   <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "greaterOrEquals" [rhs]
-
-  | (LPlus ATFloat)  <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "+" lhs rhs
-  | (LMinus ATFloat) <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "-" lhs rhs
-  | (LTimes ATFloat) <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "*" lhs rhs
-  | (LSDiv ATFloat)  <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "/" lhs rhs
-  | (LEq ATFloat)    <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "==" lhs rhs
-  | (LSLt ATFloat)   <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "<" lhs rhs
-  | (LSLe ATFloat)   <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp "<=" lhs rhs
-  | (LSGt ATFloat)   <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp ">" lhs rhs
-  | (LSGe ATFloat)   <- op
-  , (lhs:rhs:_)      <- vars = translateBinaryOp ">=" lhs rhs
-
-  | (LPlus (ATInt ITChar)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsCall "__IDRRT__fromCharCode" [
-        JSBinOp "+" (
-          jsCall "__IDRRT__charCode" [JSVar lhs]
-        ) (
-          jsCall "__IDRRT__charCode" [JSVar rhs]
-        )
-      ]
-
-  | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op
-  , (arg:_)                               <- vars =
-      jsPackUBits8 (
-        JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFF))
-      )
-
-  | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op
-  , (arg:_)                                <- vars =
-      jsPackUBits16 (
-        JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFFFF))
-      )
-
-  | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op
-  , (arg:_)                                <- vars =
-      jsPackUBits32 (
-        jsMeth (jsMeth (JSVar arg) "and" [
-          jsBigInt (JSString $ show 0xFFFFFFFF)
-        ]) "intValue" []
-      )
-
-  | (LTrunc ITBig (ITFixed IT64)) <- op
-  , (arg:_)                       <- vars =
-      jsMeth (JSVar arg) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LLSHR (ITFixed IT8)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits8 (
-        JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LLSHR (ITFixed IT16)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsPackUBits16 (
-        JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LLSHR (ITFixed IT32)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsPackUBits32  (
-        JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LLSHR (ITFixed IT64)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsMeth (JSVar lhs) "shiftRight" [JSVar rhs]
-
-  | (LSHL (ITFixed IT8)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits8 (
-        JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LSHL (ITFixed IT16)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits16 (
-        JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LSHL (ITFixed IT32)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits32  (
-        JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
-      )
-
-  | (LSHL (ITFixed IT64)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsMeth (jsMeth (JSVar lhs) "shiftLeft" [JSVar rhs]) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LAnd (ITFixed IT8)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits8 (
-        JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LAnd (ITFixed IT16)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits16 (
-        JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LAnd (ITFixed IT32)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits32 (
-        JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LAnd (ITFixed IT64)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsMeth (JSVar lhs) "and" [JSVar rhs]
-
-  | (LOr (ITFixed IT8)) <- op
-  , (lhs:rhs:_)         <- vars =
-      jsPackUBits8 (
-        JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LOr (ITFixed IT16)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits16 (
-        JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LOr (ITFixed IT32)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits32 (
-        JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LOr (ITFixed IT64)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsMeth (JSVar lhs) "or" [JSVar rhs]
-
-  | (LXOr (ITFixed IT8)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits8 (
-        JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LXOr (ITFixed IT16)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits16 (
-        JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LXOr (ITFixed IT32)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits32 (
-        JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LXOr (ITFixed IT64)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsMeth (JSVar lhs) "xor" [JSVar rhs]
-
-  | (LPlus (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                   <- vars =
-      jsPackUBits8 (
-        JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LPlus (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackUBits16 (
-        JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LPlus (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackUBits32 (
-        JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LPlus (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsMeth (jsMeth (JSVar lhs) "add" [JSVar rhs]) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LMinus (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackUBits8 (
-        JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LMinus (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsPackUBits16 (
-        JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LMinus (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsPackUBits32 (
-        JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LMinus (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsMeth (jsMeth (JSVar lhs) "subtract" [JSVar rhs]) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LTimes (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackUBits8 (
-        JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LTimes (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsPackUBits16 (
-        JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LTimes (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsPackUBits32 (
-        JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LTimes (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                     <- vars =
-      jsMeth (jsMeth (JSVar lhs) "multiply" [JSVar rhs]) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LEq (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                 <- vars =
-      jsPackUBits8 (
-        JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LEq (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                  <- vars =
-      jsPackUBits16 (
-        JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LEq (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                  <- vars =
-      jsPackUBits32 (
-        JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LEq (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                   <- vars =
-      jsMeth (jsMeth (JSVar lhs) "equals" [JSVar rhs]) "and" [
-        jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
-      ]
-
-  | (LLt (ITFixed IT8)) <- op
-  , (lhs:rhs:_)         <- vars =
-      jsPackUBits8 (
-        JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLt (ITFixed IT16)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits16 (
-        JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLt (ITFixed IT32)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits32 (
-        JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLt (ITFixed IT64)) <- op
-  , (lhs:rhs:_)          <- vars = invokeMeth lhs "lesser" [rhs]
-
-  | (LLe (ITFixed IT8)) <- op
-  , (lhs:rhs:_)         <- vars =
-      jsPackUBits8 (
-        JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLe (ITFixed IT16)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits16 (
-        JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLe (ITFixed IT32)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits32 (
-        JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LLe (ITFixed IT64)) <- op
-  , (lhs:rhs:_)          <- vars = invokeMeth lhs "lesserOrEquals" [rhs]
-
-  | (LGt (ITFixed IT8)) <- op
-  , (lhs:rhs:_)         <- vars =
-      jsPackUBits8 (
-        JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LGt (ITFixed IT16)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits16 (
-        JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-  | (LGt (ITFixed IT32)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits32 (
-        JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LGt (ITFixed IT64)) <- op
-  , (lhs:rhs:_)          <- vars = invokeMeth lhs "greater" [rhs]
-
-  | (LGe (ITFixed IT8)) <- op
-  , (lhs:rhs:_)         <- vars =
-      jsPackUBits8 (
-        JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LGe (ITFixed IT16)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits16 (
-        JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-  | (LGe (ITFixed IT32)) <- op
-  , (lhs:rhs:_)          <- vars =
-      jsPackUBits32 (
-        JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LGe (ITFixed IT64)) <- op
-  , (lhs:rhs:_)          <- vars = invokeMeth lhs "greaterOrEquals" [rhs]
-
-  | (LUDiv (ITFixed IT8)) <- op
-  , (lhs:rhs:_)           <- vars =
-      jsPackUBits8 (
-        JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LUDiv (ITFixed IT16)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsPackUBits16 (
-        JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LUDiv (ITFixed IT32)) <- op
-  , (lhs:rhs:_)            <- vars =
-      jsPackUBits32 (
-        JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
-      )
-
-  | (LUDiv (ITFixed IT64)) <- op
-  , (lhs:rhs:_)            <- vars = invokeMeth lhs "divide" [rhs]
-
-  | (LSDiv (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                   <- vars =
-      jsPackSBits8 (
-        JSBinOp "/" (
-          jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSDiv (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackSBits16 (
-        JSBinOp "/" (
-          jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSDiv (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackSBits32 (
-        JSBinOp "/" (
-          jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSDiv (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                    <- vars = invokeMeth lhs "divide" [rhs]
-
-  | (LSRem (ATInt (ITFixed IT8))) <- op
-  , (lhs:rhs:_)                   <- vars =
-      jsPackSBits8 (
-        JSBinOp "%" (
-          jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSRem (ATInt (ITFixed IT16))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackSBits16 (
-        JSBinOp "%" (
-          jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSRem (ATInt (ITFixed IT32))) <- op
-  , (lhs:rhs:_)                    <- vars =
-      jsPackSBits32 (
-        JSBinOp "%" (
-          jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)
-        ) (
-          jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)
-        )
-      )
-
-  | (LSRem (ATInt (ITFixed IT64))) <- op
-  , (lhs:rhs:_)                    <- vars = invokeMeth lhs "mod" [rhs]
-
-  | (LCompl (ITFixed IT8)) <- op
-  , (arg:_)                <- vars =
-      jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)
-
-  | (LCompl (ITFixed IT16)) <- op
-  , (arg:_)                 <- vars =
-      jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)
-
-  | (LCompl (ITFixed IT32)) <- op
-  , (arg:_)                 <- vars =
-      jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)
-
-  | (LCompl (ITFixed IT64)) <- op
-  , (arg:_)     <- vars =
-      invokeMeth arg "not" []
-
-  | (LPlus _)   <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
-  | (LMinus _)  <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs
-  | (LTimes _)  <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs
-  | (LSDiv _)   <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs
-  | (LSRem _)   <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs
-  | (LEq _)     <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
-  | (LSLt _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs
-  | (LSLe _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs
-  | (LSGt _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs
-  | (LSGe _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
-  | (LAnd _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs
-  | (LOr _)     <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs
-  | (LXOr _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs
-  | (LSHL _)    <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs
-  | (LASHR _)   <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs
-  | (LCompl _)  <- op
-  , (arg:_)     <- vars = JSPreOp "~" (JSVar arg)
-
-  | LStrConcat  <- op
-  , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
-  | LStrEq      <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
-  | LStrLt      <- op
-  , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs
-  | LStrLen     <- op
-  , (arg:_)     <- vars = JSProj (JSVar arg) "length"
-
-  | (LStrInt ITNative)      <- op
-  , (arg:_)                 <- vars = jsCall "parseInt" [JSVar arg]
-  | (LIntStr ITNative)      <- op
-  , (arg:_)                 <- vars = jsCall "String" [JSVar arg]
-  | (LSExt ITNative ITBig)  <- op
-  , (arg:_)                 <- vars = jsBigInt $ jsCall "String" [JSVar arg]
-  | (LTrunc ITBig ITNative) <- op
-  , (arg:_)                 <- vars = jsMeth (JSVar arg) "intValue" []
-  | (LIntStr ITBig)         <- op
-  , (arg:_)                 <- vars = jsMeth (JSVar arg) "toString" []
-  | (LStrInt ITBig)         <- op
-  , (arg:_)                 <- vars = jsBigInt $ JSVar arg
-  | LFloatStr               <- op
-  , (arg:_)                 <- vars = jsCall "String" [JSVar arg]
-  | LStrFloat               <- op
-  , (arg:_)                 <- vars = jsCall "parseFloat" [JSVar arg]
-  | (LIntFloat ITNative)    <- op
-  , (arg:_)                 <- vars = JSVar arg
-  | (LFloatInt ITNative)    <- op
-  , (arg:_)                 <- vars = JSVar arg
-  | (LChInt ITNative)       <- op
-  , (arg:_)                 <- vars = jsCall "__IDRRT__charCode" [JSVar arg]
-  | (LIntCh ITNative)       <- op
-  , (arg:_)                 <- vars = jsCall "__IDRRT__fromCharCode" [JSVar arg]
-
-  | LFExp       <- op
-  , (arg:_)     <- vars = jsCall "Math.exp" [JSVar arg]
-  | LFLog       <- op
-  , (arg:_)     <- vars = jsCall "Math.log" [JSVar arg]
-  | LFSin       <- op
-  , (arg:_)     <- vars = jsCall "Math.sin" [JSVar arg]
-  | LFCos       <- op
-  , (arg:_)     <- vars = jsCall "Math.cos" [JSVar arg]
-  | LFTan       <- op
-  , (arg:_)     <- vars = jsCall "Math.tan" [JSVar arg]
-  | LFASin      <- op
-  , (arg:_)     <- vars = jsCall "Math.asin" [JSVar arg]
-  | LFACos      <- op
-  , (arg:_)     <- vars = jsCall "Math.acos" [JSVar arg]
-  | LFATan      <- op
-  , (arg:_)     <- vars = jsCall "Math.atan" [JSVar arg]
-  | LFSqrt      <- op
-  , (arg:_)     <- vars = jsCall "Math.sqrt" [JSVar arg]
-  | LFFloor     <- op
-  , (arg:_)     <- vars = jsCall "Math.floor" [JSVar arg]
-  | LFCeil      <- op
-  , (arg:_)     <- vars = jsCall "Math.ceil" [JSVar arg]
-
-  | LStrCons    <- op
-  , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
-  | LStrHead    <- op
-  , (arg:_)     <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
-  | LStrRev     <- op
-  , (arg:_)     <- vars = JSProj (JSVar arg) "split('').reverse().join('')"
-  | LStrIndex   <- op
-  , (lhs:rhs:_) <- vars = JSIndex (JSVar lhs) (JSVar rhs)
-  | LStrTail    <- op
-  , (arg:_)     <- vars = let v = translateVariableName arg in
-                              JSApp (JSProj (JSIdent v) "substr") [
-                                JSNum (JSInt 1),
-                                JSBinOp "-" (JSProj (JSIdent v) "length") (JSNum (JSInt 1))
-                              ]
-  | LSystemInfo <- op
-  , (arg:_) <- vars = jsCall "__IDRRT__systemInfo"  [JSVar arg]
-  | LNullPtr    <- op
-  , (_)         <- vars = JSNull
-
-  where
-    translateBinaryOp :: String -> LVar -> LVar -> JS
-    translateBinaryOp f lhs rhs = JSParens $ JSBinOp f (JSVar lhs) (JSVar rhs)
-
-
-    invokeMeth :: LVar -> String -> [LVar] -> JS
-    invokeMeth obj meth args = jsMeth (JSVar obj) meth (map JSVar args)
-
-translateExpression (SError msg) =
-  jsError msg
-
-translateExpression (SForeign _ _ "putStr" [(FString, var)]) =
-  jsCall (idrRTNamespace ++ "print") [JSVar var]
-
-translateExpression (SForeign _ _ "isNull" [(FPtr, var)]) =
-  JSBinOp "==" (JSVar var) JSNull
-
-translateExpression (SForeign _ _ "idris_eqPtr" [(FPtr, lhs),(FPtr, rhs)]) =
-  JSBinOp "==" (JSVar lhs) (JSVar rhs)
-
-translateExpression (SForeign _ _ "idris_time" []) =
-  JSRaw "(new Date()).getTime()"
-
-translateExpression (SForeign _ _ fun args) =
-  JSFFI fun (map generateWrapper args)
-  where
-    generateWrapper (ffunc, name)
-      | FFunction   <- ffunc =
-          JSApp (
-            JSIdent $ idrRTNamespace ++ "ffiWrap"
-          ) [JSIdent $ translateVariableName name]
-      | FFunctionIO <- ffunc =
-          JSApp (
-            JSIdent $ idrRTNamespace ++ "ffiWrap"
-          ) [JSIdent $ translateVariableName name]
-
-    generateWrapper (_, name) =
-      JSIdent $ translateVariableName name
-
-translateExpression patterncase
-  | (SChkCase var cases) <- patterncase = caseHelper var cases "chk"
-  | (SCase var cases)    <- patterncase = caseHelper var cases "cse"
-  where
-    caseHelper var cases param =
-      JSApp (JSFunction [param] (
-        JSCond $ map (expandCase param . translateCaseCond param) cases
-      )) [JSVar var]
-
-
-    expandCase :: String -> (Cond, JS) -> (JS, JS)
-    expandCase _ (RawCond cond, branch) = (cond, branch)
-    expandCase _ (CaseCond DefaultCase, branch) = (JSTrue , branch)
-    expandCase var (CaseCond caseTy, branch)
-      | ConCase tag <- caseTy =
-          let checkCon = JSIdent var `jsInstanceOf` jsCon
-              checkTag = (JSNum $ JSInt tag) `jsEq` jsTag (JSIdent var) in
-              (checkCon `jsAnd` checkTag, branch)
-
-      | TypeCase ty <- caseTy =
-          let checkTy  = JSIdent var `jsInstanceOf` jsType
-              checkTag = jsTypeTag (JSIdent var) `jsEq` JSType ty in
-              (checkTy `jsAnd` checkTag, branch)
-
-translateExpression (SCon i name vars) =
-  JSNew (idrRTNamespace ++ "Con") [ JSNum $ JSInt i
-                                  , JSArray $ map JSVar vars
-                                  ]
-
-translateExpression (SUpdate var@(Loc i) e) =
-  JSAssign (JSVar var) (translateExpression e)
-
-translateExpression (SProj var i) =
-  JSIndex (JSProj (JSVar var) "vars") (JSNum $ JSInt i)
-
-translateExpression SNothing = JSNull
-
-translateExpression e =
-  jsError $ "Not yet implemented: " ++ filter (/= '\'') (show e)
-
-
-data CaseType = ConCase Int
-              | TypeCase JSType
-              | DefaultCase
-              deriving Eq
-
-
-data Cond = CaseCond CaseType
-          | RawCond JS
-
-
-translateCaseCond :: String -> SAlt -> (Cond, JS)
-translateCaseCond _ cse@(SDefaultCase _) =
-  (CaseCond DefaultCase, translateCase Nothing cse)
-
-translateCaseCond var cse@(SConstCase ty _)
-  | StrType                  <- ty = matchHelper JSStringTy
-  | PtrType                  <- ty = matchHelper JSPtrTy
-  | Forgot                   <- ty = matchHelper JSForgotTy
-  | (AType ATFloat)          <- ty = matchHelper JSFloatTy
-  | (AType (ATInt ITBig))    <- ty = matchHelper JSIntegerTy
-  | (AType (ATInt ITNative)) <- ty = matchHelper JSIntTy
-  | (AType (ATInt ITChar))   <- ty = matchHelper JSCharTy
-  where
-    matchHelper :: JSType -> (Cond, JS)
-    matchHelper ty = (CaseCond $ TypeCase ty, translateCase Nothing cse)
-
-translateCaseCond var cse@(SConstCase cst@(BI _) _) =
-  let cond = jsMeth (JSIdent var) "equals" [translateConstant cst] in
-      (RawCond cond, translateCase Nothing cse)
-
-translateCaseCond var cse@(SConstCase cst _) =
-  let cond = JSIdent var `jsEq` translateConstant cst in
-      (RawCond cond, translateCase Nothing cse)
-
-translateCaseCond var cse@(SConCase _ tag _ _ _) =
-  (CaseCond $ ConCase tag, translateCase (Just var) cse)
-
-
-translateCase :: Maybe String -> SAlt -> JS
-translateCase _          (SDefaultCase e) = JSReturn $ translateExpression e
-translateCase _          (SConstCase _ e) = JSReturn $ translateExpression e
-translateCase (Just var) (SConCase a _ _ vars e) =
-  let params = map jsVar [a .. (a + length vars)] in
-      JSReturn $ jsMeth (JSFunction params (JSReturn $ translateExpression e)) "apply" [
-        JSThis, JSProj (JSIdent var) "vars"
-      ]
+{-# LANGUAGE OverloadedStrings #-}
+module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
+
+import IRTS.JavaScript.AST
+
+import Idris.AbsSyntax hiding (TypeCase)
+import IRTS.Bytecode
+import IRTS.Lang
+import IRTS.Simplified
+import IRTS.CodegenCommon
+import Idris.Core.TT
+import IRTS.System
+import Util.System
+
+import Control.Arrow
+import Control.Monad (mapM)
+import Control.Applicative ((<$>), (<*>), pure)
+import Control.Monad.RWS hiding (mapM)
+import Control.Monad.State
+import Data.Char
+import Numeric
+import Data.List
+import Data.Maybe
+import Data.Word
+import Data.Traversable hiding (mapM)
+import System.IO
+import System.Directory
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+
+data CompileInfo = CompileInfo { compileInfoApplyCases  :: [Int]
+                               , compileInfoEvalCases   :: [Int]
+                               , compileInfoNeedsBigInt :: Bool
+                               }
+
+
+initCompileInfo :: [(Name, [BC])] -> CompileInfo
+initCompileInfo bc =
+  CompileInfo (collectCases "APPLY" bc) (collectCases "EVAL" bc) (lookupBigInt bc)
+  where
+    lookupBigInt :: [(Name, [BC])] -> Bool
+    lookupBigInt = any (needsBigInt . snd)
+      where
+        needsBigInt :: [BC] -> Bool
+        needsBigInt bc = or $ map testBCForBigInt bc
+          where
+            testBCForBigInt :: BC -> Bool
+            testBCForBigInt (ASSIGNCONST _ c)  =
+              testConstForBigInt c
+
+            testBCForBigInt (CONSTCASE _ c d) =
+                 maybe False needsBigInt d
+              || (or $ map (needsBigInt . snd) c)
+              || (or $ map (testConstForBigInt . fst) c)
+
+            testBCForBigInt _ = False
+
+            testConstForBigInt :: Const -> Bool
+            testConstForBigInt (BI _)  = True
+            testConstForBigInt (B64 _) = True
+            testConstForBigInt _       = False
+
+
+    collectCases :: String ->  [(Name, [BC])] -> [Int]
+    collectCases fun bc = getCases $ findFunction fun bc
+
+    findFunction :: String -> [(Name, [BC])] -> [BC]
+    findFunction f ((MN 0 fun, bc):_)
+      | fun == txt f = bc
+    findFunction f (_:bc) = findFunction f bc
+
+    getCases :: [BC] -> [Int]
+    getCases = concatMap analyze
+      where
+        analyze :: BC -> [Int]
+        analyze (CASE _ _ b _) = map fst b
+        analyze _              = []
+
+
+data JSTarget = Node | JavaScript deriving Eq
+
+
+codegenJavaScript :: CodeGenerator
+codegenJavaScript ci =
+  codegenJS_all JavaScript (simpleDecls ci)
+    (includes ci) [] (outputFile ci) (outputType ci)
+
+codegenNode :: CodeGenerator
+codegenNode ci =
+  codegenJS_all Node (simpleDecls ci)
+    (includes ci) (compileLibs ci) (outputFile ci) (outputType ci)
+
+codegenJS_all
+  :: JSTarget
+  -> [(Name, SDecl)]
+  -> [FilePath]
+  -> [String]
+  -> FilePath
+  -> OutputType
+  -> IO ()
+codegenJS_all target definitions includes libs filename outputType = do
+  let bytecode = map toBC definitions
+  let info = initCompileInfo bytecode
+  let js = concatMap (translateDecl info) bytecode
+  let full = concatMap processFunction js
+  let code = deadCodeElim full
+  let (cons, opt) = optimizeConstructors code
+  let (header, rt) = case target of
+                          Node -> ("#!/usr/bin/env node\n", "-node")
+                          JavaScript -> ("", "-browser")
+
+  included   <- concat <$> getIncludes includes
+  path       <- (++) <$> getDataDir <*> (pure "/jsrts/")
+  idrRuntime <- readFile $ path ++ "Runtime-common.js"
+  tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]
+  jsbn       <- if compileInfoNeedsBigInt info
+                   then readFile $ path ++ "jsbn/jsbn.js"
+                   else return ""
+  let runtime = (  header
+                ++ includeLibs libs
+                ++ included
+                ++ jsbn
+                ++ idrRuntime
+                ++ tgtRuntime
+                )
+  TIO.writeFile filename (  T.pack runtime
+                         `T.append` T.concat (map compileJS opt)
+                         `T.append` T.concat (map compileJS cons)
+                         `T.append` main
+                         `T.append` invokeMain
+                         )
+  setPermissions filename (emptyPermissions { readable   = True
+                                            , executable = target == Node
+                                            , writable   = True
+                                            })
+    where
+      deadCodeElim :: [JS] -> [JS]
+      deadCodeElim js = concatMap collectFunctions js
+        where
+          collectFunctions :: JS -> [JS]
+          collectFunctions fun@(JSAlloc name _)
+            | name == translateName (sMN 0 "runMain") = [fun]
+
+          collectFunctions fun@(JSAlloc name (Just (JSFunction _ body))) =
+            let invokations = sum $ map (
+                    \x -> execState (countInvokations name x) 0
+                  ) js
+             in if invokations == 0
+                   then []
+                   else [fun]
+
+          countInvokations :: String -> JS -> State Int ()
+          countInvokations name (JSAlloc _ (Just (JSFunction _ body))) =
+            countInvokations name body
+
+          countInvokations name (JSSeq seq) =
+            void $ traverse (countInvokations name) seq
+
+          countInvokations name (JSAssign _ rhs) =
+            countInvokations name rhs
+
+          countInvokations name (JSCond conds) =
+            void $ traverse (
+                runKleisli $ arr id *** Kleisli (countInvokations name)
+              ) conds
+
+          countInvokations name (JSSwitch _ conds def) =
+            void $ traverse (
+              runKleisli $ arr id *** Kleisli (countInvokations name)
+            ) conds >> traverse (countInvokations name) def
+
+          countInvokations name (JSApp lhs rhs) =
+            void $ countInvokations name lhs >> traverse (countInvokations name) rhs
+
+          countInvokations name (JSNew _ args) =
+            void $ traverse (countInvokations name) args
+
+          countInvokations name (JSArray args) =
+            void $ traverse (countInvokations name) args
+
+          countInvokations name (JSIdent name')
+            | name == name' = get >>= put . (+1)
+            | otherwise     = return ()
+
+          countInvokations _ _ = return ()
+
+      processFunction :: JS -> [JS]
+      processFunction =
+        collectSplitFunctions . (\x -> evalRWS (splitFunction x) () 0)
+
+      includeLibs :: [String] -> String
+      includeLibs =
+        concatMap (\lib -> "var " ++ lib ++ " = require(\"" ++ lib ++"\");\n")
+
+      getIncludes :: [FilePath] -> IO [String]
+      getIncludes = mapM readFile
+
+      main :: T.Text
+      main =
+        compileJS $ JSAlloc "main" (Just $
+          JSFunction [] (
+            case target of
+                 Node       -> mainFun
+                 JavaScript -> jsMain
+          )
+        )
+
+      jsMain :: JS
+      jsMain =
+        JSCond [ (exists document `jsAnd` isReady, mainFun)
+               , (exists window, windowMainFun)
+               , (JSTrue, mainFun)
+               ]
+        where
+          exists :: JS -> JS
+          exists js = jsTypeOf js `jsNotEq` JSString "undefined"
+
+          window :: JS
+          window = JSIdent "window"
+
+          document :: JS
+          document = JSIdent "document"
+
+          windowMainFun :: JS
+          windowMainFun =
+            jsMeth window "addEventListener" [ JSString "DOMContentLoaded"
+                                             , JSFunction [] ( mainFun )
+                                             , JSFalse
+                                             ]
+
+          isReady :: JS
+          isReady = JSParens $ readyState `jsEq` JSString "complete" `jsOr` readyState `jsEq` JSString "loaded"
+
+          readyState :: JS
+          readyState = JSProj (JSIdent "document") "readyState"
+
+      mainFun :: JS
+      mainFun =
+        JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
+              , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
+              , JSApp (
+                  JSIdent (translateName (sMN 0 "runMain"))
+                ) [JSNum (JSInt 0)]
+              , JSWhile (JSProj jsCALLSTACK "length") (
+                  JSSeq [ JSAlloc "func" (Just jsPOP)
+                        , JSAlloc "args" (Just jsPOP)
+                        , JSApp (JSProj (JSIdent "func") "apply") [JSThis, JSIdent "args"]
+                        ]
+                )
+              ]
+
+      invokeMain :: T.Text
+      invokeMain = compileJS $ JSApp (JSIdent "main") []
+
+optimizeConstructors :: [JS] -> ([JS], [JS])
+optimizeConstructors js =
+    let (js', cons) = runState (traverse optimizeConstructor' js) M.empty in
+        (map (allocCon . snd) (M.toList cons), js')
+  where
+    allocCon :: (String, JS) -> JS
+    allocCon (name, con) = JSAlloc name (Just con)
+
+    newConstructor :: Int -> String
+    newConstructor n = "i$CON$" ++ show n
+
+    optimizeConstructor' :: JS -> State (M.Map Int (String, JS)) JS
+    optimizeConstructor' js@(JSNew "i$CON" [ JSNum (JSInt tag)
+                                           , JSArray []
+                                           , a
+                                           , e
+                                           ]) = do
+      s <- get
+      case M.lookup tag s of
+           Just (i, c) -> return $ JSIdent i
+           Nothing     -> do let n = newConstructor tag
+                             put $ M.insert tag (n, js) s
+                             return $ JSIdent n
+
+    optimizeConstructor' (JSSeq seq) =
+      JSSeq <$> traverse optimizeConstructor' seq
+
+    optimizeConstructor' (JSSwitch reg cond def) = do
+      cond' <- traverse (runKleisli $ arr id *** Kleisli optimizeConstructor') cond
+      def'  <- traverse optimizeConstructor' def
+      return $ JSSwitch reg cond' def'
+
+    optimizeConstructor' (JSCond cond) =
+      JSCond <$> traverse (runKleisli $ arr id *** Kleisli optimizeConstructor') cond
+
+    optimizeConstructor' (JSAlloc fun (Just (JSFunction args body))) = do
+      body' <- optimizeConstructor' body
+      return $ JSAlloc fun (Just (JSFunction args body'))
+
+    optimizeConstructor' (JSAssign lhs rhs) = do
+      lhs' <- optimizeConstructor' lhs
+      rhs' <- optimizeConstructor' rhs
+      return $ JSAssign lhs' rhs'
+
+    optimizeConstructor' js = return js
+
+collectSplitFunctions :: (JS, [(Int,JS)]) -> [JS]
+collectSplitFunctions (fun, splits) = map generateSplitFunction splits ++ [fun]
+  where
+    generateSplitFunction :: (Int,JS) -> JS
+    generateSplitFunction (depth, JSAlloc name fun) =
+      JSAlloc (name ++ "$" ++ show depth) fun
+
+splitFunction :: JS -> RWS () [(Int,JS)] Int JS
+splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
+  body' <- splitSequence body
+  return $ JSAlloc name (Just (JSFunction args body'))
+    where
+      splitCondition :: JS -> RWS () [(Int,JS)] Int JS
+      splitCondition js
+        | JSCond branches <- js =
+            JSCond <$> processBranches branches
+        | JSSwitch cond branches def <- js =
+            JSSwitch cond <$> (processBranches branches) <*> (traverse splitSequence def)
+        | otherwise = return js
+        where
+          processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]
+          processBranches =
+            traverse (runKleisli (arr id *** Kleisli splitSequence))
+
+      splitSequence :: JS -> RWS () [(Int, JS)] Int JS
+      splitSequence js@(JSSeq seq) =
+        let (pre,post) = break isCall seq in
+            case post of
+                 []                    -> JSSeq <$> traverse splitCondition seq
+                 [js@(JSCond _)]       -> splitCondition js
+                 [js@(JSSwitch {})] -> splitCondition js
+                 [_]                   -> return js
+                 (call:rest) -> do
+                   depth <- get
+                   put (depth + 1)
+                   new <- splitFunction (newFun rest)
+                   tell [(depth, new)]
+                   return $ JSSeq (pre ++ (newCall depth : [call]))
+
+      splitSequence js = return js
+
+      isCall :: JS -> Bool
+      isCall (JSApp (JSIdent "i$CALL") _) = True
+      isCall _                            = False
+
+      newCall :: Int -> JS
+      newCall depth =
+        JSApp (JSIdent "i$CALL") [ JSIdent $ name ++ "$" ++ show depth
+                                 , JSArray [jsOLDBASE, jsMYOLDBASE]
+                                 ]
+
+      newFun :: [JS] -> JS
+      newFun seq =
+        JSAlloc name (Just $ JSFunction ["oldbase", "myoldbase"] (JSSeq seq))
+
+splitFunction js = return js
+
+translateDecl :: CompileInfo -> (Name, [BC]) -> [JS]
+translateDecl info (name@(MN 0 fun), bc)
+  | txt "APPLY" == fun =
+         allocCaseFunctions (snd body)
+      ++ [ JSAlloc (
+               translateName name
+           ) (Just $ JSFunction ["oldbase"] (
+               JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
+                 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
+                          , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
+                          )
+                          , ( JSNoop
+                            , JSSeq $ map (translateBC info) (defaultCase (snd body))
+                            )
+                        ]
+               ]
+             )
+           )
+         ]
+
+  | txt "EVAL" == fun =
+         allocCaseFunctions (snd body)
+      ++ [ JSAlloc (
+               translateName name
+           ) (Just $ JSFunction ["oldbase"] (
+               JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
+                 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
+                          , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
+                          )
+                          , ( JSNoop
+                            , JSSeq $ map (translateBC info) (defaultCase (snd body))
+                            )
+                        ]
+               ]
+             )
+           )
+         ]
+  where
+    body :: ([BC], [BC])
+    body = break isCase bc
+
+    isCase :: BC -> Bool
+    isCase bc
+      | CASE {} <- bc = True
+      | otherwise          = False
+
+    defaultCase :: [BC] -> [BC]
+    defaultCase ((CASE _ _ _ (Just d)):_) = d
+
+    caseReg :: [BC] -> Reg
+    caseReg ((CASE _ r _ _):_) = r
+
+    allocCaseFunctions :: [BC] -> [JS]
+    allocCaseFunctions ((CASE _ _ c _):_) = splitBranches c
+    allocCaseFunctions _                  = []
+
+    splitBranches :: [(Int, [BC])] -> [JS]
+    splitBranches = map prepBranch
+
+    prepBranch :: (Int, [BC]) -> JS
+    prepBranch (tag, code) =
+      JSAlloc (
+        translateName name ++ "$" ++ show tag
+      ) (Just $ JSFunction ["oldbase", "myoldbase"] (
+          JSSeq $ map (translateBC info) code
+        )
+      )
+
+translateDecl info (name, bc) =
+  [ JSAlloc (
+       translateName name
+     ) (Just $ JSFunction ["oldbase"] (
+         JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info)bc
+       )
+     )
+  ]
+
+
+translateReg :: Reg -> JS
+translateReg reg
+  | RVal <- reg = jsRET
+  | Tmp  <- reg = JSRaw "//TMPREG"
+  | L n  <- reg = jsLOC n
+  | T n  <- reg = jsTOP n
+
+translateConstant :: Const -> JS
+translateConstant (I i)                    = JSNum (JSInt i)
+translateConstant (Fl f)                   = JSNum (JSFloat f)
+translateConstant (Ch c)                   = JSString $ translateChar c
+translateConstant (Str s)                  = JSString $ concatMap translateChar s
+translateConstant (AType (ATInt ITNative)) = JSType JSIntTy
+translateConstant StrType                  = JSType JSStringTy
+translateConstant (AType (ATInt ITBig))    = JSType JSIntegerTy
+translateConstant (AType ATFloat)          = JSType JSFloatTy
+translateConstant (AType (ATInt ITChar))   = JSType JSCharTy
+translateConstant PtrType                  = JSType JSPtrTy
+translateConstant Forgot                   = JSType JSForgotTy
+translateConstant (BI 0)                   = JSNum (JSInteger JSBigZero)
+translateConstant (BI 1)                   = JSNum (JSInteger JSBigOne)
+translateConstant (BI i)                   = jsBigInt (JSString $ show i)
+translateConstant (B8 b)                   = JSWord (JSWord8 b)
+translateConstant (B16 b)                  = JSWord (JSWord16 b)
+translateConstant (B32 b)                  = JSWord (JSWord32 b)
+translateConstant (B64 b)                  = JSWord (JSWord64 b)
+translateConstant c =
+  JSError $ "Unimplemented Constant: " ++ show c
+
+
+translateChar :: Char -> String
+translateChar ch
+  | '\a'   <- ch       = "\\u0007"
+  | '\b'   <- ch       = "\\b"
+  | '\f'   <- ch       = "\\f"
+  | '\n'   <- ch       = "\\n"
+  | '\r'   <- ch       = "\\r"
+  | '\t'   <- ch       = "\\t"
+  | '\v'   <- ch       = "\\v"
+  | '\SO'  <- ch       = "\\u000E"
+  | '\DEL' <- ch       = "\\u007F"
+  | '\\'   <- ch       = "\\\\"
+  | '\"'   <- ch       = "\\\""
+  | '\''   <- ch       = "\\\'"
+  | ch `elem` asciiTab = "\\u00" ++ fill (showHex (ord ch) "")
+  | otherwise          = [ch]
+  where
+    fill :: String -> String
+    fill s = if length s == 1
+                then '0' : s
+                else s
+
+    asciiTab =
+      ['\NUL', '\SOH', '\STX', '\ETX', '\EOT', '\ENQ', '\ACK', '\BEL',
+       '\BS',  '\HT',  '\LF',  '\VT',  '\FF',  '\CR',  '\SO',  '\SI',
+       '\DLE', '\DC1', '\DC2', '\DC3', '\DC4', '\NAK', '\SYN', '\ETB',
+       '\CAN', '\EM',  '\SUB', '\ESC', '\FS',  '\GS',  '\RS',  '\US']
+
+translateName :: Name -> String
+translateName n = "_idris_" ++ concatMap cchar (showCG n)
+  where cchar x | isAlphaNum x = [x]
+                | otherwise    = "_" ++ show (fromEnum x) ++ "_"
+
+jsASSIGN :: CompileInfo -> Reg -> Reg -> JS
+jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)
+
+jsASSIGNCONST :: CompileInfo -> Reg -> Const -> JS
+jsASSIGNCONST _ r c = JSAssign (translateReg r) (translateConstant c)
+
+jsCALL :: CompileInfo -> Name -> JS
+jsCALL _ n =
+  JSApp (
+    JSIdent "i$CALL"
+  ) [JSIdent (translateName n), JSArray [jsMYOLDBASE]]
+
+jsTAILCALL :: CompileInfo -> Name -> JS
+jsTAILCALL _ n =
+  JSApp (
+    JSIdent "i$CALL"
+  ) [JSIdent (translateName n), JSArray [jsOLDBASE]]
+
+jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
+jsFOREIGN _ reg n args
+  | n == "putStr"
+  , [(FString, arg)] <- args =
+      JSAssign (
+        translateReg reg
+      ) (
+        JSApp (JSIdent "i$putStr") [translateReg arg]
+      )
+
+  | n == "isNull"
+  , [(FPtr, arg)] <- args =
+      JSAssign (
+        translateReg reg
+      ) (
+        JSBinOp "==" (translateReg arg) JSNull
+      )
+
+  | n == "idris_eqPtr"
+  , [(_, lhs),(_, rhs)] <- args =
+      JSAssign (
+        translateReg reg
+      ) (
+        JSBinOp "==" (translateReg lhs) (translateReg rhs)
+      )
+  | otherwise =
+     JSAssign (
+       translateReg reg
+     ) (
+       JSFFI n (map generateWrapper args)
+     )
+    where
+      generateWrapper :: (FType, Reg) -> JS
+      generateWrapper (ty, reg)
+        | FFunction   <- ty =
+            JSApp (JSIdent "i$ffiWrap") [ translateReg reg
+                                        , JSIdent "oldbase"
+                                        , JSIdent "myoldbase"
+                                        ]
+        | FFunctionIO <- ty =
+            JSApp (JSIdent "i$ffiWrap") [ translateReg reg
+                                        , JSIdent "oldbase"
+                                        , JSIdent "myoldbase"
+                                        ]
+
+      generateWrapper (_, reg) =
+        translateReg reg
+
+jsREBASE :: CompileInfo -> JS
+jsREBASE _ = JSAssign jsSTACKBASE jsOLDBASE
+
+jsSTOREOLD :: CompileInfo ->JS
+jsSTOREOLD _ = JSAssign jsMYOLDBASE jsSTACKBASE
+
+jsADDTOP :: CompileInfo -> Int -> JS
+jsADDTOP info n
+  | 0 <- n    = JSNoop
+  | otherwise =
+      JSBinOp "+=" jsSTACKTOP (JSNum (JSInt n))
+
+jsTOPBASE :: CompileInfo -> Int -> JS
+jsTOPBASE _ 0  = JSAssign jsSTACKTOP jsSTACKBASE
+jsTOPBASE _ n  = JSAssign jsSTACKTOP (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
+
+
+jsBASETOP :: CompileInfo -> Int -> JS
+jsBASETOP _ 0 = JSAssign jsSTACKBASE jsSTACKTOP
+jsBASETOP _ n = JSAssign jsSTACKBASE (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
+
+jsNULL :: CompileInfo -> Reg -> JS
+jsNULL _ r = JSAssign (translateReg r) JSNull
+
+jsERROR :: CompileInfo -> String -> JS
+jsERROR _ = JSError
+
+jsSLIDE :: CompileInfo -> Int -> JS
+jsSLIDE _ 1 = JSAssign (jsLOC 0) (jsTOP 0)
+jsSLIDE _ n = JSApp (JSIdent "i$SLIDE") [JSNum (JSInt n)]
+
+jsMKCON :: CompileInfo -> Reg -> Int -> [Reg] -> JS
+jsMKCON info r t rs =
+  JSAssign (translateReg r) (
+    JSNew "i$CON" [ JSNum (JSInt t)
+                  , JSArray (map translateReg rs)
+                  , if t `elem` compileInfoApplyCases info
+                       then JSIdent $ translateName (sMN 0 "APPLY") ++ "$" ++ show t
+                       else JSNull
+                  , if t `elem` compileInfoEvalCases info
+                       then JSIdent $ translateName (sMN 0 "EVAL") ++ "$" ++ show t
+                       else JSNull
+                  ]
+  )
+
+jsCASE :: CompileInfo -> Bool -> Reg -> [(Int, [BC])] -> Maybe [BC] -> JS
+jsCASE info safe reg cases def =
+  JSSwitch (tag safe $ translateReg reg) (
+    map ((JSNum . JSInt) *** prepBranch) cases
+  ) (fmap prepBranch def)
+    where
+      tag :: Bool -> JS -> JS
+      tag True  = jsCTAG
+      tag False = jsTAG
+
+      prepBranch :: [BC] -> JS
+      prepBranch bc = JSSeq $ map (translateBC info) bc
+
+      jsTAG :: JS -> JS
+      jsTAG js =
+        (JSTernary (js `jsInstanceOf` "i$CON") (
+          JSProj js "tag"
+        ) (JSNum (JSInt $ negate 1)))
+
+      jsCTAG :: JS -> JS
+      jsCTAG js = JSProj js "tag"
+
+
+jsCONSTCASE :: CompileInfo -> Reg -> [(Const, [BC])] -> Maybe [BC] -> JS
+jsCONSTCASE info reg cases def =
+  JSCond $ (
+    map (jsEq (translateReg reg) . translateConstant *** prepBranch) cases
+  ) ++ (maybe [] ((:[]) . ((,) JSNoop) . prepBranch) def)
+    where
+      prepBranch :: [BC] -> JS
+      prepBranch bc = JSSeq $ map (translateBC info) bc
+
+jsPROJECT :: CompileInfo -> Reg -> Int -> Int -> JS
+jsPROJECT _ reg loc 0  = JSNoop
+jsPROJECT _ reg loc 1  =
+  JSAssign (jsLOC loc) (
+    JSIndex (
+      JSProj (translateReg reg) "args"
+    ) (
+      JSNum (JSInt 0)
+    )
+  )
+jsPROJECT _ reg loc ar =
+  JSApp (JSIdent "i$PROJECT") [ translateReg reg
+                              , JSNum (JSInt loc)
+                              , JSNum (JSInt ar)
+                              ]
+
+jsOP :: CompileInfo -> Reg -> PrimFn -> [Reg] -> JS
+jsOP _ reg op args = JSAssign (translateReg reg) jsOP'
+  where
+    jsOP' :: JS
+    jsOP'
+      | LNoOp <- op = translateReg (last args)
+
+      | (LZExt (ITFixed IT8) ITNative)  <- op = jsUnPackBits $ translateReg (last args)
+      | (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ translateReg (last args)
+      | (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ translateReg (last args)
+
+      | (LZExt _ ITBig)        <- op = jsBigInt $ JSApp  (JSIdent "String") [translateReg (last args)]
+      | (LPlus (ATInt ITBig))  <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "add" [rhs]
+      | (LMinus (ATInt ITBig)) <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "subtract" [rhs]
+      | (LTimes (ATInt ITBig)) <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "multiply" [rhs]
+      | (LSDiv (ATInt ITBig))  <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "divide" [rhs]
+      | (LSRem (ATInt ITBig))  <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "mod" [rhs]
+      | (LEq (ATInt ITBig))    <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "equals" [rhs]
+      | (LSLt (ATInt ITBig))   <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "lesser" [rhs]
+      | (LSLe (ATInt ITBig))   <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "lesserOrEquals" [rhs]
+      | (LSGt (ATInt ITBig))   <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "greater" [rhs]
+      | (LSGe (ATInt ITBig))   <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "greaterOrEquals" [rhs]
+
+      | (LPlus ATFloat)  <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "+" lhs rhs
+      | (LMinus ATFloat) <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "-" lhs rhs
+      | (LTimes ATFloat) <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "*" lhs rhs
+      | (LSDiv ATFloat)  <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "/" lhs rhs
+      | (LEq ATFloat)    <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "==" lhs rhs
+      | (LSLt ATFloat)   <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "<" lhs rhs
+      | (LSLe ATFloat)   <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp "<=" lhs rhs
+      | (LSGt ATFloat)   <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp ">" lhs rhs
+      | (LSGe ATFloat)   <- op
+      , (lhs:rhs:_)      <- args = translateBinaryOp ">=" lhs rhs
+
+      | (LPlus (ATInt ITChar)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsCall "i$fromCharCode" [
+            JSBinOp "+" (
+              jsCall "i$charCode" [translateReg lhs]
+            ) (
+              jsCall "i$charCode" [translateReg rhs]
+            )
+          ]
+
+      | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op
+      , (arg:_)                               <- args =
+          jsPackUBits8 (
+            JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFF))
+          )
+
+      | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op
+      , (arg:_)                                <- args =
+          jsPackUBits16 (
+            JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFFFF))
+          )
+
+      | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op
+      , (arg:_)                                <- args =
+          jsPackUBits32 (
+            jsMeth (jsMeth (translateReg arg) "and" [
+              jsBigInt (JSString $ show 0xFFFFFFFF)
+            ]) "intValue" []
+          )
+
+      | (LTrunc ITBig (ITFixed IT64)) <- op
+      , (arg:_)                       <- args =
+          jsMeth (translateReg arg) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LLSHR (ITFixed IT8)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits8 (
+            JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LLSHR (ITFixed IT16)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsPackUBits16 (
+            JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LLSHR (ITFixed IT32)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsPackUBits32  (
+            JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LLSHR (ITFixed IT64)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsMeth (translateReg lhs) "shiftRight" [translateReg rhs]
+
+      | (LSHL (ITFixed IT8)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits8 (
+            JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LSHL (ITFixed IT16)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits16 (
+            JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LSHL (ITFixed IT32)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits32  (
+            JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
+          )
+
+      | (LSHL (ITFixed IT64)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsMeth (jsMeth (translateReg lhs) "shiftLeft" [translateReg rhs]) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LAnd (ITFixed IT8)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits8 (
+            JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LAnd (ITFixed IT16)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits16 (
+            JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LAnd (ITFixed IT32)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits32 (
+            JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LAnd (ITFixed IT64)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsMeth (translateReg lhs) "and" [translateReg rhs]
+
+      | (LOr (ITFixed IT8)) <- op
+      , (lhs:rhs:_)         <- args =
+          jsPackUBits8 (
+            JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LOr (ITFixed IT16)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits16 (
+            JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LOr (ITFixed IT32)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits32 (
+            JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LOr (ITFixed IT64)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsMeth (translateReg lhs) "or" [translateReg rhs]
+
+      | (LXOr (ITFixed IT8)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits8 (
+            JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LXOr (ITFixed IT16)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits16 (
+            JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LXOr (ITFixed IT32)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits32 (
+            JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LXOr (ITFixed IT64)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsMeth (translateReg lhs) "xor" [translateReg rhs]
+
+      | (LPlus (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                   <- args =
+          jsPackUBits8 (
+            JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LPlus (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackUBits16 (
+            JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LPlus (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackUBits32 (
+            JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LPlus (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsMeth (jsMeth (translateReg lhs) "add" [translateReg rhs]) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LMinus (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackUBits8 (
+            JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LMinus (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsPackUBits16 (
+            JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LMinus (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsPackUBits32 (
+            JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LMinus (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsMeth (jsMeth (translateReg lhs) "subtract" [translateReg rhs]) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LTimes (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackUBits8 (
+            JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LTimes (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsPackUBits16 (
+            JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LTimes (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsPackUBits32 (
+            JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LTimes (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                     <- args =
+          jsMeth (jsMeth (translateReg lhs) "multiply" [translateReg rhs]) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LEq (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                 <- args =
+          jsPackUBits8 (
+            JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LEq (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                  <- args =
+          jsPackUBits16 (
+            JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LEq (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                  <- args =
+          jsPackUBits32 (
+            JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LEq (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                   <- args =
+          jsMeth (jsMeth (translateReg lhs) "equals" [translateReg rhs]) "and" [
+            jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
+          ]
+
+      | (LLt (ITFixed IT8)) <- op
+      , (lhs:rhs:_)         <- args =
+          jsPackUBits8 (
+            JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLt (ITFixed IT16)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits16 (
+            JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLt (ITFixed IT32)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits32 (
+            JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLt (ITFixed IT64)) <- op
+      , (lhs:rhs:_)          <- args = invokeMeth lhs "lesser" [rhs]
+
+      | (LLe (ITFixed IT8)) <- op
+      , (lhs:rhs:_)         <- args =
+          jsPackUBits8 (
+            JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLe (ITFixed IT16)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits16 (
+            JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLe (ITFixed IT32)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits32 (
+            JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LLe (ITFixed IT64)) <- op
+      , (lhs:rhs:_)          <- args = invokeMeth lhs "lesserOrEquals" [rhs]
+
+      | (LGt (ITFixed IT8)) <- op
+      , (lhs:rhs:_)         <- args =
+          jsPackUBits8 (
+            JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LGt (ITFixed IT16)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits16 (
+            JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+      | (LGt (ITFixed IT32)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits32 (
+            JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LGt (ITFixed IT64)) <- op
+      , (lhs:rhs:_)          <- args = invokeMeth lhs "greater" [rhs]
+
+      | (LGe (ITFixed IT8)) <- op
+      , (lhs:rhs:_)         <- args =
+          jsPackUBits8 (
+            JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LGe (ITFixed IT16)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits16 (
+            JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+      | (LGe (ITFixed IT32)) <- op
+      , (lhs:rhs:_)          <- args =
+          jsPackUBits32 (
+            JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LGe (ITFixed IT64)) <- op
+      , (lhs:rhs:_)          <- args = invokeMeth lhs "greaterOrEquals" [rhs]
+
+      | (LUDiv (ITFixed IT8)) <- op
+      , (lhs:rhs:_)           <- args =
+          jsPackUBits8 (
+            JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LUDiv (ITFixed IT16)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsPackUBits16 (
+            JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LUDiv (ITFixed IT32)) <- op
+      , (lhs:rhs:_)            <- args =
+          jsPackUBits32 (
+            JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
+          )
+
+      | (LUDiv (ITFixed IT64)) <- op
+      , (lhs:rhs:_)            <- args = invokeMeth lhs "divide" [rhs]
+
+      | (LSDiv (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                   <- args =
+          jsPackSBits8 (
+            JSBinOp "/" (
+              jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSDiv (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackSBits16 (
+            JSBinOp "/" (
+              jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSDiv (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackSBits32 (
+            JSBinOp "/" (
+              jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSDiv (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                    <- args = invokeMeth lhs "divide" [rhs]
+
+      | (LSRem (ATInt (ITFixed IT8))) <- op
+      , (lhs:rhs:_)                   <- args =
+          jsPackSBits8 (
+            JSBinOp "%" (
+              jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSRem (ATInt (ITFixed IT16))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackSBits16 (
+            JSBinOp "%" (
+              jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSRem (ATInt (ITFixed IT32))) <- op
+      , (lhs:rhs:_)                    <- args =
+          jsPackSBits32 (
+            JSBinOp "%" (
+              jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
+            ) (
+              jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
+            )
+          )
+
+      | (LSRem (ATInt (ITFixed IT64))) <- op
+      , (lhs:rhs:_)                    <- args = invokeMeth lhs "mod" [rhs]
+
+      | (LCompl (ITFixed IT8)) <- op
+      , (arg:_)                <- args =
+          jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
+
+      | (LCompl (ITFixed IT16)) <- op
+      , (arg:_)                 <- args =
+          jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
+
+      | (LCompl (ITFixed IT32)) <- op
+      , (arg:_)                 <- args =
+          jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
+
+      | (LCompl (ITFixed IT64)) <- op
+      , (arg:_)     <- args =
+          invokeMeth arg "not" []
+
+      | (LPlus _)   <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
+      | (LMinus _)  <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "-" lhs rhs
+      | (LTimes _)  <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "*" lhs rhs
+      | (LSDiv _)   <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "/" lhs rhs
+      | (LSRem _)   <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "%" lhs rhs
+      | (LEq _)     <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "==" lhs rhs
+      | (LSLt _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "<" lhs rhs
+      | (LSLe _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "<=" lhs rhs
+      | (LSGt _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp ">" lhs rhs
+      | (LSGe _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp ">=" lhs rhs
+      | (LAnd _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "&" lhs rhs
+      | (LOr _)     <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "|" lhs rhs
+      | (LXOr _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "^" lhs rhs
+      | (LSHL _)    <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "<<" rhs lhs
+      | (LASHR _)   <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp ">>" rhs lhs
+      | (LCompl _)  <- op
+      , (arg:_)     <- args = JSPreOp "~" (translateReg arg)
+
+      | LStrConcat  <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
+      | LStrEq      <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "==" lhs rhs
+      | LStrLt      <- op
+      , (lhs:rhs:_) <- args = translateBinaryOp "<" lhs rhs
+      | LStrLen     <- op
+      , (arg:_)     <- args = JSProj (translateReg arg) "length"
+      | (LStrInt ITNative)      <- op
+      , (arg:_)                 <- args = jsCall "parseInt" [translateReg arg]
+      | (LIntStr ITNative)      <- op
+      , (arg:_)                 <- args = jsCall "String" [translateReg arg]
+      | (LSExt ITNative ITBig)  <- op
+      , (arg:_)                 <- args = jsBigInt $ jsCall "String" [translateReg arg]
+      | (LTrunc ITBig ITNative) <- op
+      , (arg:_)                 <- args = jsMeth (translateReg arg) "intValue" []
+      | (LIntStr ITBig)         <- op
+      , (arg:_)                 <- args = jsMeth (translateReg arg) "toString" []
+      | (LStrInt ITBig)         <- op
+      , (arg:_)                 <- args = jsBigInt $ translateReg arg
+      | LFloatStr               <- op
+      , (arg:_)                 <- args = jsCall "String" [translateReg arg]
+      | LStrFloat               <- op
+      , (arg:_)                 <- args = jsCall "parseFloat" [translateReg arg]
+      | (LIntFloat ITNative)    <- op
+      , (arg:_)                 <- args = translateReg arg
+      | (LFloatInt ITNative)    <- op
+      , (arg:_)                 <- args = translateReg arg
+      | (LChInt ITNative)       <- op
+      , (arg:_)                 <- args = jsCall "i$charCode" [translateReg arg]
+      | (LIntCh ITNative)       <- op
+      , (arg:_)                 <- args = jsCall "i$fromCharCode" [translateReg arg]
+
+      | LFExp       <- op
+      , (arg:_)     <- args = jsCall "Math.exp" [translateReg arg]
+      | LFLog       <- op
+      , (arg:_)     <- args = jsCall "Math.log" [translateReg arg]
+      | LFSin       <- op
+      , (arg:_)     <- args = jsCall "Math.sin" [translateReg arg]
+      | LFCos       <- op
+      , (arg:_)     <- args = jsCall "Math.cos" [translateReg arg]
+      | LFTan       <- op
+      , (arg:_)     <- args = jsCall "Math.tan" [translateReg arg]
+      | LFASin      <- op
+      , (arg:_)     <- args = jsCall "Math.asin" [translateReg arg]
+      | LFACos      <- op
+      , (arg:_)     <- args = jsCall "Math.acos" [translateReg arg]
+      | LFATan      <- op
+      , (arg:_)     <- args = jsCall "Math.atan" [translateReg arg]
+      | LFSqrt      <- op
+      , (arg:_)     <- args = jsCall "Math.sqrt" [translateReg arg]
+      | LFFloor     <- op
+      , (arg:_)     <- args = jsCall "Math.floor" [translateReg arg]
+      | LFCeil      <- op
+      , (arg:_)     <- args = jsCall "Math.ceil" [translateReg arg]
+
+      | LStrCons    <- op
+      , (lhs:rhs:_) <- args = invokeMeth lhs "concat" [rhs]
+      | LStrHead    <- op
+      , (arg:_)     <- args = JSIndex (translateReg arg) (JSNum (JSInt 0))
+      | LStrRev     <- op
+      , (arg:_)     <- args = JSProj (translateReg arg) "split('').reverse().join('')"
+      | LStrIndex   <- op
+      , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
+      | LStrTail    <- op
+      , (arg:_)     <- args =
+          let v = translateReg arg in
+              JSApp (JSProj v "substr") [
+                JSNum (JSInt 1),
+                JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
+              ]
+
+      | LSystemInfo <- op
+      , (arg:_) <- args = jsCall "i$systemInfo"  [translateReg arg]
+      | LNullPtr    <- op
+      , (_)         <- args = JSNull
+      | otherwise = JSError $ "Not implemented: " ++ show op
+        where
+          translateBinaryOp :: String -> Reg -> Reg -> JS
+          translateBinaryOp op lhs rhs =
+            JSBinOp op (translateReg lhs) (translateReg rhs)
+
+          invokeMeth :: Reg -> String -> [Reg] -> JS
+          invokeMeth obj meth args =
+            JSApp (JSProj (translateReg obj) meth) $ map translateReg args
+
+
+jsRESERVE :: CompileInfo -> Int -> JS
+jsRESERVE _ _ = JSNoop
+
+jsSTACK :: JS
+jsSTACK = JSIdent "i$valstack"
+
+jsCALLSTACK :: JS
+jsCALLSTACK = JSIdent "i$callstack"
+
+jsSTACKBASE :: JS
+jsSTACKBASE = JSIdent "i$valstack_base"
+
+jsSTACKTOP :: JS
+jsSTACKTOP = JSIdent "i$valstack_top"
+
+jsOLDBASE :: JS
+jsOLDBASE = JSIdent "oldbase"
+
+jsMYOLDBASE :: JS
+jsMYOLDBASE = JSIdent "myoldbase"
+
+jsRET :: JS
+jsRET = JSIdent "i$ret"
+
+jsLOC :: Int -> JS
+jsLOC 0 = JSIndex jsSTACK jsSTACKBASE
+jsLOC n = JSIndex jsSTACK (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
+
+jsTOP :: Int -> JS
+jsTOP 0 = JSIndex jsSTACK jsSTACKTOP
+jsTOP n = JSIndex jsSTACK (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
+
+jsPUSH :: [JS] -> JS
+jsPUSH args = JSApp (JSProj jsCALLSTACK "push") args
+
+jsPOP :: JS
+jsPOP = JSApp (JSProj jsCALLSTACK "pop") []
+
+translateBC :: CompileInfo -> BC -> JS
+translateBC info bc
+  | ASSIGN r1 r2          <- bc = jsASSIGN info r1 r2
+  | ASSIGNCONST r c       <- bc = jsASSIGNCONST info r c
+  | UPDATE r1 r2          <- bc = jsASSIGN info r1 r2
+  | ADDTOP n              <- bc = jsADDTOP info n
+  | NULL r                <- bc = jsNULL info r
+  | CALL n                <- bc = jsCALL info n
+  | TAILCALL n            <- bc = jsTAILCALL info n
+  | FOREIGNCALL r _ _ n a <- bc = jsFOREIGN info r n a
+  | TOPBASE n             <- bc = jsTOPBASE info n
+  | BASETOP n             <- bc = jsBASETOP info n
+  | STOREOLD              <- bc = jsSTOREOLD info
+  | SLIDE n               <- bc = jsSLIDE info n
+  | REBASE                <- bc = jsREBASE info
+  | RESERVE n             <- bc = jsRESERVE info n
+  | MKCON r t rs          <- bc = jsMKCON info r t rs
+  | CASE s r c d          <- bc = jsCASE info s r c d
+  | CONSTCASE r c d       <- bc = jsCONSTCASE info r c d
+  | PROJECT r l a         <- bc = jsPROJECT info r l a
+  | OP r o a              <- bc = jsOP info r o a
+  | ERROR e               <- bc = jsERROR info e
+  | otherwise                   = JSRaw $ "//" ++ show bc
+
diff --git a/src/IRTS/CodegenLLVM.hs b/src/IRTS/CodegenLLVM.hs
--- a/src/IRTS/CodegenLLVM.hs
+++ b/src/IRTS/CodegenLLVM.hs
@@ -9,7 +9,6 @@
 import Idris.Core.TT (ArithTy(..), IntTy(..), NativeTy(..), nativeTyWidth)
 
 import Util.System
-import Paths_idris
 
 import LLVM.General.Context
 import LLVM.General.Diagnostic
diff --git a/src/IRTS/Compiler.hs b/src/IRTS/Compiler.hs
--- a/src/IRTS/Compiler.hs
+++ b/src/IRTS/Compiler.hs
@@ -47,8 +47,6 @@
 import System.Environment
 import System.FilePath ((</>), addTrailingPathSeparator)
 
-import Paths_idris
-
 compile :: Codegen -> FilePath -> Term -> Idris ()
 compile codegen f tm
    = do checkMVs  -- check for undefined metavariables
@@ -299,7 +297,7 @@
         -- hence it takes a lambda: \unerased_argname_list -> resulting_LExp.
         let padLams = padLambdas used (length args) arity
 
-        case compare arity (length args) of
+        case compare (length args) arity of
 
             -- overapplied
             GT  -> ifail ("overapplied data constructor: " ++ show tm)
@@ -488,6 +486,7 @@
 irSC :: Vars -> SC -> Idris LExp
 irSC vs (STerm t) = irTerm vs [] t
 irSC vs (UnmatchedCase str) = return $ LError str
+
 irSC vs (ProjCase tm alts) = do
     tm'   <- irTerm vs [] tm
     alts' <- mapM (irAlt vs tm') alts
@@ -496,8 +495,9 @@
 -- Transform matching on Delay to applications of Force.
 irSC vs (Case n [ConCase (UN delay) i [_, _, n'] sc])
     | delay == txt "Delay"
-    = irSC vs $ mkForce n n' sc
-
+    = do sc' <- irSC vs $ mkForce n' n sc
+         return $ LLet n' (LForce (LV (Glob n))) sc'
+    
 -- There are two transformations in this case:
 --
 --  1. Newtype-case elimination:
diff --git a/src/IRTS/Java/JTypes.hs b/src/IRTS/Java/JTypes.hs
--- a/src/IRTS/Java/JTypes.hs
+++ b/src/IRTS/Java/JTypes.hs
@@ -33,6 +33,9 @@
 array :: J.Type -> J.Type
 array t = RefType . ArrayType $ t
 
+addressType :: J.Type
+addressType = longType
+
 -----------------------------------------------------------------------
 -- Boxed types
 
@@ -48,6 +51,10 @@
 stringType =
   RefType . ClassRefType $ ClassType [(Ident "String", [])]
 
+bufferType :: J.Type
+bufferType =
+  RefType . ClassRefType $ ClassType [(Ident "ByteBuffer", [])]
+
 threadType :: J.Type
 threadType =
   RefType . ClassRefType $ ClassType [(Ident "Thread", [])]
@@ -132,6 +139,9 @@
 runtimeExceptionType =
   RefType . ClassRefType $ ClassType [(Ident "RuntimeException", [])]
 
+-----------------------------------------------------------------------
+-- Integer types
+
 nativeTyToJType :: NativeTy -> J.Type
 nativeTyToJType IT8  = byteType
 nativeTyToJType IT16 = shortType
@@ -219,6 +229,7 @@
   | (LFloatInt to) <- x = "LFloatInt" ++ (suffixFor to)
   | (LStrInt to)   <- x = "LStrInt" ++ (suffixFor to)
   | (LChInt to)    <- x = "LChInt" ++ (suffixFor to)
+  | (LPeek to _)   <- x = "LPeek" ++ (suffixFor to)
   | otherwise = takeWhile ((/=) ' ') $ show x
   where
     suffixFor (ITFixed nt) = show nt
@@ -291,10 +302,30 @@
 sourceTypes (LStdIn) = []
 sourceTypes (LStdOut) = []
 sourceTypes (LStdErr) = []
+sourceTypes (LAllocate) = [addressType]
+sourceTypes (LAppendBuffer) =
+  [bufferType, addressType, addressType, addressType, addressType, bufferType]
+sourceTypes (LSystemInfo) = [integerType]
+sourceTypes (LAppend nt _) = [bufferType, addressType, addressType, intTyToJType nt]
+sourceTypes (LPeek _ _) = [bufferType, addressType]
 sourceTypes (LFork) = [objectType]
 sourceTypes (LPar) = [objectType]
 sourceTypes (LVMPtr) = []
 sourceTypes (LNullPtr) = [objectType]
 sourceTypes (LNoOp) = repeat objectType
 
+-----------------------------------------------------------------------
+-- Endianess markers
 
+endiannessConstant :: Endianness -> Exp
+endiannessConstant c =
+  ExpName . Name . map Ident $ ["java", "nio", "ByteOrder", endiannessConstant' c]
+  where
+    endiannessConstant' BE                 = "BIG_ENDIAN"
+    endiannessConstant' LE                 = "LITTLE_ENDIAN"
+    endiannessConstant' (IRTS.Lang.Native) = endiannessConstant' BE
+
+endiannessArguments :: PrimFn -> [Exp]
+endiannessArguments (LAppend _ end) = [endiannessConstant end]
+endiannessArguments (LPeek _ end)   = [endiannessConstant end]
+endiannessArguments _               = []
diff --git a/src/IRTS/Java/Pom.hs b/src/IRTS/Java/Pom.hs
--- a/src/IRTS/Java/Pom.hs
+++ b/src/IRTS/Java/Pom.hs
@@ -3,6 +3,9 @@
 import Data.List (unfoldr)
 import Text.XML.Light
 
+-----------------------------------------------------------------------
+-- String <-> XML processing
+
 uattr :: String -> String -> Attr
 uattr k v = Attr (QName k Nothing Nothing) v
 
@@ -31,6 +34,9 @@
 pomString :: String -> String -> [String] -> String
 pomString c a d = ppElement $ pom c a d
 
+-----------------------------------------------------------------------
+-- The pom template for idris projects
+
 pom :: String -> String -> [String] -> Element
 pom clsName artifactName dependencies = unode "project" ([
     uattr "xmlns" "http://maven.apache.org/POM/4.0.0",
@@ -49,7 +55,7 @@
       unode "skipTest" "true"
     ],
     unode "dependencies" (
-      dependency "org.idris-lang" "idris" "0.9.10-alpha-2" :
+      dependency "org.idris-lang" "idris" "0.9.14" :
       map parseToDep dependencies
     ),
     unode "build" [
diff --git a/src/IRTS/JavaScript/AST.hs b/src/IRTS/JavaScript/AST.hs
new file mode 100644
--- /dev/null
+++ b/src/IRTS/JavaScript/AST.hs
@@ -0,0 +1,397 @@
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE OverloadedStrings #-}
+module IRTS.JavaScript.AST where
+
+import Data.Word
+import Data.Char (isDigit)
+
+import qualified Data.Text as T
+
+data JSType = JSIntTy
+            | JSStringTy
+            | JSIntegerTy
+            | JSFloatTy
+            | JSCharTy
+            | JSPtrTy
+            | JSForgotTy
+            deriving Eq
+
+
+data JSInteger = JSBigZero
+               | JSBigOne
+               | JSBigInt Integer
+               | JSBigIntExpr JS
+               deriving Eq
+
+
+data JSNum = JSInt Int
+           | JSFloat Double
+           | JSInteger JSInteger
+           deriving Eq
+
+
+data JSWord = JSWord8 Word8
+            | JSWord16 Word16
+            | JSWord32 Word32
+            | JSWord64 Word64
+            deriving Eq
+
+
+data JSAnnotation = JSConstructor deriving Eq
+
+
+instance Show JSAnnotation where
+  show JSConstructor = "constructor"
+
+
+data JS = JSRaw String
+        | JSIdent String
+        | JSFunction [String] JS
+        | JSType JSType
+        | JSSeq [JS]
+        | JSReturn JS
+        | JSApp JS [JS]
+        | JSNew String [JS]
+        | JSError String
+        | JSBinOp String JS JS
+        | JSPreOp String JS
+        | JSPostOp String JS
+        | JSProj JS String
+        | JSNull
+        | JSUndefined
+        | JSThis
+        | JSTrue
+        | JSFalse
+        | JSArray [JS]
+        | JSString String
+        | JSNum JSNum
+        | JSWord JSWord
+        | JSAssign JS JS
+        | JSAlloc String (Maybe JS)
+        | JSIndex JS JS
+        | JSSwitch JS [(JS, JS)] (Maybe JS)
+        | JSCond [(JS, JS)]
+        | JSTernary JS JS JS
+        | JSParens JS
+        | JSWhile JS JS
+        | JSFFI String [JS]
+        | JSAnnotation JSAnnotation JS
+        | JSNoop
+        deriving Eq
+
+
+data FFI = FFICode Char | FFIArg Int | FFIError String
+
+ffi :: String -> [String] -> T.Text
+ffi code args = let parsed = ffiParse code in
+                    case ffiError parsed of
+                         Just err -> error err
+                         Nothing  -> renderFFI parsed args
+  where
+    ffiParse :: String -> [FFI]
+    ffiParse ""           = []
+    ffiParse ['%']        = [FFIError $ "FFI - Invalid positional argument"]
+    ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss
+    ffiParse ('%':s:ss)
+      | isDigit s =
+         FFIArg (
+           read $ s : takeWhile isDigit ss
+          ) : ffiParse (dropWhile isDigit ss)
+      | otherwise =
+          [FFIError "FFI - Invalid positional argument"]
+    ffiParse (s:ss) = FFICode s : ffiParse ss
+
+
+    ffiError :: [FFI] -> Maybe String
+    ffiError []                 = Nothing
+    ffiError ((FFIError s):xs)  = Just s
+    ffiError (x:xs)             = ffiError xs
+
+
+    renderFFI :: [FFI] -> [String] -> T.Text
+    renderFFI [] _ = ""
+    renderFFI (FFICode c : fs) args = c `T.cons` renderFFI fs args
+    renderFFI (FFIArg i : fs) args
+      | i < length args && i >= 0 =
+            T.pack (args !! i)
+          `T.append` renderFFI fs args
+      | otherwise = error "FFI - Argument index out of bounds"
+
+compileJS :: JS -> T.Text
+compileJS = compileJS' 0
+
+compileJS' :: Int -> JS -> T.Text
+compileJS' indent JSNoop = ""
+
+compileJS' indent (JSAnnotation annotation js) =
+    "/** @"
+  `T.append` T.pack (show annotation)
+  `T.append` " */\n"
+  `T.append` compileJS' indent js
+
+compileJS' indent (JSFFI raw args) =
+  ffi raw (map (T.unpack . compileJS' indent) args)
+
+compileJS' indent (JSRaw code) =
+  T.pack code
+
+compileJS' indent (JSIdent ident) =
+  T.pack ident
+
+compileJS' indent (JSFunction args body) =
+      T.replicate indent " " `T.append` "function("
+   `T.append` T.intercalate "," (map T.pack args)
+   `T.append` "){\n"
+   `T.append` compileJS' (indent + 2) body
+   `T.append` "\n}\n"
+
+compileJS' indent (JSType ty)
+  | JSIntTy     <- ty = "i$Int"
+  | JSStringTy  <- ty = "i$String"
+  | JSIntegerTy <- ty = "i$Integer"
+  | JSFloatTy   <- ty = "i$Float"
+  | JSCharTy    <- ty = "i$Char"
+  | JSPtrTy     <- ty = "i$Ptr"
+  | JSForgotTy  <- ty = "i$Forgot"
+
+compileJS' indent (JSSeq seq) =
+  T.intercalate ";\n" (
+    map (
+      (T.replicate indent " " `T.append`) . (compileJS' indent)
+    ) $ filter (/= JSNoop) seq
+  ) `T.append` ";"
+
+compileJS' indent (JSReturn val) =
+  "return " `T.append` compileJS' indent val
+
+compileJS' indent (JSApp lhs rhs)
+  | JSFunction {} <- lhs =
+    T.concat ["(", compileJS' indent lhs, ")(", args, ")"]
+  | otherwise =
+    T.concat [compileJS' indent lhs, "(", args, ")"]
+  where args :: T.Text
+        args = T.intercalate "," $ map (compileJS' 0) rhs
+
+compileJS' indent (JSNew name args) =
+    "new "
+  `T.append` T.pack name
+  `T.append` "("
+  `T.append` T.intercalate "," (map (compileJS' 0) args)
+  `T.append` ")"
+
+compileJS' indent (JSError exc) =
+  "(function(){throw new Error(\"" `T.append` T.pack exc `T.append` "\")})()"
+
+compileJS' indent (JSBinOp op lhs rhs) =
+    compileJS' indent lhs
+  `T.append` " "
+  `T.append` T.pack op
+  `T.append` " "
+  `T.append` compileJS' indent rhs
+
+compileJS' indent (JSPreOp op val) =
+  T.pack op `T.append` compileJS' indent val
+
+compileJS' indent (JSProj obj field)
+  | JSFunction {} <- obj =
+    T.concat ["(", compileJS' indent obj, ").", T.pack field]
+  | JSAssign {} <- obj =
+    T.concat ["(", compileJS' indent obj, ").", T.pack field]
+  | otherwise =
+    compileJS' indent obj `T.append` ('.' `T.cons` T.pack field)
+
+compileJS' indent JSNull =
+  "null"
+
+compileJS' indent JSUndefined =
+  "undefined"
+
+compileJS' indent JSThis =
+  "this"
+
+compileJS' indent JSTrue =
+  "true"
+
+compileJS' indent JSFalse =
+  "false"
+
+compileJS' indent (JSArray elems) =
+  "[" `T.append` T.intercalate "," (map (compileJS' 0) elems) `T.append` "]"
+
+compileJS' indent (JSString str) =
+  "\"" `T.append` T.pack str `T.append` "\""
+
+compileJS' indent (JSNum num)
+  | JSInt i                    <- num = T.pack (show i)
+  | JSFloat f                  <- num = T.pack (show f)
+  | JSInteger JSBigZero        <- num = T.pack "i$ZERO"
+  | JSInteger JSBigOne         <- num = T.pack "i$ONE"
+  | JSInteger (JSBigInt i)     <- num = T.pack (show i)
+  | JSInteger (JSBigIntExpr e) <- num =
+      "i$bigInt(" `T.append` compileJS' indent e `T.append` ")"
+
+compileJS' indent (JSAssign lhs rhs) =
+  compileJS' indent lhs `T.append` " = " `T.append` compileJS' indent rhs
+
+compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =
+    "var "
+  `T.append` T.pack name
+  `T.append` " = "
+  `T.append` compileJS' 0 val
+  `T.append` ";\n"
+
+compileJS' indent (JSAlloc name val) =
+    "var "
+  `T.append` T.pack name
+  `T.append` maybe "" ((" = " `T.append`) . compileJS' indent) val
+
+compileJS' indent (JSIndex lhs rhs) =
+    compileJS' indent lhs
+  `T.append` "["
+  `T.append` compileJS' indent rhs
+  `T.append` "]"
+
+compileJS' indent (JSCond branches) =
+  T.intercalate " else " $ map createIfBlock branches
+  where
+    createIfBlock (JSNoop, e@(JSSeq _)) =
+         "{\n"
+      `T.append` compileJS' (indent + 2) e
+      `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
+    createIfBlock (JSNoop, e) =
+         "{\n"
+      `T.append` compileJS' (indent + 2) e
+      `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"
+    createIfBlock (cond, e@(JSSeq _)) =
+         "if (" `T.append` compileJS' indent cond `T.append`") {\n"
+      `T.append` compileJS' (indent + 2) e
+      `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
+    createIfBlock (cond, e) =
+         "if (" `T.append` compileJS' indent cond `T.append`") {\n"
+      `T.append` T.replicate (indent + 2) " "
+      `T.append` compileJS' (indent + 2) e
+      `T.append` ";\n"
+      `T.append` T.replicate indent " "
+      `T.append` "}"
+
+compileJS' indent (JSSwitch val [(_,JSSeq seq)] Nothing) =
+  let (h,t) = splitAt 1 seq in
+         (T.concat (map (compileJS' indent) h) `T.append` ";\n")
+      `T.append` (
+        T.intercalate ";\n" $ map (
+          (T.replicate indent " " `T.append`) . compileJS' indent
+        ) t
+      )
+
+compileJS' indent (JSSwitch val branches def) =
+     "switch(" `T.append` compileJS' indent val `T.append` "){\n"
+  `T.append` T.concat (map mkBranch branches)
+  `T.append` mkDefault def
+  `T.append` T.replicate indent " " `T.append` "}"
+  where
+    mkBranch :: (JS, JS) -> T.Text
+    mkBranch (tag, code) =
+         T.replicate (indent + 2) " "
+      `T.append` "case "
+      `T.append` compileJS' indent tag
+      `T.append` ":\n"
+      `T.append` compileJS' (indent + 4) code
+      `T.append` "\n"
+      `T.append` (T.replicate (indent + 4) " " `T.append` "break;\n")
+
+    mkDefault :: Maybe JS -> T.Text
+    mkDefault Nothing = ""
+    mkDefault (Just def) =
+         T.replicate (indent + 2) " " `T.append` "default:\n"
+      `T.append` compileJS' (indent + 4)def
+      `T.append` "\n"
+
+
+compileJS' indent (JSTernary cond true false) =
+  let c = compileJS' indent cond
+      t = compileJS' indent true
+      f = compileJS' indent false in
+        "("
+      `T.append` c
+      `T.append` ")?("
+      `T.append` t
+      `T.append` "):("
+      `T.append` f
+      `T.append` ")"
+
+compileJS' indent (JSParens js) =
+  "(" `T.append` compileJS' indent js `T.append` ")"
+
+compileJS' indent (JSWhile cond body) =
+     "while (" `T.append` compileJS' indent cond `T.append` ") {\n"
+  `T.append` compileJS' (indent + 2) body
+  `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
+
+compileJS' indent (JSWord word)
+  | JSWord8  b <- word =
+      "new Uint8Array([" `T.append` T.pack (show b) `T.append` "])"
+  | JSWord16 b <- word =
+      "new Uint16Array([" `T.append` T.pack (show b) `T.append` "])"
+  | JSWord32 b <- word =
+      "new Uint32Array([" `T.append` T.pack (show b) `T.append` "])"
+  | JSWord64 b <- word =
+      "i$bigInt(\"" `T.append` T.pack (show b) `T.append` "\")"
+
+jsInstanceOf :: JS -> String -> JS
+jsInstanceOf obj cls = JSBinOp "instanceof" obj (JSIdent cls)
+
+jsOr :: JS -> JS -> JS
+jsOr lhs rhs = JSBinOp "||" lhs rhs
+
+jsAnd :: JS -> JS -> JS
+jsAnd lhs rhs = JSBinOp "&&" lhs rhs
+
+jsMeth :: JS -> String -> [JS] -> JS
+jsMeth obj meth args = JSApp (JSProj obj meth) args
+
+jsCall :: String -> [JS] -> JS
+jsCall fun args = JSApp (JSIdent fun) args
+
+jsTypeOf :: JS -> JS
+jsTypeOf js = JSPreOp "typeof " js
+
+jsEq :: JS -> JS -> JS
+jsEq lhs@(JSNum (JSInteger _)) rhs = JSApp (JSProj lhs "equals") [rhs]
+jsEq lhs rhs@(JSNum (JSInteger _)) = JSApp (JSProj lhs "equals") [rhs]
+jsEq lhs rhs = JSBinOp "==" lhs rhs
+
+jsNotEq :: JS -> JS -> JS
+jsNotEq lhs rhs = JSBinOp "!=" lhs rhs
+
+jsIsNumber :: JS -> JS
+jsIsNumber js = (jsTypeOf js) `jsEq` (JSString "number")
+
+jsIsNull :: JS -> JS
+jsIsNull js = JSBinOp "==" js JSNull
+
+jsBigInt :: JS -> JS
+jsBigInt (JSString "0") = JSNum (JSInteger JSBigZero)
+jsBigInt (JSString "1") = JSNum (JSInteger JSBigOne)
+jsBigInt js             = JSNum $ JSInteger $ JSBigIntExpr js
+
+jsUnPackBits :: JS -> JS
+jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
+
+jsPackUBits8 :: JS -> JS
+jsPackUBits8 js = JSNew "Uint8Array" [JSArray [js]]
+
+jsPackUBits16 :: JS -> JS
+jsPackUBits16 js = JSNew "Uint16Array" [JSArray [js]]
+
+jsPackUBits32 :: JS -> JS
+jsPackUBits32 js = JSNew "Uint32Array" [JSArray [js]]
+
+jsPackSBits8 :: JS -> JS
+jsPackSBits8 js = JSNew "Int8Array" [JSArray [js]]
+
+jsPackSBits16 :: JS -> JS
+jsPackSBits16 js = JSNew "Int16Array" [JSArray [js]]
+
+jsPackSBits32 :: JS -> JS
+jsPackSBits32 js = JSNew "Int32Array" [JSArray [js]]
+
diff --git a/src/IRTS/System.hs b/src/IRTS/System.hs
--- a/src/IRTS/System.hs
+++ b/src/IRTS/System.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
-module IRTS.System(getTargetDir,getCC,getLibFlags,getIdrisLibDir,
-                   getIncFlags,getMvn,getExecutablePom) where
+module IRTS.System(getDataFileName, getDataDir, getTargetDir,getCC,getLibFlags,getIdrisLibDir,
+                   getIncFlags,getMvn,getExecutablePom, version) where
 
 import Util.System
 
@@ -9,7 +9,12 @@
 import System.FilePath ((</>), addTrailingPathSeparator)
 import System.Environment
 
+#ifdef FREESTANDING
+import Target_idris
+import Paths_idris (version)
+#else
 import Paths_idris
+#endif
 
 getCC :: IO String
 getCC = fromMaybe "gcc" <$> environment "IDRIS_CC"
diff --git a/src/Idris/AbsSyntax.hs b/src/Idris/AbsSyntax.hs
--- a/src/Idris/AbsSyntax.hs
+++ b/src/Idris/AbsSyntax.hs
@@ -14,8 +14,6 @@
 import IRTS.CodegenCommon
 import Util.DynamicLinker
 
-import Paths_idris
-
 import System.Console.Haskeline
 import System.IO
 
@@ -484,7 +482,10 @@
        i <- getIState
        putIState $ i { idris_metavars = map (\(n, (i, top, _, isTopLevel)) -> (n, (top, i, isTopLevel))) ns ++
                                             idris_metavars i }
-  where tidyNames used (Bind (MN i x) b sc)
+  where 
+        -- 'tidyNames' is to generate user accessible names in case they are
+        -- needed in tactic scripts
+        tidyNames used (Bind (MN i x) b sc)
             = let n' = uniqueName (UN x) used in
                   Bind n' b $ tidyNames (n':used) sc
         tidyNames used (Bind n b sc)
@@ -855,7 +856,7 @@
        | n `elem` (map fst ps ++ ns) && t /= Placeholder
            = let n' = mkShadow n in
                  PDPair f p (PRef f' n') (en t) (en (shadow n n' r))
-    en (PEq f l r) = PEq f (en l) (en r)
+    en (PEq f lt rt l r) = PEq f (en lt) (en rt) (en l) (en r)
     en (PRewrite f l r g) = PRewrite f (en l) (en r) (fmap en g)
     en (PTyped l r) = PTyped (en l) (en r)
     en (PPair f p l r) = PPair f p (en l) (en r)
@@ -1024,7 +1025,7 @@
     pri (PTrue _ _) = 0
     pri (PFalse _) = 0
     pri (PRefl _ _) = 1
-    pri (PEq _ l r) = max 1 (max (pri l) (pri r))
+    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 (PAppBind _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.getTm) as)))
@@ -1080,6 +1081,16 @@
 
 -- Dealing with implicit arguments
 
+-- Add some bound implicits to the using block if they aren't there already
+
+addToUsing :: [Using] -> [(Name, PTerm)] -> [Using]
+addToUsing us [] = us
+addToUsing us ((n, t) : ns)
+   | n `notElem` mapMaybe impName us = addToUsing (us ++ [UImplicit n t]) ns
+   | otherwise = addToUsing us ns
+  where impName (UImplicit n _) = Just n
+        impName _ = Nothing
+
 -- Add constraint bindings from using block
 
 addUsingConstraints :: SyntaxInfo -> FC -> PTerm -> Idris PTerm
@@ -1088,8 +1099,6 @@
         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
@@ -1119,11 +1128,72 @@
          getName (PExp _ _ _ (PRef _ n)) = return n
          getName _ = []
 
+-- Add implicit bindings from using block, and bind any missing names
+addUsingImpls :: SyntaxInfo -> Name -> FC -> PTerm -> Idris PTerm
+addUsingImpls syn n fc t
+   = do ist <- getIState
+        let ns = implicitNamesIn (map iname uimpls) ist t
+        let badnames = filter (\n -> not (implicitable n) &&
+                                     n `notElem` (map iname uimpls)) ns
+        when (not (null badnames)) $ 
+           throwError (At fc (Elaborating "type of " n 
+                         (NoSuchVariable (head badnames))))
+        let cs = getArgnames t -- get already bound names 
+        let addimpls = filter (\n -> iname n `notElem` cs) uimpls 
+        -- if all names in the arguments of addconsts appear in ns,
+        -- add the constraint implicitly
+        return (bindFree ns (doAdd addimpls ns t))
+   where uimpls = filter uimpl (using syn)
+         uimpl (UImplicit _ _) = True
+         uimpl _ = False
+
+         iname (UImplicit n _) = n
+         iname (UConstraint _ _) = error "Can't happen addUsingImpls"
+
+         doAdd [] _ t = t
+         -- if all of args in ns, then add it
+         doAdd (UImplicit n ty : cs) ns t
+             | elem n ns
+                   = PPi (Imp [] Dynamic False) n ty (doAdd cs ns t)
+             | otherwise = doAdd cs ns t
+
+         -- bind the free names which weren't in the using block
+         bindFree [] tm = tm
+         bindFree (n:ns) tm 
+             | elem n (map iname uimpls) = bindFree ns tm
+             | otherwise 
+                    = PPi (Imp [] Dynamic False) n Placeholder (bindFree ns tm)
+
+         getArgnames (PPi _ n c sc)
+             = n : getArgnames sc
+         getArgnames _ = []
+
+-- Given the original type and the elaborated type, return the implicitness
+-- status of each pi-bound argument, and whether it's inaccessible (True) or not.
+
+getUnboundImplicits :: IState -> Type -> PTerm -> [(Bool, PArg)]
+getUnboundImplicits i (Bind n (Pi t) sc) (PPi p n' t' sc')
+     | n == n' = argInfo n p : getUnboundImplicits i sc sc'
+  where
+    argInfo n (Imp opt _ _) = (True, PImp (getPriority i t') True opt n t')
+    argInfo n (Exp opt _ _) = (InaccessibleArg `elem` opt,
+                                  PExp (getPriority i t') opt n t')
+    argInfo n (Constraint opt _) = (InaccessibleArg `elem` opt,
+                                      PConstraint 10 opt n t')
+    argInfo n (TacImp opt _ scr) = (InaccessibleArg `elem` opt,
+                                      PTacImplicit 10 opt n scr t')
+getUnboundImplicits i (Bind n (Pi t) sc) tm
+     = impBind n t : getUnboundImplicits i sc tm
+  where
+    impBind n t = (True, PImp 1 True [] n Placeholder)
+getUnboundImplicits i sc tm = []
+
 -- Add implicit Pi bindings for any names in the term which appear in an
 -- argument position.
 
 -- This has become a right mess already. Better redo it some time...
-
+-- TODO: This is obsoleted by the new way of elaborating types, but there's still
+-- a couple of places which use it. Clean them up!
 implicit :: ElabInfo -> SyntaxInfo -> Name -> PTerm -> Idris PTerm
 implicit info syn n ptm = implicit' info syn [] n ptm
 
@@ -1220,7 +1290,7 @@
              put (PTacImplicit 10 l n scr Placeholder : decls,
                   nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))
              imps True (n:env) sc
-    imps top env (PEq _ l r)
+    imps top env (PEq _ _ _ 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)))))
@@ -1272,6 +1342,7 @@
 addImplBoundInf :: IState -> [Name] -> [Name] -> PTerm -> PTerm
 addImplBoundInf ist ns inf = addImpl' False ns inf ist
 
+-- | Add the implicit arguments to applications in the term
 addImpl :: IState -> PTerm -> PTerm
 addImpl = addImpl' False [] []
 
@@ -1279,86 +1350,92 @@
 -- and *not* inside a PHidden
 
 addImpl' :: Bool -> [Name] -> [Name] -> IState -> PTerm -> PTerm
-addImpl' inpat env infns ist ptm 
-         = mkUniqueNames env (ai (zip env (repeat Nothing)) [] ptm)
+addImpl' inpat env infns ist ptm
+         = mkUniqueNames env (ai False (zip env (repeat Nothing)) [] ptm)
   where
-    ai env ds (PRef fc f)
+    ai :: Bool -> [(Name, Maybe PTerm)] -> [[T.Text]] -> PTerm -> PTerm
+    ai qq env ds (PRef fc f)
         | f `elem` infns = PInferRef fc f
-        | not (f `elem` map fst env) = handleErr $ aiFn inpat inpat ist fc f ds []
-    ai env ds (PHidden (PRef fc f))
-        | not (f `elem` map fst env) = handleErr $ aiFn inpat False ist fc f ds []
-    ai env ds (PEq fc l r)   
-      = let l' = ai env ds l
-            r' = ai env ds r in
-            PEq fc l' r'
-    ai env ds (PRewrite fc l r g)   
-       = let l' = ai env ds l
-             r' = ai env ds r
-             g' = fmap (ai env ds) g in
+        | not (f `elem` map fst env) = handleErr $ aiFn inpat inpat qq ist fc f ds []
+    ai qq env ds (PHidden (PRef fc f))
+        | not (f `elem` map fst env) = handleErr $ aiFn inpat False qq ist fc f ds []
+    ai qq env ds (PEq fc lt rt l r)
+      = let lt' = ai qq env ds lt
+            rt' = ai qq env ds rt
+            l' = ai qq env ds l
+            r' = ai qq env ds r in
+            PEq fc lt' rt' l' r'
+    ai qq env ds (PRewrite fc l r g)
+       = let l' = ai qq env ds l
+             r' = ai qq env ds r
+             g' = fmap (ai qq env ds) g in
          PRewrite fc l' r' g'
-    ai env ds (PTyped l r) 
-      = let l' = ai env ds l
-            r' = ai env ds r in
+    ai qq env ds (PTyped l r)
+      = let l' = ai qq env ds l
+            r' = ai qq env ds r in
             PTyped l' r'
-    ai env ds (PPair fc p l r) 
-      = let l' = ai env ds l
-            r' = ai env ds r in
+    ai qq env ds (PPair fc p l r)
+      = let l' = ai qq env ds l
+            r' = ai qq env ds r in
             PPair fc p l' r'
-    ai env ds (PDPair fc p l t r)
-         = let l' = ai env ds l
-               t' = ai env ds t
-               r' = ai env ds r in
+    ai qq env ds (PDPair fc p l t r)
+         = let l' = ai qq env ds l
+               t' = ai qq env ds t
+               r' = ai qq env ds r in
            PDPair fc p l' t' r'
-    ai env ds (PAlternative a as) 
-           = let as' = map (ai env ds) as in
+    ai qq env ds (PAlternative a as)
+           = let as' = map (ai qq env ds) as in
                  PAlternative a as'
-    ai env _ (PDisamb ds' as) = ai env ds' as
-    ai env ds (PApp fc (PInferRef _ f) as)
-        = let as' = map (fmap (ai env ds)) as in
+    ai qq env _ (PDisamb ds' as) = ai qq env ds' as
+    ai qq env ds (PApp fc (PInferRef _ f) as)
+        = let as' = map (fmap (ai qq env ds)) as in
               PApp fc (PInferRef fc f) as'
-    ai env ds (PApp fc ftm@(PRef _ f) as)
-        | f `elem` infns = ai env ds (PApp fc (PInferRef fc f) as)
+    ai qq env ds (PApp fc ftm@(PRef _ f) as)
+        | f `elem` infns = ai qq env ds (PApp fc (PInferRef fc f) as)
         | not (f `elem` map fst env)
-                          = let as' = map (fmap (ai env ds)) as in
-                                handleErr $ aiFn inpat False ist fc f ds as'
+                          = let as' = map (fmap (ai qq env ds)) as in
+                                handleErr $ aiFn inpat False qq ist fc f ds as'
         | Just (Just ty) <- lookup f env =
-             let as' = map (fmap (ai env ds)) as
+             let as' = map (fmap (ai qq env ds)) as
                  arity = getPArity ty in
               mkPApp fc arity ftm as'
-    ai env ds (PApp fc f as) 
-      = let f' = ai env ds f
-            as' = map (fmap (ai env ds)) as in
-         mkPApp fc 1 f' as'
-    ai env ds (PCase fc c os) 
-      = let c' = ai env ds c in
+    ai qq env ds (PApp fc f as)
+      = let f' = ai qq env ds f
+            as' = map (fmap (ai qq env ds)) as in
+            mkPApp fc 1 f' as'
+    ai qq env ds (PCase fc c os)
+      = let c' = ai qq env ds c in
         -- leave os alone, because they get lifted into a new pattern match
         -- definition which is passed through addImpl again with more scope
         -- information
             PCase fc c' os
-    ai env ds (PLam n ty sc) 
-      = let ty' = ai env ds ty
-            sc' = ai ((n, Just ty):env) ds sc in
+    ai qq env ds (PLam n ty sc)
+      = let ty' = ai qq env ds ty
+            sc' = ai qq ((n, Just ty):env) ds sc in
             PLam n ty' sc'
-    ai env ds (PLet n ty val sc)
-      = let ty' = ai env ds ty
-            val' = ai env ds val
-            sc' = ai ((n, Just ty):env) ds sc in
+    ai qq env ds (PLet n ty val sc)
+      = let ty' = ai qq env ds ty
+            val' = ai qq env ds val
+            sc' = ai qq ((n, Just ty):env) ds sc in
             PLet n ty' val' sc'
-    ai env ds (PPi p n ty sc) 
-      = let ty' = ai env ds ty
-            sc' = ai ((n, Just ty):env) ds sc in
+    ai qq env ds (PPi p n ty sc)
+      = let ty' = ai qq env ds ty
+            sc' = ai qq ((n, Just ty):env) ds sc in
             PPi p n ty' sc'
-    ai env ds (PGoal fc r n sc) 
-      = let r' = ai env ds r
-            sc' = ai ((n, Nothing):env) ds sc in
+    ai qq env ds (PGoal fc r n sc)
+      = let r' = ai qq env ds r
+            sc' = ai qq ((n, Nothing):env) ds sc in
             PGoal fc r' n sc'
-    ai env ds (PHidden tm) = PHidden (ai env ds tm)
-    ai env ds (PProof ts) = PProof (map (fmap (ai env ds)) ts)
-    ai env ds (PTactics ts) = PTactics (map (fmap (ai env ds)) ts)
-    ai env ds (PRefl fc tm) = PRefl fc (ai env ds tm)
-    ai env ds (PUnifyLog tm) = PUnifyLog (ai env ds tm)
-    ai env ds (PNoImplicits tm) = PNoImplicits (ai env ds tm)
-    ai env ds tm = tm
+    ai qq env ds (PHidden tm) = PHidden (ai qq env ds tm)
+    -- Don't do PProof or PTactics since implicits get added when scope is
+    -- properly known in ElabTerm.runTac
+    ai qq env ds (PRefl fc tm) = PRefl fc (ai qq env ds tm)
+    ai qq env ds (PUnifyLog tm) = PUnifyLog (ai qq env ds tm)
+    ai qq env ds (PNoImplicits tm) = PNoImplicits (ai qq env ds tm)
+    ai qq env ds (PQuasiquote tm g) = PQuasiquote (ai True env ds tm)
+                                                  (fmap (ai True env ds) g)
+    ai qq env ds (PUnquote tm) = PUnquote (ai False env ds tm)
+    ai qq env ds tm = tm
 
     handleErr (Left err) = PElabError err
     handleErr (Right x) = x
@@ -1366,8 +1443,8 @@
 -- if in a pattern, and there are no arguments, and there's no possible
 -- names with zero explicit arguments, don't add implicits.
 
-aiFn :: Bool -> Bool -> IState -> FC -> Name -> [[T.Text]] -> [PArg] -> Either Err PTerm
-aiFn inpat True ist fc f ds []
+aiFn :: Bool -> Bool -> Bool -> IState -> FC -> Name -> [[T.Text]] -> [PArg] -> Either Err PTerm
+aiFn inpat True qq ist fc f ds []
   = case lookupDef f (tt_ctxt ist) of
         [] -> Right $ PPatvar fc f
         alts -> let ialts = lookupCtxtName f (idris_implicits ist) in
@@ -1375,7 +1452,7 @@
                     if (not (vname f) || tcname f
                            || any (conCaf (tt_ctxt ist)) ialts)
 --                            any constructor alts || any allImp ialts))
-                        then aiFn inpat False ist fc f ds [] -- use it as a constructor
+                        then aiFn inpat False qq ist fc f ds [] -- use it as a constructor
                         else Right $ PPatvar fc f
     where imp (PExp _ _ _ _) = False
           imp _ = True
@@ -1384,14 +1461,14 @@
           constructor (TyDecl (DCon _ _) _) = True
           constructor _ = False
 
-          conCaf ctxt (n, cia) = isDConName n ctxt && allImp cia
+          conCaf ctxt (n, cia) = (isDConName n ctxt || (qq && isTConName n ctxt)) && allImp cia
 
           vname (UN n) = True -- non qualified
           vname _ = False
 
-aiFn inpat expat ist fc f ds as
+aiFn inpat expat qq ist fc f ds as
     | f `elem` primNames = Right $ PApp fc (PRef fc f) as
-aiFn inpat expat ist fc f ds as
+aiFn inpat expat qq ist fc f ds as
           -- This is where namespaces get resolved by adding PAlternative
      = do let ns = lookupCtxtName f (idris_implicits ist)
           let nh = filter (\(n, _) -> notHidden n) ns
@@ -1425,40 +1502,46 @@
                     _ -> Public
 
     insertImpl :: [PArg] -> [PArg] -> [PArg]
-    insertImpl ps as = insImpAcc M.empty ps as
+    insertImpl ps as = insImpAcc M.empty ps (filter exp as) (filter (not.exp) as)
 
+    exp (PExp _ _ _ _) = True
+    exp (PConstraint _ _ _ _) = True
+    exp _ = False
+
     insImpAcc :: M.Map Name PTerm -- accumulated param names & arg terms
               -> [PArg]           -- parameters
-              -> [PArg]           -- arguments
+              -> [PArg]           -- explicit arguments
+              -> [PArg]           -- implicits given
               -> [PArg]
-    insImpAcc pnas (PExp p l n ty : ps) (PExp _ _ _ tm : given) =
-      PExp p l n tm : insImpAcc (M.insert n tm pnas) ps given
-    insImpAcc pnas (PConstraint p l n ty : ps) (PConstraint _ _ _ tm : given) =
-      PConstraint p l n tm : insImpAcc (M.insert n tm pnas) ps given
-    insImpAcc pnas (PConstraint p l n ty : ps) given =
+    insImpAcc pnas (PExp p l n ty : ps) (PExp _ _ _ tm : given) imps =
+      PExp p l n tm : insImpAcc (M.insert n tm pnas) ps given imps
+    insImpAcc pnas (PConstraint p l n ty : ps) (PConstraint _ _ _ tm : given) imps =
+      PConstraint p l n tm : insImpAcc (M.insert n tm pnas) ps given imps
+    insImpAcc pnas (PConstraint p l n ty : ps) given imps =
       let rtc = PResolveTC fc in
-        PConstraint p l n rtc : insImpAcc (M.insert n rtc pnas) ps given
-    insImpAcc pnas (PImp p _ l n ty : ps) given =
-        case find n given [] of
-            Just (tm, given') ->
-              PImp p False l n tm : insImpAcc (M.insert n tm pnas) ps given'
+        PConstraint p l n rtc : insImpAcc (M.insert n rtc pnas) ps given imps
+    insImpAcc pnas (PImp p _ l n ty : ps) given imps =
+        case find n imps [] of
+            Just (tm, imps') ->
+              PImp p False l n tm : insImpAcc (M.insert n tm pnas) ps given imps'
             Nothing ->
               PImp p True l n Placeholder :
-                insImpAcc (M.insert n Placeholder pnas) ps given
-    insImpAcc pnas (PTacImplicit p l n sc' ty : ps) given =
+                insImpAcc (M.insert n Placeholder pnas) ps given imps
+    insImpAcc pnas (PTacImplicit p l n sc' ty : ps) given imps =
       let sc = addImpl ist (substMatches (M.toList pnas) sc') in
-        case find n given [] of
-            Just (tm, given') ->
+        case find n imps [] of
+            Just (tm, imps') ->
               PTacImplicit p l n sc tm :
-                insImpAcc (M.insert n tm pnas) ps given'
+                insImpAcc (M.insert n tm pnas) ps given imps'
             Nothing ->
               if inpat
                 then PTacImplicit p l n sc Placeholder :
-                  insImpAcc (M.insert n Placeholder pnas) ps given
+                  insImpAcc (M.insert n Placeholder pnas) ps given imps
                 else PTacImplicit p l n sc sc :
-                  insImpAcc (M.insert n sc pnas) ps given
-    insImpAcc _ expected [] = []
-    insImpAcc _ _        given  = given
+                  insImpAcc (M.insert n sc pnas) ps given imps
+    insImpAcc _ expected [] imps = imps -- so that unused implicits give error
+                                     -- TODO: report here, and prune alternatives
+    insImpAcc _ _        given imps = given ++ imps
 
     find n []               acc = Nothing
     find n (PImp _ _ _ n' t : gs) acc
@@ -1619,7 +1702,8 @@
         | not names && (not (isConName n (tt_ctxt i) ||
                              isFnName n (tt_ctxt i)) || tm == Placeholder)
             = return [(n, tm)]
-    match (PEq _ l r) (PEq _ l' r') = do ml <- match' l l'
+    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' _)
@@ -1710,7 +1794,7 @@
          | otherwise = PPi p x (sm xs t) (sm (x : xs) sc)
     sm xs (PApp f x as) = fullApp $ 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 (PEq f xt yt x y) = PEq f (sm xs xt) (sm xs yt) (sm xs x) (sm xs y)
     sm xs (PRewrite f x y tm) = PRewrite f (sm xs x) (sm xs y)
                                            (fmap (sm xs) tm)
     sm xs (PTyped x y) = PTyped (sm xs x) (sm xs y)
@@ -1734,7 +1818,7 @@
     sm (PApp f x as) = PApp f (sm x) (map (fmap sm) as)
     sm (PAppBind f x as) = PAppBind 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 (PEq f xt yt x y) = PEq f (sm xt) (sm yt) (sm x) (sm y)
     sm (PRewrite f x y tm) = PRewrite f (sm x) (sm y) (fmap sm tm)
     sm (PTyped x y) = PTyped (sm x) (sm y)
     sm (PPair f p x y) = PPair f p (sm x) (sm y)
diff --git a/src/Idris/AbsSyntaxTree.hs b/src/Idris/AbsSyntaxTree.hs
--- a/src/Idris/AbsSyntaxTree.hs
+++ b/src/Idris/AbsSyntaxTree.hs
@@ -15,8 +15,6 @@
 
 import Idris.Colours
 
-import Paths_idris
-
 import System.Console.Haskeline
 import System.IO
 
@@ -289,6 +287,7 @@
 data Command = Quit
              | Help
              | Eval PTerm
+             | NewDefn [PDecl] -- ^ Each 'PDecl' should be either a type declaration (at most one) or a clause defining the same name.
              | Check PTerm
              | DocStr (Either Name Const)
              | TotCheck Name
@@ -485,8 +484,9 @@
 
 
 -- | Data declaration options
-data DataOpt = Codata -- Set if the the data-type is coinductive
-             | DefaultEliminator -- Set if an eliminator should be generated for data type
+data DataOpt = Codata -- ^ Set if the the data-type is coinductive
+             | DefaultEliminator -- ^ Set if an eliminator should be generated for data type
+             | DefaultCaseFun -- ^ Set if a case function should be generated for data type
              | DataErrRev
     deriving (Show, Eq)
 
@@ -681,7 +681,7 @@
            | PFalse FC -- ^ _|_
            | PRefl FC PTerm
            | PResolveTC FC
-           | PEq FC PTerm PTerm -- ^ Equality type: A = B
+           | PEq FC PTerm PTerm PTerm PTerm -- ^ Heterogeneous equality type: A = B
            | PRewrite FC PTerm PTerm (Maybe PTerm)
            | PPair FC PunInfo PTerm PTerm
            | PDPair FC PunInfo PTerm PTerm PTerm
@@ -703,6 +703,8 @@
            | PDisamb [[T.Text]] PTerm -- ^ Preferences for explicit namespaces
            | PUnifyLog PTerm -- ^ dump a trace of unifications when building term
            | PNoImplicits PTerm -- ^ never run implicit converions on the term
+           | PQuasiquote PTerm (Maybe PTerm) -- ^ `(Term [: Term])
+           | PUnquote PTerm -- ^ ,Term
        deriving Eq
 
 
@@ -721,7 +723,7 @@
   mpt (PApp fc t as) = PApp fc (mapPT f t) (map (fmap (mapPT f)) as)
   mpt (PAppBind fc t as) = PAppBind 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)
+  mpt (PEq fc lt rt l r) = PEq fc (mapPT f lt) (mapPT f rt) (mapPT f l) (mapPT f r)
   mpt (PTyped l r) = PTyped (mapPT f l) (mapPT f r)
   mpt (PPair fc p l r) = PPair fc p (mapPT f l) (mapPT f r)
   mpt (PDPair fc p l t r) = PDPair fc p (mapPT f l) (mapPT f t) (mapPT f r)
@@ -739,7 +741,8 @@
 
 data PTactic' t = Intro [Name] | Intros | Focus Name
                 | Refine Name [Bool] | Rewrite t | DoUnify
-                | Induction Name
+                | Induction t
+                | CaseTac t
                 | Equiv t
                 | MatchRefine Name
                 | LetTac Name t | LetTacTy Name t t
@@ -758,6 +761,8 @@
                 | GoalType String (PTactic' t)
                 | TCheck t
                 | TEval t
+                | TDocStr (Either Name Const)
+                | TSearch t
                 | Qed | Abandon
     deriving (Show, Eq, Functor)
 {-!
@@ -833,7 +838,7 @@
                               getTm :: t }
     deriving (Show, Eq, Functor)
 
-data ArgOpt = HideDisplay | InaccessibleArg
+data ArgOpt = AlwaysShow | HideDisplay | InaccessibleArg
     deriving (Show, Eq)
 
 instance Sized a => Sized (PArg' a) where
@@ -904,7 +909,8 @@
                     index_first :: Maybe t,
                     index_next  :: Maybe t,
                     dsl_lambda  :: Maybe t,
-                    dsl_let     :: Maybe t
+                    dsl_let     :: Maybe t,
+                    dsl_pi      :: Maybe t
                   }
     deriving (Show, Functor)
 {-!
@@ -948,6 +954,7 @@
               Nothing
               Nothing
               Nothing
+              Nothing
   where f = fileFC "(builtin)"
 
 data Using = UImplicit Name PTerm
@@ -967,14 +974,15 @@
                         implicitAllowed :: Bool,
                         maxline :: Maybe Int,
                         mut_nesting :: Int,
-                        dsl_info :: DSL }
+                        dsl_info :: DSL,
+                        syn_in_quasiquote :: Bool }
     deriving Show
 {-!
 deriving instance NFData SyntaxInfo
 deriving instance Binary SyntaxInfo
 !-}
 
-defaultSyntax = Syn [] [] [] [] id False False Nothing 0 initDSL
+defaultSyntax = Syn [] [] [] [] id False False Nothing 0 initDSL False
 
 expandNS :: SyntaxInfo -> Name -> Name
 expandNS syn n@(NS _ _) = n
@@ -1070,9 +1078,9 @@
           "Thus, if Idris can't infer the type of one side of the equality, then " ++
           "you may need to annotate it. See the function `the`."
 
-eqDecl = PDatadecl eqTy (piBind [(n "A", PType), (n "B", PType),
-                                 (n "x", PRef bi (n "A")), (n "y", PRef bi (n "B"))]
-                                 PType)
+eqDecl = PDatadecl eqTy (piBindp impl [(n "A", PType), (n "B", PType)]
+                                 (piBind [(n "x", PRef bi (n "A")), (n "y", PRef bi (n "B"))]
+                                 PType))
                 [(reflDoc, reflParamDoc,
                   eqCon, PPi impl (n "A") PType (
                                   PPi impl (n "x") (PRef bi (n "A"))
@@ -1080,7 +1088,7 @@
                                                                pimp (n "B") Placeholder False,
                                                                pexp (PRef bi (n "x")),
                                                                pexp (PRef bi (n "x"))])), bi, [])]
-    where n a = sMN 0 a
+    where n a = sUN a
           reflDoc = parseDocstring . T.pack $
                       "A proof that `x` in fact equals `x`. To construct this, you must have already " ++
                       "shown that both sides are in fact equal."
@@ -1090,7 +1098,7 @@
 eqParamDoc = [(n "A", parseDocstring . T.pack $ "the type of the left side of the equality"),
               (n "B", parseDocstring . T.pack $ "the type of the right side of the equality")
               ]
-    where n a = sMN 0 a
+    where n a = sUN a
 
 eqOpts = []
 
@@ -1122,7 +1130,7 @@
   showsPrec _ tm = (displayS . renderPretty 1.0 10000000 . prettyImp defaultPPOption) tm
 
 instance Show PDecl where
-  showsPrec _ d = (displayS . renderPretty 1.0 10000000 . showDeclImp defaultPPOption) d
+  showsPrec _ d = (displayS . renderPretty 1.0 10000000 . showDeclImp verbosePPOption) d
 
 instance Show PClause where
   showsPrec _ c = (displayS . renderPretty 1.0 10000000 . showCImp verbosePPOption) c
@@ -1160,6 +1168,7 @@
   where colour BoldText      = IdrisColour Nothing True False True False
         colour UnderlineText = IdrisColour Nothing True True False False
         colour ItalicText    = IdrisColour Nothing True False False True
+consoleDecorate ist (AnnTerm _ _) = id
 
 isPostulateName :: Name -> IState -> Bool
 isPostulateName n ist = S.member n (idris_postulates ist)
@@ -1170,6 +1179,8 @@
           -> Doc OutputAnnotation
 prettyImp impl = pprintPTerm impl [] [] []
 
+-- | Serialise something to base64 using its Binary instance.
+
 -- | Do the right thing for rendering a term in an IState
 prettyIst ::  IState -> PTerm -> Doc OutputAnnotation
 prettyIst ist = pprintPTerm (ppOptionIst ist) [] [] (idris_infixes ist)
@@ -1190,7 +1201,7 @@
     prettySe p bnd e
       | Just str <- slist p bnd e = str
       | Just n <- snat p e = annotate (AnnData "Nat" "") (text (show n))
-    prettySe p bnd (PRef fc n) = prettyName (ppopt_impl ppo) bnd n
+    prettySe p bnd (PRef fc n) = prettyName True (ppopt_impl ppo) bnd n
     prettySe p bnd (PLam n ty sc) =
       bracket p 2 . group . align . hang 2 $
       text "\\" <> bindingOf n False <+> text "=>" <$>
@@ -1233,25 +1244,25 @@
       rbrace <+> text "->" </> prettySe 10 ((n, True):bnd) sc
     prettySe p bnd (PApp _ (PRef _ f) args) -- normal names, no explicit args
       | UN nm <- basename f
-      , not (ppopt_impl ppo) && null (getExps args) =
-          if isAlpha (thead nm)
-              then prettyName (ppopt_impl ppo) bnd f
-              else enclose lparen rparen $ prettyName (ppopt_impl ppo) bnd f
+      , not (ppopt_impl ppo) && null (getShowArgs args) =
+          prettyName True (ppopt_impl ppo) bnd f
     prettySe p bnd (PAppBind _ (PRef _ f) [])
-      | not (ppopt_impl ppo) = text "!" <> prettyName (ppopt_impl ppo) bnd f
+      | not (ppopt_impl ppo) = text "!" <> prettyName True (ppopt_impl ppo) bnd f
     prettySe p bnd (PApp _ (PRef _ op) args) -- infix operators
       | UN nm <- basename op
       , not (tnull nm) &&
         (not (ppopt_impl ppo)) && (not $ isAlpha (thead nm)) =
-          case getExps args of
-            [] -> enclose lparen rparen opName
-            [x] -> group (enclose lparen rparen opName <$> group (prettySe 0 bnd x))
+          case getShowArgs args of
+            [] -> opName True
+            [x] -> group (opName True <$> group (prettySe 0 bnd (getTm x)))
             [l,r] -> let precedence = fromMaybe 20 (fmap prec f)
-                     in bracket p precedence $ inFix l r
-            (l:r:rest) -> bracket p 1 $
-                          enclose lparen rparen (inFix l r) <+>
-                          align (group (vsep (map (prettyArgSe bnd) rest)))
-          where opName = prettyName (ppopt_impl ppo) bnd op
+                     in bracket p precedence $ inFix (getTm l) (getTm r)
+            (l@(PExp _ _ _ _) : r@(PExp _ _ _ _) : rest) -> 
+                   bracket p 1 $
+                          enclose lparen rparen (inFix (getTm l) (getTm r)) <+>
+                          align (group (vsep (map (prettyArgS bnd) rest)))
+            as -> opName True <+> align (vsep (map (prettyArgS bnd) as))
+          where opName isPrefix = prettyName isPrefix (ppopt_impl ppo) bnd op
                 f = getFixity (opStr op)
                 left l = case f of
                            Nothing -> prettySe (-1) bnd l
@@ -1262,13 +1273,13 @@
                             Just (Infixr p') -> prettySe p' bnd r
                             Just f' -> prettySe (prec f'-1) bnd r
                 inFix l r = align . group $
-                              (left l <+> opName) <$> group (right r)
+                              (left l <+> opName False) <$> group (right r)
     prettySe p bnd (PApp _ hd@(PRef fc f) [tm]) -- symbols, like 'foo
       | PConstant (Idris.Core.TT.Str str) <- getTm tm,
         f == sUN "Symbol_" = annotate (AnnType ("'" ++ str) ("The symbol " ++ str)) $
                                char '\'' <> prettySe 10 bnd (PRef fc (sUN str))
     prettySe p bnd (PApp _ f as) = -- Normal prefix applications
-      let args = getExps as
+      let args = getShowArgs as
           fp   = prettySe 1 bnd f
       in
         bracket p 1 . group $
@@ -1278,7 +1289,7 @@
                    else fp <+> align (vsep (map (prettyArgS bnd) as))
             else if null args
                    then fp
-                   else fp <+> align (vsep (map (prettyArgSe bnd) args))
+                   else fp <+> align (vsep (map (prettyArgS bnd) args))
     prettySe p bnd (PCase _ scr opts) =
       kwd "case" <+> prettySe 10 bnd scr <+> kwd "of" <> prettyBody
       where
@@ -1292,7 +1303,7 @@
     prettySe p bnd (PTrue _ IsTerm) = annName unitCon $ text "()"
     prettySe p bnd (PTrue _ TypeOrTerm) = text "()"
     prettySe p bnd (PFalse _) = annName falseTy $ text "_|_"
-    prettySe p bnd (PEq _ l r) =
+    prettySe p bnd (PEq _ _ _ l r) =
       bracket p 2 . align . group $
       prettySe 10 bnd l <+> eq <$> group (prettySe 10 bnd r)
       where eq = annName eqTy (text "=")
@@ -1348,8 +1359,12 @@
     prettySe p bnd (PDoBlock _) = text "do block pretty not implemented"
     prettySe p bnd (PCoerced t) = prettySe p bnd t
     prettySe p bnd (PElabError s) = pretty s
+    -- Quasiquote pprinting ignores bound vars
+    prettySe p bnd (PQuasiquote t Nothing) = text "`(" <> prettySe p [] t <> text ")"
+    prettySe p bnd (PQuasiquote t (Just g)) = text "`(" <> prettySe p [] t <+> colon <+> prettySe p [] g <> text ")"
+    prettySe p bnd (PUnquote t) = text "~" <> prettySe p bnd t
 
-    prettySe p bnd _ = text "test"
+    prettySe p bnd _ = text "missing pretty-printer for term"
 
     prettyArgS bnd (PImp _ _ _ n tm) = prettyArgSi bnd (n, tm)
     prettyArgS bnd (PExp _ _ _ tm)   = prettyArgSe bnd tm
@@ -1429,7 +1444,7 @@
 
 prettyDocumentedIst :: IState -> (Name, PTerm, Maybe Docstring) -> Doc OutputAnnotation
 prettyDocumentedIst ist (name, ty, docs) =
-          prettyName True [] name <+> colon <+> align (prettyIst ist ty) <$>
+          prettyName True True [] name <+> colon <+> align (prettyIst ist ty) <$>
           fromMaybe empty (fmap (\d -> renderDocstring d <> line) docs)
 
 -- | Pretty-printer helper for the binding site of a name
@@ -1439,18 +1454,28 @@
 bindingOf n imp = annotate (AnnBoundName n imp) (text (show n))
 
 -- | Pretty-printer helper for names that attaches the correct annotations
-prettyName :: Bool -- ^^ whether to show namespaces
-           -> [(Name, Bool)] -- ^^ the current bound variables and whether they are implicit
-           -> Name -- ^^ the name to pprint
-           -> Doc OutputAnnotation
-prettyName showNS bnd n | Just imp <- lookup n bnd = annotate (AnnBoundName n imp) (text (strName n))
-                        | otherwise = annotate (AnnName n Nothing Nothing Nothing) (text (strName n))
-  where strName (UN n) = T.unpack n
-        strName (NS n ns) | showNS    = (concatMap (++ ".") . map T.unpack . reverse) ns ++ strName n
-                          | otherwise = strName n
-        strName n | n == falseTy = "_|_"
-        strName (MN i s) = T.unpack s
-        strName other = show other
+prettyName
+  :: Bool -- ^^ whether the name should be parenthesised if it is an infix operator
+  -> Bool -- ^^ whether to show namespaces
+  -> [(Name, Bool)] -- ^^ the current bound variables and whether they are implicit
+  -> Name -- ^^ the name to pprint
+  -> Doc OutputAnnotation
+prettyName infixParen showNS bnd n 
+    | Just imp <- lookup n bnd = annotate (AnnBoundName n imp) fullName
+    | otherwise                = annotate (AnnName n Nothing Nothing Nothing) fullName
+  where fullName = text nameSpace <> parenthesise (text (baseName n))
+        baseName (UN n) = T.unpack n
+        baseName (NS n ns) = baseName n
+        baseName (MN i s) = T.unpack s 
+        baseName n | n == falseTy = "_|_"
+        baseName other = show other
+        nameSpace = case n of
+          (NS n' ns) -> if showNS then (concatMap (++ ".") . map T.unpack . reverse) ns else ""
+          _ -> ""
+        isInfix = case baseName n of
+          ""      -> False
+          (c : _) -> not (isAlpha c)
+        parenthesise = if isInfix && infixParen then enclose lparen rparen else id
 
 
 showCImp :: PPOption -> PClause -> Doc OutputAnnotation
@@ -1471,7 +1496,7 @@
 showDImp :: PPOption -> PData -> Doc OutputAnnotation
 showDImp ppo (PDatadecl n ty cons)
  = text "data" <+> text (show n) <+> colon <+> prettyImp ppo ty <+> text "where" <$>
-    (indent 2 $ vsep (map (\ (_, _, n, t, _, _) -> pipe <+> prettyName False [] n <+> colon <+> prettyImp ppo t) cons))
+    (indent 2 $ vsep (map (\ (_, _, n, t, _, _) -> pipe <+> prettyName True False [] n <+> colon <+> prettyImp ppo t) cons))
 
 showDecls :: PPOption -> [PDecl] -> Doc OutputAnnotation
 showDecls o ds = vsep (map (showDeclImp o) ds)
@@ -1504,6 +1529,12 @@
 getExps (PExp _ _ _ tm : xs) = tm : getExps xs
 getExps (_ : xs) = getExps xs
 
+getShowArgs :: [PArg] -> [PArg]
+getShowArgs [] = []
+getShowArgs (e@(PExp _ _ _ tm) : xs) = e : getShowArgs xs
+getShowArgs (e : xs) | AlwaysShow `elem` argopts e = e : getShowArgs xs
+getShowArgs (_ : xs) = getShowArgs xs
+
 getConsts :: [PArg] -> [PTerm]
 getConsts [] = []
 getConsts (PConstraint _ _ _ tm : xs) = tm : getConsts xs
@@ -1525,7 +1556,7 @@
                                    Nothing -> showbasic n
     where name = if ppopt_impl ppo then show n else showbasic n
           showbasic n@(UN _) = showCG n
-          showbasic (MN _ s) = str s
+          showbasic (MN i s) = str s
           showbasic (NS n s) = showSep "." (map str (reverse s)) ++ "." ++ showbasic n
           showbasic (SN s) = show s
           fst3 (x, _, _) = x
@@ -1569,7 +1600,7 @@
   size (PFalse fc) = 1
   size (PRefl fc _) = 1
   size (PResolveTC fc) = 1
-  size (PEq fc left right) = 1 + size left + size right
+  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
@@ -1607,7 +1638,7 @@
     ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
     ni env (PPi p n ty sc) = niTacImp env p ++ 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 (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
@@ -1632,7 +1663,7 @@
     ni (PLam n ty sc)  = n : (ni ty ++ ni sc)
     ni (PLet n ty val sc)  = n : (ni ty ++ ni val ++ ni sc)
     ni (PPi p n ty sc) = niTacImp p ++ (n : (ni ty ++ ni sc))
-    ni (PEq _ l r)     = ni l ++ ni r
+    ni (PEq _ _ _ l r)     = ni l ++ ni r
     ni (PRewrite _ l r _) = ni l ++ ni r
     ni (PTyped l r)    = ni l ++ ni r
     ni (PPair _ _ l r)   = ni l ++ ni r
@@ -1648,6 +1679,42 @@
     niTacImp (TacImp _ _ scr) = ni scr
     niTacImp _                = []
 
+-- Return names which are valid implicits in the given term (type).
+implicitNamesIn :: [Name] -> IState -> PTerm -> [Name]
+implicitNamesIn uvars ist tm = nub $ ni [] tm
+  where
+    ni env (PRef _ n)
+        | not (n `elem` env) 
+            = case lookupTy n (tt_ctxt ist) of
+                [] -> [n]
+                _ -> if n `elem` uvars then [n] else []
+    ni env (PApp _ f@(PRef _ n) as) 
+        | n `elem` uvars = ni env f ++ concatMap (ni env) (map getTm as)
+        | otherwise = concatMap (ni env) (map getTm as)
+    ni env (PApp _ f as) = ni env f ++ concatMap (ni env) (map getTm as)
+    ni env (PAppBind _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)
+    ni env (PCase _ c os)  = ni env c ++ 
+    -- names in 'os', not counting the names bound in the cases
+                                (nub (concatMap (ni env) (map snd os))
+                                     \\ nub (concatMap (ni env) (map fst os)))
+    ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
+    ni env (PPi p n ty sc) = niTacImp env p ++ 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
+    ni env (PDPair _ _ l t r) = ni env l ++ ni env t ++ ni env r
+    ni env (PAlternative a as) = concatMap (ni env) as
+    ni env (PHidden tm)    = ni env tm
+    ni env (PUnifyLog tm)    = ni env tm
+    ni env (PDisamb _ tm)    = ni env tm
+    ni env (PNoImplicits tm) = ni env tm
+    ni env _               = []
+
+    niTacImp env (TacImp _ _ scr) = ni env scr
+    niTacImp _ _                  = []
+
 -- Return names which are free in the given term.
 namesIn :: [(Name, PTerm)] -> IState -> PTerm -> [Name]
 namesIn uvars ist tm = nub $ ni [] tm
@@ -1659,10 +1726,13 @@
                 _ -> if n `elem` (map fst uvars) then [n] else []
     ni env (PApp _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)
     ni env (PAppBind _ f as)   = ni env f ++ concatMap (ni env) (map getTm as)
-    ni env (PCase _ c os)  = ni env c ++ concatMap (ni env) (map snd os)
+    ni env (PCase _ c os)  = ni env c ++ 
+    -- names in 'os', not counting the names bound in the cases
+                                (nub (concatMap (ni env) (map snd os))
+                                     \\ nub (concatMap (ni env) (map fst os)))
     ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
     ni env (PPi p n ty sc) = niTacImp env p ++ ni env ty ++ ni (n:env) sc
-    ni env (PEq _ l r)     = ni env l ++ ni env r
+    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
@@ -1693,7 +1763,7 @@
     ni env (PCase _ c os)  = ni env c ++ concatMap (ni env) (map snd os)
     ni env (PLam n ty sc)  = ni env ty ++ ni (n:env) sc
     ni env (PPi p n ty sc) = niTacImp env p ++ ni env ty ++ ni (n:env) sc
-    ni env (PEq _ l r)     = ni env l ++ ni env r
+    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
@@ -1708,3 +1778,10 @@
 
     niTacImp env (TacImp _ _ scr) = ni env scr
     niTacImp _ _                = []
+
+-- Return the list of inaccessible (= dotted) positions for a name.
+getErasureInfo :: IState -> Name -> [Int]
+getErasureInfo ist n =
+    case lookupCtxtExact n (idris_optimisation ist) of
+        Just (Optimise inacc detagg) -> map fst inacc
+        Nothing -> []
diff --git a/src/Idris/CaseSplit.hs b/src/Idris/CaseSplit.hs
--- a/src/Idris/CaseSplit.hs
+++ b/src/Idris/CaseSplit.hs
@@ -55,7 +55,7 @@
    = do ist <- getIState
         -- Make sure all the names in the term are accessible
         mapM_ (\n -> setAccessibility n Public) (allNamesIn t')
-        (tm, ty, pats) <- elabValBind toplevel True True (addImplPat ist t')
+        (tm, ty, pats) <- elabValBind toplevel ELHS True (addImplPat ist t')
         -- ASSUMPTION: tm is in normal form after elabValBind, so we don't
         -- need to do anything special to find out what family each argument
         -- is in
@@ -201,7 +201,7 @@
 --         tidyVar t = t
 
 elabNewPat :: PTerm -> Idris (Maybe PTerm)
-elabNewPat t = idrisCatch (do (tm, ty) <- elabVal toplevel True t
+elabNewPat t = idrisCatch (do (tm, ty) <- elabVal toplevel ELHS t
                               i <- getIState
                               return (Just (delab i tm)))
                           (\e -> do i <- getIState
@@ -231,7 +231,7 @@
         subst (PApp fc (PRef _ t) pats) 
             | isTConName t ctxt = Placeholder -- infer types
         subst (PApp fc f pats) = PApp fc f (map substArg pats)
-        subst (PEq fc l r) = Placeholder -- PEq fc (subst l) (subst r)
+        subst (PEq fc _ _ l r) = Placeholder -- PEq fc (subst l) (subst r)
         subst x = x
 
         substArg arg = arg { getTm = subst (getTm arg) }
@@ -276,7 +276,7 @@
     -- this isn't supported in a pattern, so special case here
     nshow (PRef _ (UN z)) | z == txt "Z" = "Z"
     nshow (PApp _ (PRef _ (UN s)) [x]) | s == txt "S" =
-               "S " ++ addBrackets (nshow (getTm x))
+               "(S " ++ addBrackets (nshow (getTm x)) ++ ")"
     nshow t = show t
 
     -- if there's any {n} replace with {n=n}
@@ -349,7 +349,7 @@
          getNameFrom i used (PPi _ _ _ _) 
               = uniqueNameFrom (mkSupply [sUN "f", sUN "g"]) used
          getNameFrom i used (PApp fc f as) = getNameFrom i used f
-         getNameFrom i used (PEq _ _ _) = uniqueNameFrom [sUN "prf"] used 
+         getNameFrom i used (PEq _ _ _ _ _) = uniqueNameFrom [sUN "prf"] used 
          getNameFrom i used (PRef fc f) 
             = case getNameHints i f of
                    [] -> uniqueName (sUN "x") used
diff --git a/src/Idris/Completion.hs b/src/Idris/Completion.hs
--- a/src/Idris/Completion.hs
+++ b/src/Idris/Completion.hs
@@ -44,7 +44,8 @@
              , ("reflect", Just ExprTArg)
              , ("fill", Just ExprTArg)
              , ("try", Just AltsTArg)
-             , ("induction", Just NameTArg)
+             , ("induction", Just ExprTArg)
+             , ("case", Just ExprTArg)
              , (":t", Just ExprTArg)
              , (":type", Just ExprTArg)
              , (":e", Just ExprTArg)
diff --git a/src/Idris/Core/Binary.hs b/src/Idris/Core/Binary.hs
new file mode 100644
--- /dev/null
+++ b/src/Idris/Core/Binary.hs
@@ -0,0 +1,356 @@
+{-| Binary instances for the core datatypes -}
+module Idris.Core.Binary where
+
+import Data.Binary
+import Data.Vector.Binary
+import qualified Data.Text as T
+
+import Idris.Core.TT
+
+----- Generated by 'derive'
+
+instance Binary FC where
+        put (FC x1 (x2, x3) (x4, x5))
+          = do put x1
+               put (x2 * 65536 + x3)
+               put (x4 * 65536 + x5)
+        get
+          = do x1 <- get
+               x2x3 <- get
+               x4x5 <- get
+               return (FC x1 (x2x3 `div` 65536, x2x3 `mod` 65536) (x4x5 `div` 65536, x4x5 `mod` 65536))
+
+
+instance Binary Name where
+        put x
+          = case x of
+                UN x1 -> do putWord8 0
+                            put x1
+                NS x1 x2 -> do putWord8 1
+                               put x1
+                               put x2
+                MN x1 x2 -> do putWord8 2
+                               put x1
+                               put x2
+                NErased -> putWord8 3
+                SN x1 -> do putWord8 4
+                            put x1
+                SymRef x1 -> do putWord8 5
+                                put x1
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           return (UN x1)
+                   1 -> do x1 <- get
+                           x2 <- get
+                           return (NS x1 x2)
+                   2 -> do x1 <- get
+                           x2 <- get
+                           return (MN x1 x2)
+                   3 -> return NErased
+                   4 -> do x1 <- get
+                           return (SN x1)
+                   5 -> do x1 <- get
+                           return (SymRef x1)
+                   _ -> error "Corrupted binary data for Name"
+
+instance Binary T.Text where
+        put x = put (str x)
+        get = do x <- get
+                 return (txt x)
+
+instance Binary SpecialName where
+        put x
+          = case x of
+                WhereN x1 x2 x3 -> do putWord8 0
+                                      put x1
+                                      put x2
+                                      put x3
+                InstanceN x1 x2 -> do putWord8 1
+                                      put x1
+                                      put x2
+                ParentN x1 x2 -> do putWord8 2
+                                    put x1
+                                    put x2
+                MethodN x1 -> do putWord8 3
+                                 put x1
+                CaseN x1 -> do putWord8 4; put x1
+                ElimN x1 -> do putWord8 5; put x1
+                InstanceCtorN x1 -> do putWord8 6; put x1
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           x2 <- get
+                           x3 <- get
+                           return (WhereN x1 x2 x3)
+                   1 -> do x1 <- get
+                           x2 <- get
+                           return (InstanceN x1 x2)
+                   2 -> do x1 <- get
+                           x2 <- get
+                           return (ParentN x1 x2)
+                   3 -> do x1 <- get
+                           return (MethodN x1)
+                   4 -> do x1 <- get
+                           return (CaseN x1)
+                   5 -> do x1 <- get
+                           return (ElimN x1)
+                   6 -> do x1 <- get
+                           return (InstanceCtorN x1)
+                   _ -> error "Corrupted binary data for SpecialName"
+
+
+instance Binary Const where
+        put x
+          = case x of
+                I x1 -> do putWord8 0
+                           put x1
+                BI x1 -> do putWord8 1
+                            put x1
+                Fl x1 -> do putWord8 2
+                            put x1
+                Ch x1 -> do putWord8 3
+                            put x1
+                Str x1 -> do putWord8 4
+                             put x1
+                B8 x1 -> putWord8 5 >> put x1
+                B16 x1 -> putWord8 6 >> put x1
+                B32 x1 -> putWord8 7 >> put x1
+                B64 x1 -> putWord8 8 >> put x1
+
+                (AType (ATInt ITNative)) -> putWord8 9
+                (AType (ATInt ITBig)) -> putWord8 10
+                (AType ATFloat) -> putWord8 11
+                (AType (ATInt ITChar)) -> putWord8 12
+                StrType -> putWord8 13
+                PtrType -> putWord8 14
+                Forgot -> putWord8 15
+                (AType (ATInt (ITFixed ity))) -> putWord8 (fromIntegral (16 + fromEnum ity)) -- 16-19 inclusive
+                (AType (ATInt (ITVec ity count))) -> do
+                        putWord8 20
+                        putWord8 (fromIntegral . fromEnum $ ity)
+                        putWord8 (fromIntegral count)
+
+                B8V  x1 -> putWord8 21 >> put x1
+                B16V x1 -> putWord8 22 >> put x1
+                B32V x1 -> putWord8 23 >> put x1
+                B64V x1 -> putWord8 24 >> put x1
+                BufferType -> putWord8 25
+                ManagedPtrType -> putWord8 26
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           return (I x1)
+                   1 -> do x1 <- get
+                           return (BI x1)
+                   2 -> do x1 <- get
+                           return (Fl x1)
+                   3 -> do x1 <- get
+                           return (Ch x1)
+                   4 -> do x1 <- get
+                           return (Str x1)
+                   5 -> fmap B8 get
+                   6 -> fmap B16 get
+                   7 -> fmap B32 get
+                   8 -> fmap B64 get
+
+                   9 -> return (AType (ATInt ITNative))
+                   10 -> return (AType (ATInt ITBig))
+                   11 -> return (AType ATFloat)
+                   12 -> return (AType (ATInt ITChar))
+                   13 -> return StrType
+                   14 -> return PtrType
+                   15 -> return Forgot
+
+                   16 -> return (AType (ATInt (ITFixed IT8)))
+                   17 -> return (AType (ATInt (ITFixed IT16)))
+                   18 -> return (AType (ATInt (ITFixed IT32)))
+                   19 -> return (AType (ATInt (ITFixed IT64)))
+
+                   20 -> do
+                        e <- getWord8
+                        c <- getWord8
+                        return (AType (ATInt (ITVec (toEnum . fromIntegral $ e) (fromIntegral c))))
+
+                   21 -> fmap B8V get
+                   22 -> fmap B16V get
+                   23 -> fmap B32V get
+                   24 -> fmap B64V get
+                   25 -> return BufferType
+                   26 -> return ManagedPtrType
+
+                   _ -> error "Corrupted binary data for Const"
+
+
+instance Binary Raw where
+        put x
+          = case x of
+                Var x1 -> do putWord8 0
+                             put x1
+                RBind x1 x2 x3 -> do putWord8 1
+                                     put x1
+                                     put x2
+                                     put x3
+                RApp x1 x2 -> do putWord8 2
+                                 put x1
+                                 put x2
+                RType -> putWord8 3
+                RConstant x1 -> do putWord8 4
+                                   put x1
+                RForce x1 -> do putWord8 5
+                                put x1
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           return (Var x1)
+                   1 -> do x1 <- get
+                           x2 <- get
+                           x3 <- get
+                           return (RBind x1 x2 x3)
+                   2 -> do x1 <- get
+                           x2 <- get
+                           return (RApp x1 x2)
+                   3 -> return RType
+                   4 -> do x1 <- get
+                           return (RConstant x1)
+                   5 -> do x1 <- get
+                           return (RForce x1)
+                   _ -> error "Corrupted binary data for Raw"
+
+
+instance (Binary b) => Binary (Binder b) where
+        put x
+          = case x of
+                Lam x1 -> do putWord8 0
+                             put x1
+                Pi x1 -> do putWord8 1
+                            put x1
+                Let x1 x2 -> do putWord8 2
+                                put x1
+                                put x2
+                NLet x1 x2 -> do putWord8 3
+                                 put x1
+                                 put x2
+                Hole x1 -> do putWord8 4
+                              put x1
+                GHole x1 x2 -> do putWord8 5
+                                  put x1
+                                  put x2
+                Guess x1 x2 -> do putWord8 6
+                                  put x1
+                                  put x2
+                PVar x1 -> do putWord8 7
+                              put x1
+                PVTy x1 -> do putWord8 8
+                              put x1
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           return (Lam x1)
+                   1 -> do x1 <- get
+                           return (Pi x1)
+                   2 -> do x1 <- get
+                           x2 <- get
+                           return (Let x1 x2)
+                   3 -> do x1 <- get
+                           x2 <- get
+                           return (NLet x1 x2)
+                   4 -> do x1 <- get
+                           return (Hole x1)
+                   5 -> do x1 <- get
+                           x2 <- get
+                           return (GHole x1 x2)
+                   6 -> do x1 <- get
+                           x2 <- get
+                           return (Guess x1 x2)
+                   7 -> do x1 <- get
+                           return (PVar x1)
+                   8 -> do x1 <- get
+                           return (PVTy x1)
+                   _ -> error "Corrupted binary data for Binder"
+
+
+instance Binary NameType where
+        put x
+          = case x of
+                Bound -> putWord8 0
+                Ref -> putWord8 1
+                DCon x1 x2 -> do putWord8 2
+                                 put (x1 * 65536 + x2)
+                TCon x1 x2 -> do putWord8 3
+                                 put (x1 * 65536 + x2)
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> return Bound
+                   1 -> return Ref
+                   2 -> do x1x2 <- get
+                           return (DCon (x1x2 `div` 65536) (x1x2 `mod` 65536))
+                   3 -> do x1x2 <- get
+                           return (TCon (x1x2 `div` 65536) (x1x2 `mod` 65536))
+                   _ -> error "Corrupted binary data for NameType"
+
+
+instance {- (Binary n) => -} Binary (TT Name) where
+        put x
+          = {-# SCC "putTT" #-}
+            case x of
+                P x1 x2 x3 -> do putWord8 0
+                                 put x1
+                                 put x2
+--                                  put x3
+                V x1 -> if (x1 >= 0 && x1 < 256)
+                           then do putWord8 1
+                                   putWord8 (toEnum (x1 + 1))
+                           else do putWord8 9
+                                   put x1
+                Bind x1 x2 x3 -> do putWord8 2
+                                    put x1
+                                    put x2
+                                    put x3
+                App x1 x2 -> do putWord8 3
+                                put x1
+                                put x2
+                Constant x1 -> do putWord8 4
+                                  put x1
+                Proj x1 x2 -> do putWord8 5
+                                 put x1
+                                 putWord8 (toEnum (x2 + 1))
+                Erased -> putWord8 6
+                TType x1 -> do putWord8 7
+                               put x1
+                Impossible -> putWord8 8
+        get
+          = do i <- getWord8
+               case i of
+                   0 -> do x1 <- get
+                           x2 <- get
+--                            x3 <- get
+                           return (P x1 x2 Erased)
+                   1 -> do x1 <- getWord8
+                           return (V ((fromEnum x1) - 1))
+                   2 -> do x1 <- get
+                           x2 <- get
+                           x3 <- get
+                           return (Bind x1 x2 x3)
+                   3 -> do x1 <- get
+                           x2 <- get
+                           return (App x1 x2)
+                   4 -> do x1 <- get
+                           return (Constant x1)
+                   5 -> do x1 <- get
+                           x2 <- getWord8
+                           return (Proj x1 ((fromEnum x2)-1))
+                   6 -> return Erased
+                   7 -> do x1 <- get
+                           return (TType x1)
+                   8 -> return Impossible
+                   9 -> do x1 <- get
+                           return (V x1)
+                   _ -> error "Corrupted binary data for TT"
+
diff --git a/src/Idris/Core/CaseTree.hs b/src/Idris/Core/CaseTree.hs
--- a/src/Idris/Core/CaseTree.hs
+++ b/src/Idris/Core/CaseTree.hs
@@ -1,13 +1,15 @@
 {-# LANGUAGE PatternGuards, DeriveFunctor, TypeSynonymInstances #-}
 
-module Idris.Core.CaseTree(CaseDef(..), SC, SC'(..), CaseAlt, CaseAlt'(..),
+module Idris.Core.CaseTree(CaseDef(..), SC, SC'(..), CaseAlt, CaseAlt'(..), ErasureInfo,
                      Phase(..), CaseTree,
                      simpleCase, small, namesUsed, findCalls, findUsedArgs,
                      substSC, substAlt, mkForce) where
 
 import Idris.Core.TT
 
+import Control.Applicative hiding (Const)
 import Control.Monad.State
+import Control.Monad.Reader
 import Data.Maybe
 import Data.List hiding (partition)
 import qualified Data.List(partition)
@@ -24,7 +26,7 @@
 -- in the function `prune` as a means of optimisation
 -- of already built case trees.
 --
--- While the intermediate representation (follows in the pipeline)
+-- While the intermediate representation (follows in the pipeline, named LExp)
 -- allows casing on arbitrary terms, here we choose to maintain the distinction
 -- in order to allow for better optimisation opportunities.
 --
@@ -213,7 +215,12 @@
   usedA (SucCase _ sc) = used sc
   usedA (DefaultCase sc) = used sc
 
+type ErasureInfo = Name -> [Int]  -- name to list of inaccessible arguments; empty list if name not found
+type CaseBuilder a = ReaderT ErasureInfo (State CS) a
 
+runCaseBuilder :: ErasureInfo -> CaseBuilder a -> (CS -> (a, CS))
+runCaseBuilder ei bld = runState $ runReaderT bld ei
+
 data Phase = CompileTime | RunTime
     deriving (Show, Eq)
 
@@ -223,8 +230,9 @@
 simpleCase :: Bool -> Bool -> Bool ->
               Phase -> FC -> [Int] -> [Type] ->
               [([Name], Term, Term)] ->
+              ErasureInfo ->
               TC CaseDef
-simpleCase tc cover reflect phase fc inacc argtys cs
+simpleCase tc cover reflect phase fc inacc argtys cs erInfo
       = sc' tc cover phase fc (filter (\(_, _, r) ->
                                           case r of
                                             Impossible -> False
@@ -243,7 +251,7 @@
                     let numargs    = length (fst (head pats))
                         ns         = take numargs args
                         (ns', ps') = order [(n, i `elem` inacc) | (i,n) <- zip [0..] ns] pats
-                        (tree, st) = runState
+                        (tree, st) = runCaseBuilder erInfo
                                          (match ns' ps' (defaultCase cover)) 
                                          ([], numargs, [])
                         t          = CaseDef ns (prune proj (depatt ns' tree)) (fstT st) in
@@ -334,18 +342,20 @@
    getArgs _ = []
 
 toPat :: Bool -> Bool -> [Term] -> [Pat]
-toPat reflect tc tms = evalState (mapM (\x -> toPat' x []) tms) []
+toPat reflect tc = map $ toPat' []
   where
-    toPat' (P (DCon t a) nm@(UN n) _) [_,_,arg]
-           | n == txt "Delay" = do arg' <- toPat' arg []
-                                   return $ PCon nm t [PAny, PAny, arg']
-    toPat' (P (DCon t a) n _) args = do args' <- mapM (\x -> toPat' x []) args
-                                        return $ PCon n t args'
+    toPat' [_,_,arg](P (DCon t a) nm@(UN n) _)
+        | n == txt "Delay"
+        = PCon nm t [PAny, PAny, toPat' [] arg]
+
+    toPat' args (P (DCon t a) n _)
+        = PCon n t $ map (toPat' []) args
+
     -- n + 1
-    toPat' (P _ (UN pabi) _)
-                  [p, Constant (BI 1)] | pabi == txt "prim__addBigInt"
-                                   = do p' <- toPat' p []
-                                        return $ PSuc p'
+    toPat' [p, Constant (BI 1)] (P _ (UN pabi) _)
+        | pabi == txt "prim__addBigInt"
+        = PSuc $ toPat' [] p
+
     -- Typecase
 --     toPat' (P (TCon t a) n _) args | tc
 --                                    = do args' <- mapM (\x -> toPat' x []) args
@@ -360,27 +370,26 @@
 --         | tc = return $ PCon (UN "Integer") 6 []
 --     toPat' (Constant (AType (ATInt (ITFixed n)))) []
 --         | tc = return $ PCon (UN (fixedN n)) (7 + fromEnum n) [] -- 7-10 inclusive
-    toPat' (P Bound n ty)     []   = -- trace (show (n, ty)) $
-                                     do ns <- get
-                                        if n `elem` ns
-                                          then return PAny
-                                          else do put (n : ns)
-                                                  return (PV n ty)
-    toPat' (App f a)  args = toPat' f (a : args)
-    toPat' (Constant (AType _)) [] = return PTyPat
-    toPat' (Constant StrType) [] = return PTyPat
-    toPat' (Constant PtrType) [] = return PTyPat
-    toPat' (Constant VoidType) [] = return PTyPat
-    toPat' (Constant x) [] = return $ PConst x
-    toPat' (Bind n (Pi t) sc) [] | reflect && noOccurrence n sc
-          = do t' <- toPat' t []
-               sc' <- toPat' sc []
-               return $ PReflected (sUN "->") (t':sc':[])
-    toPat' (P _ n _) args | reflect
-          = do args' <- mapM (\x -> toPat' x []) args
-               return $ PReflected n args'
-    toPat' t            _  = return PAny
+--
 
+    toPat' []   (P Bound n ty) = PV n ty
+    toPat' args (App f a)      = toPat' (a : args) f
+    toPat' [] (Constant (AType _)) = PTyPat
+    toPat' [] (Constant StrType)   = PTyPat
+    toPat' [] (Constant PtrType)   = PTyPat
+    toPat' [] (Constant VoidType)  = PTyPat
+    toPat' [] (Constant x)         = PConst x
+
+    toPat' [] (Bind n (Pi t) sc)
+        | reflect && noOccurrence n sc
+        = PReflected (sUN "->") [toPat' [] t, toPat' [] sc]
+
+    toPat' args (P _ n _)
+        | reflect
+        = PReflected n $ map (toPat' []) args
+
+    toPat' _ t = PAny
+
     fixedN IT8 = "Bits8"
     fixedN IT16 = "Bits16"
     fixedN IT32 = "Bits32"
@@ -459,7 +468,7 @@
     numNames xs [] = length xs
 
 match :: [Name] -> [Clause] -> SC -- error case
-                            -> State CS SC
+                            -> CaseBuilder SC
 match [] (([], ret) : xs) err
     = do (ts, v, ntys) <- get
          put (ts ++ (map (fst.snd) xs), v, ntys)
@@ -469,13 +478,19 @@
 match vs cs err = do let ps = partition cs
                      mixture vs ps err
 
-mixture :: [Name] -> [Partition] -> SC -> State CS SC
+mixture :: [Name] -> [Partition] -> SC -> CaseBuilder SC
 mixture vs [] err = return err
 mixture vs (Cons ms : ps) err = do fallthrough <- mixture vs ps err
                                    conRule vs ms fallthrough
 mixture vs (Vars ms : ps) err = do fallthrough <- mixture vs ps err
                                    varRule vs ms fallthrough
 
+-- Return the list of inaccessible arguments of a data constructor.
+inaccessibleArgs :: Name -> CaseBuilder [Int]
+inaccessibleArgs n = do
+    getInaccessiblePositions <- ask  -- this function is the only thing in the environment
+    return $ getInaccessiblePositions n
+
 data ConType = CName Name Int -- named constructor
              | CFn Name -- reflected function name
              | CSuc -- n+1
@@ -486,76 +501,99 @@
                       [([Pat], Clause)] -- arguments and rest of alternative
    deriving Show
 
-conRule :: [Name] -> [Clause] -> SC -> State CS SC
+conRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
 conRule (v:vs) cs err = do groups <- groupCons cs
                            caseGroups (v:vs) groups err
 
-caseGroups :: [Name] -> [Group] -> SC -> State CS SC
+caseGroups :: [Name] -> [Group] -> SC -> CaseBuilder SC
 caseGroups (v:vs) gs err = do g <- altGroups gs
                               return $ Case v (sort g)
   where
     altGroups [] = return [DefaultCase err]
+
     altGroups (ConGroup (CName n i) args : cs)
-        = do g <- altGroup n i args
-             rest <- altGroups cs
-             return (g : rest)
+        = (:) <$> altGroup n i args <*> altGroups cs
+
     altGroups (ConGroup (CFn n) args : cs)
-        = do g <- altFnGroup n args
-             rest <- altGroups cs
-             return (g : rest)
+        = (:) <$> altFnGroup n args <*> altGroups cs
+
     altGroups (ConGroup CSuc args : cs)
-        = do g <- altSucGroup args
-             rest <- altGroups cs
-             return (g : rest)
+        = (:) <$> altSucGroup args <*> altGroups cs
+
     altGroups (ConGroup (CConst c) args : cs)
-        = do g <- altConstGroup c args
-             rest <- altGroups cs
-             return (g : rest)
+        = (:) <$> altConstGroup c args <*> altGroups cs
 
-    altGroup n i gs = do (newArgs, nextCs) <- argsToAlt gs
-                         matchCs <- match (newArgs ++ vs) nextCs err
-                         return $ ConCase n i newArgs matchCs
-    altFnGroup n gs = do (newArgs, nextCs) <- argsToAlt gs
-                         matchCs <- match (newArgs ++ vs) nextCs err
-                         return $ FnCase n newArgs matchCs
-    altSucGroup gs = do ([newArg], nextCs) <- argsToAlt gs
-                        matchCs <- match (newArg:vs) nextCs err
-                        return $ SucCase newArg matchCs
-    altConstGroup n gs = do (_, nextCs) <- argsToAlt gs
-                            matchCs <- match vs nextCs err
-                            return $ ConstCase n matchCs
+    altGroup n i args = do inacc <- inaccessibleArgs n
+                           (newVars, accVars, inaccVars, nextCs) <- argsToAlt inacc args
+                           matchCs <- match (accVars ++ vs ++ inaccVars) nextCs err
+                           return $ ConCase n i newVars matchCs
 
-argsToAlt :: [([Pat], Clause)] -> State CS ([Name], [Clause])
-argsToAlt [] = return ([], [])
-argsToAlt rs@((r, m) : rest)
-    = do newArgs <- getNewVars r
-         return (newArgs, addRs rs)
+    altFnGroup n args = do (newVars, _, [], nextCs) <- argsToAlt [] args
+                           matchCs <- match (newVars ++ vs) nextCs err
+                           return $ FnCase n newVars matchCs
+
+    altSucGroup args = do ([newVar], _, [], nextCs) <- argsToAlt [] args
+                          matchCs <- match (newVar:vs) nextCs err
+                          return $ SucCase newVar matchCs
+
+    altConstGroup n args = do (_, _, [], nextCs) <- argsToAlt [] args
+                              matchCs <- match vs nextCs err
+                              return $ ConstCase n matchCs
+
+-- Returns:
+--   * names of all variables arising from match
+--   * names of accessible variables (subset of all variables)
+--   * names of inaccessible variables (subset of all variables)
+--   * clauses corresponding to (accVars ++ origVars ++ inaccVars)
+argsToAlt :: [Int] -> [([Pat], Clause)] -> CaseBuilder ([Name], [Name], [Name], [Clause])
+argsToAlt _ [] = return ([], [], [], [])
+argsToAlt inacc rs@((r, m) : rest) = do
+    newVars <- getNewVars r
+    let (accVars, inaccVars) = partitionAcc newVars
+    return (newVars, accVars, inaccVars, addRs rs)
   where
+    -- Create names for new variables arising from the given patterns.
+    getNewVars :: [Pat] -> CaseBuilder [Name]
     getNewVars [] = return []
     getNewVars ((PV n t) : ns) = do v <- getVar "e" 
+                                    nsv <- getNewVars ns
+
+                                    -- Record the type of the variable.
+                                    --
+                                    -- It seems that the ordering is not important
+                                    -- and we can put (v,t) always in front of "ntys"
+                                    -- (the varName-type pairs seem to represent a mapping).
+                                    --
+                                    -- The code that reads this is currently
+                                    -- commented out, anyway.
                                     (cs, i, ntys) <- get
                                     put (cs, i, (v, t) : ntys)
-                                    nsv <- getNewVars ns
+
                                     return (v : nsv)
-    getNewVars (PAny : ns) = do v <- getVar "i"
-                                nsv <- getNewVars ns
-                                return (v : nsv)
-    getNewVars (PTyPat : ns) = do v <- getVar "t"
-                                  nsv <- getNewVars ns
-                                  return (v : nsv)
-    getNewVars (_ : ns) = do v <- getVar "e"
-                             nsv <- getNewVars ns
-                             return (v : nsv)
+
+    getNewVars (PAny   : ns) = (:) <$> getVar "i" <*> getNewVars ns
+    getNewVars (PTyPat : ns) = (:) <$> getVar "t" <*> getNewVars ns
+    getNewVars (_      : ns) = (:) <$> getVar "e" <*> getNewVars ns
+
+    -- Partition a list of things into (accessible, inaccessible) things,
+    -- according to the list of inaccessible indices.
+    partitionAcc xs =
+        ( [x | (i,x) <- zip [0..] xs, i `notElem` inacc]
+        , [x | (i,x) <- zip [0..] xs, i    `elem` inacc]
+        )
+
     addRs [] = []
-    addRs ((r, (ps, res)) : rs) = ((r++ps, res) : addRs rs)
+    addRs ((r, (ps, res)) : rs) = ((acc++ps++inacc, res) : addRs rs)
+      where
+        (acc, inacc) = partitionAcc r
 
     uniq i (UN n) = MN i n
     uniq i n = n
 
-getVar :: String -> State CS Name
+getVar :: String -> CaseBuilder Name
 getVar b = do (t, v, ntys) <- get; put (t, v+1, ntys); return (sMN v b)
 
-groupCons :: [Clause] -> State CS [Group]
+groupCons :: [Clause] -> CaseBuilder [Group]
 groupCons cs = gc [] cs
   where
     gc acc [] = return acc
@@ -581,7 +619,7 @@
 --         | otherwise = g : addConG con res gs
     addConG con res (g : gs) = g : addConG con res gs
 
-varRule :: [Name] -> [Clause] -> SC -> State CS SC
+varRule :: [Name] -> [Clause] -> SC -> CaseBuilder SC
 varRule (v : vs) alts err =
     do alts' <- mapM (repVar v) alts
        match vs alts' err
@@ -728,19 +766,20 @@
     | otherwise = SucCase n' (substSC n repl sc)
 substAlt n repl (DefaultCase sc)     = DefaultCase (substSC n repl sc)
 
+-- mkForce n' n t updates the tree t under the assumption that
+-- n' = force n (so basically updating n to n')
 mkForce :: Name -> Name -> SC -> SC
 mkForce = mkForceSC
   where
     mkForceSC n arg (Case x alts) | x == arg
-        = ProjCase (forceArg n) $ map (mkForceAlt n arg) alts
+        = Case n $ map (mkForceAlt n arg) alts
 
     mkForceSC n arg (Case x alts)
         = Case x (map (mkForceAlt n arg) alts)
 
     mkForceSC n arg (ProjCase t alts)
-        = ProjCase (forceTm n arg t) $ map (mkForceAlt n arg) alts
+        = ProjCase t $ map (mkForceAlt n arg) alts
 
-    mkForceSC n arg (STerm t) = STerm (forceTm n arg t)
     mkForceSC n arg c = c
 
     mkForceAlt n arg (ConCase cn t args rhs)
@@ -754,7 +793,5 @@
     mkForceAlt n arg (DefaultCase rhs)
         = DefaultCase (mkForceSC n arg rhs)
 
-    forceTm n arg t = subst arg (forceArg n) t
+    forceTm n arg t = subst n arg t
 
-    forceArg n = App (App (App (P Ref (sUN "Force") Erased) Erased) Erased)
-                    (P Bound n Erased)
diff --git a/src/Idris/Core/Elaborate.hs b/src/Idris/Core/Elaborate.hs
--- a/src/Idris/Core/Elaborate.hs
+++ b/src/Idris/Core/Elaborate.hs
@@ -77,6 +77,7 @@
                                      then MN (next+500) x
                                      else MN (next+100) x
                         NS (UN x) s -> MN (next+100) x
+                        _ -> n
                    return $! n'
 
 setNextName :: Elab' aux ()
@@ -371,12 +372,16 @@
 rewrite :: Raw -> Elab' aux ()
 rewrite tm = processTactic' (Rewrite tm)
 
-induction :: Name -> Elab' aux ()
-induction nm = processTactic' (Induction nm)
+induction :: Raw -> Elab' aux ()
+induction tm = processTactic' (Induction tm)
 
+casetac :: Raw -> Elab' aux ()
+casetac tm = processTactic' (CaseTac tm)
+
 equiv :: Raw -> Elab' aux ()
 equiv tm = processTactic' (Equiv tm)
 
+-- | Turn the current hole into a pattern variable with the provided name, made unique if MN
 patvar :: Name -> Elab' aux ()
 patvar n = do env <- get_env
               hs <- get_holes
@@ -452,7 +457,7 @@
              -> [(Name, Name)] -- ^ Accumulator for produced claims
              -> [Name] -- ^ Hypotheses
              -> Elab' aux [(Name, Name)] -- ^ The names of the arguments and their holes, resp.
-    mkClaims (Bind n' (Pi t_in) sc) (i : is) claims hs =
+    mkClaims (Bind n' (Pi t_in) sc) (i : is) claims hs = 
         do let t = rebind hs t_in
            n <- getNameFrom (mkMN n')
 --            when (null claims) (start_unify n)
@@ -509,8 +514,10 @@
        put (ES (p { dontunify = dont, unified = (n, unify),
                     notunified = notunify ++ notunified p }, a) s prev)
        fillt (raw_apply fn (map (Var . snd) args))
---        trace ("Goal " ++ show g ++ "\n" ++ show (fn,  imps, unify) ++ "\n" ++ show ptm) $
-       end_unify
+       ulog <- getUnifyLog
+       g <- goal
+       traceWhen ulog ("Goal " ++ show g ++ " -- when elaborating " ++ show fn) $
+        end_unify
        return $! (map (\(argName, argHole) -> (argName, updateUnify unify argHole)) args)
   where updateUnify us n = case lookup n us of
                                 Just (P _ t _) -> t
diff --git a/src/Idris/Core/Evaluate.hs b/src/Idris/Core/Evaluate.hs
--- a/src/Idris/Core/Evaluate.hs
+++ b/src/Idris/Core/Evaluate.hs
@@ -8,7 +8,7 @@
                 Context, initContext, ctxtAlist, uconstraints, next_tvar,
                 addToCtxt, setAccess, setTotal, setMetaInformation, addCtxtDef, addTyDecl,
                 addDatatype, addCasedef, simplifyCasedef, addOperator,
-                lookupNames, lookupTyName, lookupTy, lookupP, lookupDef, lookupNameDef, lookupDefExact, lookupDefAcc, lookupVal,
+                lookupNames, lookupTyName, lookupTyNameExact, lookupTy, lookupTyExact, lookupP, lookupDef, lookupNameDef, lookupDefExact, lookupDefAcc, lookupVal,
                 mapDefCtxt,
                 lookupTotal, lookupNameTotal, lookupMetaInformation, lookupTyEnv, isDConName, isTConName, isConName, isFnName,
                 Value(..), Quote(..), initEval, uniqueNameCtxt, uniqueBindersCtxt, definitions) where
@@ -549,6 +549,12 @@
         | 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 (Bind n (PVar t) sc) y = ceq ps sc y
+    ceq ps x (Bind n (PVar t) sc) = ceq ps x sc
+    ceq ps (Bind n (PVTy t) sc) y = ceq ps sc y
+    ceq ps x (Bind n (PVTy t) sc) = ceq ps x sc
+
     ceq ps (V x)      (V y)      = return (x == y)
     ceq ps (V x)      (P _ y _)  
         | x >= 0 && length ps > x = return (fst (ps!!x) == y)
@@ -788,7 +794,8 @@
                   (TyDecl (DCon tag (arity ty')) ty, Public, Unchecked, EmptyMI) ctxt)
 
 -- FIXME: Too many arguments! Refactor all these Bools.
-addCasedef :: Name -> CaseInfo -> Bool -> Bool -> Bool -> Bool ->
+addCasedef :: Name -> ErasureInfo -> CaseInfo ->
+              Bool -> Bool -> Bool -> Bool ->
               [Type] -> -- argument types
               [Int] ->  -- inaccessible arguments
               [Either Term (Term, Term)] ->
@@ -797,17 +804,17 @@
               [([Name], Term, Term)] -> -- inlined
               [([Name], Term, Term)] -> -- run time
               Type -> Context -> Context
-addCasedef n ci@(CaseInfo alwaysInline tcdict)
+addCasedef n ei ci@(CaseInfo alwaysInline tcdict)
            tcase covering reflect asserted argtys inacc
            ps_in ps_tot ps_inl ps_ct ps_rt ty uctxt
     = let ctxt = definitions uctxt
           access = case lookupDefAcc n False uctxt of
                         [(_, acc)] -> acc
                         _ -> Public
-          ctxt' = case (simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_tot,
-                        simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_ct,
-                        simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_inl,
-                        simpleCase tcase covering reflect RunTime emptyFC inacc argtys ps_rt) of
+          ctxt' = case (simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_tot ei,
+                        simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_ct ei,
+                        simpleCase tcase covering reflect CompileTime emptyFC inacc argtys ps_inl ei,
+                        simpleCase tcase covering reflect RunTime emptyFC inacc argtys ps_rt ei) of
                     (OK (CaseDef args_tot sc_tot _),
                      OK (CaseDef args_ct sc_ct _),
                      OK (CaseDef args_inl sc_inl _),
@@ -825,8 +832,8 @@
           uctxt { definitions = ctxt' }
 
 -- simplify a definition for totality checking
-simplifyCasedef :: Name -> Context -> Context
-simplifyCasedef n uctxt
+simplifyCasedef :: Name -> ErasureInfo -> Context -> Context
+simplifyCasedef n ei uctxt
    = let ctxt = definitions uctxt
          ctxt' = case lookupCtxt n ctxt of
               [(CaseOp ci ty atys [] ps _, acc, tot, metainf)] ->
@@ -834,7 +841,7 @@
               [(CaseOp ci ty atys ps_in ps cd, acc, tot, metainf)] ->
                  let ps_in' = map simpl ps_in
                      pdef = map debind ps_in' in
-                     case simpleCase False True False CompileTime emptyFC [] atys pdef of
+                     case simpleCase False True False CompileTime emptyFC [] atys pdef ei of
                        OK (CaseDef args sc _) ->
                           addDef n (CaseOp ci
                                            ty atys ps_in' ps (cd { cases_totcheck = (args, sc) }),
@@ -868,8 +875,9 @@
                 = let ns = lookupCtxtName n (definitions ctxt) in
                       map fst ns
 
+-- | Get the list of pairs of fully-qualified names and their types that match some name
 lookupTyName :: Name -> Context -> [(Name, Type)]
-lookupTyName n ctxt = do 
+lookupTyName n ctxt = do
   (name, def) <- lookupCtxtName n (definitions ctxt)
   ty <- case tfst def of
                        (Function ty _) -> return ty
@@ -878,9 +886,21 @@
                        (CaseOp _ ty _ _ _ _) -> return ty
   return (name, ty)
 
+-- | Get the pair of a fully-qualified name and its type, if there is a unique one matching the name used as a key.
+lookupTyNameExact :: Name -> Context -> Maybe (Name, Type)
+lookupTyNameExact n ctxt = case lookupTyName n ctxt of
+                             [x] -> Just x
+                             _   -> Nothing
 
+-- | Get the types that match some name
 lookupTy :: Name -> Context -> [Type]
 lookupTy n ctxt = map snd (lookupTyName n ctxt)
+
+-- | Get the single type that matches some name precisely
+lookupTyExact :: Name -> Context -> Maybe Type
+lookupTyExact n ctxt = case lookupTy n ctxt of
+                         [t] -> Just t
+                         _   -> Nothing
 
 isConName :: Name -> Context -> Bool
 isConName n ctxt = isTConName n ctxt || isDConName n ctxt
diff --git a/src/Idris/Core/ProofState.hs b/src/Idris/Core/ProofState.hs
--- a/src/Idris/Core/ProofState.hs
+++ b/src/Idris/Core/ProofState.hs
@@ -72,7 +72,8 @@
             | LetBind Name Raw Raw
             | ExpandLet Name Term
             | Rewrite Raw
-            | Induction Name
+            | Induction Raw
+            | CaseTac Raw
             | Equiv Raw
             | PatVar Name
             | PatBind Name
@@ -167,12 +168,16 @@
                   ++ "\n" ++ show (pterm ps) ++ "\n\n"
                  ) $
        case match_unify ctxt env topx topy inj (holes ps) while of
-            OK u -> do let (h, ns) = unified ps
-                       put (ps { unified = (h, u ++ ns) })
-                       return u
-            Error e -> do put (ps { problems = (topx, topy, env, e, while, Match) :
-                                                  problems ps })
-                          return []
+            OK u -> traceWhen (unifylog ps)
+                        ("Matched " ++ show u) $
+                     do let (h, ns) = unified ps
+                        put (ps { unified = (h, u ++ ns) })
+                        return u
+            Error e -> traceWhen (unifylog ps)
+                         ("No match " ++ show e) $
+                        do put (ps { problems = (topx, topy, env, e, while, Match) :
+                                                 problems ps })
+                           return []
 --       traceWhen (unifylog ps)
 --             ("Matched " ++ show (topx, topy) ++ " without " ++ show dont ++
 --              "\nSolved: " ++ show u 
@@ -208,7 +213,8 @@
                          "\nHoles: " ++ show (holes ps)
                          ++ "\nInjective: " ++ show (injective ps)
                          ++ "\n") $
-                     lift $ unify ctxt env topx topy inj (holes ps) while
+                     lift $ unify ctxt env topx topy inj (holes ps) 
+                                  (map fst (notunified ps)) while
       let notu = filter (\ (n, t) -> case t of
                                         P _ _ _ -> False
                                         _ -> n `elem` dont) u
@@ -228,9 +234,11 @@
                                               (fails ++ problems ps)
                                               (injective ps)
                                               (holes ps)
+                                              (map fst (notunified ps))
            let (notu', probs_notu) = mergeNotunified env (notu ++ notunified ps)
            traceWhen (unifylog ps)
-            ("Now solved: " ++ show ns') $
+            ("Now solved: " ++ show ns' ++
+             "\nNow problems: " ++ qshow (probs' ++ probs_notu)) $
              put (ps { problems = probs' ++ probs_notu,
                        unified = (h, ns'),
                        injective = updateInj u (injective ps),
@@ -537,10 +545,11 @@
    = do ps <- get
         let (uh, uns) = unified ps
         case lookup x (notunified ps) of
-            Just tm -> -- trace ("NEED MATCH: " ++ show (tm, val)) $
+            Just tm -> -- trace ("NEED MATCH: " ++ show (x, tm, val) ++ "\nIN " ++ show (pterm ps)) $
                          match_unify' ctxt env tm val
             _ -> return []
-        action (\ps -> ps { holes = holes ps \\ [x],
+        action (\ps -> ps { holes = traceWhen (unifylog ps) ("Dropping hole " ++ show x) $
+                                       holes ps \\ [x],
                             solved = Just (x, val),
                             notunified = updateNotunified [(x,val)]
                                            (notunified ps),
@@ -551,7 +560,7 @@
    = do ps <- get
         case findType x sc of
              Just t -> lift $ tfail (CantInferType (show t))
-             _ -> fail $ "Not a guess " ++ show h ++ "\n" ++ show (holes ps, pterm ps)
+             _ -> lift $ tfail (IncompleteTerm h)
    where findType x (Bind n (Let t v) sc)
               = findType x v `mplus` findType x sc
          findType x (Bind n t sc) 
@@ -604,7 +613,9 @@
 
 patvar :: Name -> RunTactic
 patvar n ctxt env (Bind x (Hole t) sc) =
-    do action (\ps -> ps { holes = holes ps \\ [x],
+    do action (\ps -> ps { holes = traceWhen (unifylog ps) ("Dropping pattern hole " ++ show x) $
+                                     holes ps \\ [x],
+                           solved = Just (x, P Bound n t),
                            notunified = updateNotunified [(x,P Bound n t)]
                                           (notunified ps),
                            injective = addInj n x (injective ps) })
@@ -661,13 +672,16 @@
                              b { binderTy = ty' }
 mkP lt l r x = x
 
-induction :: Name -> RunTactic
-induction nm ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' = do
-  (tmv, tmt) <- lift $ check ctxt env (Var nm)
+casetac :: Raw -> Bool -> RunTactic
+casetac tm induction ctxt env (Bind x (Hole t) (P _ x' _)) | x == x' = do
+  (tmv, tmt) <- lift $ check ctxt env tm
   let tmt' = normalise ctxt env tmt
+  let (tacn, tacstr, tactt) = if induction
+              then (ElimN, "an eliminator", "induction")
+              else (CaseN, "a case function", "case analysis")
   case unApply tmt' of
     (P _ tnm _, tyargs) -> do
-        case lookupTy (SN (ElimN tnm)) ctxt of
+        case lookupTy (SN (tacn tnm)) ctxt of
           [elimTy] -> do
              param_pos <- case lookupMetaInformation tnm ctxt of
                                [DataMI param_pos] -> return param_pos
@@ -683,9 +697,14 @@
              let indxargs = drop (length restargs - length indicies) $ restargs
              let scr      = last $ tail args'
              let indxnames = makeIndexNames indicies
-             prop <- replaceIndicies indxnames indicies $ Bind nm (Lam tmt') t
+             currentNames <- query $ allTTNames . pterm
+             let tmnm = case tm of
+                         Var nm -> uniqueNameCtxt ctxt nm currentNames
+                         _ -> uniqueNameCtxt ctxt (sMN 0 "iv") currentNames
+             let tmvar = P Bound tmnm tmt'
+             prop <- replaceIndicies indxnames indicies $ Bind tmnm (Lam tmt') (mkP tmvar tmv tmvar t)
              consargs' <- query (\ps -> map (flip (uniqueNameCtxt (context ps)) (holes ps ++ allTTNames (pterm ps)) *** uniqueBindersCtxt (context ps) (holes ps ++ allTTNames (pterm ps))) consargs)
-             let res = flip (foldr substV) params $ (substV prop $ bindConsArgs consargs' (mkApp (P Ref (SN (ElimN tnm)) (TType (UVal 0)))
+             let res = flip (foldr substV) params $ (substV prop $ bindConsArgs consargs' (mkApp (P Ref (SN (tacn tnm)) (TType (UVal 0)))
                                                         (params ++ [prop] ++ map makeConsArg consargs' ++ indicies ++ [tmv])))
              action (\ps -> ps {holes = holes ps \\ [x]})
              mapM_ addConsHole (reverse consargs')
@@ -693,9 +712,9 @@
              (scv, sct) <- lift $ check ctxt env res'
              let scv' = specialise ctxt env [] scv
              return scv'
-          [] -> fail $ "Induction needs an eliminator for " ++ show tnm
-          xs -> fail $ "Multiple definitions found when searching for the eliminator of " ++ show tnm
-    _ -> fail "Unkown type for induction"
+          [] -> fail $ tactt ++ " needs " ++ tacstr ++ " for " ++ show tnm
+          xs -> fail $ "Multiple definitions found when searching for " ++ tacstr ++ "of " ++ show tnm
+    _ -> fail $ "Unkown type for " ++ if induction then "induction" else "case analysis"
     where scname = sMN 0 "scarg"
           makeConsArg (nm, ty) = P Bound nm ty
           bindConsArgs ((nm, ty):args) v = Bind nm (Hole ty) $ bindConsArgs args v
@@ -709,7 +728,7 @@
           replaceIndicies idnms idxs prop = foldM (\t (idnm, idx) -> do (idxv, idxt) <- lift $ check ctxt env (forget idx)
                                                                         let var = P Bound idnm idxt
                                                                         return $ Bind idnm (Lam idxt) (mkP var idxv var t)) prop $ zip idnms idxs
-induction tm ctxt env _ = do fail "Can't do induction here"
+induction tm induction ctxt env _ = do fail "Can't do induction here"
 
 
 equiv :: Raw -> RunTactic
@@ -778,7 +797,8 @@
     do ps <- get
        let (_, ns) = unified ps
        let unify = dropGiven (dontunify ps) ns (holes ps)
-       action (\ps -> ps { holes = holes ps \\ map fst unify })
+       action (\ps -> ps { holes = traceWhen (unifylog ps) ("Dropping holes " ++ show (map fst unify)) $
+                                     holes ps \\ map fst unify })
        action (\ps -> ps { pterm = updateSolved unify (pterm ps) })
        return (updateSolved unify tm)
 
@@ -841,8 +861,8 @@
   mnu [] ns_acc ps_acc = (reverse ns_acc, reverse ps_acc)
   mnu ((n, t):ns) ns_acc ps_acc
       | Just t' <- lookup n ns, t /= t'
-             = mnu ns ((n,t') : ns_acc)
-                      ((t,t',env,Msg "", [],Unify) : ps_acc)
+             = mnu ns ((n,t') : ns_acc) 
+                      ((t,t',env,CantUnify True t t' (Msg "") [] 0, [],Match) : ps_acc)
       | otherwise = mnu ns ((n,t) : ns_acc) ps_acc
 
 updateNotunified [] nu = nu
@@ -851,10 +871,11 @@
   up ((n, t) : nus) = let t' = updateSolved ns t in
                           ((n, t') : up nus)
 
-updateProblems :: Context -> [(Name, TT Name)] -> Fails -> [Name] -> [Name]
+-- FIXME: Why not just pass the whole proof state?
+updateProblems :: Context -> [(Name, TT Name)] -> Fails -> [Name] -> [Name] -> [Name]
                -> ([(Name, TT Name)], Fails)
-updateProblems ctxt [] ps inj holes = ([], ps)
-updateProblems ctxt ns ps inj holes = up ns ps where
+-- updateProblems ctxt [] ps inj holes = ([], ps)
+updateProblems ctxt ns ps inj holes usupp = up ns ps where
   up ns [] = (ns, [])
   up ns ((x, y, env, err, while, um) : ps) =
     let x' = updateSolved ns x
@@ -862,7 +883,7 @@
         err' = updateError ns err
         env' = updateEnv ns env in
 --          trace ("Updating " ++ show (x',y')) $ 
-          case unify ctxt env' x' y' inj holes while of
+          case unify ctxt env' x' y' inj holes usupp while of
             OK (v, []) -> -- trace ("Added " ++ show v ++ " from " ++ show (x', y')) $
                                up (ns ++ v) ps
             e -> -- trace ("Failed " ++ show e) $
@@ -903,12 +924,14 @@
           ns' = map (\ (n, t) -> (n, updateSolved ns t)) ns
           (ns'', probs') = updateProblems (context ps) ns' (problems ps)
                                           (injective ps) (holes ps)
+                                          (map fst (notunified ps))
           tm' = updateSolved ns'' (pterm ps) in
-          return (ps { pterm = tm',
-                       unified = (h, []),
-                       problems = probs',
-                       notunified = updateNotunified ns'' (notunified ps),
-                       holes = holes ps \\ map fst ns'' }, "")
+          traceWhen (unifylog ps) ("Dropping holes: " ++ show (map fst ns'')) $
+            return (ps { pterm = tm',
+                         unified = (h, []),
+                         problems = probs',
+                         notunified = updateNotunified ns'' (notunified ps),
+                         holes = holes ps \\ map fst ns'' }, "")
 processTactic UnifyAll ps
     = let tm' = updateSolved (notunified ps) (pterm ps) in
           return (ps { pterm = tm',
@@ -924,11 +947,13 @@
                                          (problems ps)
                                          (injective ps)
                                          (holes ps)
+                                         (map fst (notunified ps))
           pterm' = updateSolved ns' (pterm ps) in
-      return (ps { pterm = pterm', solved = Nothing, problems = probs',
-                   previous = Just ps, plog = "",
-                   notunified = updateNotunified ns' (notunified ps),
-                   holes = holes ps \\ (map fst ns') }, plog ps)
+      traceWhen (unifylog ps) ("Dropping holes: " ++ show (map fst ns')) $
+        return (ps { pterm = pterm', solved = Nothing, problems = probs',
+                     previous = Just ps, plog = "",
+                     notunified = updateNotunified ns' (notunified ps),
+                     holes = holes ps \\ (map fst ns') }, plog ps)
 processTactic (MatchProblems all) ps
     = let (ns', probs') = matchProblems all [] (context ps)
                                             (problems ps)
@@ -939,6 +964,7 @@
                                            (injective ps)
                                            (holes ps)
           pterm' = updateSolved ns'' (pterm ps) in
+       traceWhen (unifylog ps) ("Dropping holes: " ++ show (map fst ns'')) $
         return (ps { pterm = pterm', solved = Nothing, problems = probs'',
                    previous = Just ps, plog = "",
                    notunified = updateNotunified ns'' (notunified ps),
@@ -955,16 +981,18 @@
                                                       [s] (problems ps')
                                                       (injective ps')
                                                       (holes ps')
+                                                      (map fst (notunified ps))
                                     _ -> ([], problems ps')
                      -- rechecking problems may find more solutions, so
                      -- apply them here
                      let pterm'' = updateSolved ns' (pterm ps')
-                     return (ps' { pterm = pterm'',
-                                   solved = Nothing,
-                                   problems = probs',
-                                   notunified = updateNotunified ns' (notunified ps'),
-                                   previous = Just ps, plog = "",
-                                   holes = holes ps' \\ (map fst ns')}, plog ps')
+                     traceWhen (unifylog ps) ("Dropping holes: " ++ show (map fst ns')) $
+                       return (ps' { pterm = pterm'',
+                                     solved = Nothing,
+                                     problems = probs',
+                                     notunified = updateNotunified ns' (notunified ps'),
+                                     previous = Just ps, plog = "",
+                                     holes = holes ps' \\ (map fst ns')}, plog ps')
 
 process :: Tactic -> Name -> StateT TState TC ()
 process EndUnify _
@@ -991,7 +1019,8 @@
          mktac (LetBind n t v)   = letbind n t v
          mktac (ExpandLet n b)   = expandLet n b
          mktac (Rewrite t)       = rewrite t
-         mktac (Induction t)     = induction t
+         mktac (Induction t)     = casetac t True
+         mktac (CaseTac t)       = casetac t False
          mktac (Equiv t)         = equiv t
          mktac (PatVar n)        = patvar n
          mktac (PatBind n)       = patbind n
diff --git a/src/Idris/Core/TT.hs b/src/Idris/Core/TT.hs
--- a/src/Idris/Core/TT.hs
+++ b/src/Idris/Core/TT.hs
@@ -99,6 +99,7 @@
                       | AnnKeyword
                       | AnnFC FC
                       | AnnTextFmt TextFormatting
+                      | AnnTerm [(Name, Bool)] (TT Name) -- ^ pprint bound vars, original term
 
 -- | Used for error reflection
 data ErrorReportPart = TextPart String
@@ -195,8 +196,9 @@
 instance Show Err where
     show (Msg s) = s
     show (InternalMsg s) = "Internal error: " ++ show s
-    show (CantUnify _ l r e sc i) = "CantUnify " ++ show l ++ " " ++ show r ++ " "
-                                      ++ show e ++ " in " ++ show sc ++ " " ++ show i
+    show (CantUnify rec l r e sc i) = "CantUnify " ++ show rec ++ " " ++
+                                         show l ++ " " ++ show r ++ " " ++
+                                         show e ++ " in " ++ show sc ++ " " ++ show i
     show (CantSolveGoal g _) = "CantSolve " ++ show g
     show (Inaccessible n) = show n ++ " is not an accessible pattern variable"
     show (ProviderError msg) = "Type provider error: " ++ msg
@@ -382,8 +384,8 @@
 
 implicitable (NS n _) = implicitable n
 implicitable (UN xs) | T.null xs = False
-                     | otherwise = isLower (T.head xs)
-implicitable (MN _ _) = True
+                     | otherwise = isLower (T.head xs) || T.head xs == '_'
+implicitable (MN _ x) = not (tnull x) && thead x /= '_'
 implicitable _ = False
 
 nsroot (NS n _) = n
@@ -1263,8 +1265,11 @@
 orderPats :: Term -> Term
 orderPats tm = op [] tm
   where
+    op [] (App f a) = App f (op [] a) -- for Infer terms
+
     op ps (Bind n (PVar t) sc) = op ((n, PVar t) : ps) sc
     op ps (Bind n (Hole t) sc) = op ((n, Hole t) : ps) sc
+    op ps (Bind n (Pi t)   sc) = op ((n, Pi t) : ps) sc
     op ps sc = bindAll (sortP ps) sc
 
     sortP ps = pick [] (reverse ps)
@@ -1286,6 +1291,44 @@
                       concatMap namesIn (map (binderTy . snd) ps))
             = (n', t') : insert n t ps
         | otherwise = (n,t):(n',t'):ps
+
+-- Make sure all the pattern bindings are as far out as possible
+liftPats :: Term -> Term
+liftPats tm = let (tm', ps) = runState (getPats tm) [] in
+                  orderPats $ bindPats (reverse ps) tm'
+  where
+    bindPats []          tm = tm
+    bindPats ((n, t):ps) tm 
+         | n `notElem` map fst ps = Bind n (PVar t) (bindPats ps tm)
+         | otherwise = bindPats ps tm
+
+    getPats :: Term -> State [(Name, Type)] Term
+    getPats (Bind n (PVar t) sc) = do ps <- get
+                                      put ((n, t) : ps)
+                                      getPats sc
+    getPats (Bind n (Guess t v) sc) = do t' <- getPats t
+                                         v' <- getPats v
+                                         sc' <- getPats sc
+                                         return (Bind n (Guess t' v') sc')
+    getPats (Bind n (Let t v) sc) = do t' <- getPats t
+                                       v' <- getPats v
+                                       sc' <- getPats sc
+                                       return (Bind n (Let t' v') sc')
+    getPats (Bind n (Pi t) sc) = do t' <- getPats t
+                                    sc' <- getPats sc
+                                    return (Bind n (Pi t') sc')
+    getPats (Bind n (Lam t) sc) = do t' <- getPats t
+                                     sc' <- getPats sc
+                                     return (Bind n (Lam t') sc')
+    getPats (Bind n (Hole t) sc) = do t' <- getPats t
+                                      sc' <- getPats sc
+                                      return (Bind n (Hole t') sc')
+
+
+    getPats (App f a) = do f' <- getPats f
+                           a' <- getPats a
+                           return (App f' a')
+    getPats t = return t
 
 allTTNames :: Eq n => TT n -> [n]
 allTTNames = nub . allNamesIn
diff --git a/src/Idris/Core/Unify.hs b/src/Idris/Core/Unify.hs
--- a/src/Idris/Core/Unify.hs
+++ b/src/Idris/Core/Unify.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE PatternGuards #-}
 
-module Idris.Core.Unify(match_unify, unify, Fails, FailContext(..), FailAt(..)) where
+module Idris.Core.Unify(match_unify, unify, Fails, FailContext(..), FailAt(..),
+                        unrecoverable) where
 
 import Idris.Core.TT
 import Idris.Core.Evaluate
@@ -30,6 +31,16 @@
 type Injs = [(TT Name, TT Name, TT Name)]
 type Fails = [(TT Name, TT Name, Env, Err, [FailContext], FailAt)]
 
+unrecoverable :: Fails -> Bool
+unrecoverable = any bad 
+  where bad (_,_,_, err, _, _) = unrec err
+
+        unrec (CantUnify r _ _ _ _ _) = not r
+        unrec (At _ e) = unrec e
+        unrec (Elaborating _ _ e) = unrec e
+        unrec (ElaboratingArg _ _ _ e) = unrec e
+        unrec _ = False
+
 data UInfo = UI Int Fails
      deriving Show
 
@@ -84,11 +95,11 @@
            = let n' = uniqueName fn (map fst env) in
                  checkCycle names (f, Bind n' (Lam t) x) 
 
-    un names (P _ x _) tm
-        | holeIn env x || x `elem` holes
+    un names tx@(P _ x _) tm
+        | tx /= tm && holeIn env x || x `elem` holes
             = do sc 1; checkCycle names (x, tm)
-    un names tm (P _ y _)
-        | holeIn env y || y `elem` holes
+    un names tm ty@(P _ y _)
+        | ty /= tm && holeIn env y || y `elem` holes
             = do sc 1; checkCycle names (y, tm)
     un bnames (V i) (P _ x _)
         | length bnames > i, 
@@ -153,11 +164,13 @@
         = case lookup n as of
             Nothing -> combine bnames (as ++ [(n,t)]) bs
             Just t' -> do ns <- un bnames t t'
-                          -- make sure there's n mapping from n in ns
                           let ns' = filter (\ (x, _) -> x/=n) ns
                           sc 1
                           combine bnames as (ns' ++ bs)
 
+--     substN n tm (var, sol) = (var, subst n tm sol)
+
+    checkCycle ns p@(x, P _ x' _) | x == x' = return []
     checkCycle ns p@(x, P _ _ _) = return [p]
     checkCycle ns (x, tm)
         | not (x `elem` freeNames tm) = checkScope ns (x, tm)
@@ -229,9 +242,10 @@
 hasv (Bind x b sc) = hasv (binderTy b) || hasv sc
 hasv _ = False
 
-unify :: Context -> Env -> TT Name -> TT Name -> [Name] -> [Name] -> [FailContext] ->
+unify :: Context -> Env -> TT Name -> TT Name -> 
+         [Name] -> [Name] -> [Name] -> [FailContext] ->
          TC ([(Name, TT Name)], Fails)
-unify ctxt env topx topy inj holes from =
+unify ctxt env topx topy inj holes usersupp from =
 --      traceWhen (hasv topx || hasv topy) 
 --           ("Unifying " ++ show topx ++ "\nAND\n" ++ show topy ++ "\n") $
              -- don't bother if topx and topy are different at the head
@@ -415,18 +429,12 @@
 
     unApp fn bnames appx@(App fx ax) appy@(App fy ay)
          | (injectiveApp fx && injectiveApp fy)
-        || (injectiveApp fx && rigid appx && metavarApp appy && numArgs appx == numArgs appy)
-        || (injectiveApp fy && rigid appy && metavarApp appx && numArgs appx == numArgs appy)
         || (injectiveApp fx && metavarApp fy && ax == ay)
         || (injectiveApp fy && metavarApp fx && ax == ay)
          = do let (headx, _) = unApply fx
               let (heady, _) = unApply fy
               -- fail quickly if the heads are disjoint
               checkHeads headx heady
---              if True then -- (injective fx || injective fy || fx == fy) then
---              if (injective fx && metavarApp appy) ||
---                 (injective fy && metavarApp appx) ||
---                 (injective fx && injective fy) || fx == fy
               uplus
                 (do hf <- un' True bnames fx fy
                     let ax' = hnormalise hf ctxt env (substNames hf ax)
@@ -490,7 +498,8 @@
                                 _ -> False
 
             metavar t = case t of
-                             P _ x _ -> (x `elem` holes || holeIn env x)
+                             P _ x _ -> (x `notElem` usersupp && 
+                                             (x `elem` holes || holeIn env x))
                                           || globmetavar t
                              _ -> False
             pat t = case t of
@@ -611,12 +620,13 @@
 -- ASSUMPTION: inputs are in normal form
 
 recoverable t@(App _ _) _
-    | (P _ (UN l) _, _) <- unApply t, l == txt "Lazy" = False
+    | (P _ (UN l) _, _) <- unApply t, l == txt "Lazy'" = False
 recoverable _ t@(App _ _)
-    | (P _ (UN l) _, _) <- unApply t, l == txt "Lazy" = False
+    | (P _ (UN l) _, _) <- unApply t, l == txt "Lazy'" = False
 recoverable (P (DCon _ _) x _) (P (DCon _ _) y _) = x == y
 recoverable (P (TCon _ _) x _) (P (TCon _ _) y _) = x == y
 recoverable (Constant _) (P (DCon _ _) y _) = False
+recoverable (Constant x) (Constant y) = x == y
 recoverable (P (DCon _ _) x _) (Constant _) = False
 recoverable (Constant _) (P (TCon _ _) y _) = False
 recoverable (P (TCon _ _) x _) (Constant _) = False
@@ -626,6 +636,8 @@
 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')
+    | f == f' = recoverable a a' 
 recoverable (App f a) (App f' a')
     = recoverable f f' -- && recoverable a a'
 recoverable f (Bind _ (Pi _) sc)
diff --git a/src/Idris/Coverage.hs b/src/Idris/Coverage.hs
--- a/src/Idris/Coverage.hs
+++ b/src/Idris/Coverage.hs
@@ -360,9 +360,7 @@
                             _ -> []
          case mapMaybe (checkLHS i) (map (\ (_, l, r) -> l) pats) of
             (failure : _) -> return failure
-            _ -> if (Coinductive `elem` opts)
-                      then calcProd i fc n pats
-                      else checkSizeChange n
+            _ -> checkSizeChange n
   where
     checkLHS i (P _ fn _)
         = case lookupTotal fn (tt_ctxt i) of
@@ -376,7 +374,8 @@
     | n `elem` path = return (Partial (Mutual (n : path)))
     | otherwise = do
         t <- getTotality n
-        updateContext (simplifyCasedef n)
+        i <- getIState
+        updateContext (simplifyCasedef n $ getErasureInfo i)
         ctxt <- getContext
         i <- getIState
         let opts = case lookupCtxt n (idris_flags i) of
@@ -470,7 +469,7 @@
                do logLvl 2 $ "Building SCG for " ++ show n ++ " from\n"
                                 ++ show pats ++ "\n" ++ show sc
                   let newscg = buildSCG' ist (rights pats) args
-                  logLvl 5 $ show newscg
+                  logLvl 5 $ "SCG is: " ++ show newscg
                   addToCG n ( cg { scg = newscg } )
        [] -> logLvl 5 $ "Could not build SCG for " ++ show n ++ "\n"
        x -> error $ "buildSCG: " ++ show (n, x)
@@ -488,13 +487,14 @@
 delazy' all t = t
 
 data Guardedness = Toplevel | Unguarded | Guarded
+  deriving Show
 
 buildSCG' :: IState -> [(Term, Term)] -> [Name] -> [SCGEntry]
 buildSCG' ist pats args = nub $ concatMap scgPat pats where
   scgPat (lhs, rhs) = let lhs' = delazy lhs
                           rhs' = delazy rhs
                           (f, pargs) = unApply (dePat lhs') in
-                          findCalls Toplevel (dePat rhs') (patvars lhs') pargs
+                            findCalls Toplevel (dePat rhs') (patvars lhs') pargs
 
   findCalls guarded ap@(App f a) pvs pargs
      -- under a call to "assert_total", don't do any checking, just believe
@@ -505,10 +505,10 @@
      -- immediate call, as long as the call is guarded. 
      -- Then check its arguments
      | (P _ (UN del) _, [_,_,arg]) <- unApply ap,
-       guarded <- Guarded,
+       Guarded <- guarded,
        del == txt "Delay" 
            = let (capp, args) = unApply arg in
-                 concatMap (\x -> findCalls Toplevel x pvs pargs) args
+                 concatMap (\x -> findCalls guarded x pvs pargs) args
      | (P _ n _, args) <- unApply ap
         = let nguarded = case guarded of
                               Unguarded -> Unguarded
diff --git a/src/Idris/DSL.hs b/src/Idris/DSL.hs
--- a/src/Idris/DSL.hs
+++ b/src/Idris/DSL.hs
@@ -3,7 +3,6 @@
 module Idris.DSL where
 
 import Idris.AbsSyntax
-import Paths_idris
 
 import Idris.Core.TT
 import Idris.Core.Evaluate
@@ -29,6 +28,10 @@
         = let sc = PApp (fileFC "(dsl)") letb [pexp v, pexp (var dsl n tm 0)] in
               expandDo dsl sc
 expandDo dsl (PLet n ty v tm) = PLet n (expandDo dsl ty) (expandDo dsl v) (expandDo dsl tm)
+expandDo dsl (PPi p n ty tm)
+    | Just pi <- dsl_pi dsl
+        = let sc = PApp (fileFC "(dsl)") pi [pexp ty, pexp (var dsl n tm 0)] in
+              expandDo dsl sc
 expandDo dsl (PPi p n ty tm) = PPi p n (expandDo dsl ty) (expandDo dsl tm)
 expandDo dsl (PApp fc t args) = PApp fc (expandDo dsl t)
                                         (map (fmap (expandDo dsl)) args)
@@ -36,7 +39,8 @@
                                                 (map (fmap (expandDo dsl)) args)
 expandDo dsl (PCase fc s opts) = PCase fc (expandDo dsl s)
                                         (map (pmap (expandDo dsl)) opts)
-expandDo dsl (PEq fc l r) = PEq fc (expandDo dsl l) (expandDo dsl r)
+expandDo dsl (PEq fc lt rt l r) = PEq fc (expandDo dsl lt) (expandDo dsl rt)
+                                         (expandDo dsl l) (expandDo dsl r)
 expandDo dsl (PPair fc p l r) = PPair fc p (expandDo dsl l) (expandDo dsl r)
 expandDo dsl (PDPair fc p l t r) = PDPair fc p (expandDo dsl l) (expandDo dsl t)
                                                (expandDo dsl r)
@@ -88,11 +92,14 @@
         | Nothing <- dsl_let dsl
             = PLet n (v' i ty) (v' i val) (v' i sc)
         | otherwise = PLet n (v' i ty) (v' i val) (v' (i + 1) sc)
-    v' i (PPi p n ty sc) = PPi p n (v' i ty) (v' i sc)
+    v' i (PPi p n ty sc)
+        | Nothing <- dsl_pi dsl
+            = PPi p n (v' i ty) (v' i sc)
+        | otherwise = PPi p n (v' i ty) (v' (i+1) sc)
     v' i (PTyped l r)    = PTyped (v' i l) (v' i r)
     v' i (PApp f x as)   = PApp f (v' i x) (fmap (fmap (v' i)) as)
     v' i (PCase f t as)  = PCase f (v' i t) (fmap (pmap (v' i)) as)
-    v' i (PEq f l r)     = PEq f (v' i l) (v' i r)
+    v' i (PEq f lt rt l r) = PEq f (v' i lt) (v' i rt) (v' i l) (v' i r)
     v' i (PPair f p l r) = PPair f p (v' i l) (v' i r)
     v' i (PDPair f p l t r) = PDPair f p (v' i l) (v' i t) (v' i r)
     v' i (PAlternative a as) = PAlternative a $ map (v' i) as
diff --git a/src/Idris/DeepSeq.hs b/src/Idris/DeepSeq.hs
--- a/src/Idris/DeepSeq.hs
+++ b/src/Idris/DeepSeq.hs
@@ -119,6 +119,7 @@
 instance NFData DataOpt where
         rnf Codata = ()
         rnf DefaultEliminator = ()
+        rnf DefaultCaseFun = ()
 
 instance (NFData t) => NFData (PDecl' t) where
         rnf (PFix x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()
@@ -204,7 +205,7 @@
         rnf (PFalse x1) = rnf x1 `seq` ()
         rnf (PRefl x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
         rnf (PResolveTC x1) = rnf x1 `seq` ()
-        rnf (PEq x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()
+        rnf (PEq x1 x2 x3 x4 x5) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()
         rnf (PRewrite x1 x2 x3 x4)
           = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
         rnf (PPair x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
@@ -236,6 +237,7 @@
         rnf (Refine x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
         rnf (Rewrite x1) = rnf x1 `seq` ()
         rnf (Induction x1) = rnf x1 `seq` ()
+        rnf (CaseTac x1) = rnf x1 `seq` ()
         rnf (Equiv x1) = rnf x1 `seq` ()
         rnf (MatchRefine x1) = rnf x1 `seq` ()
         rnf (LetTac x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
@@ -291,12 +293,13 @@
         rnf (TI x1 x2 x3 x4 x5) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()
 
 instance (NFData t) => NFData (DSL' t) where
-        rnf (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9)
+        rnf (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)
           = rnf x1 `seq`
               rnf x2 `seq`
                 rnf x3 `seq`
                   rnf x4 `seq`
-                    rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` ()
+                    rnf x5 `seq`
+                      rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` ()
 
 instance NFData SynContext where
         rnf PatternSyntax = ()
@@ -317,13 +320,14 @@
         rnf (UImplicit x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
         rnf (UConstraint x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
 
- 
 instance NFData SyntaxInfo where
-        rnf (Syn x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)
+        rnf (Syn x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)
           = rnf x1 `seq`
               rnf x2 `seq`
                 rnf x3 `seq`
-                  rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` ()
+                  rnf x4 `seq`
+                    rnf x5 `seq`
+                      rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` rnf x11 `seq` ()
 
 
 
diff --git a/src/Idris/Delaborate.hs b/src/Idris/Delaborate.hs
--- a/src/Idris/Delaborate.hs
+++ b/src/Idris/Delaborate.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE PatternGuards #-}
-module Idris.Delaborate (bugaddr, delab, delab', delabMV, delabTy, delabTy', fancifyAnnots, pprintErr) where
+module Idris.Delaborate (bugaddr, delab, delab', delabMV, delabTy, delabTy', fancifyAnnots, pprintDelab, pprintDelabTy, pprintErr) where
 
 -- Convert core TT back into high level syntax, primarily for display
 -- purposes.
@@ -12,8 +12,9 @@
 import Idris.Docstrings (overview, renderDocstring)
 import Idris.ErrReverse
 
-import Data.List (intersperse)
+import Data.List (intersperse, nub)
 import qualified Data.Text as T
+import Control.Monad.State
 
 import Debug.Trace
 
@@ -96,9 +97,10 @@
          | n == sUN "Sigma"
                = PDPair un IsType (PRef un x) (de env [] ty)
                            (de ((x,x):env) [] (instantiate (P Bound x ty) r))
-    deFn env (P _ n _) [_,_,l,r]
+    deFn env (P _ n _) [lt,rt,l,r]
          | n == pairCon = PPair un IsTerm (de env [] l) (de env [] r)
-         | n == eqTy    = PEq un (de env [] l) (de env [] r)
+         | n == eqTy    = PEq un (de env [] lt) (de env [] rt)
+                                 (de env [] l) (de env [] r)
          | n == sUN "Sg_intro" = PDPair un IsTerm (de env [] l) Placeholder
                                            (de env [] r)
     deFn env f@(P _ n _) args 
@@ -135,6 +137,20 @@
 indented :: Doc a -> Doc a
 indented = nest errorIndent . (line <>)
 
+-- | Pretty-print a core term using delaboration
+pprintDelab :: IState -> Term -> Doc OutputAnnotation
+pprintDelab ist tm = annotate (AnnTerm [] tm)
+                              (prettyIst ist (delab ist tm))
+
+-- | Pretty-print the type of some name
+pprintDelabTy :: IState -> Name -> Doc OutputAnnotation
+pprintDelabTy i n
+    = case lookupTy n (tt_ctxt i) of
+           (ty:_) -> annotate (AnnTerm [] ty) . prettyIst i $
+                     case lookupCtxt n (idris_implicits i) of
+                         (imps:_) -> delabTy' i imps ty False False
+                         _ -> delabTy' i [] ty False False
+
 pprintTerm :: IState -> PTerm -> Doc OutputAnnotation
 pprintTerm ist = pprintTerm' ist []
 
@@ -150,56 +166,62 @@
          text "This is probably a bug, or a missing error message.",
          text ("Please consider reporting at " ++ bugaddr)
        ]
-pprintErr' i (CantUnify _ x y e sc s) =
-  text "Can't unify" <> indented (pprintTerm' i (map (\ (n, b) -> (n, False)) sc) (delab i x)) <$>
-  text "with" <> indented (pprintTerm' i (map (\ (n, b) -> (n, False)) sc) (delab i y)) <>
-  case e of
-    Msg "" -> empty
-    _ -> line <> line <> text "Specifically:" <>
-         indented (pprintErr' i e) <>
-         if (opt_errContext (idris_options i)) then showSc i sc else empty
+pprintErr' i (CantUnify _ x_in y_in e sc s) =
+  let (x_ns, y_ns, nms) = renameMNs x_in y_in
+      (x, y) = addImplicitDiffs (delab i x_ns) (delab i y_ns) in
+    text "Can't unify" <> indented (annTm x_ns 
+                      (pprintTerm' i (map (\ (n, b) -> (n, False)) sc
+                                        ++ zip nms (repeat False)) x)) <$>
+    text "with" <> indented (annTm y_ns 
+                      (pprintTerm' i (map (\ (n, b) -> (n, False)) sc
+                                        ++ zip nms (repeat False)) y)) <>
+    case e of
+      Msg "" -> empty
+      _ -> line <> line <> text "Specifically:" <>
+           indented (pprintErr' i e) <>
+           if (opt_errContext (idris_options i)) then showSc i sc else empty
 pprintErr' i (CantConvert x y env) =
   text "Can't convert" <>
-  indented (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i x)) <$>
+  indented (annTm x (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i x))) <$>
   text "with" <>
-  indented (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i y)) <>
+  indented (annTm y (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i y))) <>
   if (opt_errContext (idris_options i)) then line <> showSc i env else empty
 pprintErr' i (CantSolveGoal x env) =
   text "Can't solve goal " <>
-  indented (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i x)) <>
+  indented (annTm x (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i x))) <>
   if (opt_errContext (idris_options i)) then line <> showSc i env else empty
 pprintErr' i (UnifyScope n out tm env) =
   text "Can't unify" <> indented (annName n) <+>
-  text "with" <> indented (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i tm)) <+>
-  text "as" <> indented (annName out) <> text "is not in scope" <>
+  text "with" <> indented (annTm tm (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i tm))) <+>
+ text "as" <> indented (annName out) <> text "is not in scope" <>
   if (opt_errContext (idris_options i)) then line <> showSc i env else empty
 pprintErr' i (CantInferType t) = text "Can't infer type for" <+> text t
 pprintErr' i (NonFunctionType f ty) =
-  pprintTerm i (delab i f) <+>
+  annTm f (pprintTerm i (delab i f)) <+>
   text "does not have a function type" <+>
   parens (pprintTerm i (delab i ty))
 pprintErr' i (NotEquality tm ty) =
-  pprintTerm i (delab i tm) <+>
+  annTm tm (pprintTerm i (delab i tm)) <+>
   text "does not have an equality type" <+>
-  parens (pprintTerm i (delab i ty))
+  annTm ty (parens (pprintTerm i (delab i ty)))
 pprintErr' i (TooManyArguments f) = text "Too many arguments for" <+> annName f
 pprintErr' i (CantIntroduce ty) =
-  text "Can't use lambda here: type is" <+> pprintTerm i (delab i ty)
+  text "Can't use lambda here: type is" <+> annTm ty (pprintTerm i (delab i ty))
 pprintErr' i (InfiniteUnify x tm env) =
   text "Unifying" <+> annName' x (showbasic x) <+> text "and" <+>
-  pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i tm) <+>
+  annTm tm (pprintTerm' i (map (\ (n, b) -> (n, False)) env) (delab i tm)) <+>
   text "would lead to infinite value" <>
   if (opt_errContext (idris_options i)) then line <> showSc i env else empty
 pprintErr' i (NotInjective p x y) =
-  text "Can't verify injectivity of" <+> pprintTerm i (delab i p) <+>
-  text " when unifying" <+> pprintTerm i (delab i x) <+> text "and" <+>
-  pprintTerm i (delab i y)
+  text "Can't verify injectivity of" <+> annTm p (pprintTerm i (delab i p)) <+>
+  text " when unifying" <+> annTm x (pprintTerm i (delab i x)) <+> text "and" <+>
+  annTm y (pprintTerm i (delab i y))
 pprintErr' i (CantResolve c) = text "Can't resolve type class" <+> pprintTerm i (delab i c)
 pprintErr' i (CantResolveAlts as) = text "Can't disambiguate name:" <+>
                                     align (cat (punctuate (comma <> space) (map (fmap (fancifyAnnots i) . annName) as)))
 pprintErr' i (NoTypeDecl n) = text "No type declaration for" <+> annName n
 pprintErr' i (NoSuchVariable n) = text "No such variable" <+> annName n
-pprintErr' i (IncompleteTerm t) = text "Incomplete term" <+> pprintTerm i (delab i t)
+pprintErr' i (IncompleteTerm t) = text "Incomplete term" <+> annTm t (pprintTerm i (delab i t))
 pprintErr' i UniverseError = text "Universe inconsistency"
 pprintErr' i ProgramLineComment = text "Program line next to comment"
 pprintErr' i (Inaccessible n) = annName n <+> text "is not an accessible pattern variable"
@@ -208,7 +230,7 @@
 pprintErr' i (AlreadyDefined n) = annName n<+>
                                   text "is already defined"
 pprintErr' i (ProofSearchFail e) = pprintErr' i e
-pprintErr' i (NoRewriting tm) = text "rewrite did not change type" <+> pprintTerm i (delab i tm)
+pprintErr' i (NoRewriting tm) = text "rewrite did not change type" <+> annTm tm (pprintTerm i (delab i tm))
 pprintErr' i (At f e) = annotate (AnnFC f) (text (show f)) <> colon <> pprintErr' i e
 pprintErr' i (Elaborating s n e) = text "When elaborating" <+> text s <>
                                    annName' n (showqual i n) <> colon <$>
@@ -248,6 +270,117 @@
   indented (pprintErr' i err) <>
   text ("This is probably a bug. Please consider reporting it at " ++ bugaddr)
 
+-- Make sure the machine invented names are shown helpfully to the user, so
+-- that any names which differ internally also differ visibly
+-- FIXME: I can't actually contrive an error to test this! Will revisit later...
+renameMNs :: Term -> Term -> (Term, Term, [Name])
+renameMNs x y = let ns = nub $ allTTNames x ++ allTTNames y
+                    newnames = evalState (getRenames [] ns) 1 in
+                      (rename newnames x, rename newnames y, map snd newnames)
+  where
+    getRenames :: [(Name, Name)] -> [Name] -> State Int [(Name, Name)]
+    getRenames acc [] = return acc
+    getRenames acc (n@(MN i x) : xs) | UN x `elem` xs
+         = do idx <- get
+              put (idx + 1)
+              let x' = sUN (str x ++ show idx)
+              getRenames ((n, x') : acc) xs
+    getRenames acc (x : xs) = getRenames acc xs
+
+    rename :: [(Name, Name)] -> Term -> Term
+    rename ns (P nt x t) | Just x' <- lookup x ns = P nt x' t
+    rename ns (App f a) = App (rename ns f) (rename ns a)
+    rename ns (Bind x b sc) 
+           = let b' = fmap (rename ns) b
+                 sc' = rename ns sc in
+                 case lookup x ns of
+                      Just x' -> Bind x' b' sc'
+                      Nothing -> Bind x b' sc'
+    rename ns x = x
+
+-- If the two terms only differ in their implicits, mark the implicits which
+-- differ as AlwaysShow so that they appear in errors
+addImplicitDiffs :: PTerm -> PTerm -> (PTerm, PTerm)
+addImplicitDiffs x y 
+    = if (x `expLike` y) then addI x y else (x, y)
+  where
+    addI :: PTerm -> PTerm -> (PTerm, PTerm)
+    addI (PApp fc f as) (PApp gc g bs) 
+         = let (as', bs') = addShows as bs in
+               (PApp fc f as', PApp gc g bs')
+       where addShows [] [] = ([], [])
+             addShows (a:as) (b:bs) 
+                = let (as', bs') = addShows as bs
+                      (a', b') = addI (getTm a) (getTm b) in
+                      if (not (a' `expLike` b'))
+                         then (a { argopts = AlwaysShow : argopts a,
+                                   getTm = a' } : as',
+                               b { argopts = AlwaysShow : argopts b,
+                                   getTm = b' } : bs')
+                         else (a { getTm = a' } : as', 
+                               b { getTm = b' } : bs')
+    addI (PLam n a b) (PLam n' c d) 
+         = let (a', c') = addI a c
+               (b', d') = addI b d in
+               (PLam n a' b', PLam n' c' d')
+    addI (PPi p n a b) (PPi p' n' c d) 
+         = let (a', c') = addI a c
+               (b', d') = addI b d in
+               (PPi p n a' b', PPi p' n' c' d')
+    addI (PRefl fc a) (PRefl fc' b) 
+         = let (a', b') = addI a b in
+               (PRefl fc a', PRefl fc' b')
+    addI (PEq fc at bt a b) (PEq fc' ct dt c d) 
+         | trace (show (at,bt)) False = undefined
+         | at `expLike` ct && bt `expLike` dt
+         = let (a', c') = addI a c
+               (b', d') = addI b d in
+               (PEq fc at bt a' b', PEq fc' ct dt c' d')
+         | otherwise
+         = let (at', ct') = addI at ct
+               (bt', dt') = addI bt dt
+               (a', c') = addI a c
+               (b', d') = addI b d 
+               showa = if at `expLike` ct then [] else [AlwaysShow] 
+               showb = if bt `expLike` dt then [] else [AlwaysShow] in
+               (PApp fc (PRef fc eqTy) [(pimp (sUN "A") at' True)
+                                               { argopts = showa },
+                                        (pimp (sUN "B") bt' True)
+                                               { argopts = showb },
+                                        pexp a', pexp b'],
+                PApp fc (PRef fc eqTy) [(pimp (sUN "A") ct' True)
+                                               { argopts = showa },
+                                        (pimp (sUN "B") dt' True)
+                                               { argopts = showb },
+                                        pexp c', pexp d'])
+                                                
+    addI (PPair fc pi a b) (PPair fc' pi' c d) 
+         = let (a', c') = addI a c
+               (b', d') = addI b d in
+               (PPair fc pi a' b', PPair fc' pi' c' d')
+    addI (PDPair fc pi a t b) (PDPair fc' pi' c u d) 
+         = let (a', c') = addI a c
+               (t', u') = addI t u
+               (b', d') = addI b d in
+               (PDPair fc pi a' t' b', PDPair fc' pi' c' u' d')
+    addI x y = (x, y)
+
+    -- Just the ones which appear desugared in errors
+    expLike (PRef _ n) (PRef _ n') = n == n'
+    expLike (PApp _ f as) (PApp _ f' as')
+        = expLike f f' && length as == length as' &&
+          and (zipWith expLike (getExps as) (getExps as'))
+    expLike (PPi _ n s t) (PPi _ n' s' t') 
+        = n == n' && expLike s s' && expLike t t'
+    expLike (PLam n s t) (PLam n' s' t') 
+        = n == n' && expLike s s' && expLike t t'
+    expLike (PPair _ _ x y) (PPair _ _ x' y') = expLike x x' && expLike y y'
+    expLike (PDPair _ _ x _ y) (PDPair _ _ x' _ y') = expLike x x' && expLike y y'
+    expLike (PEq _ xt yt x y) (PEq _ xt' yt' x' y') 
+         = expLike x x' && expLike y y'
+    expLike (PRefl _ x) (PRefl _ x') = expLike x x'
+    expLike x y = x == y
+
 isUN :: Name -> Bool
 isUN (UN n) = not $ T.isPrefixOf (T.pack "__") n -- TODO figure out why MNs are getting rewritte to UNs for top-level pattern-matching functions
 isUN (NS n _) = isUN n
@@ -258,6 +391,9 @@
 
 annName' :: Name -> String -> Doc OutputAnnotation
 annName' n str = annotate (AnnName n Nothing Nothing Nothing) (text str)
+
+annTm :: Term -> Doc OutputAnnotation -> Doc OutputAnnotation
+annTm tm = annotate (AnnTerm [] tm)
 
 fancifyAnnots :: IState -> OutputAnnotation -> OutputAnnotation
 fancifyAnnots ist annot@(AnnName n _ _ _) =
diff --git a/src/Idris/Docs.hs b/src/Idris/Docs.hs
--- a/src/Idris/Docs.hs
+++ b/src/Idris/Docs.hs
@@ -37,7 +37,7 @@
 
 pprintFD :: IState -> FunDoc -> Doc OutputAnnotation
 pprintFD ist (FD n doc args ty f)
-    = nest 4 (prettyName (ppopt_impl ppo) [] n <+> colon <+>
+    = nest 4 (prettyName True (ppopt_impl ppo) [] n <+> colon <+>
               pprintPTerm ppo [] [ n | (n@(UN n'),_,_,_) <- args
                                      , not (T.isPrefixOf (T.pack "__") n') ] infixes ty <$>
               renderDocstring doc <$>
@@ -79,7 +79,7 @@
              else nest 4 (text "Constructors:" <> line <>
                           vsep (map (pprintFD ist) args))
 pprintDocs ist (ClassDoc n doc meths params instances superclasses)
-           = nest 4 (text "Type class" <+> prettyName (ppopt_impl ppo) [] n <>
+           = nest 4 (text "Type class" <+> prettyName True (ppopt_impl ppo) [] n <>
                      if nullDocstring doc then empty else line <> renderDocstring doc)
              <> line <$>
              nest 4 (text "Parameters:" <$> prettyParameters)
@@ -131,8 +131,8 @@
     (subclasses, instances') = partition isSubclass instances
 
     prettyParameters = if any (isJust . snd) params
-                       then vsep (map (\(nm,md) -> prettyName False params' nm <+> maybe empty showDoc md) params)
-                       else hsep (punctuate comma (map (prettyName False params' . fst) params))
+                       then vsep (map (\(nm,md) -> prettyName True False params' nm <+> maybe empty showDoc md) params)
+                       else hsep (punctuate comma (map (prettyName True False params' . fst) params))
 
 getDocs :: Name -> Idris Docs
 getDocs n
diff --git a/src/Idris/ElabDecls.hs b/src/Idris/ElabDecls.hs
--- a/src/Idris/ElabDecls.hs
+++ b/src/Idris/ElabDecls.hs
@@ -19,7 +19,6 @@
 import Idris.DeepSeq
 import Idris.Output (iputStrLn, pshow, iWarn)
 import IRTS.Lang
-import Paths_idris
 
 import Idris.Core.TT
 import Idris.Core.Elaborate hiding (Tactic(..))
@@ -72,33 +71,28 @@
 --                     mapM (\(n, (i, top, t)) -> do (t', _) <- recheckC fc [] t
 --                                                   return (n, (i, top, t'))) ns
 
--- | Elaborate a top-level type declaration - for example, "foo : Int -> Int".
-elabType :: ElabInfo -> SyntaxInfo -> Docstring -> [(Name, Docstring)] ->
-            FC -> FnOpts -> Name -> PTerm -> Idris Type
-elabType = elabType' False
-
-elabType' :: Bool -> -- normalise it
-             ElabInfo -> SyntaxInfo -> Docstring -> [(Name, Docstring)] ->
-             FC -> FnOpts -> Name -> PTerm -> Idris Type
-elabType' norm info syn doc argDocs fc opts n ty' = {- let ty' = piBind (params info) ty_in
-                                                       n  = liftname info n_in in    -}
-      do checkUndefined fc n
+buildType :: ElabInfo -> SyntaxInfo -> FC -> FnOpts -> Name -> PTerm -> 
+             Idris (Type, PTerm, [(Int, Name)])
+buildType info syn fc opts n ty' = do
          ctxt <- getContext
          i <- getIState
 
-         logLvl 5 $ show n ++ " pre-type " ++ showTmImpls ty'
+         logLvl 3 $ show n ++ " pre-type " ++ showTmImpls ty'
          ty' <- addUsingConstraints syn fc ty'
-         ty' <- implicit info syn n ty'
+         ty' <- addUsingImpls syn n fc ty'
+         let ty = addImpl i ty'
 
-         let ty    = addImpl i ty'
-             inacc = inaccessibleArgs 0 ty
-         logLvl 5 $ show n ++ " type pre-addimpl " ++ showTmImpls ty'
-         logLvl 5 $ show n ++ " type " ++ showTmImpls ty
-         logLvl 3 $ show n ++ ": inaccessible arguments: " ++ show inacc
+         logLvl 3 $ show n ++ " type pre-addimpl " ++ showTmImpls ty'
+         logLvl 3 $ show n ++ " type " ++ show (using syn) ++ "\n" ++ showTmImpls ty
 
-         ((tyT, defer, is), log) <-
+         ((tyT', defer, is), log) <-
                tclift $ elaborate ctxt n (TType (UVal 0)) []
-                        (errAt "type of " n (erun fc (build i info False [] n ty)))
+                        (errAt "type of " n (erun fc (build i info ETyDecl [] n ty)))
+
+         let tyT = patToImp tyT'
+
+         logLvl 3 $ show ty ++ "\nElaborated: " ++ show tyT'
+
          ds <- checkAddDef True False fc defer
          -- if the type is not complete, note that we'll need to infer
          -- things later (for solving metavariables)
@@ -108,19 +102,52 @@
          ctxt <- getContext
          logLvl 5 $ "Rechecking"
          logLvl 6 $ show tyT
+         logLvl 10 $ "Elaborated to " ++ showEnvDbg [] tyT
          (cty, _)   <- recheckC fc [] tyT
-         addStatics n cty ty'
-         logLvl 6 $ "Elaborated to " ++ showEnvDbg [] tyT
-         logLvl 2 $ "Rechecked to " ++ show cty
+
+         -- record the implicit and inaccessible arguments
+         i <- getIState
+         let (inaccData, impls) = unzip $ getUnboundImplicits i cty ty
+         let inacc = inaccessibleImps 0 cty inaccData
+         logLvl 3 $ show n ++ ": inaccessible arguments: " ++ show inacc
+
+         putIState $ i { idris_implicits = addDef n impls (idris_implicits i) }
+         logLvl 3 ("Implicit " ++ show n ++ " " ++ show impls)
+         addIBC (IBCImp n)
+
+         return (cty, ty, inacc)
+  where
+    patToImp (Bind n (PVar t) sc) = Bind n (Pi t) (patToImp sc)
+    patToImp (Bind n b sc) = Bind n b (patToImp sc)
+    patToImp t = t
+
+
+-- | Elaborate a top-level type declaration - for example, "foo : Int -> Int".
+elabType :: ElabInfo -> SyntaxInfo -> Docstring -> [(Name, Docstring)] ->
+            FC -> FnOpts -> Name -> PTerm -> Idris Type
+elabType = elabType' False
+
+elabType' :: Bool -> -- normalise it
+             ElabInfo -> SyntaxInfo -> Docstring -> [(Name, Docstring)] ->
+             FC -> FnOpts -> Name -> PTerm -> Idris Type
+elabType' norm info syn doc argDocs fc opts n ty' = {- let ty' = piBind (params info) ty_in
+                                                       n  = liftname info n_in in    -}
+      do checkUndefined fc n
+         (cty, ty, inacc) <- buildType info syn fc opts n ty'
+
+         addStatics n cty ty
          let nty = cty -- normalise ctxt [] cty
          -- if the return type is something coinductive, freeze the definition
+         ctxt <- getContext
          let nty' = normalise ctxt [] nty
+         logLvl 2 $ "Rechecked to " ++ show nty'
 
          -- Add normalised type to internals
+         i <- getIState
          rep <- useREPL
          when rep $ do
-           addInternalApp (fc_fname fc) (fst . fc_start $ fc) (mergeTy ty' (delab i nty')) -- TODO: Should use span instead of line and filename?
-           addIBC (IBCLineApp (fc_fname fc) (fst . fc_start $ fc) (mergeTy ty' (delab i nty')))
+           addInternalApp (fc_fname fc) (fst . fc_start $ fc) ty' -- (mergeTy ty' (delab i nty')) -- TODO: Should use span instead of line and filename?
+           addIBC (IBCLineApp (fc_fname fc) (fst . fc_start $ fc) ty') -- (mergeTy ty' (delab i nty')))
 
          let (t, _) = unApply (getRetTy nty')
          let corec = case t of
@@ -164,7 +191,7 @@
     -- for making an internalapp, we only want the explicit ones, and don't
     -- want the parameters, so just take the arguments which correspond to the
     -- user declared explicit ones
-    mergeTy (PPi e n ty sc) (PPi e' _ _ sc')
+    mergeTy (PPi e n ty sc) (PPi e' n' _ sc')
          | e == e' = PPi e n ty (mergeTy sc sc')
          | otherwise = mergeTy sc sc'
     mergeTy _ sc = sc
@@ -185,6 +212,14 @@
         , ns4 == map txt ["Errors","Reflection","Language"] = True
     tyIsHandler _                                           = False
 
+-- Get the list of (index, name) of inaccessible arguments from an elaborated
+-- type
+inaccessibleImps :: Int -> Type -> [Bool] -> [(Int, Name)]
+inaccessibleImps i (Bind n (Pi t) sc) (inacc : ins)
+    | inacc = (i, n) : inaccessibleImps (i + 1) sc ins
+    | otherwise = inaccessibleImps (i + 1) sc ins
+inaccessibleImps _ _ _ = []
+
 -- Get the list of (index, name) of inaccessible arguments from the type.
 inaccessibleArgs :: Int -> PTerm -> [(Int, Name)]
 inaccessibleArgs i (PPi (Imp _ _ _) n Placeholder t)
@@ -211,42 +246,20 @@
     = do let codata = Codata `elem` opts
          iLOG (show (fc, doc))
          checkUndefined fc n
-         ctxt <- getContext
-         i <- getIState
-         -- TODO think: something more in info?
-         t_in <- implicit info syn n t_in
-         let t = addImpl i t_in
-         ((t', defer, is), log) <- tclift $ elaborate ctxt n (TType (UVal 0)) []
-                                            (erun fc (build i info False [] n t))
-         def' <- checkDef fc defer
-         let def'' = map (\(n, (i, top, t)) -> (n, (i, top, t, True))) def'
-         addDeferredTyCon def''
+         (cty, t, inacc) <- buildType info syn fc [] n t_in
+
          addIBC (IBCDef n)
-         mapM_ (elabCaseBlock info []) is
-         (cty, _)  <- recheckC fc [] t'
-         logLvl 2 $ "---> " ++ show cty
          updateContext (addTyDecl n (TCon 0 0) cty) -- temporary, to check cons
 
 elabData info syn doc argDocs fc opts (PDatadecl n t_in dcons)
     = do let codata = Codata `elem` opts
          iLOG (show fc)
          undef <- isUndefined fc n
-         ctxt <- getContext
-         i <- getIState
-         t_in <- implicit info syn n t_in
-         let t = addImpl i t_in
-         ((t', defer, is), log) <-
-             tclift $ elaborate ctxt n (TType (UVal 0)) []
-                  (errAt "data declaration " n (erun fc (build i info False [] n t)))
-         def' <- checkDef fc defer
-         let def'' = map (\(n, (i, top, t)) -> (n, (i, top, t, True))) def'
+         (cty, t, inacc) <- buildType info syn fc [] n t_in
          -- if n is defined already, make sure it is just a type declaration
          -- with the same type we've just elaborated
-         checkDefinedAs fc n t' (tt_ctxt i)
-         addDeferredTyCon def''
-         mapM_ (elabCaseBlock info []) is
-         (cty, _)  <- recheckC fc [] t'
-         logLvl 2 $ "---> " ++ show cty
+         i <- getIState
+         checkDefinedAs fc n cty (tt_ctxt i)
          -- temporary, to check cons
          when undef $ updateContext (addTyDecl n (TCon 0 0) cty)
          let cnameinfo = cinfo info (map cname dcons)
@@ -263,7 +276,7 @@
                                              (idris_datatypes i) })
          addIBC (IBCDef n)
          addIBC (IBCData n)
-         checkDocs fc argDocs t_in
+         checkDocs fc argDocs t
          addDocStr n doc argDocs
          addIBC (IBCDoc n)
          let metainf = DataMI params
@@ -283,7 +296,10 @@
 
          -- create an eliminator
          when (DefaultEliminator `elem` opts) $
-            evalStateT (elabEliminator params n t dcons info) Map.empty
+            evalStateT (elabCaseFun True params n t dcons info) Map.empty
+         -- create a case function
+         when (DefaultCaseFun `elem` opts) $
+            evalStateT (elabCaseFun False params n t dcons info) Map.empty
   where
         setDetaggable :: Name -> Idris ()
         setDetaggable n = do
@@ -366,14 +382,66 @@
                        liftname = id -- Is this appropriate?
                      }
 
+-- FIXME: 'forcenames' is an almighty hack! Need a better way of
+-- erasing non-forceable things
+-- ^^^
+-- TODO: the above is a comment from the past;
+-- forcenames is probably no longer needed
+elabCon :: ElabInfo -> SyntaxInfo -> Name -> Bool ->
+           (Docstring, [(Name, Docstring)], Name, PTerm, FC, [Name]) -> Idris (Name, Type)
+elabCon info syn tn codata (doc, argDocs, n, t_in, fc, forcenames)
+    = do checkUndefined fc n
+         (cty, t, inacc) <- buildType info syn fc [] n (if codata then mkLazy t_in else t_in)
+         ctxt <- getContext
+         let cty' = normalise ctxt [] cty
+
+         logLvl 2 $ show fc ++ ":Constructor " ++ show n ++ " : " ++ show t
+         logLvl 5 $ "Inaccessible args: " ++ show inacc
+         logLvl 2 $ "---> " ++ show n ++ " : " ++ show cty'
+
+         addIBC (IBCDef n)
+         checkDocs fc argDocs t
+         addDocStr n doc argDocs
+         addIBC (IBCDoc n)
+         fputState (opt_inaccessible . ist_optimisation n) inacc
+         addIBC (IBCOpt n)
+         return (n, cty')
+  where
+    tyIs (Bind n b sc) = tyIs sc
+    tyIs t | (P _ n' _, _) <- unApply t
+        = if n' /= tn then tclift $ tfail (At fc (Msg (show n' ++ " is not " ++ show tn)))
+             else return ()
+    tyIs t = tclift $ tfail (At fc (Msg (show t ++ " is not " ++ show tn)))
+
+    mkLazy (PPi pl n ty sc) 
+        = let ty' = if getTyName ty
+                       then PApp fc (PRef fc (sUN "Lazy'"))
+                            [pexp (PRef fc (sUN "LazyCodata")),
+                             pexp ty]
+                       else ty in
+              PPi pl n ty' (mkLazy sc)
+    mkLazy t = t
+
+    getTyName (PApp _ (PRef _ n) _) = n == nsroot tn
+    getTyName (PRef _ n) = n == nsroot tn
+    getTyName _ = False
+
+
+    getNamePos :: Int -> PTerm -> Name -> Maybe Int
+    getNamePos i (PPi _ n _ sc) x | n == x = Just i
+                                  | otherwise = getNamePos (i + 1) sc x
+    getNamePos _ _ _ = Nothing
+
 type EliminatorState = StateT (Map.Map String Int) Idris
 
 -- TODO: Rewrite everything to use idris_implicits instead of manual splitting (or in TT)
-elabEliminator :: [Int] -> Name -> PTerm ->
+-- FIXME: Many things have name starting with elim internally since this was the only purpose in the first edition of the function
+-- rename to caseFun to match updated intend
+elabCaseFun :: Bool -> [Int] -> Name -> PTerm ->
                   [(Docstring, [(Name, Docstring)], Name, PTerm, FC, [Name])] ->
                   ElabInfo -> EliminatorState ()
-elabEliminator paramPos n ty cons info = do
-  elimLog $ "Elaborating eliminator"
+elabCaseFun ind paramPos n ty cons info = do
+  elimLog $ "Elaborating case function"
   put (Map.fromList $ zip (concatMap (\(_, p, _, ty, _, _) -> (map show $ boundNamesIn ty) ++ map (show . fst) p) cons ++ (map show $ boundNamesIn ty)) (repeat 0))
   let (cnstrs, _) = splitPi ty
   let (splittedTy@(pms, idxs)) = splitPms cnstrs
@@ -381,7 +449,8 @@
   motiveIdxs    <- namePis False idxs
   let motive = mkMotive n paramPos generalParams motiveIdxs
   consTerms <- mapM (\(c@(_, _, cnm, _, _, _)) -> do
-                               name <- freshName $ "elim_" ++ simpleName cnm
+                               let casefunt = if ind then "elim_" else "case_"
+                               name <- freshName $ casefunt ++ simpleName cnm
                                consTerm <- extractConsTerm c generalParams
                                return (name, expl, consTerm)) cons
   scrutineeIdxs <- namePis False idxs
@@ -392,11 +461,11 @@
   let clauseConsElimArgs = map getPiName consTerms
   let clauseGeneralArgs' = map getPiName generalParams ++ [motiveName] ++ clauseConsElimArgs
   let clauseGeneralArgs  = map (\arg -> pexp (PRef elimFC arg)) clauseGeneralArgs'
-  let elimSig = "-- eliminator signature: " ++ showTmImpls eliminatorTy
+  let elimSig = "-- case function signature: " ++ showTmImpls eliminatorTy
   elimLog elimSig
   eliminatorClauses <- mapM (\(cns, cnsElim) -> generateEliminatorClauses cns cnsElim clauseGeneralArgs generalParams) (zip cons clauseConsElimArgs)
   let eliminatorDef = PClauses emptyFC [TotalFn] elimDeclName eliminatorClauses
-  elimLog $ "-- eliminator definition: " ++ (show . showDeclImp verbosePPOption) eliminatorDef
+  elimLog $ "-- case function definition: " ++ (show . showDeclImp verbosePPOption) eliminatorDef
   State.lift $ idrisCatch (elabDecl EAll info eliminatorTyDecl) (\err -> return ())
   -- Do not elaborate clauses if there aren't any
   case eliminatorClauses of
@@ -406,10 +475,10 @@
         elimLog s = State.lift (logLvl 2 s)
 
         elimFC :: FC
-        elimFC = fileFC "(eliminator)"
+        elimFC = fileFC "(casefun)"
 
         elimDeclName :: Name
-        elimDeclName = SN $ ElimN n
+        elimDeclName = if ind then SN . ElimN $ n else SN . CaseN $ n
 
         applyNS :: Name -> [String] -> Name
         applyNS n []  = n
@@ -560,7 +629,7 @@
           implidxs <- implicitIndexes (doc, cnm, ty, fc, fs)
           consArgs <- namePis False args
           let recArgs = findRecArgs consArgs
-          let recMotives = map applyRecMotive recArgs
+          let recMotives = if ind then map applyRecMotive recArgs else []
           let (_, consIdxs) = splitArgPms resTy
           return $ piConstr (implidxs ++ consArgs ++ recMotives) (applyMotive consIdxs (applyCons cnm consArgs))
             where applyRecMotive :: (Name, Plicity, PTerm) -> (Name, Plicity, PTerm)
@@ -600,7 +669,7 @@
           consArgs <- namePis False args
           let lhsPattern = PApp elimFC (PRef elimFC elimDeclName) (generalArgs ++ generalIdxs ++ [pexp $ applyCons cnm consArgs])
           let recArgs = findRecArgs consArgs
-          let recElims = map applyRecElim recArgs
+          let recElims = if ind then map applyRecElim recArgs else []
           let rhsExpr    = PApp elimFC (PRef elimFC cnsElim) (map convertArg implidxs ++ map convertArg consArgs ++ recElims)
           return $ PClause elimFC elimDeclName lhsPattern [] rhsExpr []
             where applyRecElim :: (Name, Plicity, PTerm) -> PArg
@@ -694,15 +763,15 @@
          -- First elaborate the expected type (and check that it's a type)
          -- The goal type for a postulate is always Type.
          (ty', typ) <- case what of
-                         ProvTerm ty p   -> elabVal toplevel False ty
-                         ProvPostulate _ -> elabVal toplevel False PType
+                         ProvTerm ty p   -> elabVal toplevel ERHS ty
+                         ProvPostulate _ -> elabVal toplevel ERHS PType
          unless (isTType typ) $
            ifail ("Expected a type, got " ++ show ty' ++ " : " ++ show typ)
 
          -- Elaborate the provider term to TT and check that the type matches
          (e, et) <- case what of
-                      ProvTerm _ tm    -> elabVal toplevel False tm
-                      ProvPostulate tm -> elabVal toplevel False tm
+                      ProvTerm _ tm    -> elabVal toplevel ERHS tm
+                      ProvPostulate tm -> elabVal toplevel ERHS tm
          unless (isProviderOf (normalise ctxt [] ty') et) $
            ifail $ "Expected provider type IO (Provider (" ++
                    show ty' ++ "))" ++ ", got " ++ show et ++ " instead."
@@ -751,7 +820,7 @@
          let lhs = addImplPat i lhs_in
          ((lhs', dlhs, []), _) <-
               tclift $ elaborate ctxt (sMN 0 "transLHS") infP []
-                       (erun fc (buildTC i info True [] (sUN "transform")
+                       (erun fc (buildTC i info ELHS [] (sUN "transform")
                                    (infTerm lhs)))
          let lhs_tm = orderPats (getInferTerm lhs')
          let lhs_ty = getInferType lhs'
@@ -764,7 +833,7 @@
               tclift $ elaborate ctxt (sMN 0 "transRHS") clhs_ty []
                        (do pbinds i lhs_tm
                            setNextName
-                           erun fc (build i info False [] (sUN "transform") rhs)
+                           erun fc (build i info ERHS [] (sUN "transform") rhs)
                            erun fc $ psolve lhs_tm
                            tt <- get_term
                            return (runState (collectDeferred Nothing tt) []))
@@ -794,19 +863,31 @@
                     _ -> ifail "Something went inexplicably wrong"
          cimp <- case lookupCtxt cn (idris_implicits i) of
                     [imps] -> return imps
-         let ptys = getProjs [] (renameBs cimp cty)
+         ppos <- case lookupCtxt tyn (idris_datatypes i) of
+                    [ti] -> return $ param_pos ti
+         let cty_imp = renameBs cimp cty
+         let ptys = getProjs [] cty_imp
          let ptys_u = getProjs [] cty
-         let recty = getRecTy cty
+         let recty = getRecTy cty_imp
+         let recty_u = getRecTy cty
 
+         let paramNames = getPNames recty ppos
+
          -- rename indices when we generate the getter/setter types, so
          -- that they don't clash with the names of the projections
          -- we're generating
-         let index_names_in = getRecNameMap "_in" recty
+         let index_names_in = getRecNameMap "_in" ppos recty
          let recty_in = substMatches index_names_in recty
 
-         logLvl 1 $ show (recty, ptys)
-         let substs = map (\ (n, _) -> (n, PApp fc (PRef fc n)
-                                                [pexp (PRef fc rec)])) ptys
+         logLvl 3 $ show (recty, recty_u, ppos, paramNames, ptys)
+         -- Substitute indices with projection functions, and parameters with
+         -- the updated parameter name
+         let substs = map (\ (n, _) -> 
+                             if n `elem` paramNames
+                                then (n, PRef fc (mkp n))
+                                else (n, PApp fc (PRef fc n)
+                                                [pexp (PRef fc rec)])) 
+                          ptys 
 
          -- Generate projection functions
          proj_decls <- mapM (mkProj recty_in substs cimp) (zip ptys [0..])
@@ -815,7 +896,7 @@
          let implBinds = getImplB id cty'
 
          -- Generate update functions
-         update_decls <- mapM (mkUpdate recty index_names_in extraImpls
+         update_decls <- mapM (mkUpdate recty_u index_names_in extraImpls
                                    (getFieldNames cty')
                                    implBinds (length nonImp)) (zip nonImp [0..])
          mapM_ (elabDecl EAll info) (concat proj_decls)
@@ -827,6 +908,14 @@
     isNonImp (PExp _ _ _ _, a) = Just a
     isNonImp _ = Nothing
 
+    getPNames (PApp _ _ as) ppos = getpn as ppos
+      where
+        getpn as [] = []
+        getpn as (i:is) | length as > i,
+                          PRef _ n <- getTm (as!!i) = n : getpn as is
+                        | otherwise = getpn as is
+    getPNames _ _ = []
+   
     tryElabDecl info (fn, ty, val)
         = do i <- getIState
              idrisCatch (do elabDecl' EAll info ty
@@ -863,15 +952,21 @@
     getRecTy (PPi _ n ty s) = getRecTy s
     getRecTy t = t
 
-    getRecNameMap x (PApp fc t args) = mapMaybe (toMN . getTm) args
+    -- make sure we pick a consistent name for parameters; any name will do
+    -- otherwise
+    getRecNameMap x ppos (PApp fc t args) 
+         = mapMaybe toMN (zip [0..] (map getTm args))
       where
-        toMN (PRef fc n) = Just (n, PRef fc (sMN 0 (show n ++ x)))
+        toMN (i, PRef fc n) 
+             | i `elem` ppos = Just (n, PRef fc (mkp n))
+             | otherwise = Just (n, PRef fc (sMN 0 (show n ++ x)))
         toMN _ = Nothing
-    getRecNameMap x _ = []
+    getRecNameMap x _ _ = []
 
     rec = sMN 0 "rec"
 
-    mkp (UN n) = sMN 0 ("p_" ++ str n)
+    -- only UNs propagate properly as parameters (bit of a hack then...)
+    mkp (UN n) = sUN ("_p_" ++ str n)
     mkp (MN i n) = sMN i ("p_" ++ str n)
     mkp (NS n s) = NS (mkp n) s
 
@@ -884,18 +979,19 @@
     mkType (NS n s) = NS (mkType n) s
 
     mkProj recty substs cimp ((pn_in, pty), pos)
-        = do let pn = expandNS syn pn_in
+        = do let pn = expandNS syn pn_in -- projection name
+             -- use pn_in in the indices, consistently, to avoid clash
              let pfnTy = PTy emptyDocstring [] defaultSyntax fc [] pn
                             (PPi expl rec recty
                                (substMatches substs pty))
              let pls = repeat Placeholder
              let before = pos
              let after = length substs - (pos + 1)
-             let args = take before pls ++ PRef fc (mkp pn) : take after pls
+             let args = take before pls ++ PRef fc (mkp pn_in) : take after pls
              let iargs = map implicitise (zip cimp args)
              let lhs = PApp fc (PRef fc pn)
                         [pexp (PApp fc (PRef fc cn) iargs)]
-             let rhs = PRef fc (mkp pn)
+             let rhs = PRef fc (mkp pn_in)
              let pclause = PClause fc pn lhs [] rhs []
              return [pfnTy, PClauses fc [] pn [pclause]]
 
@@ -940,68 +1036,6 @@
                   then PPi impl n' ty (implBindUp ns is t)
                   else implBindUp ns is t
 
--- FIXME: 'forcenames' is an almighty hack! Need a better way of
--- erasing non-forceable things
--- ^^^
--- TODO: the above is a comment from the past;
--- forcenames is probably no longer needed
-elabCon :: ElabInfo -> SyntaxInfo -> Name -> Bool ->
-           (Docstring, [(Name, Docstring)], Name, PTerm, FC, [Name]) -> Idris (Name, Type)
-elabCon info syn tn codata (doc, argDocs, n, t_in, fc, forcenames)
-    = do checkUndefined fc n
-         ctxt <- getContext
-         i <- getIState
-         t_in <- implicit info syn n (if codata then mkLazy t_in else t_in)
-         let t = addImpl i t_in
-         logLvl 2 $ show fc ++ ":Constructor " ++ show n ++ " : " ++ show t
-         let inacc = inaccessibleArgs 0 t
-         logLvl 5 $ "Inaccessible args: " ++ show inacc
-         ((t', defer, is), log) <-
-              tclift $ elaborate ctxt n (TType (UVal 0)) []
-                       (errAt "constructor " n (erun fc (build i info False [] n t)))
-         logLvl 2 $ "Rechecking " ++ show t'
-         def' <- checkDef fc defer
-         let def'' = map (\(n, (i, top, t)) -> (n, (i, top, t, True))) def'
-         addDeferred def''
-         mapM_ (elabCaseBlock info []) is
-         ctxt <- getContext
-         (cty, _)  <- recheckC fc [] t'
-         let cty' = normaliseC ctxt [] cty
-         tyIs cty'
-         logLvl 2 $ "---> " ++ show n ++ " : " ++ show cty'
-         addIBC (IBCDef n)
-         checkDocs fc argDocs t_in
-         addDocStr n doc argDocs
-         addIBC (IBCDoc n)
-         fputState (opt_inaccessible . ist_optimisation n) inacc
-         addIBC (IBCOpt n)
-         return (n, cty')
-  where
-    tyIs (Bind n b sc) = tyIs sc
-    tyIs t | (P _ n' _, _) <- unApply t
-        = if n' /= tn then tclift $ tfail (At fc (Msg (show n' ++ " is not " ++ show tn)))
-             else return ()
-    tyIs t = tclift $ tfail (At fc (Msg (show t ++ " is not " ++ show tn)))
-
-    mkLazy (PPi pl n ty sc) 
-        = let ty' = if getTyName ty
-                       then PApp fc (PRef fc (sUN "Lazy'"))
-                            [pexp (PRef fc (sUN "LazyCodata")),
-                             pexp ty]
-                       else ty in
-              PPi pl n ty' (mkLazy sc)
-    mkLazy t = t
-
-    getTyName (PApp _ (PRef _ n) _) = n == nsroot tn
-    getTyName (PRef _ n) = n == nsroot tn
-    getTyName _ = False
-
-
-    getNamePos :: Int -> PTerm -> Name -> Maybe Int
-    getNamePos i (PPi _ n _ sc) x | n == x = Just i
-                                  | otherwise = getNamePos (i + 1) sc x
-    getNamePos _ _ _ = Nothing
-
 -- | Elaborate a collection of left-hand and right-hand pairs - that is, a
 -- top-level definition.
 elabClauses :: ElabInfo -> FC -> FnOpts -> Name -> [PClause] -> Idris ()
@@ -1076,8 +1110,9 @@
                 Just _ -> logLvl 5 $ "Partially evaluated:\n" ++ show pats
                 _ -> return ()
 
+           erInfo <- getErasureInfo <$> getIState
            tree@(CaseDef scargs sc _) <- tclift $
-                   simpleCase tcase False reflect CompileTime fc inacc atys pdef
+                   simpleCase tcase False reflect CompileTime fc inacc atys pdef erInfo
            cov <- coverage
            pmissing <-
                    if cov && not (hasDefault cs)
@@ -1126,7 +1161,7 @@
            let knowncovering = (pcover && cov) || AssertTotal `elem` opts
 
            tree' <- tclift $ simpleCase tcase knowncovering reflect
-                                        RunTime fc inacc atys pdef'
+                                        RunTime fc inacc atys pdef' erInfo
            logLvl 3 $ "Unoptimised " ++ show n ++ ": " ++ show tree
            logLvl 3 $ "Optimised: " ++ show tree'
            ctxt <- getContext
@@ -1136,7 +1171,7 @@
                                                 (idris_patdefs ist) })
            let caseInfo = CaseInfo (inlinable opts) (dictionary opts)
            case lookupTy n ctxt of
-               [ty] -> do updateContext (addCasedef n caseInfo
+               [ty] -> do updateContext (addCasedef n erInfo caseInfo
                                                        tcase knowncovering
                                                        reflect
                                                        (AssertTotal `elem` opts)
@@ -1230,7 +1265,7 @@
                 Nothing -> pats
                 Just ns -> partial_eval (tt_ctxt ist) ns pats
 
--- Find 'static' applications in a term and partially evaluate them
+-- | Find 'static' applications in a term and partially evaluate them
 elabPE :: ElabInfo -> FC -> Name -> Term -> Idris ()
 elabPE info fc caller r =
   do ist <- getIState
@@ -1301,6 +1336,7 @@
 --                             (normalise (tt_ctxt ist) [] (specType args ty))
               _ -> error "Can't happen (getSpecTy)"
 
+    -- get the clause of a specialised application
     getSpecClause ist (n, args)
        = let newnm = sUN ("__"++show (nsroot n) ++ "_" ++ 
                                showSep "_" (map showArg args)) in 
@@ -1313,7 +1349,7 @@
 
 -- Elaborate a value, returning any new bindings created (this will only
 -- happen if elaborating as a pattern clause)
-elabValBind :: ElabInfo -> Bool -> Bool -> PTerm -> Idris (Term, Type, [(Name, Type)])
+elabValBind :: ElabInfo -> ElabMode -> Bool -> PTerm -> Idris (Term, Type, [(Name, Type)])
 elabValBind info aspat norm tm_in
    = do ctxt <- getContext
         i <- getIState
@@ -1347,7 +1383,7 @@
 
         return (vtm, vty, bargs)
 
-elabVal :: ElabInfo -> Bool -> PTerm -> Idris (Term, Type)
+elabVal :: ElabInfo -> ElabMode -> PTerm -> Idris (Term, Type)
 elabVal info aspat tm_in
    = do (tm, ty, _) <- elabValBind info aspat False tm_in
         return (tm, ty)
@@ -1362,7 +1398,7 @@
         let lhs = addImplPat i lhs_in
         -- if the LHS type checks, it is possible
         case elaborate ctxt (sMN 0 "patLHS") infP []
-                            (erun fc (buildTC i info True [] fname (infTerm lhs))) of
+                            (erun fc (buildTC i info ELHS [] fname (infTerm lhs))) of
             OK ((lhs', _, _), _) ->
                do let lhs_tm = orderPats (getInferTerm lhs')
                   case recheck ctxt [] (forget lhs_tm) lhs_tm of
@@ -1416,7 +1452,8 @@
                     | otherwise = False -- name is different, unrecoverable
 
 getFixedInType i env (PExp _ _ _ _ : is) (Bind n (Pi t) sc)
-    = getFixedInType i (n : env) is (instantiate (P Bound n t) sc)
+    = nub $ getFixedInType i env [] t ++
+            getFixedInType i (n : env) is (instantiate (P Bound n t) sc)
 getFixedInType i env (_ : is) (Bind n (Pi t) sc)
     = getFixedInType i (n : env) is (instantiate (P Bound n t) sc)
 getFixedInType i env is tm@(App f a)
@@ -1463,8 +1500,8 @@
                           _ -> paramNames args env ps
    | otherwise = paramNames args env ps
 
-propagateParams :: [Name] -> Type -> PTerm -> PTerm
-propagateParams ps t tm@(PApp _ (PRef fc n) args)
+propagateParams :: IState -> [Name] -> Type -> PTerm -> PTerm
+propagateParams i ps t tm@(PApp _ (PRef fc n) args)
      = PApp fc (PRef fc n) (addP t args)
    where addP (Bind n _ sc) (t : ts)
               | Placeholder <- getTm t,
@@ -1473,9 +1510,15 @@
                     = t { getTm = PRef fc n } : addP sc ts
          addP (Bind n _ sc) (t : ts) = t : addP sc ts
          addP _ ts = ts
-propagateParams ps t (PRef fc n)
-     = PApp fc (PRef fc n) (map (\x -> pimp x (PRef fc x) True) ps)
-propagateParams ps t x = x
+propagateParams i ps t (PRef fc n)
+     = case lookupCtxt n (idris_implicits i) of
+            [is] -> let ps' = filter (isImplicit is) ps in
+                        PApp fc (PRef fc n) (map (\x -> pimp x (PRef fc x) True) ps')
+            _ -> PRef fc n
+    where isImplicit [] n = False
+          isImplicit (PImp _ _ _ x _ : is) n | x == n = True
+          isImplicit (_ : is) n = isImplicit is n
+propagateParams i ps t x = x
 
 -- Return the elaborated LHS/RHS, and the original LHS with implicits added
 elabClause :: ElabInfo -> FnOpts -> (Int, PClause) ->
@@ -1507,7 +1550,7 @@
                          _ -> []
         let params = getParamsInType i [] fn_is fn_ty
         let lhs = mkLHSapp $ stripUnmatchable i $
-                    propagateParams params fn_ty (addImplPat i (stripLinear i lhs_in))
+                    propagateParams i params fn_ty (addImplPat i (stripLinear i lhs_in))
         logLvl 5 ("LHS: " ++ show fc ++ " " ++ showTmImpls lhs)
         logLvl 4 ("Fixed parameters: " ++ show params ++ " from " ++ show lhs_in ++
                   "\n" ++ show (fn_ty, fn_is))
@@ -1515,7 +1558,7 @@
         (((lhs', dlhs, []), probs, inj), _) <-
             tclift $ elaborate ctxt (sMN 0 "patLHS") infP []
                      (do res <- errAt "left hand side of " fname
-                                  (erun fc (buildTC i info True opts fname (infTerm lhs)))
+                                  (erun fc (buildTC i info ELHS opts fname (infTerm lhs)))
                          probs <- get_probs
                          inj <- get_inj
                          return (res, probs, inj))
@@ -1573,7 +1616,7 @@
                         mapM_ setinj (nub (params ++ inj))
                         setNextName 
                         (_, _, is) <- errAt "right hand side of " fname
-                                         (erun fc (build i winfo False opts fname rhs))
+                                         (erun fc (build i winfo ERHS opts fname rhs))
                         errAt "right hand side of " fname
                               (erun fc $ psolve lhs_tm)
                         hs <- get_holes
@@ -1702,19 +1745,19 @@
                          [t] -> t
                          _ -> []
         let params = getParamsInType i [] fn_is fn_ty
-        let lhs = propagateParams params fn_ty (addImplPat i (stripLinear i lhs_in))
+        let lhs = propagateParams i params fn_ty (addImplPat i (stripLinear i lhs_in))
         logLvl 2 ("LHS: " ++ show lhs)
         ((lhs', dlhs, []), _) <-
             tclift $ elaborate ctxt (sMN 0 "patLHS") infP []
               (errAt "left hand side of with in " fname
-                (erun fc (buildTC i info True opts fname (infTerm lhs))) )
+                (erun fc (buildTC i info ELHS opts fname (infTerm lhs))) )
         let lhs_tm = orderPats (getInferTerm lhs')
         let lhs_ty = getInferType lhs'
-        let ret_ty = getRetTy lhs_ty
+        let ret_ty = getRetTy (explicitNames (normalise ctxt [] lhs_ty))
         logLvl 3 (show lhs_tm)
         (clhs, clhsty) <- recheckC fc [] lhs_tm
         logLvl 5 ("Checked " ++ show clhs)
-        let bargs = getPBtys lhs_tm
+        let bargs = getPBtys (explicitNames (normalise ctxt [] lhs_tm))
         let wval = addImplBound i (map fst bargs) wval_in
         logLvl 5 ("Checking " ++ showTmImpls wval)
         -- Elaborate wval in this context
@@ -1725,7 +1768,7 @@
                             setNextName
                             -- TODO: may want where here - see winfo abpve
                             (_', d, is) <- errAt "with value in " fname
-                              (erun fc (build i info False opts fname (infTerm wval)))
+                              (erun fc (build i info ERHS opts fname (infTerm wval)))
                             erun fc $ psolve lhs_tm
                             tt <- get_term
                             return (tt, d, is))
@@ -1735,8 +1778,8 @@
         mapM_ (elabCaseBlock info opts) is
         logLvl 5 ("Checked wval " ++ show wval')
         (cwval, cwvalty) <- recheckC fc [] (getInferTerm wval')
-        let cwvaltyN = explicitNames cwvalty
-        let cwvalN = explicitNames cwval
+        let cwvaltyN = explicitNames (normalise ctxt [] cwvalty)
+        let cwvalN = explicitNames (normalise ctxt [] cwval)
         logLvl 5 ("With type " ++ show cwvalty ++ "\nRet type " ++ show ret_ty)
         let pvars = map fst (getPBtys cwvalty)
         -- we need the unelaborated term to get the names it depends on
@@ -1751,12 +1794,12 @@
         -- (ps : Xs) -> (withval : cwvalty) -> (ps' : Xs') -> ret_ty
         let wargval = getRetTy cwvalN
         let wargtype = getRetTy cwvaltyN
-        logLvl 5 ("Abstract over " ++ show wargval)
+        logLvl 5 ("Abstract over " ++ show wargval ++ " in " ++ show wargtype)
         let wtype = bindTyArgs Pi (bargs_pre ++
                      (sMN 0 "warg", wargtype) :
                      map (abstract (sMN 0 "warg") wargval wargtype) bargs_post)
                      (substTerm wargval (P Bound (sMN 0 "warg") wargtype) ret_ty)
-        logLvl 3 ("New function type " ++ show wtype)
+        logLvl 5 ("New function type " ++ show wtype)
         let wname = sMN windex (show fname)
 
         let imps = getImps wtype -- add to implicits context
@@ -1788,7 +1831,7 @@
            tclift $ elaborate ctxt (sMN 0 "wpatRHS") clhsty []
                     (do pbinds i lhs_tm
                         setNextName
-                        (_, d, is) <- erun fc (build i info False opts fname rhs)
+                        (_, d, is) <- erun fc (build i info ERHS opts fname rhs)
                         psolve lhs_tm
                         tt <- get_term
                         return (tt, d, is))
@@ -1815,7 +1858,7 @@
              logLvl 2 ("Matching " ++ showTmImpls tm ++ " against " ++
                                       showTmImpls toplhs)
              case matchClause i toplhs tm of
-                Left (a,b) -> trace ("matchClause: " ++ show a ++ " =/= " ++ show b) (ifail $ show fc ++ ":with clause does not match top level")
+                Left (a,b) -> ifail $ 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
@@ -1865,11 +1908,14 @@
 elabClass :: ElabInfo -> SyntaxInfo -> Docstring ->
              FC -> [PTerm] ->
              Name -> [(Name, PTerm)] -> [(Name, Docstring)] -> [PDecl] -> Idris ()
-elabClass info syn doc fc constraints tn ps pDocs ds
+elabClass info syn_in doc fc constraints tn ps pDocs ds
     = do let cn = SN (InstanceCtorN tn) -- sUN ("instance" ++ show tn) -- MN 0 ("instance" ++ show tn)
          let tty = pibind ps PType
          let constraint = PApp fc (PRef fc tn)
                                   (map (pexp . PRef fc) (map fst ps))
+
+         let syn = syn_in { using = addToUsing (using syn_in) ps }
+
          -- build data declaration
          let mdecls = filter tydecl ds -- method declarations
          let idecls = filter instdecl ds -- default superclass instance declarations
@@ -1895,12 +1941,12 @@
          elabData info (syn { no_imp = no_imp syn ++ mnames }) doc pDocs fc [] ddecl
          -- for each constraint, build a top level function to chase it
          logLvl 5 $ "Building functions"
-         let usyn = syn { using = map (\ (x,y) -> UImplicit x y) ps
-                                      ++ using syn }
-         fns <- mapM (cfun cn constraint usyn (map fst imethods)) constraints
+--          let usyn = syn { using = map (\ (x,y) -> UImplicit x y) ps
+--                                       ++ using syn }
+         fns <- mapM (cfun cn constraint syn (map fst imethods)) constraints
          mapM_ (elabDecl EAll info) (concat fns)
          -- for each method, build a top level function
-         fns <- mapM (tfun cn constraint usyn (map fst imethods)) imethods
+         fns <- mapM (tfun cn constraint syn (map fst imethods)) imethods
          mapM_ (elabDecl EAll info) (concat fns)
          -- add the default definitions
          mapM_ (elabDecl EAll info) (concat (map (snd.snd) defs))
@@ -2145,7 +2191,7 @@
              ctxt <- getContext
              ((tyT, _, _), _) <-
                    tclift $ elaborate ctxt iname (TType (UVal 0)) []
-                            (errAt "type of " iname (erun fc (build i info False [] iname ty)))
+                            (errAt "type of " iname (erun fc (build i info ERHS [] iname ty)))
              ctxt <- getContext
              (cty, _) <- recheckC fc [] tyT
              let nty = normalise ctxt [] cty
@@ -2353,7 +2399,7 @@
          -- Do totality checking after entire mutual block
          i <- get
          mapM_ (\n -> do logLvl 5 $ "Simplifying " ++ show n
-                         updateContext (simplifyCasedef n))
+                         updateContext (simplifyCasedef n $ getErasureInfo i))
                  (map snd (idris_totcheck i))
          mapM_ buildSCG (idris_totcheck i)
          mapM_ checkDeclTotality (idris_totcheck i)
diff --git a/src/Idris/ElabQuasiquote.hs b/src/Idris/ElabQuasiquote.hs
new file mode 100644
--- /dev/null
+++ b/src/Idris/ElabQuasiquote.hs
@@ -0,0 +1,171 @@
+module Idris.ElabQuasiquote (extractUnquotes) where
+
+import Idris.Core.Elaborate hiding (Tactic(..))
+import Idris.Core.TT
+import Idris.AbsSyntax
+
+
+extract1 :: (PTerm -> a) -> PTerm -> Elab' aux (a, [(Name, PTerm)])
+extract1 c tm = do (tm', ex) <- extractUnquotes tm
+                   return (c tm', ex)
+
+extract2 :: (PTerm -> PTerm -> a) -> PTerm -> PTerm -> Elab' aux (a, [(Name, PTerm)])
+extract2 c a b = do (a', ex1) <- extractUnquotes a
+                    (b', ex2) <- extractUnquotes b
+                    return (c a' b', ex1 ++ ex2)
+
+extractTUnquotes :: PTactic -> Elab' aux (PTactic, [(Name, PTerm)])
+extractTUnquotes (Rewrite t) = extract1 Rewrite t
+extractTUnquotes (Induction t) = extract1 Induction t
+extractTUnquotes (LetTac n t) = extract1 (LetTac n) t
+extractTUnquotes (LetTacTy n t1 t2) = extract2 (LetTacTy n) t1 t2
+extractTUnquotes (Exact tm) = extract1 Exact tm
+extractTUnquotes (Try tac1 tac2)
+  = do (tac1', ex1) <- extractTUnquotes tac1
+       (tac2', ex2) <- extractTUnquotes tac2
+       return (Try tac1' tac2', ex1 ++ ex2)
+extractTUnquotes (TSeq tac1 tac2)
+  = do (tac1', ex1) <- extractTUnquotes tac1
+       (tac2', ex2) <- extractTUnquotes tac2
+       return (TSeq tac1' tac2', ex1 ++ ex2)
+extractTUnquotes (ApplyTactic t) = extract1 ApplyTactic t
+extractTUnquotes (ByReflection t) = extract1 ByReflection t
+extractTUnquotes (Reflect t) = extract1 Reflect t
+extractTUnquotes (GoalType s tac)
+  = do (tac', ex) <- extractTUnquotes tac
+       return (GoalType s tac', ex)
+extractTUnquotes (TCheck t) = extract1 TCheck t
+extractTUnquotes (TEval t) = extract1 TEval t
+extractTUnquotes tac = return (tac, []) -- the rest don't contain PTerms
+
+extractPArgUnquotes :: PArg -> Elab' aux (PArg, [(Name, PTerm)])
+extractPArgUnquotes (PImp p m opts n t) =
+  do (t', ex) <- extractUnquotes t
+     return (PImp p m opts n t', ex)
+extractPArgUnquotes (PExp p opts n t) =
+  do (t', ex) <- extractUnquotes t
+     return (PExp p opts n t', ex)
+extractPArgUnquotes (PConstraint p opts n t) =
+  do (t', ex) <- extractUnquotes t
+     return (PConstraint p opts n t', ex)
+extractPArgUnquotes (PTacImplicit p opts n scpt t) =
+  do (scpt', ex1) <- extractUnquotes scpt
+     (t', ex2) <- extractUnquotes t
+     return (PTacImplicit p opts n scpt' t', ex1 ++ ex2)
+
+extractDoUnquotes :: PDo -> Elab' aux (PDo, [(Name, PTerm)])
+extractDoUnquotes (DoExp fc tm)
+  = do (tm', ex) <- extractUnquotes tm
+       return (DoExp fc tm', ex)
+extractDoUnquotes (DoBind fc n tm)
+  = do (tm', ex) <- extractUnquotes tm
+       return (DoBind fc n tm', ex)
+extractDoUnquotes (DoBindP fc t t' alts)
+  = fail "Pattern-matching binds cannot be quasiquoted"
+extractDoUnquotes (DoLet  fc n v b)
+  = do (v', ex1) <- extractUnquotes v
+       (b', ex2) <- extractUnquotes b
+       return (DoLet fc n v' b', ex1 ++ ex2)
+extractDoUnquotes (DoLetP fc t t') = fail "Pattern-matching lets cannot be quasiquoted"
+
+
+extractUnquotes :: PTerm -> Elab' aux (PTerm, [(Name, PTerm)])
+extractUnquotes (PLam n ty body)
+  = do (ty', ex1) <- extractUnquotes ty
+       (body', ex2) <- extractUnquotes body
+       return (PLam n ty' body', ex1 ++ ex2)
+extractUnquotes (PPi  plicity n ty body)
+  = do (ty', ex1) <- extractUnquotes ty
+       (body', ex2) <- extractUnquotes body
+       return (PPi plicity n ty' body', ex1 ++ ex2)
+extractUnquotes (PLet n ty val body)
+  = do (ty', ex1) <- extractUnquotes ty
+       (val', ex2) <- extractUnquotes val
+       (body', ex3) <- extractUnquotes body
+       return (PLet n ty' val' body', ex1 ++ ex2 ++ ex3)
+extractUnquotes (PTyped tm ty)
+  = do (tm', ex1) <- extractUnquotes tm
+       (ty', ex2) <- extractUnquotes ty
+       return (PTyped tm' ty', ex1 ++ ex2)
+extractUnquotes (PApp fc f args)
+  = do (f', ex1) <- extractUnquotes f
+       args' <- mapM extractPArgUnquotes args
+       let (args'', exs) = unzip args'
+       return (PApp fc f' args'', ex1 ++ concat exs)
+extractUnquotes (PAppBind fc f args)
+  = do (f', ex1) <- extractUnquotes f
+       args' <- mapM extractPArgUnquotes args
+       let (args'', exs) = unzip args'
+       return (PAppBind fc f' args'', ex1 ++ concat exs)
+extractUnquotes (PCase fc expr cases)
+  = do (expr', ex1) <- extractUnquotes expr
+       let (pats, rhss) = unzip cases
+       (pats', exs1) <- fmap unzip $ mapM extractUnquotes pats
+       (rhss', exs2) <- fmap unzip $ mapM extractUnquotes rhss
+       return (PCase fc expr' (zip pats' rhss'), ex1 ++ concat exs1 ++ concat exs2)
+extractUnquotes (PRefl fc x)
+  = do (x', ex) <- extractUnquotes x
+       return (PRefl fc x', ex)
+extractUnquotes (PEq fc at bt a b)
+  = do (at', ex1) <- extractUnquotes at
+       (bt', ex2) <- extractUnquotes bt
+       (a', ex1) <- extractUnquotes a
+       (b', ex2) <- extractUnquotes b
+       return (PEq fc at' bt' a' b', ex1 ++ ex2)
+extractUnquotes (PRewrite fc x y z)
+  = do (x', ex1) <- extractUnquotes x
+       (y', ex2) <- extractUnquotes y
+       case z of
+         Just zz -> do (z', ex3) <- extractUnquotes zz
+                       return (PRewrite fc x' y' (Just z'), ex1 ++ ex2 ++ ex3)
+         Nothing -> return (PRewrite fc x' y' Nothing, ex1 ++ ex2)
+extractUnquotes (PPair fc info l r)
+  = do (l', ex1) <- extractUnquotes l
+       (r', ex2) <- extractUnquotes r
+       return (PPair fc info l' r', ex1 ++ ex2)
+extractUnquotes (PDPair fc info a b c)
+  = do (a', ex1) <- extractUnquotes a
+       (b', ex2) <- extractUnquotes b
+       (c', ex3) <- extractUnquotes c
+       return (PDPair fc info a' b' c', ex1 ++ ex2 ++ ex3)
+extractUnquotes (PAlternative b alts)
+  = do alts' <- mapM extractUnquotes alts
+       let (alts'', exs) = unzip alts'
+       return (PAlternative b alts'', concat exs)
+extractUnquotes (PHidden tm)
+  = do (tm', ex) <- extractUnquotes tm
+       return (PHidden tm', ex)
+extractUnquotes (PGoal fc a n b)
+  = do (a', ex1) <- extractUnquotes a
+       (b', ex2) <- extractUnquotes b
+       return (PGoal fc a' n b', ex1 ++ ex2)
+extractUnquotes (PDoBlock steps)
+  = do steps' <- mapM extractDoUnquotes steps
+       let (steps'', exs) = unzip steps'
+       return (PDoBlock steps'', concat exs)
+extractUnquotes (PIdiom fc tm)
+  = fmap (\(tm', ex) -> (PIdiom fc tm', ex)) $ extractUnquotes tm
+extractUnquotes (PProof tacs)
+  = do (tacs', exs) <- fmap unzip $ mapM extractTUnquotes tacs
+       return (PProof tacs', concat exs)
+extractUnquotes (PTactics tacs)
+  = do (tacs', exs) <- fmap unzip $ mapM extractTUnquotes tacs
+       return (PTactics tacs', concat exs)
+extractUnquotes (PElabError err) = fail "Can't quasiquote an error"
+extractUnquotes (PCoerced tm)
+  = do (tm', ex) <- extractUnquotes tm
+       return (PCoerced tm', ex)
+extractUnquotes (PDisamb ns tm)
+  = do (tm', ex) <- extractUnquotes tm
+       return (PDisamb ns tm', ex)
+extractUnquotes (PUnifyLog tm)
+  = fmap (\(tm', ex) -> (PUnifyLog tm', ex)) $ extractUnquotes tm
+extractUnquotes (PNoImplicits tm)
+  = fmap (\(tm', ex) -> (PNoImplicits tm', ex)) $ extractUnquotes tm
+extractUnquotes (PQuasiquote _ _) = fail "Nested quasiquotes not supported"
+extractUnquotes (PUnquote tm) =
+  do n <- getNameFrom (sMN 0 "unquotation")
+     return (PRef (fileFC "(unquote)") n, [(n, tm)])
+extractUnquotes x = return (x, []) -- no subterms!
+
+
diff --git a/src/Idris/ElabTerm.hs b/src/Idris/ElabTerm.hs
--- a/src/Idris/ElabTerm.hs
+++ b/src/Idris/ElabTerm.hs
@@ -14,8 +14,9 @@
 import Idris.Core.TT
 import Idris.Core.Evaluate
 import Idris.Core.Unify
-import Idris.Core.Typecheck (check)
+import Idris.Core.Typecheck (check, recheck)
 import Idris.ErrReverse (errReverse)
+import Idris.ElabQuasiquote (extractUnquotes)
 
 import Control.Applicative ((<$>))
 import Control.Monad
@@ -28,6 +29,9 @@
 
 import Debug.Trace
 
+data ElabMode = ETyDecl | ELHS | ERHS
+  deriving Eq
+
 -- Using the elaborator, convert a term in raw syntax to a fully
 -- elaborated, typechecked term.
 --
@@ -36,10 +40,10 @@
 
 -- Also find deferred names in the term and their types
 
-build :: IState -> ElabInfo -> Bool -> FnOpts -> Name -> PTerm ->
+build :: IState -> ElabInfo -> ElabMode -> FnOpts -> Name -> PTerm ->
          ElabD (Term, [(Name, (Int, Maybe Name, Type))], [PDecl])
-build ist info pattern opts fn tm
-    = do elab ist info pattern opts fn tm
+build ist info emode opts fn tm
+    = do elab ist info emode opts fn tm
          let tmIn = tm
          let inf = case lookupCtxt fn (idris_tyinfodata ist) of
                         [TIPartial] -> True
@@ -79,20 +83,32 @@
             ((_,_,_,e,_,_):es) -> traceWhen u ("Final problems:\n" ++ show probs) $
                                    if inf then return ()
                                           else lift (Error e)
+
+         when tydecl (do update_term orderPats
+                         mkPat)
+--                          update_term liftPats)
          is <- getAux
          tt <- get_term
          let (tm, ds) = runState (collectDeferred (Just fn) tt) []
          log <- getLog
          if (log /= "") then trace log $ return (tm, ds, is)
             else return (tm, ds, is)
+  where pattern = emode == ELHS
+        tydecl = emode == ETyDecl
+    
+        mkPat = do hs <- get_holes
+                   tm <- get_term
+                   case hs of
+                      (h: hs) -> do patvar h; mkPat
+                      [] -> return ()
 
 -- Build a term autogenerated as a typeclass method definition
 -- (Separate, so we don't go overboard resolving things that we don't
 -- know about yet on the LHS of a pattern def)
 
-buildTC :: IState -> ElabInfo -> Bool -> FnOpts -> Name -> PTerm ->
+buildTC :: IState -> ElabInfo -> ElabMode -> FnOpts -> Name -> PTerm ->
          ElabD (Term, [(Name, (Int, Maybe Name, Type))], [PDecl])
-buildTC ist info pattern opts fn tm
+buildTC ist info emode opts fn tm
     = do -- set name supply to begin after highest index in tm
          let ns = allNamesIn tm
          let tmIn = tm
@@ -100,7 +116,7 @@
                         [TIPartial] -> True
                         _ -> False
          initNextNameFrom ns
-         elab ist info pattern opts fn tm
+         elab ist info emode opts fn tm
          probs <- get_probs
          tm <- get_term
          case probs of
@@ -113,17 +129,18 @@
          log <- getLog
          if (log /= "") then trace log $ return (tm, ds, is)
             else return (tm, ds, is)
+  where pattern = emode == ELHS
 
 -- Returns the set of declarations we need to add to complete the definition
 -- (most likely case blocks to elaborate)
 
-elab :: IState -> ElabInfo -> Bool -> FnOpts -> Name -> PTerm ->
+elab :: IState -> ElabInfo -> ElabMode -> FnOpts -> Name -> PTerm ->
         ElabD ()
-elab ist info pattern opts fn tm
+elab ist info emode opts fn tm
     = do let loglvl = opt_logLevel (idris_options ist)
          when (loglvl > 5) $ unifyLog True
          compute -- expand type synonyms, etc
-         elabE (False, False, False) tm -- (in argument, guarded, in type)
+         elabE (False, False, False, False) tm -- (in argument, guarded, in type, in qquote)
          end_unify
          when pattern -- convert remaining holes to pattern vars
               (do update_term orderPats
@@ -132,12 +149,15 @@
                   unifyProblems
                   mkPat)
   where
+    pattern = emode == ELHS
+    bindfree = emode == ETyDecl || emode == ELHS
+
     tcgen = Dictionary `elem` opts
-    reflect = Reflection `elem` opts
+    reflection = Reflection `elem` opts
 
     isph arg = case getTm arg of
         Placeholder -> (True, priority arg)
-        _ -> (False, priority arg)
+        tm -> (False, priority arg)
 
     toElab ina arg = case getTm arg of
         Placeholder -> Nothing
@@ -153,8 +173,12 @@
                   (h: hs) -> do patvar h; mkPat
                   [] -> return ()
 
-    elabE :: (Bool, Bool, Bool) -> PTerm -> ElabD ()
-    elabE ina t = 
+    -- | elabE elaborates an expression, possibly wrapping implicit coercions
+    -- and forces/delays.  If you make a recursive call in elab', it is
+    -- normally correct to call elabE - the ones that don't are desugarings
+    -- typically
+    elabE :: (Bool, Bool, Bool, Bool) -> PTerm -> ElabD ()
+    elabE ina t =
                --do g <- goal
                   --trace ("Elaborating " ++ show t ++ " : " ++ show g) $
                   do ct <- insertCoerce ina t
@@ -203,13 +227,15 @@
     constType VoidType = True
     constType _ = False
 
-    elab' :: (Bool, Bool, Bool)  -- ^ (in an argument, guarded, in a type)
+    -- "guarded" means immediately under a constructor, to help find patvars
+
+    elab' :: (Bool, Bool, Bool, Bool)  -- ^ (in an argument, guarded, in a type, in a quasiquote)
           -> PTerm -- ^ The term to elaborate
           -> ElabD ()
     elab' ina (PNoImplicits t) = elab' ina t -- skip elabE step
     elab' ina PType           = do apply RType []; solve
 --  elab' (_,_,inty) (PConstant c) 
---     | constType c && pattern && not reflect && not inty
+--     | constType c && pattern && not reflection && not inty
 --       = lift $ tfail (Msg "Typecase is not allowed") 
     elab' ina (PConstant c)  = do apply (RConstant c) []; solve
     elab' ina (PQuote r)     = do fill r; solve
@@ -219,29 +245,44 @@
     elab' ina (PResolveTC (FC "HACK" _ _)) -- for chasing parent classes
        = do g <- goal; resolveTC 5 g fn ist
     elab' ina (PResolveTC fc)
-        | True = do c <- getNameFrom (sMN 0 "class")
-                    instanceArg c
-        | otherwise = do g <- goal
-                         try (resolveTC 2 g fn ist)
-                          (do c <- getNameFrom (sMN 0 "class")
-                              instanceArg c)
+        = do c <- getNameFrom (sMN 0 "class")
+             instanceArg c
     elab' ina (PRefl fc t)
         = elab' ina (PApp fc (PRef fc eqCon) [pimp (sMN 0 "A") Placeholder True,
                                               pimp (sMN 0 "x") t False])
-    elab' ina (PEq fc l r)   = elab' ina (PApp fc (PRef fc eqTy)
-                                    [pimp (sMN 0 "A") Placeholder True,
-                                     pimp (sMN 0 "B") Placeholder False,
+    elab' ina (PEq fc Placeholder Placeholder l r)
+       = try (do tyn <- getNameFrom (sMN 0 "aqty")
+                 claim tyn RType
+                 movelast tyn
+                 elab' ina (PApp fc (PRef fc eqTy)
+                              [pimp (sUN "A") (PRef fc tyn) True,
+                               pimp (sUN "B") (PRef fc tyn) False,
+                               pexp l, pexp r]))
+             (do atyn <- getNameFrom (sMN 0 "aqty")
+                 btyn <- getNameFrom (sMN 0 "bqty")
+                 claim atyn RType
+                 movelast atyn
+                 claim btyn RType
+                 movelast btyn
+                 elab' ina (PApp fc (PRef fc eqTy)
+                              [pimp (sUN "A") (PRef fc atyn) True,
+                               pimp (sUN "B") (PRef fc btyn) False,
+                               pexp l, pexp r]))
+
+    elab' ina (PEq fc lt rt l r) = elab' ina (PApp fc (PRef fc eqTy)
+                                    [pimp (sUN "A") lt True,
+                                     pimp (sUN "B") rt False,
                                      pexp l, pexp r])
-    elab' ina@(_, a, inty) (PPair fc _ l r)
+    elab' ina@(_, a, inty, qq) (PPair fc _ l r)
         = do hnf_compute
              g <- goal
              case g of
-                TType _ -> elabE (True, a,inty) (PApp fc (PRef fc pairTy)
-                                                  [pexp l,pexp r])
-                _ -> elabE (True, a, inty) (PApp fc (PRef fc pairCon)
-                                            [pimp (sMN 0 "A") Placeholder True,
-                                             pimp (sMN 0 "B") Placeholder True,
-                                             pexp l, pexp r])
+                TType _ -> elabE (True, a,inty, qq) (PApp fc (PRef fc pairTy)
+                                                      [pexp l,pexp r])
+                _ -> elabE (True, a, inty, qq) (PApp fc (PRef fc pairCon)
+                                                [pimp (sMN 0 "A") Placeholder True,
+                                                 pimp (sMN 0 "B") Placeholder True,
+                                                 pexp l, pexp r])
     elab' ina (PDPair fc p l@(PRef _ n) t r)
             = case t of
                 Placeholder ->
@@ -283,28 +324,32 @@
               trySeq' deferr [] = proofFail deferr
               trySeq' deferr (x : xs)
                   = try' (elab' ina x) (trySeq' deferr xs) True
-    elab' ina (PPatvar fc n) | pattern = patvar n
+    elab' ina (PPatvar fc n) | bindfree = do patvar n; -- update_term liftPats
 --    elab' (_, _, inty) (PRef fc f)
---       | isTConName f (tt_ctxt ist) && pattern && not reflect && not inty
---          = lift $ tfail (Msg "Typecase is not allowed") 
-    elab' (ina, guarded, inty) (PRef fc n) | pattern && not (inparamBlock n)
+--       | isTConName f (tt_ctxt ist) && pattern && not reflection && not inty
+--          = lift $ tfail (Msg "Typecase is not allowed")
+    elab' (ina, guarded, inty, qq) (PRef fc n) 
+      | (pattern || (bindfree && bindable n)) && not (inparamBlock n) && not qq
         = 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
+             if (tcname n && ina) then erun fc $ do patvar n; -- update_term liftPats
                else if (defined && not guarded)
                        then do apply (Var n) []; solve
                        else try (do apply (Var n) []; solve)
-                                (patvar n)
+                                (do patvar n; ) -- update_term liftPats)
       where inparamBlock n = case lookupCtxtName n (inblock info) of
                                 [] -> False
                                 _ -> True
+            bindable (NS _ _) = False
+            bindable (UN xs) = True
+            bindable n = implicitable n
     elab' ina f@(PInferRef fc n) = elab' ina (PApp fc f [])
     elab' ina (PRef fc n) = erun fc $ do apply (Var n) []; solve
-    elab' ina@(_, a, inty) (PLam n Placeholder sc)
+    elab' ina@(_, a, inty, qq) (PLam n Placeholder sc)
           = do -- if n is a type constructor name, this makes no sense...
                ctxt <- get_context
                when (isTConName n ctxt) $
@@ -312,8 +357,8 @@
                checkPiGoal n
                attack; intro (Just n);
                -- trace ("------ intro " ++ show n ++ " ---- \n" ++ show ptm)
-               elabE (True, a, inty) sc; solve
-    elab' ina@(_, a, inty) (PLam n ty sc)
+               elabE (True, a, inty, qq) sc; solve
+    elab' ina@(_, a, inty, qq) (PLam n ty sc)
           = do tyn <- getNameFrom (sMN 0 "lamty")
                -- if n is a type constructor name, this makes no sense...
                ctxt <- get_context
@@ -327,12 +372,12 @@
                hs <- get_holes
                introTy (Var tyn) (Just n)
                focus tyn
-               elabE (True, a, True) ty
-               elabE (True, a, inty) sc
+               elabE (True, a, True, qq) ty
+               elabE (True, a, inty, qq) sc
                solve
-    elab' ina@(_, a, _) (PPi _ n Placeholder sc)
-          = do attack; arg n (sMN 0 "ty"); elabE (True, a, True) sc; solve
-    elab' ina@(_, a, _) (PPi _ n ty sc)
+    elab' ina@(_, a, _, qq) (PPi _ n Placeholder sc)
+          = do attack; arg n (sMN 0 "ty"); elabE (True, a, True, qq) sc; solve
+    elab' ina@(_, a, _, qq) (PPi _ n ty sc)
           = do attack; tyn <- getNameFrom (sMN 0 "ty")
                claim tyn RType
                n' <- case n of
@@ -340,11 +385,12 @@
                         _ -> return n
                forall n' (Var tyn)
                focus tyn
-               elabE (True, a, True) ty
-               elabE (True, a, True) sc
+               elabE (True, a, True, qq) ty
+               elabE (True, a, True, qq) sc
                solve
-    elab' ina@(_, a, inty) (PLet n ty val sc)
-          = do attack;
+    elab' ina@(_, a, inty, qq) (PLet n ty val sc)
+          = do attack
+               ivs <- get_instances
                tyn <- getNameFrom (sMN 0 "letty")
                claim tyn RType
                valn <- getNameFrom (sMN 0 "letval")
@@ -355,17 +401,28 @@
                    Placeholder -> return ()
                    _ -> do focus tyn
                            explicit tyn
-                           elabE (True, a, True) ty
+                           elabE (True, a, True, qq) ty
                focus valn
-               elabE (True, a, True) val
+               elabE (True, a, True, qq) val
+               ivs' <- get_instances
+               when (not pattern) $
+                   mapM_ (\n -> do focus n
+                                   g <- goal
+                                   hs <- get_holes
+                                   if all (\n -> n == tyn || not (n `elem` hs)) (freeNames g)
+                                   -- let insts = filter tcname $ map fst (ctxtAlist (tt_ctxt ist))
+                                    then try (resolveTC 7 g fn ist)
+                                             (movelast n)
+                                    else movelast n)
+                         (ivs' \\ ivs)
                env <- get_env
-               elabE (True, a, inty) sc
+               elabE (True, a, inty, qq) sc
                -- HACK: If the name leaks into its type, it may leak out of
                -- scope outside, so substitute in the outer scope.
                expandLet n (case lookup n env of
                                  Just (Let t v) -> v)
                solve
-    elab' ina@(_, a, inty) (PGoal fc r n sc) = do
+    elab' ina@(_, a, inty, qq) (PGoal fc r n sc) = do
          rty <- goal
          attack
          tyn <- getNameFrom (sMN 0 "letty")
@@ -374,10 +431,10 @@
          claim valn (Var tyn)
          letbind n (Var tyn) (Var valn)
          focus valn
-         elabE (True, a, True) (PApp fc r [pexp (delab ist rty)])
+         elabE (True, a, True, qq) (PApp fc r [pexp (delab ist rty)])
          env <- get_env
          computeLet n
-         elabE (True, a, inty) sc
+         elabE (True, a, inty, qq) sc
          solve
 --          elab' ina (PLet n Placeholder
 --              (PApp fc r [pexp (delab ist rty)]) sc)
@@ -433,16 +490,16 @@
                              _ -> lift $ tfail (NoSuchVariable fn)
             ns <- match_apply (Var fn') (map (\x -> (x,0)) imps)
             solve
-    elab' (_, _, inty) (PApp fc (PRef _ f) args')
-       | isTConName f (tt_ctxt ist) && pattern && not reflect && not inty
+    elab' (_, _, inty, qq) (PApp fc (PRef _ f) args')
+       | isTConName f (tt_ctxt ist) && pattern && not reflection && not inty && not qq
           = lift $ tfail (Msg "Typecase is not allowed")
     -- if f is local, just do a simple_app
-    elab' (ina, g, inty) tm@(PApp fc (PRef _ f) args)
+    elab' (ina, g, inty, qq) tm@(PApp fc (PRef _ f) args)
        = do env <- get_env
             if (f `elem` map fst env && length args == 1)
                then -- simple app, as below
-                    do simple_app (elabE (ina, g, inty) (PRef fc f))
-                                  (elabE (True, g, inty) (getTm (head args)))
+                    do simple_app (elabE (ina, g, inty, qq) (PRef fc f))
+                                  (elabE (True, g, inty, qq) (getTm (head args)))
                                   (show tm)
                        solve
                else
@@ -455,7 +512,9 @@
                     -- we can unify with them
                     case lookupCtxt f (idris_classes ist) of
                         [] -> return ()
-                        _ -> mapM_ setInjective (map getTm args)
+                        _ -> do mapM_ setInjective (map getTm args)
+                                -- maybe more things are solvable now
+                                unifyProblems
                     ctxt <- get_context
                     let guarded = isConName f ctxt
 --                    trace ("args is " ++ show args) $ return ()
@@ -468,10 +527,11 @@
                     -- Sort so that the implicit tactics and alternatives go last
                     let (ns', eargs) = unzip $
                              sortBy cmpArg (zip ns args)
-                    elabArgs ist (ina || not isinf, guarded, inty)
+                    ulog <- getUnifyLog
+                    elabArgs ist (ina || not isinf, guarded, inty, qq)
                            [] fc False f ns' 
                              (f == sUN "Force")
-                             (map (\x -> (False, getTm x)) eargs) -- TODO: remove this False arg
+                             (map (\x -> getTm x) eargs) -- TODO: remove this False arg
                     solve
                     ivs' <- get_instances
                     -- Attempt to resolve any type classes which have 'complete' types,
@@ -495,16 +555,23 @@
             -- FIXME: Better would be to allow alternative resolution to be
             -- retried after more information is in.
             cmpArg (_, x) (_, y)
+                | constraint x && not (constraint y) = LT
+                | constraint y && not (constraint x) = GT
+                | otherwise
                    = compare (conDepth 0 (getTm x) + priority x + alt x) 
                              (conDepth 0 (getTm y) + priority y + alt y)
                 where alt t = case getTm t of
                                    PAlternative False _ -> 5
-                                   PAlternative True _ -> 1
+                                   PAlternative True _ -> 2
                                    PTactics _ -> 150
-                                   PLam _ _ _ -> 2
-                                   PRewrite _ _ _ _ -> 3
-                                   _ -> 0
+                                   PLam _ _ _ -> 3
+                                   PRewrite _ _ _ _ -> 4
+                                   PResolveTC _ -> 0
+                                   _ -> 1
 
+            constraint (PConstraint _ _ _ _) = True
+            constraint _ = False
+ 
             -- Score a point for every level where there is a non-constructor
             -- function (so higher score --> done later)
             -- Only relevant when on lhs
@@ -516,6 +583,7 @@
             conDepth d (PPatvar _ _) = 0
             conDepth d (PAlternative _ as) = maximum (map (conDepth d) as)
             conDepth d Placeholder = 0
+            conDepth d (PResolveTC _) = 0
             conDepth d t = max (100 - d) 1
 
             checkIfInjective n = do
@@ -528,7 +596,14 @@
                                 case lookupCtxt c (idris_classes ist) of
                                    [] -> return ()
                                    _ -> -- type class, set as injective
-                                        mapM_ setinjArg args
+                                        do mapM_ setinjArg args
+                                        -- maybe we can solve more things now...
+                                           ulog <- getUnifyLog
+                                           probs <- get_probs
+                                           traceWhen ulog ("Injective now " ++ show args ++ "\n" ++ qshow probs) $
+                                             unifyProblems
+                                           probs <- get_probs
+                                           traceWhen ulog (qshow probs) $ return ()
                             _ -> return ()
                      
             setinjArg (P _ n _) = setinj n
@@ -542,9 +617,9 @@
             setInjective (PApp _ (PRef _ n) _) = setinj n
             setInjective _ = return ()
 
-    elab' ina@(_, a, inty) tm@(PApp fc f [arg])
+    elab' ina@(_, a, inty, qq) tm@(PApp fc f [arg])
           = erun fc $
-             do simple_app (elabE ina f) (elabE (True, a, inty) (getTm arg))
+             do simple_app (elabE ina f) (elabE (True, a, inty, qq) (getTm arg))
                            (show tm)
                 solve
     elab' ina Placeholder = do (h : hs) <- get_holes
@@ -593,7 +668,7 @@
                    elab' ina sc
                    elab' ina (PRef fc letn)
                    solve
-    elab' ina@(_, a, inty) c@(PCase fc scr opts)
+    elab' ina@(_, a, inty, qq) c@(PCase fc scr opts)
         = do attack
              tyn <- getNameFrom (sMN 0 "scty")
              claim tyn RType
@@ -602,7 +677,7 @@
              claim valn (Var tyn)
              letbind scvn (Var tyn) (Var valn)
              focus valn
-             elabE (True, a, inty) scr
+             elabE (True, a, inty, qq) scr
              args <- get_env
              cname <- unique_hole' True (mkCaseName fn)
              let cname' = mkN cname
@@ -629,6 +704,85 @@
     elab' ina (PUnifyLog t) = do unifyLog True
                                  elab' ina t
                                  unifyLog False
+    elab' (ina, g, inty, qq) (PQuasiquote t goal) -- TODO: goal type
+        = do -- First extract the unquoted subterms, replacing them with fresh
+             -- names in the quasiquoted term. Claim their reflections to be
+             -- of type TT.
+             (t, unq) <- extractUnquotes t
+             let unquoteNames = map fst unq
+             mapM_ (flip claim (Var tt)) unquoteNames
+
+
+             -- Save the old state - we need a fresh proof state to avoid
+             -- capturing lexically available variables in the quoted term.
+             ctxt <- get_context
+             saveState
+             updatePS (const .
+                       newProof (sMN 0 "q") ctxt $
+                       P Ref tt Erased)
+
+             -- Re-add the unquotes, letting Idris infer the (fictional)
+             -- types. Here, they represent the real type rather than the type
+             -- of their reflection.
+             mapM_ (\n -> do ty <- getNameFrom (sMN 0 "unqTy")
+                             claim ty RType
+                             movelast ty
+                             claim n (Var ty)
+                             movelast n)
+                   unquoteNames
+
+             -- Determine whether there's an explicit goal type, and act accordingly
+             -- Establish holes for the type and value of the term to be
+             -- quasiquoted
+             qTy <- getNameFrom (sMN 0 "qquoteTy")
+             claim qTy RType
+             movelast qTy
+             qTm <- getNameFrom (sMN 0 "qquoteTm")
+             claim qTm (Var qTy)
+
+             -- Let-bind the result of elaborating the contained term, so that
+             -- the hole doesn't disappear
+             nTm <- getNameFrom (sMN 0 "quotedTerm")
+             letbind nTm (Var qTy) (Var qTm)
+
+             -- Fill out the goal type, if relevant
+             case goal of
+               Nothing  -> return ()
+               Just gTy -> do focus qTy
+                              elabE (ina, g, inty, True) gTy
+
+             -- Elaborate the quasiquoted term into the hole
+             focus qTm
+             elabE (ina, g, inty, True) t
+             end_unify
+
+             -- We now have an elaborated term. Reflect it and solve the
+             -- original goal in the original proof state.
+             env <- get_env
+             loadState
+             let quoted = fmap (explicitNames . binderVal) $ lookup nTm env
+
+             case quoted of
+               Just q -> do ctxt <- get_context
+                            (q', _, _) <- lift $ recheck ctxt [(uq, Lam Erased) | uq <- unquoteNames] (forget q) q
+                            if pattern
+                              then reflectQuotePattern unquoteNames q'
+                              else do fill $ reflectQuote unquoteNames q'
+                                      solve
+               Nothing -> lift . tfail . Msg $ "Broken elaboration of quasiquote"
+
+             -- Finally fill in the terms or patterns from the unquotes. This
+             -- happens last so that their holes still exist while elaborating
+             -- the main quotation.
+             mapM_ elabUnquote unq
+      where tt = sNS (sUN "TT") ["Reflection", "Language"]
+
+            elabUnquote (n, tm)
+                = do focus n
+                     elabE (ina, g, inty, False) tm
+
+
+    elab' ina (PUnquote t) = fail "Found unquote outside of quasiquote"
     elab' ina x = fail $ "Unelaboratable syntactic form " ++ showTmImpls x
 
     isScr :: PTerm -> (Name, Binder Term) -> (Name, (Bool, Binder Term))
@@ -687,16 +841,17 @@
         do ty <- goal
            env <- get_env
            let (tyh, _) = unApply (normalise (tt_ctxt ist) env ty)
-           let tries = if pattern then [t, mkDelay t] else [mkDelay t, t]
+           let tries = if pattern then [t, mkDelay env t] else [mkDelay env t, t]
            case tyh of
                 P _ (UN l) _ | l == txt "Lazy'"
                     -> return (PAlternative False tries)
                 _ -> return t
       where
-        mkDelay (PAlternative b xs) = PAlternative b (map mkDelay xs)
-        mkDelay t = let fc = fileFC "Delay" in
-                        addImpl ist (PApp fc (PRef fc (sUN "Delay"))
-                                          [pexp t])
+        mkDelay env (PAlternative b xs) = PAlternative b (map (mkDelay env) xs)
+        mkDelay env t 
+            = let fc = fileFC "Delay" in
+                  addImplBound ist (map fst env) (PApp fc (PRef fc (sUN "Delay"))
+                                                 [pexp t])
 
     -- case is tricky enough without implicit coercions! If they are needed,
     -- they can go in the branches separately.
@@ -712,32 +867,29 @@
                          (PCoerced tm, _) -> tm
                          (_, []) -> t
                          (_, cs) -> PAlternative False [t ,
-                                       PAlternative True (map (mkCoerce t) cs)]
+                                       PAlternative True (map (mkCoerce env t) cs)]
            return t'
        where
-         mkCoerce t n = let fc = fileFC "Coercion" in -- line never appears!
-                            addImpl ist (PApp fc (PRef fc n) [pexp (PCoerced t)])
+         mkCoerce env t n = let fc = fileFC "Coercion" in -- line never appears!
+                                addImplBound ist (map fst env)
+                                  (PApp fc (PRef fc n) [pexp (PCoerced t)])
 
     -- | Elaborate the arguments to a function
     elabArgs :: IState -- ^ The current Idris state
-             -> (Bool, Bool, Bool) -- ^ (in an argument, guarded, in a type)
+             -> (Bool, Bool, Bool, Bool) -- ^ (in an argument, guarded, in a type, in a qquote)
              -> [Bool]
              -> FC -- ^ Source location
              -> Bool
              -> Name -- ^ Name of the function being applied
              -> [(Name, Name)] -- ^ (Argument Name, Hole Name)
              -> Bool -- ^ under a 'force'
-             -> [(Bool, PTerm)] -- ^ (Laziness, argument)
+             -> [PTerm] -- ^ (Laziness, argument)
              -> ElabD ()
     elabArgs ist ina failed fc retry f [] force _ = return ()
-    elabArgs ist ina failed fc r f (n:ns) force ((_, Placeholder) : args)
+    elabArgs ist ina failed fc r f (n:ns) force (Placeholder : args)
         = elabArgs ist ina failed fc r f ns force args
-    elabArgs ist ina failed fc r f ((argName, holeName):ns) force ((lazy, t) : args)
-        | lazy && not pattern
-          = elabArg argName holeName (PApp bi (PRef bi (sUN "Delay"))
-                                           [pimp (sUN "a") Placeholder True,
-                                            pexp t])
-        | otherwise = elabArg argName holeName t
+    elabArgs ist ina failed fc r f ((argName, holeName):ns) force (t : args)
+        = do elabArg argName holeName t
       where elabArg argName holeName t =
               do now_elaborating fc f argName
                  wrapErr f argName $ do
@@ -749,7 +901,11 @@
                    failed' <- -- trace (show (n, t, hs, tm)) $
                               -- traceWhen (not (null cs)) (show ty ++ "\n" ++ showImp True t) $
                               case holeName `elem` hs of
-                                True -> do focus holeName; elab ina t; return failed
+                                True -> do focus holeName; 
+                                           g <- goal
+                                           ulog <- getUnifyLog
+                                           traceWhen ulog ("Elaborating argument " ++ show (argName, holeName, g)) $ 
+                                             elab ina t; return failed
                                 False -> return failed
                    done_elaborating_arg f argName
                    elabArgs ist ina failed fc r f ns force args
@@ -842,11 +998,11 @@
     | otherwise = []
 
 trivial' ist
-    = trivial (elab ist toplevel False [] (sMN 0 "tac")) ist
+    = trivial (elab ist toplevel ERHS [] (sMN 0 "tac")) ist
 proofSearch' ist rec depth prv top n hints
     = do unifyProblems
          proofSearch rec prv depth 
-                     (elab ist toplevel False [] (sMN 0 "tac")) top n hints ist
+                     (elab ist toplevel ERHS [] (sMN 0 "tac")) top n hints ist
 
 resolveTC :: Int -> Term -> Name -> IState -> ElabD ()
 resolveTC = resTC' [] 
@@ -920,7 +1076,8 @@
                 args <- map snd <$> try' (apply (Var n) imps)
                                          (match_apply (Var n) imps) True
                 ps' <- get_probs
-                when (length ps < length ps') $ fail "Can't apply type class"
+                when (length ps < length ps' || unrecoverable ps') $ 
+                     fail "Can't apply type class"
 --                 traceWhen (all boundVar ttypes) ("Progress: " ++ show t ++ " with " ++ show n) $
                 mapM_ (\ (_,n) -> do focus n
                                      t' <- goal
@@ -956,6 +1113,24 @@
 collectDeferred top (App f a) = liftM2 App (collectDeferred top f) (collectDeferred top a)
 collectDeferred top t = return t
 
+case_ :: Bool -> Bool -> IState -> Name -> PTerm -> ElabD ()
+case_ ind autoSolve ist fn tm = do
+  attack
+  tyn <- getNameFrom (sMN 0 "ity")
+  claim tyn RType
+  valn <- getNameFrom (sMN 0 "ival")
+  claim valn (Var tyn)
+  letn <- getNameFrom (sMN 0 "irule")
+  letbind letn (Var tyn) (Var valn)
+  focus valn
+  elab ist toplevel ERHS [] (sMN 0 "tac") tm
+  env <- get_env
+  let (Just binding) = lookup letn env
+  let val = binderVal binding
+  if ind then induction (forget val)
+         else casetac (forget val)
+  when autoSolve solveAll
+
 -- Running tactics directly
 -- if a tactic adds unification problems, return an error
 
@@ -963,9 +1138,10 @@
 runTac autoSolve ist fn tac 
     = do env <- get_env
          g <- goal
+         let tac' = fmap (addImplBound ist (map fst env)) tac
          if autoSolve 
-            then runT (fmap (addImplBound ist (map fst env)) tac)
-            else no_errors (runT (fmap (addImplBound ist (map fst env)) tac))
+            then runT tac'
+            else no_errors (runT tac')
                    (Just (CantSolveGoal g (map (\(n, b) -> (n, binderTy b)) env)))
   where
     runT (Intro []) = do g <- goal
@@ -981,7 +1157,7 @@
       where
         bname (Bind n _ _) = Just n
         bname _ = Nothing
-    runT (Exact tm) = do elab ist toplevel False [] (sMN 0 "tac") tm
+    runT (Exact tm) = do elab ist toplevel ERHS [] (sMN 0 "tac") tm
                          when autoSolve solveAll
     runT (MatchRefine fn)
         = do fnimps <-
@@ -1030,7 +1206,7 @@
                    letn <- getNameFrom (sMN 0 "equiv_val")
                    letbind letn (Var tyn) (Var valn)
                    focus tyn
-                   elab ist toplevel False [] (sMN 0 "tac") tm
+                   elab ist toplevel ERHS [] (sMN 0 "tac") tm
                    focus valn
                    when autoSolve solveAll
     runT (Rewrite tm) -- to elaborate tm, let bind it, then rewrite by that
@@ -1043,12 +1219,13 @@
                    letn <- getNameFrom (sMN 0 "rewrite_rule")
                    letbind letn (Var tyn) (Var valn)
                    focus valn
-                   elab ist toplevel False [] (sMN 0 "tac") tm
+                   elab ist toplevel ERHS [] (sMN 0 "tac") tm
                    rewrite (Var letn)
                    when autoSolve solveAll
-    runT (Induction nm)
-              = do induction nm
-                   when autoSolve solveAll
+    runT (Induction tm) -- let bind tm, similar to the others
+              = case_ True autoSolve ist fn tm
+    runT (CaseTac tm)
+              = case_ False autoSolve ist fn tm
     runT (LetTac n tm)
               = do attack
                    tyn <- getNameFrom (sMN 0 "letty")
@@ -1058,7 +1235,7 @@
                    letn <- unique_hole n
                    letbind letn (Var tyn) (Var valn)
                    focus valn
-                   elab ist toplevel False [] (sMN 0 "tac") tm
+                   elab ist toplevel ERHS [] (sMN 0 "tac") tm
                    when autoSolve solveAll
     runT (LetTacTy n ty tm)
               = do attack
@@ -1069,9 +1246,9 @@
                    letn <- unique_hole n
                    letbind letn (Var tyn) (Var valn)
                    focus tyn
-                   elab ist toplevel False [] (sMN 0 "tac") ty
+                   elab ist toplevel ERHS [] (sMN 0 "tac") ty
                    focus valn
-                   elab ist toplevel False [] (sMN 0 "tac") tm
+                   elab ist toplevel ERHS [] (sMN 0 "tac") tm
                    when autoSolve solveAll
     runT Compute = compute
     runT Trivial = do trivial' ist; when autoSolve solveAll
@@ -1091,7 +1268,7 @@
                                scriptvar <- getNameFrom (sMN 0 "scriptvar" )
                                letbind scriptvar scriptTy (Var script)
                                focus script
-                               elab ist toplevel False [] (sMN 0 "tac") tm
+                               elab ist toplevel ERHS [] (sMN 0 "tac") tm
                                (script', _) <- get_type_val (Var scriptvar)
                                -- now that we have the script apply
                                -- it to the reflected goal and context
@@ -1124,7 +1301,7 @@
              letbind scriptvar scriptTy (Var script)
              focus script
              ptm <- get_term
-             elab ist toplevel False [] (sMN 0 "tac") 
+             elab ist toplevel ERHS [] (sMN 0 "tac") 
                   (PApp emptyFC tm [pexp (delabTy' ist [] tgoal True True)])
              (script', _) <- get_type_val (Var scriptvar)
              -- now that we have the script apply
@@ -1152,7 +1329,7 @@
                           letn <- getNameFrom (sMN 0 "letvar")
                           letbind letn (Var tyn) (Var valn)
                           focus valn
-                          elab ist toplevel False [] (sMN 0 "tac") v
+                          elab ist toplevel ERHS [] (sMN 0 "tac") v
                           (value, _) <- get_type_val (Var letn)
                           ctxt <- get_context
                           env <- get_env
@@ -1166,7 +1343,7 @@
                        letn <- getNameFrom (sMN 0 "letvar")
                        letbind letn (Var tyn) (Var valn)
                        focus valn
-                       elab ist toplevel False [] (sMN 0 "tac") v
+                       elab ist toplevel ERHS [] (sMN 0 "tac") v
                        (value, _) <- get_type_val (Var letn)
                        ctxt <- get_context
                        env <- get_env
@@ -1214,7 +1391,8 @@
 reifyApp ist t [Constant (Str n), x]
              | t == reflm "GoalType" = liftM (GoalType n) (reify ist x)
 reifyApp _ t [n] | t == reflm "Intro" = liftM (Intro . (:[])) (reifyTTName n)
-reifyApp _ t [n] | t == reflm "Induction" = liftM Induction (reifyTTName n)
+reifyApp ist t [t'] | t == reflm "Induction" = liftM (Induction . delab ist) (reifyTT t')
+reifyApp ist t [t'] | t == reflm "Case" = liftM (Induction . delab ist) (reifyTT t')
 reifyApp ist t [t']
              | t == reflm "ApplyTactic" = liftM (ApplyTactic . delab ist) (reifyTT t')
 reifyApp ist t [t']
@@ -1421,21 +1599,159 @@
 
 -- | 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)
+reflect = reflectQuote []
+
+claimTT :: Name -> ElabD Name
+claimTT n = do n' <- getNameFrom n
+               claim n' (Var (sNS (sUN "TT") ["Reflection", "Language"]))
+               return n'
+
+-- | Convert a reflected term to a more suitable form for pattern-matching.
+-- In particular, the less-interesting bits are elaborated to _ patterns. This
+-- happens to NameTypes, universe levels, names that are bound but not used,
+-- and the type annotation field of the P constructor.
+reflectQuotePattern :: [Name] -> Term -> ElabD ()
+reflectQuotePattern unq (P _ n _)
+  | n `elem` unq = -- the unquoted names have been claimed as TT already - just use them
+    do fill (Var n) ; solve
+  | otherwise =
+    do tyannot <- claimTT (sMN 0 "pTyAnnot")
+       movelast tyannot  -- use a _ pattern here
+       nt <- getNameFrom (sMN 0 "nt")
+       claim nt (Var (reflm "NameType"))
+       movelast nt       -- use a _ pattern here
+       n' <- getNameFrom (sMN 0 "n")
+       claim n' (Var (reflm "TTName"))
+       fill $ reflCall "P" [Var nt, Var n', Var tyannot]
+       solve
+       focus n'; reflectNameQuotePattern n
+reflectQuotePattern unq (V n)
+  = do fill $ reflCall "V" [RConstant (I n)]
+       solve
+reflectQuotePattern unq (Bind n b x)
+  = do x' <- claimTT (sMN 0 "sc")
+       movelast x'
+       b' <- getNameFrom (sMN 0 "binder")
+       claim b' (RApp (Var (sNS (sUN "Binder") ["Reflection", "Language"]))
+                      (Var (sNS (sUN "TT") ["Reflection", "Language"])))
+       if n `elem` freeNames x
+         then do fill $ reflCall "Bind"
+                                 [reflectName n,
+                                  Var b',
+                                  Var x']
+                 solve
+         else do any <- getNameFrom (sMN 0 "anyName")
+                 claim any (Var (reflm "TTName"))
+                 movelast any
+                 fill $ reflCall "Bind"
+                                 [Var any,
+                                  Var b',
+                                  Var x']
+                 solve
+       focus x'; reflectQuotePattern unq x
+       focus b'; reflectBinderQuotePattern unq b
+
+  where
+    reflectBinderQuotePattern :: [Name] -> Binder Term -> ElabD ()
+    reflectBinderQuotePattern unq (Lam t)
+       = do t' <- claimTT (sMN 0 "ty"); movelast t'
+            fill $ reflCall "Lam" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+    reflectBinderQuotePattern unq (Pi t)
+       = do t' <- claimTT (sMN 0 "ty") ; movelast t'
+            fill $ reflCall "Pi" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+    reflectBinderQuotePattern unq (Let x y)
+       = do x' <- claimTT (sMN 0 "ty"); movelast x';
+            y' <- claimTT (sMN 0 "v"); movelast y';
+            fill $ reflCall "Let" [Var (reflm "TT"), Var x', Var y']
+            solve
+            focus x'; reflectQuotePattern unq x
+            focus y'; reflectQuotePattern unq y
+    reflectBinderQuotePattern unq (NLet x y)
+       = do x' <- claimTT (sMN 0 "ty"); movelast x'
+            y' <- claimTT (sMN 0 "v"); movelast y'
+            fill $ reflCall "NLet" [Var (reflm "TT"), Var x', Var y']
+            solve
+            focus x'; reflectQuotePattern unq x
+            focus y'; reflectQuotePattern unq y
+    reflectBinderQuotePattern unq (Hole t)
+       = do t' <- claimTT (sMN 0 "ty"); movelast t'
+            fill $ reflCall "Hole" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+    reflectBinderQuotePattern unq (GHole _ t)
+       = do t' <- claimTT (sMN 0 "ty"); movelast t'
+            fill $ reflCall "GHole" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+    reflectBinderQuotePattern unq (Guess x y)
+       = do x' <- claimTT (sMN 0 "ty"); movelast x'
+            y' <- claimTT (sMN 0 "v"); movelast y'
+            fill $ reflCall "Guess" [Var (reflm "TT"), Var x', Var y']
+            solve
+            focus x'; reflectQuotePattern unq x
+            focus y'; reflectQuotePattern unq y
+    reflectBinderQuotePattern unq (PVar t)
+       = do t' <- claimTT (sMN 0 "ty"); movelast t'
+            fill $ reflCall "PVar" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+    reflectBinderQuotePattern unq (PVTy t)
+       = do t' <- claimTT (sMN 0 "ty"); movelast t'
+            fill $ reflCall "PVTy" [Var (reflm "TT"), Var t']
+            solve
+            focus t'; reflectQuotePattern unq t
+reflectQuotePattern unq (App f x)
+  = do f' <- claimTT (sMN 0 "f"); movelast f'
+       x' <- claimTT (sMN 0 "x"); movelast x'
+       fill $ reflCall "App" [Var f', Var x']
+       solve
+       focus f'; reflectQuotePattern unq f
+       focus x'; reflectQuotePattern unq x
+reflectQuotePattern unq (Constant c)
+  = do fill $ reflCall "TConst" [reflectConstant c]
+       solve
+reflectQuotePattern unq (Proj t i)
+  = do t' <- claimTT (sMN 0 "t"); movelast t'
+       fill $ reflCall "Proj" [Var t', RConstant (I i)]
+       solve
+       focus t'; reflectQuotePattern unq t
+reflectQuotePattern unq (Erased)
+  = do erased <- claimTT (sMN 0 "erased")
+       movelast erased
+       fill $ (Var erased)
+       solve
+reflectQuotePattern unq (Impossible)
+  = do fill $ Var (reflm "Impossible")
+       solve
+reflectQuotePattern unq (TType exp)
+  = do ue <- getNameFrom (sMN 0 "uexp")
+       claim ue (Var (sNS (sUN "TTUExp") ["Reflection", "Language"]))
+       movelast ue
+       fill $ reflCall "TType" [Var ue]
+       solve
+
+-- | Create a reflected term, but leave refs to the provided name intact
+reflectQuote :: [Name] -> Term -> Raw
+reflectQuote unq (P nt n t)
+  | n `elem` unq = Var n
+  | otherwise = reflCall "P" [reflectNameType nt, reflectName n, reflectQuote unq t]
+reflectQuote unq (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)
+reflectQuote unq (Bind n b x)
+  = reflCall "Bind" [reflectName n, reflectBinderQuote unq b, reflectQuote unq x]
+reflectQuote unq (App f x)
+  = reflCall "App" [reflectQuote unq f, reflectQuote unq x]
+reflectQuote unq (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]
+reflectQuote unq (Proj t i)
+  = reflCall "Proj" [reflectQuote unq t, RConstant (I i)]
+reflectQuote unq (Erased) = Var (reflm "Erased")
+reflectQuote unq (Impossible) = Var (reflm "Impossible")
+reflectQuote unq (TType exp) = reflCall "TType" [reflectUExp exp]
 
 reflectNameType :: NameType -> Raw
 reflectNameType (Bound) = Var (reflm "Bound")
@@ -1462,25 +1778,44 @@
 reflectName (NErased) = Var (reflm "NErased")
 reflectName n = Var (reflm "NErased") -- special name, not yet implemented
 
+-- | Elaborate a name to a pattern. This means that NS and UN will be intact,
+-- while all others become _
+reflectNameQuotePattern :: Name -> ElabD ()
+reflectNameQuotePattern n@(UN s)
+  = do fill $ reflectName n
+       solve
+reflectNameQuotePattern n@(NS _ _)
+  = do fill $ reflectName n
+       solve
+reflectNameQuotePattern _ -- for all other names, match any
+  = do nameHole <- getNameFrom (sMN 0 "name")
+       claim nameHole (Var (reflm "TTName"))
+       movelast nameHole
+       fill (Var nameHole)
+       solve
+
 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]
+reflectBinder = reflectBinderQuote []
+
+reflectBinderQuote :: [Name] -> Binder Term -> Raw
+reflectBinderQuote unq (Lam t)
+   = reflCall "Lam" [Var (reflm "TT"), reflectQuote unq t]
+reflectBinderQuote unq (Pi t)
+   = reflCall "Pi" [Var (reflm "TT"), reflectQuote unq t]
+reflectBinderQuote unq (Let x y)
+   = reflCall "Let" [Var (reflm "TT"), reflectQuote unq x, reflectQuote unq y]
+reflectBinderQuote unq (NLet x y)
+   = reflCall "NLet" [Var (reflm "TT"), reflectQuote unq x, reflectQuote unq y]
+reflectBinderQuote unq (Hole t)
+   = reflCall "Hole" [Var (reflm "TT"), reflectQuote unq t]
+reflectBinderQuote unq (GHole _ t)
+   = reflCall "GHole" [Var (reflm "TT"), reflectQuote unq t]
+reflectBinderQuote unq (Guess x y)
+   = reflCall "Guess" [Var (reflm "TT"), reflectQuote unq x, reflectQuote unq y]
+reflectBinderQuote unq (PVar t)
+   = reflCall "PVar" [Var (reflm "TT"), reflectQuote unq t]
+reflectBinderQuote unq (PVTy t)
+   = reflCall "PVTy" [Var (reflm "TT"), reflectQuote unq t]
 
 reflectConstant :: Const -> Raw
 reflectConstant c@(I  _) = reflCall "I"  [RConstant c]
diff --git a/src/Idris/IBC.hs b/src/Idris/IBC.hs
--- a/src/Idris/IBC.hs
+++ b/src/Idris/IBC.hs
@@ -4,6 +4,7 @@
 
 import Idris.Core.Evaluate
 import Idris.Core.TT
+import Idris.Core.Binary
 import Idris.Core.CaseTree
 import Idris.AbsSyntax
 import Idris.Imports
@@ -30,7 +31,7 @@
 import Util.Zlib (decompressEither)
 
 ibcVersion :: Word8
-ibcVersion = 74
+ibcVersion = 75
 
 data IBCFile = IBCFile { ver :: Word8,
                          sourcefile :: FilePath,
@@ -617,352 +618,6 @@
                x4 <- get
                x5 <- get
                return (CGInfo x1 x2 [] x4 x5)
-
-instance Binary FC where
-        put (FC x1 (x2, x3) (x4, x5))
-          = do put x1
-               put (x2 * 65536 + x3)
-               put (x4 * 65536 + x5)
-        get
-          = do x1 <- get
-               x2x3 <- get
-               x4x5 <- get
-               return (FC x1 (x2x3 `div` 65536, x2x3 `mod` 65536) (x4x5 `div` 65536, x4x5 `mod` 65536))
-
-
-instance Binary Name where
-        put x
-          = case x of
-                UN x1 -> do putWord8 0
-                            put x1
-                NS x1 x2 -> do putWord8 1
-                               put x1
-                               put x2
-                MN x1 x2 -> do putWord8 2
-                               put x1
-                               put x2
-                NErased -> putWord8 3
-                SN x1 -> do putWord8 4
-                            put x1
-                SymRef x1 -> do putWord8 5
-                                put x1
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           return (UN x1)
-                   1 -> do x1 <- get
-                           x2 <- get
-                           return (NS x1 x2)
-                   2 -> do x1 <- get
-                           x2 <- get
-                           return (MN x1 x2)
-                   3 -> return NErased
-                   4 -> do x1 <- get
-                           return (SN x1)
-                   5 -> do x1 <- get
-                           return (SymRef x1)
-                   _ -> error "Corrupted binary data for Name"
-
-instance Binary T.Text where
-        put x = put (str x)
-        get = do x <- get
-                 return (txt x)
-
-instance Binary SpecialName where
-        put x
-          = case x of
-                WhereN x1 x2 x3 -> do putWord8 0
-                                      put x1
-                                      put x2
-                                      put x3
-                InstanceN x1 x2 -> do putWord8 1
-                                      put x1
-                                      put x2
-                ParentN x1 x2 -> do putWord8 2
-                                    put x1
-                                    put x2
-                MethodN x1 -> do putWord8 3
-                                 put x1
-                CaseN x1 -> do putWord8 4; put x1
-                ElimN x1 -> do putWord8 5; put x1
-                InstanceCtorN x1 -> do putWord8 6; put x1
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           x2 <- get
-                           x3 <- get
-                           return (WhereN x1 x2 x3)
-                   1 -> do x1 <- get
-                           x2 <- get
-                           return (InstanceN x1 x2)
-                   2 -> do x1 <- get
-                           x2 <- get
-                           return (ParentN x1 x2)
-                   3 -> do x1 <- get
-                           return (MethodN x1)
-                   4 -> do x1 <- get
-                           return (CaseN x1)
-                   5 -> do x1 <- get
-                           return (ElimN x1)
-                   6 -> do x1 <- get
-                           return (InstanceCtorN x1)
-                   _ -> error "Corrupted binary data for SpecialName"
-
-
-instance Binary Const where
-        put x
-          = case x of
-                I x1 -> do putWord8 0
-                           put x1
-                BI x1 -> do putWord8 1
-                            put x1
-                Fl x1 -> do putWord8 2
-                            put x1
-                Ch x1 -> do putWord8 3
-                            put x1
-                Str x1 -> do putWord8 4
-                             put x1
-                B8 x1 -> putWord8 5 >> put x1
-                B16 x1 -> putWord8 6 >> put x1
-                B32 x1 -> putWord8 7 >> put x1
-                B64 x1 -> putWord8 8 >> put x1
-
-                (AType (ATInt ITNative)) -> putWord8 9
-                (AType (ATInt ITBig)) -> putWord8 10
-                (AType ATFloat) -> putWord8 11
-                (AType (ATInt ITChar)) -> putWord8 12
-                StrType -> putWord8 13
-                PtrType -> putWord8 14
-                Forgot -> putWord8 15
-                (AType (ATInt (ITFixed ity))) -> putWord8 (fromIntegral (16 + fromEnum ity)) -- 16-19 inclusive
-                (AType (ATInt (ITVec ity count))) -> do
-                        putWord8 20
-                        putWord8 (fromIntegral . fromEnum $ ity)
-                        putWord8 (fromIntegral count)
-
-                B8V  x1 -> putWord8 21 >> put x1
-                B16V x1 -> putWord8 22 >> put x1
-                B32V x1 -> putWord8 23 >> put x1
-                B64V x1 -> putWord8 24 >> put x1
-                BufferType -> putWord8 25
-                ManagedPtrType -> putWord8 26
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           return (I x1)
-                   1 -> do x1 <- get
-                           return (BI x1)
-                   2 -> do x1 <- get
-                           return (Fl x1)
-                   3 -> do x1 <- get
-                           return (Ch x1)
-                   4 -> do x1 <- get
-                           return (Str x1)
-                   5 -> fmap B8 get
-                   6 -> fmap B16 get
-                   7 -> fmap B32 get
-                   8 -> fmap B64 get
-
-                   9 -> return (AType (ATInt ITNative))
-                   10 -> return (AType (ATInt ITBig))
-                   11 -> return (AType ATFloat)
-                   12 -> return (AType (ATInt ITChar))
-                   13 -> return StrType
-                   14 -> return PtrType
-                   15 -> return Forgot
-
-                   16 -> return (AType (ATInt (ITFixed IT8)))
-                   17 -> return (AType (ATInt (ITFixed IT16)))
-                   18 -> return (AType (ATInt (ITFixed IT32)))
-                   19 -> return (AType (ATInt (ITFixed IT64)))
-
-                   20 -> do
-                        e <- getWord8
-                        c <- getWord8
-                        return (AType (ATInt (ITVec (toEnum . fromIntegral $ e) (fromIntegral c))))
-
-                   21 -> fmap B8V get
-                   22 -> fmap B16V get
-                   23 -> fmap B32V get
-                   24 -> fmap B64V get
-                   25 -> return BufferType
-                   26 -> return ManagedPtrType
-
-                   _ -> error "Corrupted binary data for Const"
-
-
-instance Binary Raw where
-        put x
-          = case x of
-                Var x1 -> do putWord8 0
-                             put x1
-                RBind x1 x2 x3 -> do putWord8 1
-                                     put x1
-                                     put x2
-                                     put x3
-                RApp x1 x2 -> do putWord8 2
-                                 put x1
-                                 put x2
-                RType -> putWord8 3
-                RConstant x1 -> do putWord8 4
-                                   put x1
-                RForce x1 -> do putWord8 5
-                                put x1
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           return (Var x1)
-                   1 -> do x1 <- get
-                           x2 <- get
-                           x3 <- get
-                           return (RBind x1 x2 x3)
-                   2 -> do x1 <- get
-                           x2 <- get
-                           return (RApp x1 x2)
-                   3 -> return RType
-                   4 -> do x1 <- get
-                           return (RConstant x1)
-                   5 -> do x1 <- get
-                           return (RForce x1)
-                   _ -> error "Corrupted binary data for Raw"
-
-
-instance (Binary b) => Binary (Binder b) where
-        put x
-          = case x of
-                Lam x1 -> do putWord8 0
-                             put x1
-                Pi x1 -> do putWord8 1
-                            put x1
-                Let x1 x2 -> do putWord8 2
-                                put x1
-                                put x2
-                NLet x1 x2 -> do putWord8 3
-                                 put x1
-                                 put x2
-                Hole x1 -> do putWord8 4
-                              put x1
-                GHole x1 x2 -> do putWord8 5
-                                  put x1
-                                  put x2
-                Guess x1 x2 -> do putWord8 6
-                                  put x1
-                                  put x2
-                PVar x1 -> do putWord8 7
-                              put x1
-                PVTy x1 -> do putWord8 8
-                              put x1
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           return (Lam x1)
-                   1 -> do x1 <- get
-                           return (Pi x1)
-                   2 -> do x1 <- get
-                           x2 <- get
-                           return (Let x1 x2)
-                   3 -> do x1 <- get
-                           x2 <- get
-                           return (NLet x1 x2)
-                   4 -> do x1 <- get
-                           return (Hole x1)
-                   5 -> do x1 <- get
-                           x2 <- get
-                           return (GHole x1 x2)
-                   6 -> do x1 <- get
-                           x2 <- get
-                           return (Guess x1 x2)
-                   7 -> do x1 <- get
-                           return (PVar x1)
-                   8 -> do x1 <- get
-                           return (PVTy x1)
-                   _ -> error "Corrupted binary data for Binder"
-
-
-instance Binary NameType where
-        put x
-          = case x of
-                Bound -> putWord8 0
-                Ref -> putWord8 1
-                DCon x1 x2 -> do putWord8 2
-                                 put (x1 * 65536 + x2)
-                TCon x1 x2 -> do putWord8 3
-                                 put (x1 * 65536 + x2)
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> return Bound
-                   1 -> return Ref
-                   2 -> do x1x2 <- get
-                           return (DCon (x1x2 `div` 65536) (x1x2 `mod` 65536))
-                   3 -> do x1x2 <- get
-                           return (TCon (x1x2 `div` 65536) (x1x2 `mod` 65536))
-                   _ -> error "Corrupted binary data for NameType"
-
-
-instance {- (Binary n) => -} Binary (TT Name) where
-        put x
-          = {-# SCC "putTT" #-}
-            case x of
-                P x1 x2 x3 -> do putWord8 0
-                                 put x1
-                                 put x2
---                                  put x3
-                V x1 -> if (x1 >= 0 && x1 < 256)
-                           then do putWord8 1
-                                   putWord8 (toEnum (x1 + 1))
-                           else do putWord8 9
-                                   put x1
-                Bind x1 x2 x3 -> do putWord8 2
-                                    put x1
-                                    put x2
-                                    put x3
-                App x1 x2 -> do putWord8 3
-                                put x1
-                                put x2
-                Constant x1 -> do putWord8 4
-                                  put x1
-                Proj x1 x2 -> do putWord8 5
-                                 put x1
-                                 putWord8 (toEnum (x2 + 1))
-                Erased -> putWord8 6
-                TType x1 -> do putWord8 7
-                               put x1
-                Impossible -> putWord8 8
-        get
-          = do i <- getWord8
-               case i of
-                   0 -> do x1 <- get
-                           x2 <- get
---                            x3 <- get
-                           return (P x1 x2 Erased)
-                   1 -> do x1 <- getWord8
-                           return (V ((fromEnum x1) - 1))
-                   2 -> do x1 <- get
-                           x2 <- get
-                           x3 <- get
-                           return (Bind x1 x2 x3)
-                   3 -> do x1 <- get
-                           x2 <- get
-                           return (App x1 x2)
-                   4 -> do x1 <- get
-                           return (Constant x1)
-                   5 -> do x1 <- get
-                           x2 <- getWord8
-                           return (Proj x1 ((fromEnum x2)-1))
-                   6 -> return Erased
-                   7 -> do x1 <- get
-                           return (TType x1)
-                   8 -> return Impossible
-                   9 -> do x1 <- get
-                           return (V x1)
-                   _ -> error "Corrupted binary data for TT"
-
 instance Binary SC where
         put x
           = case x of
@@ -1264,11 +919,13 @@
     Codata -> putWord8 0
     DefaultEliminator -> putWord8 1
     DataErrRev -> putWord8 2
+    DefaultCaseFun -> putWord8 3
   get = do i <- getWord8
            case i of
             0 -> return Codata
             1 -> return DefaultEliminator
             2 -> return DataErrRev
+            3 -> return DefaultCaseFun
 
 instance Binary FnOpt where
         put x
@@ -1344,11 +1001,13 @@
           = case x of
                 HideDisplay -> putWord8 0
                 InaccessibleArg -> putWord8 1
+                AlwaysShow -> putWord8 2
         get
           = do i <- getWord8
                case i of
                    0 -> return HideDisplay
                    1 -> return InaccessibleArg
+                   2 -> return AlwaysShow
                    _ -> error "Corrupted binary data for Static"
 
 instance Binary Static where
@@ -1582,7 +1241,7 @@
                     1 -> do x1 <- get; x2 <- get; return (UConstraint x1 x2)
 
 instance Binary SyntaxInfo where
-        put (Syn x1 x2 x3 x4 _ x5 x6 _ _ x7)
+        put (Syn x1 x2 x3 x4 _ x5 x6 _ _ x7 _)
           = do put x1
                put x2
                put x3
@@ -1598,7 +1257,7 @@
                x5 <- get
                x6 <- get
                x7 <- get
-               return (Syn x1 x2 x3 x4 id x5 x6 Nothing 0 x7)
+               return (Syn x1 x2 x3 x4 id x5 x6 Nothing 0 x7 False)
 
 instance (Binary t) => Binary (PClause' t) where
         put x
@@ -1747,10 +1406,12 @@
                                   put x2
                 PResolveTC x1 -> do putWord8 15
                                     put x1
-                PEq x1 x2 x3 -> do putWord8 16
-                                   put x1
-                                   put x2
-                                   put x3
+                PEq x1 x2 x3 x4 x5 -> do putWord8 16
+                                         put x1
+                                         put x2
+                                         put x3
+                                         put x4
+                                         put x5
                 PRewrite x1 x2 x3 x4 -> do putWord8 17
                                            put x1
                                            put x2
@@ -1864,7 +1525,9 @@
                    16 -> do x1 <- get
                             x2 <- get
                             x3 <- get
-                            return (PEq x1 x2 x3)
+                            x4 <- get
+                            x5 <- get
+                            return (PEq x1 x2 x3 x4 x5)
                    17 -> do x1 <- get
                             x2 <- get
                             x3 <- get
@@ -1968,6 +1631,8 @@
                                                  put x4
                                                  put x5
                 DoUnify -> putWord8 22
+                CaseTac x1 -> do putWord8 23
+                                 put x1
         get
           = do i <- getWord8
                case i of
@@ -2016,6 +1681,8 @@
                             x5 <- get
                             return (ProofSearch x1 x2 x3 x4 x5)
                    22 -> return DoUnify
+                   23 -> do x1 <- get
+                            return (CaseTac x1)
                    _ -> error "Corrupted binary data for PTactic'"
 
 
@@ -2191,7 +1858,7 @@
                return (Rule x1 x2 x3)
 
 instance (Binary t) => Binary (DSL' t) where
-        put (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9)
+        put (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)
           = do put x1
                put x2
                put x3
@@ -2201,6 +1868,7 @@
                put x7
                put x8
                put x9
+               put x10
         get
           = do x1 <- get
                x2 <- get
@@ -2211,7 +1879,8 @@
                x7 <- get
                x8 <- get
                x9 <- get
-               return (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9)
+               x10 <- get
+               return (DSL x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)
 
 instance Binary SSymbol where
         put x
diff --git a/src/Idris/IdeSlave.hs b/src/Idris/IdeSlave.hs
--- a/src/Idris/IdeSlave.hs
+++ b/src/Idris/IdeSlave.hs
@@ -5,12 +5,16 @@
 import Text.Printf
 import Numeric
 import Data.List
+import qualified Data.Binary as Binary
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Lazy as Lazy
 import qualified Data.ByteString.UTF8 as UTF8
 -- import qualified Data.Text as T
 import Text.Trifecta hiding (Err)
 import Text.Trifecta.Delta
 
 import Idris.Core.TT
+import Idris.Core.Binary
 
 import Control.Applicative hiding (Const)
 
@@ -128,7 +132,15 @@
                        BoldText      -> "bold"
                        ItalicText    -> "italic"
                        UnderlineText -> "underline"
+  toSExp (AnnTerm bnd tm) = toSExp [(SymbolAtom "tt-term", StringAtom (encodeTerm bnd tm))]
 
+encodeTerm :: [(Name, Bool)] -> Term -> String
+encodeTerm bnd tm = UTF8.toString . Base64.encode . Lazy.toStrict . Binary.encode $
+                    (bnd, tm)
+
+decodeTerm :: String -> ([(Name, Bool)], Term)
+decodeTerm = Binary.decode . Lazy.fromStrict . Base64.decodeLenient . UTF8.fromString
+
 instance SExpable FC where
   toSExp (FC f (sl, sc) (el, ec)) =
     toSExp ((SymbolAtom "filename", StringAtom f),
@@ -185,6 +197,9 @@
                      | Metavariables Int -- ^^ the Int is the column count for pretty-printing
                      | WhoCalls String
                      | CallsWho String
+                     | TermNormalise [(Name, Bool)] Term
+                     | TermShowImplicits [(Name, Bool)] Term
+                     | TermNoImplicits [(Name, Bool)] Term
 
 sexpToCommand :: SExp -> Maybe IdeSlaveCommand
 sexpToCommand (SexpList (x:[]))                                                         = sexpToCommand x
@@ -221,6 +236,12 @@
 sexpToCommand (SexpList [SymbolAtom "metavariables", IntegerAtom cols])                 = Just (Metavariables (fromIntegral cols))
 sexpToCommand (SexpList [SymbolAtom "who-calls", StringAtom name])                      = Just (WhoCalls name)
 sexpToCommand (SexpList [SymbolAtom "calls-who", StringAtom name])                      = Just (CallsWho name)
+sexpToCommand (SexpList [SymbolAtom "normalise-term", StringAtom encoded])              = let (bnd, tm) = decodeTerm encoded in
+                                                                                          Just (TermNormalise bnd tm)
+sexpToCommand (SexpList [SymbolAtom "show-term-implicits", StringAtom encoded])         = let (bnd, tm) = decodeTerm encoded in
+                                                                                          Just (TermShowImplicits bnd tm)
+sexpToCommand (SexpList [SymbolAtom "hide-term-implicits", StringAtom encoded])         = let (bnd, tm) = decodeTerm encoded in
+                                                                                          Just (TermNoImplicits bnd tm)
 sexpToCommand _                                                                         = Nothing
 
 parseMessage :: String -> Either Err (SExp, Integer)
diff --git a/src/Idris/IdrisDoc.hs b/src/Idris/IdrisDoc.hs
--- a/src/Idris/IdrisDoc.hs
+++ b/src/Idris/IdrisDoc.hs
@@ -14,7 +14,7 @@
 import Idris.Docs
 import Idris.Docstrings (nullDocstring)
 
-import Paths_idris (getDataFileName)
+import IRTS.System (getDataFileName)
 
 import Control.Monad (forM_)
 import Control.Monad.Trans.Error
@@ -285,7 +285,7 @@
 extractPTermNames (PCase _ p ps)     = let (ps1, ps2) = unzip ps
                                        in  concatMap extract (p:(ps1 ++ ps2))
 extractPTermNames (PRefl _ p)        = extract p
-extractPTermNames (PEq _ p1 p2)      = concatMap extract [p1, p2]
+extractPTermNames (PEq _ _ _ p1 p2)  = concatMap extract [p1, p2]
 extractPTermNames (PRewrite _ a b m) | Just c <- m =
                                        concatMap extract [a, b, c]
 extractPTermNames (PRewrite _ a b _) = concatMap extract [a, b]
@@ -334,7 +334,8 @@
 extractPTactic (Focus n)          = [n]
 extractPTactic (Refine n _)       = [n]
 extractPTactic (Rewrite p)        = extract p
-extractPTactic (Induction n)      = [n]
+extractPTactic (Induction p)      = extract p
+extractPTactic (CaseTac p)        = extract p
 extractPTactic (Equiv p)          = extract p
 extractPTactic (MatchRefine n)    = [n]
 extractPTactic (LetTac n p)       = n : extract p
diff --git a/src/Idris/Imports.hs b/src/Idris/Imports.hs
--- a/src/Idris/Imports.hs
+++ b/src/Idris/Imports.hs
@@ -4,7 +4,6 @@
 import Idris.Error
 
 import Idris.Core.TT
-import Paths_idris
 
 import System.FilePath
 import System.Directory
diff --git a/src/Idris/Interactive.hs b/src/Idris/Interactive.hs
--- a/src/Idris/Interactive.hs
+++ b/src/Idris/Interactive.hs
@@ -12,6 +12,7 @@
 import Idris.CaseSplit
 import Idris.AbsSyntax
 import Idris.ElabDecls
+import Idris.ElabTerm
 import Idris.Error
 import Idris.Delaborate
 import Idris.Output
@@ -26,6 +27,7 @@
 import Data.Char
 import Data.Maybe (fromMaybe)
 
+import Debug.Trace
 
 caseSplitAt :: Handle -> FilePath -> Bool -> Int -> Name -> Idris ()
 caseSplitAt h fn updatefile l n
@@ -173,7 +175,7 @@
          let def = PClause fc mn (PRef fc mn) [] (body top) []
          newmv <- idrisCatch
              (do elabDecl' EAll toplevel (PClauses fc [] mn [def])
-                 (tm, ty) <- elabVal toplevel False (PRef fc mn)
+                 (tm, ty) <- elabVal toplevel ERHS (PRef fc mn)
                  ctxt <- getContext
                  i <- getIState
                  return . flip displayS "" . renderPretty 1.0 80 $
@@ -247,12 +249,15 @@
                     [] -> ierror (NoSuchVariable n)
                     ns -> ierror (CantResolveAlts (map fst ns))
         i <- getIState
+        margs <- case lookup n (idris_metavars i) of
+                      Just (_, arity, _) -> return arity
+                      _ -> return (-1)
 
         if (not isProv) then do
             let skip = guessImps (tt_ctxt i) mty
 
             let lem = show n ++ " : " ++ show (stripMNBind skip (delab i mty))
-            let lem_app = show n ++ appArgs skip mty
+            let lem_app = show n ++ appArgs skip margs mty
 
             if updatefile then
                do let fb = fn ++ "~"
@@ -270,7 +275,7 @@
                         in runIO . hPutStrLn h $ convSExp "return" good n
 
           else do -- provisional definition
-            let lem_app = show n ++ appArgs [] mty ++
+            let lem_app = show n ++ appArgs [] (-1) mty ++
                                  " = ?" ++ show n ++ "_rhs"
             if updatefile then
                do let fb = fn ++ "~"
@@ -287,15 +292,17 @@
 
   where getIndent s = length (takeWhile isSpace s)
 
-        appArgs skip (Bind n@(UN c) (Pi _) sc) 
-           | thead c /= '_' && n `notElem` skip
-                = " " ++ show n ++ appArgs skip sc
-        appArgs skip (Bind _ (Pi _) sc) = appArgs skip sc
-        appArgs skip _ = ""
+        appArgs skip 0 _ = ""
+        appArgs skip i (Bind n@(UN c) (Pi _) sc) 
+           | (thead c /= '_' && n `notElem` skip)
+                = " " ++ show n ++ appArgs skip (i - 1) sc
+        appArgs skip i (Bind _ (Pi _) sc) = appArgs skip (i - 1) sc
+        appArgs skip i _ = ""
 
         stripMNBind skip (PPi b n@(UN c) ty sc) 
-           | thead c /= '_' && 
-             n `notElem` skip = PPi b n ty (stripMNBind skip sc)
+           | (thead c /= '_' && n `notElem` skip) ||
+               take 4 (str c) == "__pi" -- keep in type, but not in app
+                = PPi b n ty (stripMNBind skip sc)
         stripMNBind skip (PPi b _ ty sc) = stripMNBind skip sc
         stripMNBind skip t = t
 
diff --git a/src/Idris/Output.hs b/src/Idris/Output.hs
--- a/src/Idris/Output.hs
+++ b/src/Idris/Output.hs
@@ -15,6 +15,7 @@
 
 import System.IO (stdout, Handle, hPutStrLn)
 
+import Data.Char (isAlpha)
 import Data.List (nub)
 import Data.Maybe (fromMaybe)
 
@@ -73,10 +74,21 @@
                                        let infixes = idris_infixes ist
                                        let output = vsep (map (uncurry (ppOverload ppo infixes)) overloads)
                                        ihRenderResult h output
-  where fullName n = prettyName True bnd n
+  where fullName n = prettyName True True bnd n
         ppOverload ppo infixes n tm =
           fullName n <+> colon <+> align (pprintPTerm ppo bnd [] infixes tm)
 
+ihRenderOutput :: Handle -> Doc OutputAnnotation -> Idris ()
+ihRenderOutput h doc =
+  do i <- getIState
+     case idris_outputmode i of
+       RawOutput -> do out <- iRender doc
+                       runIO $ putStrLn (displayDecorated (consoleDecorate i) out)
+       IdeSlave n ->
+        do (str, spans) <- fmap displaySpans . iRender . fmap (fancifyAnnots i) $ doc
+           let out = [toSExp str, toSExp spans]
+           runIO . putStrLn $ convSExp "write-decorated" out n
+
 ihRenderResult :: Handle -> Doc OutputAnnotation -> Idris ()
 ihRenderResult h d = do ist <- getIState
                         case idris_outputmode ist of
@@ -84,7 +96,7 @@
                           IdeSlave n -> ideSlaveReturnAnnotated n h d
 
 ideSlaveReturnWithStatus :: String -> Integer -> Handle -> Doc OutputAnnotation -> Idris ()
-ideSlaveReturnWithStatus status n h out = do 
+ideSlaveReturnWithStatus status n h out = do
   ist <- getIState
   (str, spans) <- fmap displaySpans .
                   iRender .
@@ -140,13 +152,15 @@
                                    IdeSlave n -> runIO . putStrLn $ convSExp cmd info n
                                    _ -> return ()
 
--- this needs some typing magic and more structured output towards emacs
+-- TODO: send structured output similar to the metavariable list
 iputGoal :: SimpleDoc OutputAnnotation -> Idris ()
 iputGoal g = do i <- getIState
                 case idris_outputmode i of
                   RawOutput -> runIO $ putStrLn (displayDecorated (consoleDecorate i) g)
-                  IdeSlave n -> runIO . putStrLn $
-                                convSExp "write-goal" (displayS (fmap (fancifyAnnots i) g) "") n
+                  IdeSlave n ->
+                    let (str, spans) = displaySpans . fmap (fancifyAnnots i) $ g
+                        goal = [toSExp str, toSExp spans]
+                    in runIO . putStrLn $ convSExp "write-goal" goal n
 
 -- | Warn about totality problems without failing to compile
 warnTotality :: Idris ()
diff --git a/src/Idris/ParseData.hs b/src/Idris/ParseData.hs
--- a/src/Idris/ParseData.hs
+++ b/src/Idris/ParseData.hs
@@ -79,12 +79,13 @@
 dataI = do reserved "data"; return []
     <|> do reserved "codata"; return [Codata]
 
-{- | Parses if a data should not have a default eliminator 
+{- | Parses if a data should not have a default eliminator
 DefaultEliminator ::= 'noelim'?
  -}
 dataOpts :: DataOpts -> IdrisParser DataOpts
 dataOpts opts
-    = do reserved "%elim"; dataOpts (DefaultEliminator : opts)
+    = do reserved "%elim"; dataOpts (DefaultEliminator : DefaultCaseFun : opts)
+  <|> do reserved "%case"; dataOpts (DefaultCaseFun : opts)
   <|> do reserved "%error_reverse"; dataOpts (DataErrRev : opts)
   <|> return opts
   <?> "data options"
@@ -129,7 +130,7 @@
                     let tyn = expandNS syn tyn_in
                     option (PData doc argDocs syn fc dataOpts (PLaterdecl tyn ty)) (do
                       try (lchar '=') <|> do reserved "where"
-                                             let kw = (if DefaultEliminator `elem` dataOpts then "" else "%noelim ") ++ (if Codata `elem` dataOpts then "co" else "") ++ "data "
+                                             let kw = (if DefaultEliminator `elem` dataOpts then "%elim" else "") ++ (if Codata `elem` dataOpts then "co" else "") ++ "data "
                                              let n  = show tyn_in ++ " "
                                              let s  = kw ++ n
                                              let as = concat (intersperse " " $ map show args) ++ " "
@@ -209,12 +210,14 @@
                              first  = lookup "index_first" bs
                              next   = lookup "index_next" bs
                              leto   = lookup "let" bs
-                             lambda = lookup "lambda" bs in
+                             lambda = lookup "lambda" bs
+                             pi     = lookup "pi" bs in
                              initDSL { dsl_var = var,
                                        index_first = first,
                                        index_next = next,
                                        dsl_lambda = lambda,
-                                       dsl_let = leto }
+                                       dsl_let = leto,
+                                       dsl_pi = pi }
 
 {- | Checks DSL for errors -}
 -- FIXME: currently does nothing, check if DSL is really sane
@@ -235,6 +238,6 @@
                        t <- expr syn
                        return (o, t)
                <?> "dsl overload declaratioN"
-    where overloadable = ["let","lambda","index_first","index_next","variable"]
+    where overloadable = ["let","lambda","pi","index_first","index_next","variable"]
 
 
diff --git a/src/Idris/ParseExpr.hs b/src/Idris/ParseExpr.hs
--- a/src/Idris/ParseExpr.hs
+++ b/src/Idris/ParseExpr.hs
@@ -289,6 +289,8 @@
   | Constant
   | Type
   | '_|_'
+  | Quasiquote
+  | Unquote
   | '_'
   ;
 @
@@ -326,6 +328,8 @@
         <|> do symbol "_|_"
                fc <- getFC
                return (PFalse fc)
+        <|> quasiquote syn
+        <|> unquote syn
         <|> do lchar '_'; return Placeholder
         <?> "expression"
 
@@ -587,7 +591,35 @@
                        return (pconst e)
                     <?> "constraint argument"
 
+{-| Parses a quasiquote expression (for building reflected terms using the elaborator)
 
+> Quasiquote ::= '`(' Expr ')'
+
+-}
+quasiquote :: SyntaxInfo -> IdrisParser PTerm
+quasiquote syn = do guard (not (syn_in_quasiquote syn))
+                    symbol "`("
+                    e <- expr syn { syn_in_quasiquote = True , inPattern = False}
+                    g <- optional $ do
+                           symbol ":"
+                           expr syn { inPattern = False } -- don't allow antiquotes
+                    symbol ")"
+                    return $ PQuasiquote e g
+                 <?> "quasiquotation"
+
+{-| Parses an unquoting inside a quasiquotation (for building reflected terms using the elaborator)
+
+> Unquote ::= ',' Expr
+
+-}
+unquote :: SyntaxInfo -> IdrisParser PTerm
+unquote syn = do guard (syn_in_quasiquote syn)
+                 symbol "~"
+                 e <- simpleExpr syn { syn_in_quasiquote = False }
+                 return $ PUnquote e
+              <?> "unquotation"
+
+
 {-| Parses a record field setter expression
 @
 RecordType ::=
@@ -748,24 +780,27 @@
 @
  -}
 let_ :: SyntaxInfo -> IdrisParser PTerm
-let_ syn = try (do reserved "let"; fc <- getFC; n <- name;
-                   ty <- option Placeholder (do lchar ':'; expr' syn)
-                   lchar '='
-                   v <- expr syn
-                   ts <- option [] (do lchar '|'
-                                       sepBy1 (do_alt syn) (lchar '|'))
+let_ syn = try (do reserved "let"
+                   ls <- indentedBlock (let_binding syn)
                    reserved "in";  sc <- expr syn
-                   case ts of
-                        [] -> return (PLet n ty v sc)
-                        alts -> return (PCase fc v ((PRef fc n, sc) : ts)))
-           <|> (do reserved "let"; fc <- getFC; pat <- expr' (syn { inPattern = True } )
-                   symbol "="; v <- expr syn
-                   ts <- option [] (do lchar '|'
-                                       sepBy1 (do_alt syn) (lchar '|'))
-                   reserved "in"; sc <- expr syn
-                   return (PCase fc v ((pat, sc) : ts)))
+                   return (buildLets ls sc))
            <?> "let binding"
+  where buildLets [] sc = sc
+        buildLets ((fc,PRef _ n,ty,v,[]):ls) sc
+          = PLet n ty v (buildLets ls sc)
+        buildLets ((fc,pat,ty,v,alts):ls) sc
+          = PCase fc v ((pat, buildLets ls sc) : alts)
 
+let_binding syn = do fc <- getFC; 
+                     pat <- expr' (syn { inPattern = True })
+                     ty <- option Placeholder (do lchar ':'; expr' syn)
+                     lchar '='
+                     v <- expr syn
+                     ts <- option [] (do lchar '|'
+                                         sepBy1 (do_alt syn) (lchar '|'))
+                     return (fc,pat,ty,v,ts)
+                  
+
 {- | Parses a quote goal
 
 @
@@ -816,7 +851,7 @@
                    symbol "->"
                    sc <- expr syn
                    return (bindList (PPi
-                     (TacImp [] Dynamic (PTactics [Trivial]))) xt sc)) <|> (do
+                     (TacImp [] Dynamic (PTactics [ProofSearch True True 100 Nothing []]))) xt sc)) <|> (do
                        try (lchar '{' *> reserved "default")
                        when (st == Static) $ fail "default tactic constraints can not be lazy or static"
                        script <- simpleExpr syn
@@ -1033,9 +1068,10 @@
    <?> "do block expression"
 
 do_alt syn = do l <- expr' syn
-                symbol "=>"
-                r <- expr' syn
-                return (l, r)
+                option (Placeholder, l)
+                       (do symbol "=>"
+                           r <- expr' syn
+                           return (l, r))
 
 {- | Parses an expression in idiom brackets
 @
@@ -1136,6 +1172,7 @@
        |   'refine'      Name Imp+
        |   'mrefine'     Name
        |   'rewrite'     Expr
+       |   'induction'   Expr
        |   'equiv'       Expr
        |   'let'         Name ':' Expr' '=' Expr
        |   'let'         Name           '=' Expr
@@ -1183,8 +1220,12 @@
           <|> do reserved "rewrite"; t <- (indentPropHolds gtProp *> expr syn);
                  i <- get
                  return $ Rewrite (desugar syn i t)
-          <|> do reserved "induction"; nm <- (indentPropHolds gtProp *> fnName);
-                 return $ Induction nm
+          <|> do reserved "case"; t <- (indentPropHolds gtProp *> expr syn);
+                 i <- get
+                 return $ CaseTac (desugar syn i t)
+          <|> do reserved "induction"; t <- (indentPropHolds gtProp *> expr syn);
+                 i <- get
+                 return $ Induction (desugar syn i t)
           <|> do reserved "equiv"; t <- (indentPropHolds gtProp *> expr syn);
                  i <- get
                  return $ Equiv (desugar syn i t)
@@ -1247,6 +1288,21 @@
                           t <- (indentPropHolds gtProp *> expr syn);
                           i <- get
                           return $ TCheck (desugar syn i t))
+                  <|> try (do reserved "doc"
+                              whiteSpace
+                              c <- constant
+                              eof
+                              return (TDocStr (Right c)))
+                  <|> try (do reserved "doc"
+                              whiteSpace
+                              n <- (fnName <|> (string "_|_" >> return falseTy))
+                              eof
+                              return (TDocStr (Left n)))
+                  <|> try (do reserved "search"
+                              whiteSpace
+                              t <- (indentPropHolds gtProp *> expr syn);
+                              i <- get
+                              return $ TSearch (desugar syn i t))
                   <?> "prover command")
           <?> "tactic"
   where
diff --git a/src/Idris/ParseHelpers.hs b/src/Idris/ParseHelpers.hs
--- a/src/Idris/ParseHelpers.hs
+++ b/src/Idris/ParseHelpers.hs
@@ -439,7 +439,8 @@
                         Nothing : xs -> lchar '}' >> return xs <?> "end of block"
                         Just lvl : xs -> (do i   <- indent
                                              isParen <- lookAheadMatches (char ')')
-                                             if i >= lvl && not isParen
+                                             isIn <- lookAheadMatches (reserved "in")
+                                             if i >= lvl && not (isParen || isIn)
                                                 then fail "not end of block"
                                                 else return xs)
                                           <|> (do notOpenBraces
@@ -462,7 +463,8 @@
               <|> do c <- indent; l <- lastIndent
                      unless (c <= l) $ fail "not a terminator"
               <|> do isParen <- lookAheadMatches (oneOf ")}|")
-                     unless isParen $ fail "not a terminator"
+                     isIn <- lookAheadMatches (reserved "in")
+                     unless (isIn || isParen) $ fail "not a terminator"
               <|> lookAhead eof
 
 -- | Checks if application expression does not end
diff --git a/src/Idris/ParseOps.hs b/src/Idris/ParseOps.hs
--- a/src/Idris/ParseOps.hs
+++ b/src/Idris/ParseOps.hs
@@ -38,7 +38,7 @@
        ++ toTable (reverse fixes) ++
       [[backtick],
        [binary "$" (\fc x y -> flatten $ PApp fc x [pexp y]) AssocRight],
-       [binary "="  PEq AssocLeft]]
+       [binary "="  (\fc x y -> PEq fc Placeholder Placeholder x y) AssocLeft]]
   where
     flatten :: PTerm -> PTerm -- flatten application
     flatten (PApp fc (PApp _ f as) bs) = flatten (PApp fc f (as ++ bs))
diff --git a/src/Idris/Parser.hs b/src/Idris/Parser.hs
--- a/src/Idris/Parser.hs
+++ b/src/Idris/Parser.hs
@@ -739,7 +739,9 @@
         <|> do reserved "impossible"; return PImpossible
         <?> "function right hand side"
   where mkN :: Name -> Name
-        mkN (UN x)   = sUN (str x++"_lemma_1")
+        mkN (UN x)   = if (tnull x || not (isAlpha (thead x)))
+                         then sUN "infix_op_lemma_1"
+                         else sUN (str x++"_lemma_1")
         mkN (NS x n) = NS (mkN x) n
         n' :: Name
         n' = mkN n
@@ -1282,7 +1284,7 @@
                   -- simplify every definition do give the totality checker
                   -- a better chance
                   mapM_ (\n -> do logLvl 5 $ "Simplifying " ++ show n
-                                  updateContext (simplifyCasedef n))
+                                  updateContext (simplifyCasedef n $ getErasureInfo i))
                            (map snd (idris_totcheck i))
                   -- build size change graph from simplified definitions
                   iLOG "Totality checking"
diff --git a/src/Idris/PartialEval.hs b/src/Idris/PartialEval.hs
--- a/src/Idris/PartialEval.hs
+++ b/src/Idris/PartialEval.hs
@@ -12,11 +12,14 @@
 import Control.Monad.State
 import Debug.Trace
 
+-- | Partially evaluates given terms under the given context.
 partial_eval :: Context -> [(Name, Maybe Int)] ->
                 [Either Term (Term, Term)] ->
                 [Either Term (Term, Term)]
 partial_eval ctxt ns tms = map peClause tms where
+   -- If the term is not a clause, it is simply kept as is
    peClause (Left t) = Left t
+   -- If the term is a clause, specialise the right hand side
    peClause (Right (lhs, rhs))
        = let rhs' = specialise ctxt [] (map toLimit ns) rhs in
              Right (lhs, rhs')
@@ -24,20 +27,28 @@
    toLimit (n, Nothing) = (n, 65536) -- somewhat arbitrary reduction limit
    toLimit (n, Just l) = (n, l)
 
+-- | Specialises the type of a partially evaluated TT function returning
+-- a pair of the specialised type and the types of expected arguments.
 specType :: [(PEArgType, Term)] -> Type -> (Type, [(PEArgType, Term)])
 specType args ty = let (t, args') = runState (unifyEq args ty) [] in
                        (st (map fst args') t, map fst args')
   where
+    -- Specialise static argument in type by let-binding provided value instead
+    -- of expecting it as a function argument
     st ((ExplicitS, v) : xs) (Bind n (Pi t) sc)
          = Bind n (Let t v) (st xs sc)
     st ((ImplicitS, v) : xs) (Bind n (Pi t) sc)
          = Bind n (Let t v) (st xs sc)
+    -- Erase argument from function type
     st ((UnifiedD, _) : xs) (Bind n (Pi t) sc)
          = st xs sc
+    -- Keep types as is
     st (_ : xs) (Bind n (Pi t) sc)
          = Bind n (Pi t) (st xs sc)
     st _ t = t
 
+    -- Erase implicit dynamic argument if existing argument shares it value,
+    -- by substituting the value of previous argument
     unifyEq (imp@(ImplicitD, v) : xs) (Bind n (Pi t) sc)
          = do amap <- get
               case lookup imp amap of
@@ -57,6 +68,8 @@
                       put (args ++ (zip xs (repeat (sUN "_"))))
                       return t
 
+-- | Creates an Idris type declaration given current state and a specialised TT function application type.
+-- Can be used in combination with the output of 'specType'.
 mkPE_TyDecl :: IState -> [(PEArgType, Term)] -> Type -> PTerm
 mkPE_TyDecl ist args ty = mkty args ty
   where
@@ -71,12 +84,15 @@
        = mkty xs t
     mkty [] t = delab ist t
 
+-- | Checks if a given argument is a type class constraint argument
 classConstraint ist v
     | (P _ c _, args) <- unApply v = case lookupCtxt c (idris_classes ist) of
                                           [_] -> True
                                           _ -> False
     | otherwise = False
 
+-- | Checks if the given arguments of a type class constraint are all either constants
+-- or references (i.e. that it doesn't contain any complex terms).
 concreteClass ist v
     | not (classConstraint ist v) = False
     | (P _ c _, args) <- unApply v = all concrete args
@@ -88,6 +104,7 @@
                                  _ -> False
                     | otherwise = False
 
+-- | Creates a new clause for a specialised function application
 mkPE_TermDecl :: IState -> Name -> Name ->
                  [(PEArgType, Term)] -> [(PTerm, PTerm)]
 mkPE_TermDecl ist newname sname ns 
@@ -106,11 +123,15 @@
   deImpArg a@(PImp _ _ _ _ _) = a { getTm = Placeholder }
   deImpArg a = a
 
-data PEArgType = ImplicitS | ImplicitD
-               | ExplicitS | ExplicitD
-               | UnifiedD
+-- | Data type representing binding-time annotations for partial evaluation of arguments
+data PEArgType = ImplicitS -- ^ Implicit static argument
+               | ImplicitD -- ^ Implicit dynamic argument
+               | ExplicitS -- ^ Explicit static argument
+               | ExplicitD -- ^ Explicit dynamic argument
+               | UnifiedD  -- ^ Erasable dynamic argument (found under unification)
   deriving (Eq, Show)
 
+-- | Get specialised applications for a given function
 getSpecApps :: IState -> [Name] -> Term -> 
                [(Name, [(PEArgType, Term)])]
 getSpecApps ist env tm = ga env (explicitNames tm) where
diff --git a/src/Idris/Prover.hs b/src/Idris/Prover.hs
--- a/src/Idris/Prover.hs
+++ b/src/Idris/Prover.hs
@@ -9,6 +9,7 @@
 import Idris.AbsSyntax
 import Idris.AbsSyntaxTree
 import Idris.Delaborate
+import Idris.Docs (getDocs, pprintDocs, pprintConstDocs)
 import Idris.ElabDecls
 import Idris.ElabTerm
 import Idris.Parser hiding (params)
@@ -17,6 +18,7 @@
 import Idris.Completion
 import Idris.IdeSlave
 import Idris.Output
+import Idris.TypeSearch (searchByType)
 
 import Text.Trifecta.Result(Result(..))
 
@@ -78,7 +80,8 @@
               OK _ -> return ()
               Error e -> ierror (CantUnify False ty pty e [] 0)
          ptm' <- applyOpts ptm
-         updateContext (addCasedef n (CaseInfo True False) False False True False
+         ei <- getErasureInfo `fmap` getIState
+         updateContext (addCasedef n ei (CaseInfo True False) False False True False
                                  [] []  -- argtys, inaccArgs
                                  [Right (P Ref n ty, ptm)]
                                  [([], P Ref n ty, ptm)]
@@ -97,6 +100,8 @@
                      OK (a, st') -> return (a, st')
                      Error a -> ierror a
   where eCheck = do res <- e
+                    matchProblems True
+                    unifyProblems
                     probs' <- get_probs
                     case probs' of
                          [] -> do tm <- get_term
@@ -107,7 +112,7 @@
 
 dumpState :: IState -> ProofState -> Idris ()
 dumpState ist (PS nm [] _ _ tm _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) =
-  do rendered <- iRender $ prettyName False [] nm <> colon <+> text "No more goals."
+  do rendered <- iRender $ prettyName True False [] nm <> colon <+> text "No more goals."
      iputGoal rendered
 dumpState ist ps@(PS nm (h:hs) _ _ tm _ _ _ _ _ _ problems i _ _ ctxy _ _ _ _) = do
   let OK ty  = goalAtFocus ps
@@ -121,7 +126,9 @@
   where
     ppo = ppOptionIst ist
 
-    tPretty bnd t = pprintPTerm ppo bnd [] (idris_infixes ist) $ delab ist t
+    tPretty bnd t = annotate (AnnTerm bnd t) .
+                    pprintPTerm ppo bnd [] (idris_infixes ist) $
+                    delab ist t
 
     assumptionNames :: Env -> [Name]
     assumptionNames = map fst
@@ -177,6 +184,8 @@
             ideslavePutSExp "return" good
             receiveInput e
        Just (Interpret cmd) -> return (Just cmd)
+       Just (TypeOf str) -> return (Just (":t " ++ str))
+       Just (DocsFor str) -> return (Just (":doc " ++ str))
        _ -> return Nothing
 
 ploop :: Name -> Bool -> String -> [String] -> ElabState [PDecl] -> Maybe History -> Idris (Term, [String])
@@ -208,21 +217,23 @@
            (case cmd of
               Failure err -> return (False, e, False, prf, Left . Msg . show . fixColour (idris_colourRepl i) $ err)
               Success Undo -> do (_, st) <- elabStep e loadState
-                                 return (True, st, False, init prf, Right "")
-              Success ProofState -> return (True, e, False, prf, Right "")
+                                 return (True, st, False, init prf, Right $ iPrintResult "")
+              Success ProofState -> return (True, e, False, prf, Right $ iPrintResult "")
               Success ProofTerm -> do tm <- lifte e get_term
                                       iputStrLn $ "TT: " ++ show tm ++ "\n"
-                                      return (False, e, False, prf, Right "")
+                                      return (False, e, False, prf, Right $ iPrintResult "")
               Success Qed -> do hs <- lifte e get_holes
                                 when (not (null hs)) $ ifail "Incomplete proof"
                                 iputStrLn "Proof completed!"
-                                return (False, e, True, prf, Right "")
+                                return (False, e, True, prf, Right $ iPrintResult "")
               Success (TCheck (PRef _ n)) -> checkNameType n
               Success (TCheck t) -> checkType t
               Success (TEval t)  -> evalTerm t e
+              Success (TDocStr x) -> docStr x
+              Success (TSearch t) -> search t
               Success tac -> do (_, e) <- elabStep e saveState
                                 (_, st) <- elabStep e (runTac autoSolve i fn tac)
-                                return (True, st, False, prf ++ [step], Right ""))
+                                return (True, st, False, prf ++ [step], Right $ iPrintResult ""))
            (\err -> return (False, e, False, prf, Left err))
          ideslavePutSExp "write-proof-state" (prf', length prf')
          case res of
@@ -231,7 +242,7 @@
            Right ok ->
              if done then do (tm, _) <- elabStep st get_term
                              return (tm, prf')
-                     else do iPrintResult ok
+                     else do ok
                              ploop fn d prompt prf' st h'
   where envCtxt env ctxt = foldl (\c (n, b) -> addTyDecl n Bound (binderTy b) c) ctxt env
         checkNameType n = do
@@ -247,11 +258,11 @@
               putIState ist'
               -- Unlike the REPL, metavars have no special treatment, to
               -- make it easier to see how to prove with them.
-              case lookupNames n ctxt' of
-                [] -> ihPrintError h $ "No such variable " ++ show n
-                ts -> ihPrintFunTypes h bnd n (map (\n -> (n, delabTy ist' n)) ts)
+              let action = case lookupNames n ctxt' of
+                             [] -> ihPrintError h $ "No such variable " ++ show n
+                             ts -> ihPrintFunTypes h bnd n (map (\n -> (n, delabTy ist' n)) ts)
               putIState ist
-              return (False, e, False, prf, Right ""))
+              return (False, e, False, prf, Right action))
             (\err -> do putIState ist ; ierror err)
 
         checkType t = do
@@ -261,19 +272,19 @@
               let OK env = envAtFocus (proof e)
                   ctxt'  = envCtxt env ctxt
               putIState ist { tt_ctxt = ctxt' }
-              (tm, ty) <- elabVal toplevel False t
+              (tm, ty) <- elabVal toplevel ERHS t
               let ppo = ppOptionIst ist
                   ty'     = normaliseC ctxt [] ty
                   h       = idris_outh ist
                   infixes = idris_infixes ist
-              case tm of
-                 TType _ ->
-                   ihPrintTermWithType h (prettyImp ppo PType) type1Doc
-                 _ -> let bnd = map (\x -> (fst x, False)) env in
-                      ihPrintTermWithType h (pprintPTerm ppo bnd [] infixes (delab ist tm))
-                                            (pprintPTerm ppo bnd [] infixes (delab ist ty))
+                  action = case tm of
+                    TType _ ->
+                      ihPrintTermWithType h (prettyImp ppo PType) type1Doc
+                    _ -> let bnd = map (\x -> (fst x, False)) env in
+                         ihPrintTermWithType h (pprintPTerm ppo bnd [] infixes (delab ist tm))
+                                               (pprintPTerm ppo bnd [] infixes (delab ist ty))
               putIState ist
-              return (False, e, False, prf, Right ""))
+              return (False, e, False, prf, Right action))
             (\err -> do putIState ist { tt_ctxt = ctxt } ; ierror err)
 
         evalTerm t e = withErrorReflection $
@@ -285,14 +296,32 @@
                    ist'   = ist { tt_ctxt = ctxt' }
                    bnd    = map (\x -> (fst x, False)) env
                putIState ist'
-               (tm, ty) <- elabVal toplevel False t
+               (tm, ty) <- elabVal toplevel ERHS t
                let tm'     = force (normaliseAll ctxt' env tm)
                    ty'     = force (normaliseAll ctxt' env ty)
                    ppo     = ppOption (idris_options ist')
                    infixes = idris_infixes ist
                    tmDoc   = pprintPTerm ppo bnd [] infixes (delab ist' tm')
                    tyDoc   = pprintPTerm ppo bnd [] infixes (delab ist' ty')
-               ihPrintTermWithType (idris_outh ist') tmDoc tyDoc
+                   action  = ihPrintTermWithType (idris_outh ist') tmDoc tyDoc
                putIState ist
-               return (False, e, False, prf, Right ""))
+               return (False, e, False, prf, Right action))
               (\err -> do putIState ist ; ierror err)
+        docStr :: Either Name Const -> Idris (Bool, ElabState [PDecl], Bool, [String], Either Err (Idris ()))
+        docStr (Left n) = do ist <- getIState
+                             let h = idris_outh ist
+                             idrisCatch (case lookupCtxtName n (idris_docstrings ist) of
+                                           [] -> return (False, e, False, prf,
+                                                         Left . Msg $ "No documentation for " ++ show n)
+                                           ns -> do toShow <- mapM (showDoc ist) ns
+                                                    return (False,  e, False, prf,
+                                                            Right $ ihRenderResult h (vsep toShow)))
+                                        (\err -> do putIState ist ; ierror err)
+               where showDoc ist (n, d) = do doc <- getDocs n
+                                             return $ pprintDocs ist doc
+        docStr (Right c) = do ist <- getIState
+                              let h = idris_outh ist
+                              return (False, e, False, prf, Right . ihRenderResult h $ pprintConstDocs ist c (constDocs c))
+        search t = do ist <- getIState
+                      let h = idris_outh ist
+                      return (False, e, False, prf, Right $ searchByType h t)
diff --git a/src/Idris/REPL.hs b/src/Idris/REPL.hs
--- a/src/Idris/REPL.hs
+++ b/src/Idris/REPL.hs
@@ -34,7 +34,6 @@
 import Idris.WhoCalls
 import Idris.TypeSearch (searchByType)
 
-import Paths_idris
 import Version_idris (gitHash)
 import Util.System
 import Util.DynamicLinker
@@ -48,8 +47,10 @@
 
 import IRTS.Compiler
 import IRTS.CodegenCommon
+import IRTS.System
 
 import Data.List.Split (splitOn)
+import Data.List (groupBy)
 import qualified Data.Text as T
 
 import Text.Trifecta.Result(Result(..))
@@ -151,6 +152,7 @@
 
         loop fn ist sock
             = do (h,_,_) <- accept sock
+                 hSetEncoding h utf8
                  cmd <- hGetLine h
                  (ist', fn) <- processNetCmd orig ist h fn cmd
                  hClose h
@@ -189,6 +191,7 @@
 runClient :: String -> IO ()
 runClient str = withSocketsDo $ do
                   h <- connectTo "localhost" (PortNumber 4294)
+                  hSetEncoding h utf8
                   hPutStrLn h str
                   resp <- hGetResp "" h
                   putStr resp
@@ -342,34 +345,63 @@
   do ist <- getIState
      let mvs = reverse $ map fst (idris_metavars ist) \\ primDefs
      let ppo = ppOptionIst ist
-     let mvarTys = map (delabTy ist) mvs
-     let res = (IdeSlave.SymbolAtom "ok",
-                zipWith (\ n (prems, concl) -> (n, prems, concl))
-                        (map (IdeSlave.StringAtom . show) mvs)
-                        (map (sexpGoal ist cols ppo [] . getGoal) mvarTys))
-     runIO . putStrLn $ IdeSlave.convSExp "return" res id
-  where getGoal :: PTerm -> ([(Name, PTerm)], PTerm)
-        getGoal (PPi _ n t sc) = let (prems, conc) = getGoal sc
-                                 in ((n, t):prems, conc)
-        getGoal tm = ([], tm)
-        sexpGoal :: IState -> Int -> PPOption -> [Name] -> ([(Name, PTerm)], PTerm)
-                 -> ([(String, String, SpanList OutputAnnotation)],
-                     (String, SpanList OutputAnnotation))
-        sexpGoal ist cols ppo ns ([],        concl) =
-          let infixes = idris_infixes ist
-              concl' = displaySpans . renderPretty 0.9 cols . fmap (fancifyAnnots ist) $
-                       pprintPTerm ppo (zip ns (repeat False)) [] infixes concl
-          in ([], concl')
-        sexpGoal ist cols ppo ns ((n, t):ps, concl) =
-          let n'          = case n of
-                              NS (UN nm) ns -> str nm
-                              UN nm | ('_':'_':_) <- str nm -> "_"
-                                    | otherwise -> str nm
-                              _ -> "_"
-              (t', spans) = displaySpans . renderPretty 0.9 cols . fmap (fancifyAnnots ist) $
-                            pprintPTerm ppo (zip ns (repeat False)) [] (idris_infixes ist) t
-              rest        = sexpGoal ist cols ppo (n:ns) (ps, concl)
-          in ((n', t', spans) : fst rest, snd rest)
+     -- splitMvs is a list of pairs of names and their split types
+     let splitMvs = mapSnd (splitPi ist) (mvTys ist mvs)
+     -- mvOutput is the pretty-printed version ready for conversion to SExpr
+     let mvOutput = map (\(n, (hs, c)) -> (n, hs, c)) $
+                    mapPair show
+                            (\(hs, c, pc) ->
+                             let bnd = [ n | (n,_,_) <- hs ] in
+                             let bnds = inits bnd in
+                             (map (\(bnd, h) -> processPremise ist bnd h)
+                                  (zip bnds hs),
+                              render ist bnd c pc))
+                            splitMvs
+     runIO . putStrLn $
+       IdeSlave.convSExp "return" (IdeSlave.SymbolAtom "ok", mvOutput) id
+  where mapPair f g xs = zip (map (f . fst) xs) (map (g . snd) xs)
+        mapSnd f xs = zip (map fst xs) (map (f . snd) xs)
+
+        -- | Split a function type into a pair of premises, conclusion.
+        -- Each maintains both the original and delaborated versions.
+        splitPi :: IState -> Type -> ([(Name, Type, PTerm)], Type, PTerm)
+        splitPi ist (Bind n (Pi t) rest) =
+          let (hs, c, pc) = splitPi ist rest in
+            ((n, t, delabTy' ist [] t False False):hs,
+             c, delabTy' ist [] c False False)
+        splitPi ist tm = ([], tm, delabTy' ist [] tm False False)
+
+        -- | Get the types of a list of metavariable names
+        mvTys :: IState -> [Name] -> [(Name, Type)]
+        mvTys ist = mapSnd vToP . mapMaybe (flip lookupTyNameExact (tt_ctxt ist))
+
+        -- | Show a type and its corresponding PTerm in a format suitable
+        -- for the IDE - that is, pretty-printed and annotated.
+        render :: IState -> [Name] -> Type -> PTerm -> (String, SpanList OutputAnnotation)
+        render ist bnd t pt =
+          let prettyT = pprintPTerm (ppOptionIst ist)
+                                    (zip bnd (repeat False))
+                                    []
+                                    (idris_infixes ist)
+                                    pt
+          in
+            displaySpans .
+            renderPretty 0.9 cols .
+            fmap (fancifyAnnots ist) .
+            annotate (AnnTerm (zip bnd (take (length bnd) (repeat False))) t) $
+              prettyT
+
+        -- | Juggle the bits of a premise to prepare for output.
+        processPremise :: IState
+                       -> [Name] -- ^ the names to highlight as bound
+                       -> (Name, Type, PTerm)
+                       -> (String,
+                           String,
+                           SpanList OutputAnnotation)
+        processPremise ist bnd (n, t, pt) =
+          let (out, spans) = render ist bnd t pt in
+          (show n , out, spans)
+
 runIdeSlaveCommand id orig fn mods (IdeSlave.WhoCalls n) =
   case splitName n of
        Left err -> iPrintError err
@@ -381,7 +413,7 @@
   where pn ist = displaySpans .
                  renderPretty 0.9 1000 .
                  fmap (fancifyAnnots ist) .
-                 prettyName True []
+                 prettyName True True []
 runIdeSlaveCommand id orig fn mods (IdeSlave.CallsWho n) =
   case splitName n of
        Left err -> iPrintError err
@@ -393,8 +425,42 @@
   where pn ist = displaySpans .
                  renderPretty 0.9 1000 .
                  fmap (fancifyAnnots ist) .
-                 prettyName True []
+                 prettyName True True []
 
+runIdeSlaveCommand id orig fn modes (IdeSlave.TermNormalise bnd tm) =
+  do ctxt <- getContext
+     ist <- getIState
+     let tm' = force (normaliseAll ctxt [] tm)
+         ptm = annotate (AnnTerm bnd tm')
+               (pprintPTerm (ppOptionIst ist)
+                            bnd
+                            []
+                            (idris_infixes ist)
+                            (delab ist tm'))
+         msg = (IdeSlave.SymbolAtom "ok",
+                displaySpans .
+                renderPretty 0.9 80 .
+                fmap (fancifyAnnots ist) $ ptm)
+     runIO . putStrLn $ IdeSlave.convSExp "return" msg id
+runIdeSlaveCommand id orig fn modes (IdeSlave.TermShowImplicits bnd tm) =
+  ideSlaveForceTermImplicits id bnd True tm
+runIdeSlaveCommand id orig fn modes (IdeSlave.TermNoImplicits bnd tm) =
+  ideSlaveForceTermImplicits id bnd False tm
+
+-- | Show a term for IDESlave with the specified implicitness
+ideSlaveForceTermImplicits :: Integer -> [(Name, Bool)] -> Bool -> Term -> Idris ()
+ideSlaveForceTermImplicits id bnd impl tm =
+  do ist <- getIState
+     let expl = annotate (AnnTerm bnd tm)
+                (pprintPTerm ((ppOptionIst ist) { ppopt_impl = impl })
+                             bnd [] (idris_infixes ist)
+                             (delab ist tm))
+         msg = (IdeSlave.SymbolAtom "ok",
+                displaySpans .
+                renderPretty 0.9 80 .
+                fmap (fancifyAnnots ist) $ expl)
+     runIO . putStrLn $ IdeSlave.convSExp "return" msg id
+
 splitName :: String -> Either String Name
 splitName s = case reverse $ splitOn "." s of
                 [] -> Left ("Didn't understand name '" ++ s ++ "'")
@@ -407,6 +473,8 @@
 ideslaveProcess fn (ChangeDirectory f) = do process stdout fn (ChangeDirectory f)
                                             iPrintResult "changed directory to"
 ideslaveProcess fn (Eval t) = process stdout fn (Eval t)
+ideslaveProcess fn (NewDefn decls) = do process stdout fn (NewDefn decls)
+                                        iPrintResult "defined"
 ideslaveProcess fn (ExecVal t) = process stdout fn (ExecVal t)
 ideslaveProcess fn (Check (PRef x n)) = process stdout fn (Check (PRef x n))
 ideslaveProcess fn (Check t) = process stdout fn (Check t)
@@ -585,7 +653,7 @@
                       return ()
 process h fn (Eval t)
                  = withErrorReflection $ do logLvl 5 $ show t
-                                            (tm, ty) <- elabVal toplevel False t
+                                            (tm, ty) <- elabVal toplevel ERHS t
                                             ctxt <- getContext
                                             let tm' = force (normaliseAll ctxt [] tm)
                                             let ty' = force (normaliseAll ctxt [] ty)
@@ -594,14 +662,46 @@
                                             ist <- getIState
                                             logLvl 3 $ "Raw: " ++ show (tm', ty')
                                             logLvl 10 $ "Debug: " ++ showEnvDbg [] tm'
-                                            let tmDoc = prettyIst ist (delab ist tm')
-                                                tyDoc = prettyIst ist (delab ist ty')
+                                            let tmDoc = pprintDelab ist tm'
+                                                tyDoc = pprintDelab ist ty'
                                             ihPrintTermWithType h tmDoc tyDoc
 
+
+process h fn (NewDefn decls) = logLvl 3 ("Defining names using these decls: " ++ show namedGroups) >> mapM_ defineName namedGroups where
+  namedGroups = groupBy (\d1 d2 -> getName d1 == getName d2) decls
+  getName :: PDecl -> Maybe Name
+  getName (PTy docs argdocs syn fc opts name ty) = Just name
+  getName (PClauses fc opts name (clause:clauses)) = Just (getClauseName clause)
+  getName (PData doc argdocs syn fc opts dataDecl) = Just (d_name dataDecl)
+  getName _ = Nothing
+  -- getClauseName is partial and I am not sure it's used safely! -- trillioneyes
+  getClauseName (PClause fc name whole with rhs whereBlock) = name
+  getClauseName (PWith fc name whole with rhs whereBlock) = name
+  defineName :: [PDecl] -> Idris ()
+  defineName (tyDecl@(PTy docs argdocs syn fc opts name ty) : decls) = do 
+    elabDecl EAll toplevel tyDecl
+    elabClauses toplevel fc opts name (concatMap getClauses decls)
+  defineName [PClauses fc opts _ [clause]] = do
+    let pterm = getRHS clause
+    (tm,ty) <- elabVal toplevel ERHS pterm
+    ctxt <- getContext
+    let tm' = force (normaliseAll ctxt [] tm)
+    let ty' = force (normaliseAll ctxt [] ty)
+    updateContext (addCtxtDef (getClauseName clause) (Function ty' tm'))
+  defineName [PData doc argdocs syn fc opts decl] = do
+    elabData toplevel syn doc argdocs fc opts decl
+  getClauses (PClauses fc opts name clauses) = clauses
+  getClauses _ = []
+  getRHS :: PClause -> PTerm
+  getRHS (PClause fc name whole with rhs whereBlock) = rhs
+  getRHS (PWith fc name whole with rhs whereBlock) = rhs
+  getRHS (PClauseR fc with rhs whereBlock) = rhs
+  getRHS (PWithR fc with rhs whereBlock) = rhs
+
 process h fn (ExecVal t)
                   = do ctxt <- getContext
                        ist <- getIState
-                       (tm, ty) <- elabVal toplevel False t
+                       (tm, ty) <- elabVal toplevel ERHS t
 --                       let tm' = normaliseAll ctxt [] tm
                        let ty' = normaliseAll ctxt [] ty
                        res <- execute tm
@@ -645,7 +745,7 @@
 
 
 process h fn (Check t)
-   = do (tm, ty) <- elabVal toplevel False t
+   = do (tm, ty) <- elabVal toplevel ERHS t
         ctxt <- getContext
         ist <- getIState
         let ppo = ppOptionIst ist
@@ -653,8 +753,8 @@
         case tm of
            TType _ ->
              ihPrintTermWithType h (prettyIst ist PType) type1Doc
-           _ -> ihPrintTermWithType h (prettyIst ist (delab ist tm))
-                                      (prettyIst ist (delab ist ty))
+           _ -> ihPrintTermWithType h (pprintDelab ist tm)
+                                      (pprintDelab ist ty)
 
 process h fn (DocStr (Left n))
    = do ist <- getIState
@@ -740,7 +840,7 @@
 process h fn (DoProofSearch updatefile rec l n hints)
     = doProofSearch h fn updatefile rec l n hints Nothing
 process h fn (Spec t)
-                    = do (tm, ty) <- elabVal toplevel False t
+                    = do (tm, ty) <- elabVal toplevel ERHS t
                          ctxt <- getContext
                          ist <- getIState
                          let tm' = simplify ctxt [] {- (idris_statics ist) -} tm
@@ -819,13 +919,13 @@
           warnTotality
 
 process h fn (HNF t)
-                    = do (tm, ty) <- elabVal toplevel False t
+                    = do (tm, ty) <- elabVal toplevel ERHS t
                          ctxt <- getContext
                          ist <- getIState
                          let tm' = hnf ctxt [] tm
                          iPrintResult (show (delab ist tm'))
 process h fn (TestInline t)
-                           = do (tm, ty) <- elabVal toplevel False t
+                           = do (tm, ty) <- elabVal toplevel ERHS t
                                 ctxt <- getContext
                                 ist <- getIState
                                 let tm' = inlineTerm ist tm
@@ -834,7 +934,7 @@
 process h fn Execute
                    = idrisCatch
                        (do ist <- getIState
-                           (m, _) <- elabVal toplevel False
+                           (m, _) <- elabVal toplevel ERHS
                                            (PApp fc
                                               (PRef fc (sUN "run__IO"))
                                               [pexp $ PRef fc (sNS (sUN "main") ["Main"])])
@@ -850,7 +950,7 @@
                        (\e -> getIState >>= ihRenderError stdout . flip pprintErr e)
   where fc = fileFC "main"
 process h fn (Compile codegen f)
-      = do (m, _) <- elabVal toplevel False
+      = do (m, _) <- elabVal toplevel ERHS
                        (PApp fc (PRef fc (sUN "run__IO"))
                        [pexp $ PRef fc (sNS (sUN "main") ["Main"])])
            compile codegen f m
@@ -858,7 +958,7 @@
 process h fn (LogLvl i) = setLogLevel i
 -- Elaborate as if LHS of a pattern (debug command)
 process h fn (Pattelab t)
-     = do (tm, ty) <- elabVal toplevel True t
+     = do (tm, ty) <- elabVal toplevel ELHS t
           iPrintResult $ show tm ++ "\n\n : " ++ show ty
 
 process h fn (Missing n)
@@ -942,8 +1042,8 @@
      ist <- getIState
      ihRenderResult h . vsep $
        map (\(n, ns) ->
-             text "Callers of" <+> prettyName True [] n <$>
-             indent 1 (vsep (map ((text "*" <+>) . align . prettyName True []) ns)))
+             text "Callers of" <+> prettyName True True [] n <$>
+             indent 1 (vsep (map ((text "*" <+>) . align . prettyName True True []) ns)))
            calls
 
 process h fn (CallsWho n) =
@@ -951,8 +1051,8 @@
      ist <- getIState
      ihRenderResult h . vsep $
        map (\(n, ns) ->
-             prettyName True [] n <+> text "calls:" <$>
-             indent 1 (vsep (map ((text "*" <+>) . align . prettyName True []) ns)))
+             prettyName True True [] n <+> text "calls:" <$>
+             indent 1 (vsep (map ((text "*" <+>) . align . prettyName True True []) ns)))
            calls
 -- IdrisDoc
 process h fn (MakeDoc s) =
@@ -1276,7 +1376,7 @@
                           Failure err -> do iputStrLn $ show (fixColour c err)
                                             runIO $ exitWith (ExitFailure 1)
                           Success term -> do ctxt <- getContext
-                                             (tm, _) <- elabVal toplevel False term
+                                             (tm, _) <- elabVal toplevel ERHS term
                                              res <- execute tm
                                              runIO $ exitWith ExitSuccess
 
diff --git a/src/Idris/REPLParser.hs b/src/Idris/REPLParser.hs
--- a/src/Idris/REPLParser.hs
+++ b/src/Idris/REPLParser.hs
@@ -1,3 +1,4 @@
+
 module Idris.REPLParser(parseCmd) where
 
 import System.FilePath ((</>))
@@ -49,6 +50,9 @@
               <|> try (do cmd ["rmproof"]; n <- P.name; eof; return (RmProof n))
               <|> try (do cmd ["showproof"]; n <- P.name; eof; return (ShowProof n))
               <|> try (do cmd ["log"]; i <- P.natural; eof; return (LogLvl (fromIntegral i)))
+              <|> try (do cmd ["let"]
+                          defn <- concat <$> many (P.decl defaultSyntax)
+                          return (NewDefn defn))
               <|> try (do cmd ["lto", "loadto"];
                           toline <- P.natural
                           f <- many anyChar;
@@ -61,7 +65,7 @@
               <|> try (do cmd ["inline"]; P.whiteSpace; t <- P.fullExpr defaultSyntax; return (TestInline t))
               <|> try (do cmd ["doc"]; c <- P.constant; eof; return (DocStr (Right c)))
               <|> try (do cmd ["doc"]; n <- (P.fnName <|> (P.string "_|_" >> return falseTy)); eof; return (DocStr (Left n)))
-              <|> try (do cmd ["d", "def"]; some (P.char ' ') ; n <- P.fnName; eof; return (Defn n))
+              <|> try (do cmd ["d", "def"]; P.whiteSpace; n <- P.fnName; eof; return (Defn n))
               <|> try (do cmd ["total"]; do n <- P.fnName; eof; return (TotCheck n))
               <|> try (do cmd ["t", "type"]; do P.whiteSpace; t <- P.fullExpr defaultSyntax; return (Check t))
               <|> try (do cmd ["u", "universes"]; eof; return Universes)
diff --git a/src/Idris/TypeSearch.hs b/src/Idris/TypeSearch.hs
--- a/src/Idris/TypeSearch.hs
+++ b/src/Idris/TypeSearch.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Idris.TypeSearch (
   searchByType, searchPred, defaultScoreFunction
 ) where
@@ -6,30 +8,32 @@
 import Control.Arrow (first, second, (&&&))
 import Control.Monad (forM_, guard)
 
-import Data.Function (on)
-import Data.List (find, minimumBy, sortBy, (\\))
+import Data.List (find, delete, deleteBy, minimumBy, partition, sortBy, (\\))
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Maybe (catMaybes, fromMaybe, isJust)
+import Data.Maybe (catMaybes, fromMaybe, isJust, maybeToList, mapMaybe)
 import Data.Monoid (Monoid (mempty, mappend))
+import Data.Ord (comparing)
+import qualified Data.PriorityQueue.FingerTree as Q
 import Data.Set (Set)
 import qualified Data.Set as S
+import qualified Data.Text as T (pack, isPrefixOf)
 
 import Idris.AbsSyntax (addUsingConstraints, addImpl, getContext, getIState, putIState, implicit)
-import Idris.AbsSyntaxTree (class_instances, defaultSyntax, Idris, 
-  IState (idris_classes, idris_docstrings, tt_ctxt),
-  implicitAllowed, prettyDocumentedIst, prettyIst, PTerm, toplevel)
+import Idris.AbsSyntaxTree (class_instances, ClassInfo, defaultSyntax, Idris,
+  IState (idris_classes, idris_docstrings, tt_ctxt, idris_outputmode),
+  implicitAllowed, OutputMode(..), prettyDocumentedIst, prettyIst, PTerm, toplevel)
 import Idris.Core.Evaluate (Context (definitions), Def (Function, TyDecl, CaseOp), normaliseC)
-import Idris.Core.TT
+import Idris.Core.TT hiding (score)
 import Idris.Core.Unify (match_unify)
-import Idris.Delaborate (delab, delabTy)
+import Idris.Delaborate (delabTy)
 import Idris.Docstrings (noDocs, overview)
 import Idris.ElabDecls (elabType')
-import Idris.Output (ihRenderResult, ihPrintResult, ihPrintFunTypes)
+import Idris.Output (ihRenderOutput, ihPrintResult, ihRenderResult)
 
 import System.IO (Handle)
 
-import Util.Pretty (text, vsep, char, (<>), Doc)
+import Util.Pretty (text, char, vsep, (<>), Doc)
 
 searchByType :: Handle -> PTerm -> Idris ()
 searchByType h pterm = do
@@ -40,264 +44,401 @@
   ty <- elabType' False toplevel syn (fst noDocs) (snd noDocs) emptyFC [] n pterm'
   putIState i -- don't actually make any changes
   let names = searchUsing searchPred i ty
-  let names' = take numLimit . takeWhile ((< scoreLimit) . getScore) $ 
-         sortBy (compare `on` getScore) names
+  let names' = take numLimit $ names
   let docs =
        [ let docInfo = (n, delabTy i n, fmap (overview . fst) (lookupCtxtExact n (idris_docstrings i))) in
          displayScore score <> char ' ' <> prettyDocumentedIst i docInfo
-                | (n, (_,score)) <- names']
-  ihRenderResult h $ vsep docs
-  where 
-    getScore = defaultScoreFunction . snd . snd
+                | (n, score) <- names']
+  case idris_outputmode i of
+    RawOutput -> do mapM_ (ihRenderOutput h) docs
+                    ihPrintResult h ""
+    IdeSlave n -> ihRenderResult h (vsep docs)
+  where
     numLimit = 50
-    scoreLimit = 100
     syn = defaultSyntax { implicitAllowed = True } -- syntax
     n = sMN 0 "searchType" -- name
-  
 
-searchUsing :: (IState -> Type -> Type -> Maybe a) -> IState -> Type -> [(Name, (Type, a))]
-searchUsing pred istate ty = 
-  concat . M.elems $ M.mapWithKey (\key -> M.toAscList . M.mapMaybe (f key)) (definitions ctxt)
+-- | Conduct a type-directed search using a given match predicate
+searchUsing :: (IState -> Type -> [(Name, Type)] -> [(Name, a)]) 
+  -> IState -> Type -> [(Name, a)]
+searchUsing pred istate ty = pred istate nty . concat . M.elems $ 
+  M.mapWithKey (\key -> M.toAscList . M.mapMaybe (f key)) (definitions ctxt)
   where
+  nty = normaliseC ctxt [] ty
   ctxt = tt_ctxt istate
   f k x = do
     guard $ not (special k)
-    y <- get (fst4 x)
-    let ny = normaliseC ctxt [] y
-  --  traceShow k False `seq` return ()
-    val <- pred istate nty ny
-    return (y, val)
-  nty = normaliseC ctxt [] ty
-  fst4 :: (a,b,c,d) -> a
-  fst4 (w,x,y,z) = w
-  get :: Def -> Maybe Type
-  get (Function ty tm) = Just ty
-  get (TyDecl _ ty) = Just ty
- -- get (Operator ty _ _) = Just ty
-  get (CaseOp _ ty _ _ _ _)  = Just ty
-  get _ = Nothing
+    type2 <- typeFromDef x
+    return $ normaliseC ctxt [] type2
   special :: Name -> Bool
+  special (NS n ns) = special n
   special (SN _) = True
+  special (UN n) =    T.pack "default#" `T.isPrefixOf` n 
+                   || n `elem` map T.pack ["believe_me", "really_believe_me"]
   special _ = False
 
-
-tcToMaybe :: TC' e a -> Maybe a
-tcToMaybe (OK x) = Just x
-tcToMaybe (Error _) = Nothing
-
-
-
-searchPred :: IState -> Type -> Type -> Maybe Score
-searchPred istate ty1 = \ty2 -> case matcher ty2 of
-  Nothing -> Nothing
-  Just xs -> guard (not (null xs)) >> return (minimumBy (compare `on` defaultScoreFunction) xs)
-  where
-  matcher = unifyWithHoles True istate ty1
+-- Our default search predicate.
+searchPred :: IState -> Type -> [(Name, Type)] -> [(Name, Score)]
+searchPred istate ty1 = matcher where
+  maxScore = 100
+  matcher = matchTypesBulk istate maxScore ty1
 
 
+typeFromDef :: (Def, b, c, d) -> Maybe Type
+typeFromDef (def, _, _, _) = get def where
+  get :: Def -> Maybe Type
+  get (Function ty tm) = Just ty
+  get (TyDecl _ ty) = Just ty
+ -- get (Operator ty _ _) = Just ty
+  get (CaseOp _ ty _ _ _ _)  = Just ty
+  get _ = Nothing
 
 
+-- | reverse the edges for a directed acyclic graph
 reverseDag :: Ord k => [((k, a), Set k)] -> [((k, a), Set k)]
 reverseDag xs = map f xs where
   f ((k, v), _) = ((k, v), S.fromList . map (fst . fst) $ filter (S.member k . snd) xs)
 
 -- run vToP first!
+-- | Compute a directed acyclic graph corresponding to the
+-- arguments of a function. 
 -- returns [(the name and type of the bound variable
 --          the names in the type of the bound variable)]
-computeDagP :: Ord n => TT n -> ([((n, TT n), Set n)], TT n)
-computeDagP t = (reverse (map f args), retTy) where
-
+computeDagP :: Ord n 
+  => (TT n -> Bool) -- ^ filter to remove some arguments
+  -> TT n
+  -> ([((n, TT n), Set n)], [(n, TT n)], TT n)
+computeDagP removePred t = (reverse (map f args), reverse removedArgs , retTy) where
   f (n, t) = ((n, t), M.keysSet (usedVars t))
 
-  (numArgs, args, retTy) = go 0 [] t
+  (numArgs, args, removedArgs, retTy) = go 0 [] [] t
 
   -- NOTE : args are in reverse order
-  go k args (Bind n (Pi t) sc) = go (succ k) ( (n, t) : args ) sc
-  go k args retTy = (k, args, retTy)
-
+  go k args removedArgs (Bind n (Pi t) sc) = let arg = (n, t) in
+    if removePred t
+      then go k        args (arg : removedArgs) sc
+      else go (succ k) (arg : args) removedArgs sc
+  go k args removedArgs retTy = (k, args, removedArgs, retTy)
 
-usedVars :: Ord n => TT n -> Map n (TT n)
-usedVars (V j) = error "unexpected! run vToP first"
-usedVars (P Bound n t) = M.singleton n t `M.union` usedVars t
-usedVars (Bind n binder t2) = (M.delete n (usedVars t2) `M.union`) $ case binder of
-  Let t v ->   usedVars t `M.union` usedVars v
-  Guess t v -> usedVars t `M.union` usedVars v
-  b -> usedVars (binderTy b)
-usedVars (App t1 t2) = usedVars t1 `M.union` usedVars t2
-usedVars (Proj t _) = usedVars t
-usedVars _ = M.empty
+-- | Collect the names and types of all the free variables
+-- The Boolean indicates those variables which are determined due to injectivity
+-- I have not given nearly enough thought to know whether this is correct
+usedVars :: Ord n => TT n -> Map n (TT n, Bool)
+usedVars = f True where
+  f b (P Bound n t) = M.singleton n (t, b) `M.union` f b t
+  f b (Bind n binder t2) = (M.delete n (f b t2) `M.union`) $ case binder of
+    Let t v ->   f b t `M.union` f b v
+    Guess t v -> f b t `M.union` f b v
+    bind -> f b (binderTy bind)
+  f b (App t1 t2) = f b t1 `M.union` f (b && isInjective t1) t2
+  f b (Proj t _) = f b t
+  f _ (V j) = error "unexpected! run vToP first"
+  f _ _ = M.empty
 
+-- | Remove a node from a directed acyclic graph
 deleteFromDag :: Ord n => n -> [((n, TT n), (a, Set n))] -> [((n, TT n), (a, Set n))]
 deleteFromDag name [] = []
 deleteFromDag name (((name2, ty), (ix, set)) : xs) = (if name == name2
   then id
   else (((name2, ty) , (ix, S.delete name set)) :) ) (deleteFromDag name xs)
 
+deleteFromArgList :: Ord n => n -> [(n, TT n)] -> [(n, TT n)]
+deleteFromArgList n = filter ((/= n) . fst)
 
 data Score = Score
-  { transposition :: Int
-  , leftApplied   :: Int
-  , rightApplied  :: Int
-  , leftTypeClass :: Int
-  , rightTypeClass :: Int } deriving (Eq, Show)
+  { transposition       :: !Int
+  , leftApplied         :: !Int
+  , rightApplied        :: !Int
+  , leftTypeClassApp    :: !Int
+  , rightTypeClassApp   :: !Int
+  , leftTypeClassIntro  :: !Int
+  , rightTypeClassIntro :: !Int } deriving (Eq, Show)
 
 displayScore :: Score -> Doc a
-displayScore (Score trans lapp rapp lclass rclass) = text $ case (lt, gt) of
-  (True , True ) -> "="
-  (True , False) -> "<"
-  (False, True ) -> ">"
-  (False, False) -> " "
-  where lt = lapp + lclass == 0
-        gt = rapp + rclass == 0
+displayScore (Score trans lapp rapp lclassapp rclassapp lclassintro rclassintro) = text $ case (lt, gt) of
+  (True , True ) -> "=" -- types are isomorphic
+  (True , False) -> "<" -- found type is more general than searched type
+  (False, True ) -> ">" -- searched type is more general than found type
+  (False, False) -> "_"
+  where lt = lapp + lclassapp + lclassintro == 0
+        gt = rapp + rclassapp + rclassintro == 0
 
 
 scoreCriterion :: Score -> Bool
-scoreCriterion (Score a b c d e) = True {- not
-  ( (b > 0 && c > 0) || (b + c) > 2 ) -}
+scoreCriterion (Score a b c d e f g) = not
+  ( (b > 0 && c > 0) || (b + c) > 4 || any (> 3) [d,e,f,g])
 
 defaultScoreFunction :: Score -> Int
-defaultScoreFunction (Score a b c d e) = a + 9*b + 3*c + 12*d + 4*e + 100*(2*b + d)*(2*c + e)
+defaultScoreFunction (Score a b c d e f g) = a + 9*b + 3*c + 12*d + 4*e + 6*f + 2*g + 100*(2*b + d + f)*(2*c + e + g)
   -- it's very bad to have *both* upcasting and downcasting
 
 instance Monoid Score where
-  mempty = Score 0 0 0 0 0
-  (Score a b c d e) `mappend` (Score a' b' c' d' e') = Score (a + a') (b + b') (c + c') (d + d') (e + e')
-
+  mempty = Score 0 0 0 0 0 0 0
+  (Score a b c d e f g) `mappend` (Score a' b' c' d' e' f' g') =
+    Score (a + a') (b + b') (c + c') (d + d') (e + e') (f + f') (g + g')
 
+-- | A directed acyclic graph representing the arguments to a function
+-- The 'Int' represents the position of the argument (1st argument, 2nd, etc.)
 type ArgsDAG = [((Name, Type), (Int, Set Name))]
-type ResType = ( [Name] , ArgsDAG , ArgsDAG )
 
+-- | The state corresponding to an attempted match of two types.
 data State = State
-  { holes :: ![Name]
-  , args1 :: !ArgsDAG
-  , args2 :: !ArgsDAG
-  , score :: !Score
-  }
+  { holes     :: ![(Name, Type)] -- ^ names which have yet to be resolved
+  , args1     :: !ArgsDAG -- ^ arguments for the left  type which have yet to be resolved
+  , args2     :: !ArgsDAG -- ^ arguments for the right type which have yet to be resolved
+  , classes1  :: ![(Name, Type)] -- ^ typeclass arguments for the left  type which haven't been resolved
+  , classes2  :: ![(Name, Type)] -- ^ typeclass arguments for the right type which haven't been resolved
+  , score     :: !Score -- ^ the score so far
+  , usedNames :: ![Name] -- ^ all names that have been used
+  } deriving Show
 
+modifyTypes :: (Type -> Type) -> State -> State
+modifyTypes f (State h a1 a2 c1 c2 s un) = 
+  State h (modifyDag a1) (modifyDag a2) 
+          (modifyList c1) (modifyList c2)
+          s un
+  where
+  modifyDag = map (first (second f))
+  modifyList = map (second f)
 
---DONT run vToP first!
-unifyWithHoles :: Bool -> IState -> Type -> Type -> Maybe [Score]
-unifyWithHoles debugParam istate type1 = \type2 -> let
-  (dag2, retTy2) = makeDag (uniqueBinders argNames1 type2)
-  argNames2 = map (fst . fst) dag2
-  startingHoles = argNames1 ++ argNames2
+findNameInArgsDAG :: Name -> ArgsDAG -> Maybe (Type, Maybe Int)
+findNameInArgsDAG name xs = fmap ((snd . fst) &&& (Just . fst . snd)) . find ((name ==) . fst . fst) $ xs
 
-  startingTypes = (retTy1, retTy2) : [] 
-  in do 
-  state <- go (State startingHoles dag1 dag2 mempty) startingTypes
-  return $ processDags state
+findLeft, findRight :: Name -> State -> Maybe (Type, Maybe Int)
+findLeft  n (State _ a1 a2 c1 c2 _ _) = findNameInArgsDAG n a1 <|> ((,) <$> lookup n c1 <*> Nothing)
+findRight n (State _ a1 a2 c1 c2 _ _) = findNameInArgsDAG n a2 <|> ((,) <$> lookup n c2 <*> Nothing)
+
+deleteLeft, deleteRight :: Name -> State -> State
+deleteLeft  n state = state { args1 = deleteFromDag n (args1 state) , classes1 = filter ((/= n) . fst) (classes1 state) }
+deleteRight n state = state { args2 = deleteFromDag n (args2 state) , classes2 = filter ((/= n) . fst) (classes2 state) }
+
+
+tcToMaybe :: TC' e a -> Maybe a
+tcToMaybe (OK x) = Just x
+tcToMaybe (Error _) = Nothing
+
+inArgTys :: (Type -> Type) -> ArgsDAG -> ArgsDAG
+inArgTys = map . first . second
+
+
+typeclassUnify :: Ctxt ClassInfo -> Context -> Type -> Type -> Maybe [(Name, Type)]
+typeclassUnify classInfo ctxt ty tyTry = do
+  res <- tcToMaybe $ match_unify ctxt [] ty retTy [] holes []
+  guard $ null (holes \\ map fst res)
+  let argTys' = map (second $ foldr (.) id [ subst n t | (n, t) <- res ]) tcArgs
+  return argTys'
   where
+  tyTry' = vToP tyTry
+  holes = map fst nonTcArgs
+  retTy = getRetTy tyTry'
+  (tcArgs, nonTcArgs) = partition (isTypeClassArg classInfo . snd) $ getArgTys tyTry'
+
+isTypeClassArg :: Ctxt ClassInfo -> Type -> Bool
+isTypeClassArg classInfo ty = not (null (getClassName clss >>= flip lookupCtxt classInfo)) where
+  (clss, args) = unApply ty
+  getClassName (P (TCon _ _) className _) = [className]
+  getClassName _ = []
+
+
+instance Ord Score where
+  compare = comparing defaultScoreFunction
+
+-- | Compute the power set
+subsets :: [a] -> [[a]]
+subsets [] = [[]]
+subsets (x : xs) = let ss = subsets xs in map (x :) ss ++ ss
+
+
+--DONT run vToP first!
+-- | Try to match two types together in a unification-like procedure.
+-- Returns a list of types and their minimum scores, sorted in order
+-- of increasing score.
+matchTypesBulk :: forall info. IState -> Int -> Type -> [(info, Type)] -> [(info, Score)]
+matchTypesBulk istate maxScore type1 types = getAllResults startQueueOfQueues where
+  getStartQueue :: (info, Type) -> Maybe (Score, (info, Q.PQueue Score State))
+  getStartQueue nty@(info, type2) = do
+    state <- unifyQueue (State startingHoles dag1 dag2 
+              typeClassArgs1 typeClassArgs2
+              mempty usedNames) startingTypes
+    let sc = score state
+    return $ (sc, (info, Q.singleton sc state))
+    where
+    (dag2, typeClassArgs2, retTy2) = makeDag (uniqueBinders (map fst argNames1) type2)
+    argNames2 = map fst dag2
+    usedNames = map fst (argNames1 ++ argNames2)
+    startingHoles = argNames1 ++ argNames2
+
+    startingTypes = (retTy1, retTy2) : [] 
+
+
+  startQueueOfQueues :: Q.PQueue Score (info, Q.PQueue Score State)
+  startQueueOfQueues = Q.fromList $ mapMaybe getStartQueue types
+
+  getAllResults :: Q.PQueue Score (info, Q.PQueue Score State) -> [(info, Score)]
+  getAllResults q = case Q.minViewWithKey q of
+    Nothing -> []
+    Just ((nextScore, (info, stateQ)), q') ->
+      if defaultScoreFunction nextScore <= maxScore
+        then case nextStepsQueue stateQ of
+          Nothing -> getAllResults q'
+          Just (Left stateQ') -> case Q.minViewWithKey stateQ' of
+             Nothing -> getAllResults q'
+             Just ((newQscore,_), _) -> getAllResults (Q.add newQscore (info, stateQ') q')
+          Just (Right score) -> (info, score) : getAllResults q'
+        else []
+
+
   ctxt = tt_ctxt istate
   classInfo = idris_classes istate
-  (dag1, retTy1) = makeDag type1
-  argNames1 = map (fst . fst) dag1
-  makeDag = first (zipWith (\i (ty, deps) -> (ty, (i, deps))) [0..] . reverseDag) . computeDagP . vToP
 
-  matchf :: (Name, Term) -> Maybe (Name, Name)
-  matchf (name, P Bound name2 _) = Just (name, name2)
-  matchf _ = Nothing
+  (dag1, typeClassArgs1, retTy1) = makeDag type1
+  argNames1 = map fst dag1
+  makeDag :: Type -> (ArgsDAG, [(Name, Type)], Type)
+  makeDag = first3 (zipWith (\i (ty, deps) -> (ty, (i, deps))) [0..] . reverseDag) . 
+    computeDagP (isTypeClassArg classInfo) . vToP
+  first3 f (a,b,c) = (f a, b, c)
   
   -- update our state with the unification resolutions
-  updateDags :: [(Name, Type)] -> ResType -> Maybe (ResType, [(Type, Type)], Score)
-  updateDags [] res = Just (res, [], mempty)
-  updateDags ((name, term@(P Bound name2 _)) : xs) (holes, args1, args2) | isJust findArgs = do
+  resolveUnis :: [(Name, Type)] -> State -> Maybe (State, [(Type, Type)])
+  resolveUnis [] state = Just (state, [])
+  resolveUnis ((name, term@(P Bound name2 _)) : xs) 
+    state@(State holes args1 args2 _ _ _ _) | isJust findArgs = do
     ((ty1, ix1), (ty2, ix2)) <- findArgs
 
-    (res, queue, score) <- updateDags xs (holes', args1'', args2'')
-    --traceShow (ty1, ty2) False `seq` return ()
-    return $ (res, (ty1, ty2) : queue , score { transposition = transposition score + abs (ix2 - ix1) })
+    (state'', queue) <- resolveUnis xs state'
+    let transScore = fromMaybe 0 (abs <$> ((-) <$> ix1 <*> ix2))
+    return $ (inScore (\s -> s { transposition = transposition s + transScore }) state'', (ty1, ty2) : queue)
     where
-    findArgs = ((,) <$> mgetType name args1 <*> mgetType name2 args2) <|>
-               ((,) <$> mgetType name2 args1 <*> mgetType name args2)
-    matchnames = [name, name2]
-    holes' = holes \\ matchnames
-    substf = deleteFromDag name . deleteFromDag name2
-    args1' = substf args1
-    args2' = substf args2
-    args1'' = map (first . second $ subst name term) args1'
-    args2'' = map (first . second $ subst name term) args2'
     mgetType name xs = fmap ((snd . fst) &&& (fst . snd)) . find ((name ==) . fst . fst) $ xs
+    inScore f state = state { score = f (score state) }
+    findArgs = ((,) <$> findLeft name state <*> findRight name2 state) <|>
+               ((,) <$> findLeft name2 state <*> findRight name state)
+    matchnames = [name, name2]
+    holes' = filter (not . (`elem` matchnames) . fst) holes
+    deleteArgs = deleteLeft name . deleteLeft name2 . deleteRight name . deleteRight name2
+    state' = modifyTypes (subst name term) $ deleteArgs
+              (state { holes = holes'})
 
-  updateDags ((name, term) : xs) (holes, args1, args2) = case (mgetType name args1, mgetType name args2) of
-        (Just (_,ix), Nothing) -> thrd (\score -> score { leftApplied = succ (leftApplied score) }) <$> nextStep
-        (Nothing, Just (_, ix)) -> thrd (\score -> score { rightApplied = succ (rightApplied score) }) <$> nextStep
-        (Nothing, Nothing) -> nextStep
-        _ -> error ("Shouldn't happen. Watch the alpha conversion!\n" ++ show args1 ++ "\n\n" ++ show args2)
+  resolveUnis ((name, term) : xs)
+    state@(State holes args1 args2 _ _ _ _) = case (findLeft name state, findRight name state) of
+      (Just (_,ix), Nothing) -> first (addScore (mempty { leftApplied  = 1, rightApplied = otherApplied})) <$> nextStep
+      (Nothing, Just (_,ix)) -> first (addScore (mempty { rightApplied = 1, leftApplied  = otherApplied})) <$> nextStep
+      (Nothing, Nothing) -> nextStep
+      _ -> error ("Idris internal error: TypeSearch.resolveUnis")
     where
-    varsInTy = map fst $ M.toList (usedVars term)
-    deleteMany = foldr (.) id $ map deleteFromDag (name : varsInTy)
-    thrd f (a,b,c) = (a,b,f c)
-    nextStep = updateDags xs (holes \\ [name], updatef args1, updatef args2 )
-    updatef = map (first . second $ subst name term) . deleteMany
-    mgetType name xs = fmap ((snd . fst) &&& (fst . snd)) . find ((name ==) . fst . fst) $ xs
+    -- find variables which are determined uniquely by the type
+    -- due to injectivity
+    matchedVarMap = usedVars term
+    both f (x, y) = (f x, f y)
+    (injUsedVars, notInjUsedVars) = both M.keys . M.partition id . M.filterWithKey (\k _-> k `elem` map fst holes) $ M.map snd matchedVarMap 
+    varsInTy = injUsedVars ++ notInjUsedVars
+    toDelete = name : varsInTy
+    deleteMany = foldr (.) id $ [ deleteLeft t . deleteRight t | t <- toDelete ]
 
+    otherApplied = length notInjUsedVars
 
-  go :: State -> [(Type, Type)] -> Maybe State
-  --go (State holes args1 args2 score) queue | trace ("go\n\t" ++ show holes ++ "\n\t" ++ show args1 ++ "\n\t" ++ show args2 ++ "\n\t" ++ show queue) False = undefined
-  go state [] = return state
-  go (State holes args1 args2 score) ((ty1, ty2) : queue) = do
-    res <- tcToMaybe $ match_unify ctxt [] ty1 ty2 [] holes []
-    --trace ("UnifyResult: " ++ show (ty1, ty2, res, errors)) False `seq` return ()
-    --guard (null errors)
-    ((holes', args1', args2'), queueAdditions, scoreAdditions) <- updateDags res (holes, args1, args2)
-    let newScore = score `mappend` scoreAdditions
-    guard $ scoreCriterion newScore
-    go (State holes' args1' args2' newScore) (queue ++ queueAdditions)
+    addScore additions state = state { score = score state `mappend` additions }
+    state' = modifyTypes (subst name term) . deleteMany $ 
+               state { holes = filter (not . (`elem` toDelete) . fst) holes }
+    nextStep = resolveUnis xs state'
 
 
-  processDags :: State -> [Score]
-  processDags (State [] [] [] scoreAcc) = [scoreAcc]
-  --processDags (State holes (_:_) [] scoreAcc) = []
-  --processDags (State holes [] (_:_) scoreAcc) = []
-  processDags (State holes dag1 dag2 scoreAcc) = concat [ processDags state | state <- allResults ] where
+  -- | resolve a queue of unification constraints
+  unifyQueue :: State -> [(Type, Type)] -> Maybe State
+  unifyQueue state [] = return state
+  unifyQueue state ((ty1, ty2) : queue) = do
+    --trace ("go: \n" ++ show state) True `seq` return ()
+    res <- tcToMaybe $ match_unify ctxt [ (n, Pi ty) | (n, ty) <- holes state] ty1 ty2 [] (map fst $ holes state) []
+    (state', queueAdditions) <- resolveUnis res state
+    guard $ scoreCriterion (score state')
+    unifyQueue state' (queue ++ queueAdditions)
 
-    results = catMaybes [ go (State (holes \\ (map nameOf [ty1, ty2])) (deleteFromDag (nameOf ty1) dag1)
-         (inArgTys (psubst (nameOf ty2) (P Bound (nameOf ty1) (typeOf ty1))) $ deleteFromDag (nameOf ty2) dag2) scoreAcc) [(typeOf ty1, typeOf ty2)] 
-     | ty1 <- canBeFirst dag1, ty2 <- canBeFirst dag2 {-, exactTypeEquality ctxt (typeOf ty1) (typeOf ty2) -} ]
+  possClassInstances :: [Name] -> Type -> [Type]
+  possClassInstances usedNames ty = do
+    className <- getClassName clss
+    classDef <- lookupCtxt className classInfo
+    n <- class_instances classDef
+    def <- lookupCtxt n (definitions ctxt)
+    ty <- normaliseC ctxt [] <$> (case typeFromDef def of Just x -> [x]; Nothing -> [])
+    let ty' = vToP (uniqueBinders usedNames ty)
+    return ty'
+    where
+    (clss, _) = unApply ty
+    getClassName (P (TCon _ _) className _) = [className]
+    getClassName _ = []
 
-    results2 = [ State (holes \\ [nameOf ty]) 
-               (deleteFromDag (nameOf ty) dag1) dag2
-               (scoreAcc `mappend` (mempty { leftTypeClass = 1 }))
-               | ty <- typeClassArgs1 ]
+  -- Just if the computation hasn't totally failed yet, Nothing if it has
+  -- Left if we haven't found a terminal state, Right if we have
+  nextStepsQueue :: Q.PQueue Score State -> Maybe (Either (Q.PQueue Score State) Score)
+  nextStepsQueue queue = do
+    ((nextScore, next), rest) <- Q.minViewWithKey queue
+    if isFinal next 
+      then Just $ Right nextScore
+      else let additions = if scoreCriterion nextScore
+                 then Q.fromList [ (score state, state) | state <- nextSteps next ]
+                 else Q.empty in
+           Just $ Left (Q.union rest additions)
+    where
+    isFinal (State [] [] [] [] [] score _) = True
+    isFinal _ = False
 
-    typeClassArgs1 = filter (isSaturatedClass . typeOf) dag1
-    typeClassArgs2 = filter (isSaturatedClass . typeOf) dag2
+  -- | Find all possible matches starting from a given state.
+  -- We go in stages rather than concatenating all three results in hopes of narrowing
+  -- the search tree. Once we advance in a phase, there should be no going back.
+  nextSteps :: State -> [State]
 
+  -- Stage 3 - match typeclasses
+  nextSteps (State [] [] [] c1 c2 scoreAcc usedNames) = 
+    if null results3 then results4 else results3
+    where
+    -- try to match a typeclass argument from the left with a typeclass argument from the right
+    results3 =
+         catMaybes [ unifyQueue (State [] [] []
+         (deleteFromArgList n1 c1) (map (second subst2for1) (deleteFromArgList n2 c2)) scoreAcc usedNames) [(ty1, ty2)] 
+     | (n1, ty1) <- c1, (n2, ty2) <- c2, let subst2for1 = psubst n2 (P Bound n1 ty1)]
 
-    results3 = [ State (holes \\ [nameOf ty]) 
-               dag1 (deleteFromDag (nameOf ty) dag2)
-               (scoreAcc `mappend` (mempty { rightTypeClass = 1 }))
-               | ty <- typeClassArgs2 ]
+    -- try to hunt match a typeclass constraint by replacing it with an instance
+    results4 = results4A ++ results4B
+    typeClassArgs classes = [ ((n, ty), inst) | (n, ty) <- classes, inst <- possClassInstances usedNames ty ]
+    results4A = [ State [] [] []
+                  (deleteFromArgList n c1 ++ newClassArgs) c2
+                  (scoreAcc `mappend` (mempty { leftTypeClassApp = 1 }))
+                  (usedNames ++ newHoles)
+                | ((n, ty), inst) <- typeClassArgs c1
+                , newClassArgs <- maybeToList $ typeclassUnify classInfo ctxt ty inst
+                , let newHoles = map fst newClassArgs ]
+    results4B = [ State [] [] []
+                  c1 (deleteFromArgList n c2 ++ newClassArgs)
+                  (scoreAcc `mappend` (mempty { rightTypeClassApp = 1 }))
+                  (usedNames ++ newHoles)
+                | ((n, ty), inst) <- typeClassArgs c2
+                , newClassArgs <- maybeToList $ typeclassUnify classInfo ctxt ty inst
+                , let newHoles = map fst newClassArgs ]
 
-    allResults :: [State]
-    allResults = {- (if not (null typeClasses) then (traceShow typeClasses False `seq` id) else id ) -}
-                 (results ++ results2 ++ results3)
-      where
-      typeClasses = filter (isSaturatedClass . typeOf) (dag1 ++ dag2)
-               
 
-    -- check if the canBeFirst thing is losing any possibilities
+  -- Stage 1 - match arguments
+  nextSteps (State holes dag1 dag2 c1 c2 scoreAcc usedNames) = results where
 
+    results = concatMap takeSomeClasses results1
 
-    inArgTys = map . first . second
-    typeOf ((name, ty), set) = ty
-    nameOf ((name, ty), set) = name
+    -- we only try to match arguments whose names don't appear in the types
+    -- of any other arguments
+    canBeFirst :: ArgsDAG -> [(Name, Type)]
+    canBeFirst = map fst . filter (S.null . snd . snd)
 
-    -- XXX : debug stuff
-    canBeFirst = if debugParam then filter (S.null . snd . snd) else id
-    holes = map (fst . fst) dag1 ++ map (fst . fst) dag2
+    -- try to match an argument from the left with an argument from the right
+    results1 = catMaybes [ unifyQueue (State (filter (not . (`elem` [n1,n2]) . fst) holes) (deleteFromDag n1 dag1)
+         ((inArgTys subst2for1) $ deleteFromDag n2 dag2) c1 (map (second subst2for1) c2) scoreAcc usedNames) [(ty1, ty2)] 
+     | (n1, ty1) <- canBeFirst dag1, (n2, ty2) <- canBeFirst dag2, let subst2for1 = psubst n2 (P Bound n1 ty1)]
 
-    deleteIdx _ [] = []
-    deleteIdx idx l@(x@(i,_,_) : xs) = if i == idx then xs else x : deleteIdx idx xs
 
-  isSaturatedClass :: Type -> Bool
-  isSaturatedClass ty = fromMaybe False $ do
-    className <- getClassName clss
-    let possInstances = concatMap class_instances $ lookupCtxt className classInfo 
-    return $ (SN (sInstanceN className (map argToName args))) `elem` possInstances
-    where
-    (clss, args) = unApply ty
-    getClassName (P (TCon _ _) className _) = Just className
-    getClassName _ = Nothing
-    argToName arg = show (delab istate arg)
-
+    -- Stage 2 - simply introduce a subset of the typeclasses
+    -- we've finished, so take some classes
+    takeSomeClasses (State [] [] [] c1 c2 scoreAcc usedNames) = 
+      let lc1 = length c1; lc2 = length c2 in
+       [ State [] [] [] c1' c2' (scoreAcc `mappend` 
+           mempty { rightTypeClassIntro = lc1 - length c1',
+                    leftTypeClassIntro  = lc2 - length c2' }) usedNames
+       | c1' <- subsets c1, c2' <- subsets c2 ]
+    -- still have arguments to match, so just be the identity
+    takeSomeClasses s = [s]
diff --git a/src/Pkg/PParser.hs b/src/Pkg/PParser.hs
--- a/src/Pkg/PParser.hs
+++ b/src/Pkg/PParser.hs
@@ -10,12 +10,12 @@
 import Idris.ParseHelpers
 import Idris.CmdOptions
 
-import Paths_idris
-
 import Control.Monad.State.Strict
 import Control.Applicative
 
+import System.Info (os)
 
+
 type PParser = StateT PkgDesc IdrisInnerParser
 
 data PkgDesc = PkgDesc { pkgname :: String,
@@ -56,7 +56,10 @@
 pClause = do reserved "executable"; lchar '=';
              exec <- iName []
              st <- get
-             put (st { execout = Just (show exec) })
+             put (st { execout = Just (if os `elem` ["win32", "mingw32", "cygwin32"] 
+                                          then ((show exec) ++ ".exe")
+                                          else ( show exec )
+                                      ) })
       <|> do reserved "main"; lchar '=';
              main <- iName []
              st <- get
diff --git a/src/Pkg/Package.hs b/src/Pkg/Package.hs
--- a/src/Pkg/Package.hs
+++ b/src/Pkg/Package.hs
@@ -29,8 +29,6 @@
 
 import Pkg.PParser
 
-import Paths_idris (getDataDir)
-
 -- To build a package:
 -- * read the package description
 -- * check all the library dependencies exist
diff --git a/src/Target_idris.hs b/src/Target_idris.hs
new file mode 100644
--- /dev/null
+++ b/src/Target_idris.hs
@@ -0,0 +1,13 @@
+module Target_idris where
+
+import System.FilePath
+import System.Environment
+getDataDir :: IO String
+getDataDir = do 
+   expath <- getExecutablePath
+   execDir <- return $ dropFileName expath
+   return $ execDir ++ "./libs"
+getDataFileName :: FilePath -> IO FilePath
+getDataFileName name = do
+   dir <- getDataDir
+   return (dir ++ "/" ++ name)
diff --git a/test/Makefile b/test/Makefile
--- a/test/Makefile
+++ b/test/Makefile
@@ -8,7 +8,7 @@
 	@perl ./runtest.pl $(patsubst %.test,%,$@)
 
 test_java:
-	perl ./runtest.pl without sugar004 buffer001 --codegen Java
+	@perl ./runtest.pl without --codegen Java
 
 test_js:
 	@perl ./runtest.pl without sugar004 reg029 io001 dsl002 io003 effects001 effects002 buffer001 --codegen node
diff --git a/test/basic001/basic001a.idr b/test/basic001/basic001a.idr
new file mode 100644
--- /dev/null
+++ b/test/basic001/basic001a.idr
@@ -0,0 +1,32 @@
+module Main
+
+data RLE : Vect n Char -> Type where
+     REnd  : RLE []
+     RChar : {xs : Vect k Char} ->
+             (n : Nat) -> (c : Char) -> (rs : RLE xs) ->
+             RLE (replicate (S n) c ++ xs)
+
+------------
+
+rle : (xs : Vect n Char) -> RLE xs
+rle [] = REnd
+rle (x :: xs) with (rle xs)
+  rle (x :: []) | REnd = RChar 0 x REnd
+  rle (x :: (c :: (replicate n c ++ ys))) | (RChar n c rs) with (decEq x c)
+    rle (x :: (x :: (replicate n x ++ ys))) | (RChar n x rs) | (Yes refl) 
+        = RChar (S n) x rs
+    rle (x :: (c :: (replicate n c ++ ys))) | (RChar n c rs) | (No f) 
+        = RChar 0 x (RChar n c rs)
+
+compress : Vect n Char -> String
+compress xs with (rle xs)
+  compress [] | REnd = ""
+  compress (c :: (replicate n c ++ xs1)) | (RChar n c rs) 
+       = show (the Integer (cast (S n))) ++
+           strCons c (compress xs1)
+
+compressString : String -> String
+compressString xs = compress (fromList (unpack xs))
+
+main : IO ()
+main = putStrLn (compressString "foooobaaaarbaaaz")
diff --git a/test/basic001/expected b/test/basic001/expected
--- a/test/basic001/expected
+++ b/test/basic001/expected
@@ -1,1 +1,2 @@
 1f4o1b4a1r1b3a1z
+1f4o1b4a1r1b3a1z
diff --git a/test/basic001/rle-vect.idr b/test/basic001/rle-vect.idr
new file mode 100644
--- /dev/null
+++ b/test/basic001/rle-vect.idr
@@ -0,0 +1,32 @@
+module Main
+
+data RLE : Vect n Char -> Type where
+     REnd  : RLE []
+     RChar : {xs : Vect k Char} ->
+             (n : Nat) -> (c : Char) -> (rs : RLE xs) ->
+             RLE (replicate (S n) c ++ xs)
+
+------------
+
+rle : (xs : Vect n Char) -> RLE xs
+rle [] = REnd
+rle (x :: xs) with (rle xs)
+  rle (x :: []) | REnd = RChar 0 x REnd
+  rle (x :: (c :: (replicate n c ++ ys))) | (RChar n c rs) with (decEq x c)
+    rle (x :: (x :: (replicate n x ++ ys))) | (RChar n x rs) | (Yes refl) 
+        = RChar (S n) x rs
+    rle (x :: (c :: (replicate n c ++ ys))) | (RChar n c rs) | (No f) 
+        = RChar 0 x (RChar n c rs)
+
+compress : Vect n Char -> String
+compress xs with (rle xs)
+  compress [] | REnd = ""
+  compress (c :: (replicate n c ++ xs1)) | (RChar n c rs) 
+       = show (the Integer (cast (S n))) ++
+           strCons c (compress xs1)
+
+compressString : String -> String
+compressString xs = compress (fromList (unpack xs))
+
+main : IO ()
+main = putStrLn (compressString "foooobaaaarbaaaz")
diff --git a/test/basic001/run b/test/basic001/run
--- a/test/basic001/run
+++ b/test/basic001/run
@@ -1,4 +1,6 @@
 #!/usr/bin/env bash
 idris $@ reg005.idr -o reg005
+idris $@ basic001a.idr -o basic001a
 ./reg005
-rm -f reg005 *.ibc
+./basic001a
+rm -f reg005 basic001a *.ibc
diff --git a/test/basic009/expected b/test/basic009/expected
--- a/test/basic009/expected
+++ b/test/basic009/expected
@@ -1,5 +1,5 @@
 MAIN-PASS
 Faulty.idr:6:7:When elaborating type of Faulty.fault:
-When elaborating an application of type constructor =:
+When elaborating argument x to type constructor =:
         Can't disambiguate name: A.num, B.C.num
 Multiple.idr:3:1:import alias not unique: "X"
diff --git a/test/dsl003/DSLPi.idr b/test/dsl003/DSLPi.idr
new file mode 100644
--- /dev/null
+++ b/test/dsl003/DSLPi.idr
@@ -0,0 +1,38 @@
+module DSLPi
+
+data Ty = BOOL | INT | UNIT | ARR Ty Ty
+
+dsl simple_type
+  pi = ARR
+
+test1 : simple_type (BOOL -> INT -> UNIT) = BOOL `ARR` (INT `ARR` UNIT)
+test1 = refl
+
+using (vars : Vect n Ty)
+  infix 2 ===
+
+  data Expr : Vect n Ty -> Ty -> Type where
+    Var : (i : Fin n) -> Expr vars (index i vars)
+    (===) : Expr vars t -> Expr vars t -> Expr vars BOOL
+
+  data Spec : Vect n Ty -> Type where
+    ForAll : (t : Ty) -> Spec (t :: vars) -> Spec vars
+    ItHolds : Expr vars BOOL -> Spec vars
+
+  implicit exprSpec : Expr vars BOOL -> Spec vars
+  exprSpec = ItHolds
+
+dsl specs
+  pi = ForAll
+  variable = Var
+  index_first = fZ
+  index_next = fS
+
+test2 : Spec []
+test2 = specs ((x, y : INT) -> x === y)
+
+test3 : Spec []
+test3 = ForAll INT . ForAll INT . ItHolds $ Var (fS fZ) === Var fZ
+
+test4 : test2 = test3
+test4 = refl
diff --git a/test/dsl003/expected b/test/dsl003/expected
new file mode 100644
--- /dev/null
+++ b/test/dsl003/expected
@@ -0,0 +1,2 @@
+ForAll INT (ForAll INT (ItHolds (Var (fS fZ) === Var fZ))) : Spec []
+refl : ARR BOOL (ARR INT UNIT) = ARR BOOL (ARR INT UNIT)
diff --git a/test/dsl003/run b/test/dsl003/run
new file mode 100644
--- /dev/null
+++ b/test/dsl003/run
@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+idris $@ --nocolour --check DSLPi.idr -e test1 -e test2
+rm -f *.ibc
diff --git a/test/effects001/test021.idr b/test/effects001/test021.idr
--- a/test/effects001/test021.idr
+++ b/test/effects001/test021.idr
@@ -9,7 +9,7 @@
 
 FileIO : Type -> Type -> Type
 FileIO st t
-   = { [FILE_IO st, STDIO, Count ::: STATE Int] } Eff IO t
+   = { [FILE_IO st, STDIO, Count ::: STATE Int] } Eff t
 
 readFile : FileIO (OpenFile Read) (List String)
 readFile = readAcc [] where
diff --git a/test/effects001/test021a.idr b/test/effects001/test021a.idr
--- a/test/effects001/test021a.idr
+++ b/test/effects001/test021a.idr
@@ -17,7 +17,7 @@
 -- Evaluator t
 --    = Eff m [EXCEPTION String, RND, STATE Env] t
 
-eval : Expr -> { [EXCEPTION String, STDIO, RND, STATE Env] } Eff IO Integer
+eval : Expr -> { [EXCEPTION String, STDIO, RND, STATE Env] } Eff Integer
 eval (Var x) = do vs <- get
                   case lookup x vs of
                         Nothing => raise ("No such variable " ++ x)
diff --git a/test/effects002/test025.idr b/test/effects002/test025.idr
--- a/test/effects002/test025.idr
+++ b/test/effects002/test025.idr
@@ -6,7 +6,7 @@
 
 MemoryIO : Type -> Type -> Type -> Type
 MemoryIO td ts r = { [ Dst ::: RAW_MEMORY td
-                     , Src ::: RAW_MEMORY ts ] } Eff (IOExcept String) r
+                     , Src ::: RAW_MEMORY ts ] } Eff r
 
 inpVect : Vect 5 Bits8
 inpVect = map prim__truncInt_B8 [0, 1, 2, 3, 5]
diff --git a/test/error003/ErrorReflection.idr b/test/error003/ErrorReflection.idr
--- a/test/error003/ErrorReflection.idr
+++ b/test/error003/ErrorReflection.idr
@@ -58,7 +58,7 @@
                                         tm2' <- getTmTy tm2
                                         ty1 <- reifyTy tm1'
                                         ty2 <- reifyTy tm2'
-                                        return [TextPart $ "DSL type error: " ++ (show ty1) ++ " doesn't match " ++(show ty2)]
+                                        Just [TextPart $ "DSL type error: " ++ (show ty1) ++ " doesn't match " ++(show ty2)]
 dslerr _ = Nothing
 
 
diff --git a/test/error003/expected b/test/error003/expected
--- a/test/error003/expected
+++ b/test/error003/expected
@@ -1,2 +1,2 @@
 ErrorReflection.idr:67:5:When elaborating right hand side of bad:
-DSL type error: (t(503) => t'(504)) doesn't match ()
+DSL type error: (t(502) => t'(503)) doesn't match ()
diff --git a/test/proof002/expected b/test/proof002/expected
--- a/test/proof002/expected
+++ b/test/proof002/expected
@@ -1,7 +1,7 @@
 Reflect.idr:207:38:When elaborating right hand side of testReflect1:
 When elaborating an application of function Reflect.getJust:
         Can't unify
-                IsJust (Just x)
+                IsJust (Just x2)
         with
                 IsJust (prove (getProof x))
         
diff --git a/test/quasiquote001/QuasiquoteBasics.idr b/test/quasiquote001/QuasiquoteBasics.idr
new file mode 100644
--- /dev/null
+++ b/test/quasiquote001/QuasiquoteBasics.idr
@@ -0,0 +1,30 @@
+module QuasiquoteBasics
+
+import Language.Reflection
+import Language.Reflection.Utils
+
+nat : TT
+nat = `(Nat)
+
+three : TT
+three = `(S (S (S Z)))
+
+twoElems : TT
+twoElems = `(with List [(), ()])
+
+copy : TT -> TT
+copy q = `((~q,~q) : (Type, Type))
+
+thing : TT -> TT
+thing tm = `(with List [Type, ~tm])
+
+
+
+
+namespace Main
+  main : IO ()
+  main = do putStrLn . show $ twoElems
+            putStrLn "--------------"
+            putStrLn . show . thing $ copy nat
+            putStrLn "--------------"
+            putStrLn . show . copy . copy $ `(Type)
diff --git a/test/quasiquote001/expected b/test/quasiquote001/expected
new file mode 100644
--- /dev/null
+++ b/test/quasiquote001/expected
@@ -0,0 +1,5 @@
+(App (App (App (P (DCon 1 3) (NS (UN ::) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (Bind (MN 0 "_t") (Pi (V 0)) (Bind (MN 2 "_t") (Pi (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 2)))))) (P (TCon 7 0) (MN 0 "__Unit") (TType (UVar 6)))) (P (DCon 0 0) (MN 0 "__II") (P (TCon 0 0) (MN 0 "__Unit") (TType (UVar 6))))) (App (App (App (P (DCon 1 3) (NS (UN ::) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (Bind (MN 0 "_t") (Pi (V 0)) (Bind (MN 2 "_t") (Pi (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 2)))))) (P (TCon 7 0) (MN 0 "__Unit") (TType (UVar 6)))) (P (DCon 0 0) (MN 0 "__II") (P (TCon 0 0) (MN 0 "__Unit") (TType (UVar 6))))) (App (P (DCon 0 1) (NS (UN Nil) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 0)))) (P (TCon 7 0) (MN 0 "__Unit") (TType (UVar 6))))))
+--------------
+(App (App (App (P (DCon 1 3) (NS (UN ::) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (Bind (MN 0 "_t") (Pi (V 0)) (Bind (MN 2 "_t") (Pi (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 2)))))) (TType (UVar 110))) (TType (UVar 112))) (App (App (App (P (DCon 1 3) (NS (UN ::) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (Bind (MN 0 "_t") (Pi (V 0)) (Bind (MN 2 "_t") (Pi (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 2)))))) (TType (UVar 114))) (App (App (App (App (P (DCon 0 4) (MN 0 "__MkPair") (Bind (MN 0 "A") (Pi (TType (UVar 36))) (Bind (MN 0 "B") (Pi (TType (UVar 38))) (Bind (MN 0 "a") (Pi (V 1)) (Bind (MN 0 "b") (Pi (V 1)) (App (App (P (TCon 0 0) (MN 0 "__Pair") (Bind (MN 1 "A") (Pi (TType (UVar 28))) (Bind (MN 1 "B") (Pi (TType (UVar 30))) (TType (UVar 32))))) (V 3)) (V 2))))))) (TType (UVar 108))) (TType (UVar 110))) (P (TCon 15 0) (NS (UN Nat) ["Nat", "Prelude"]) (TType (UVar -1)))) (P (TCon 15 0) (NS (UN Nat) ["Nat", "Prelude"]) (TType (UVar -1))))) (App (P (DCon 0 1) (NS (UN Nil) ["List", "Prelude"]) (Bind (UN a) (Pi (TType (UVar -1))) (App (P (TCon 0 0) (NS (UN List) ["List", "Prelude"]) Erased) (V 0)))) (TType (UVar 116)))))
+--------------
+(App (App (App (App (P (DCon 0 4) (MN 0 "__MkPair") (Bind (MN 0 "A") (Pi (TType (UVar 36))) (Bind (MN 0 "B") (Pi (TType (UVar 38))) (Bind (MN 0 "a") (Pi (V 1)) (Bind (MN 0 "b") (Pi (V 1)) (App (App (P (TCon 0 0) (MN 0 "__Pair") (Bind (MN 1 "A") (Pi (TType (UVar 28))) (Bind (MN 1 "B") (Pi (TType (UVar 30))) (TType (UVar 32))))) (V 3)) (V 2))))))) (TType (UVar 108))) (TType (UVar 110))) (App (App (App (App (P (DCon 0 4) (MN 0 "__MkPair") (Bind (MN 0 "A") (Pi (TType (UVar 36))) (Bind (MN 0 "B") (Pi (TType (UVar 38))) (Bind (MN 0 "a") (Pi (V 1)) (Bind (MN 0 "b") (Pi (V 1)) (App (App (P (TCon 0 0) (MN 0 "__Pair") (Bind (MN 1 "A") (Pi (TType (UVar 28))) (Bind (MN 1 "B") (Pi (TType (UVar 30))) (TType (UVar 32))))) (V 3)) (V 2))))))) (TType (UVar 108))) (TType (UVar 110))) (TType (UVar 110))) (TType (UVar 110)))) (App (App (App (App (P (DCon 0 4) (MN 0 "__MkPair") (Bind (MN 0 "A") (Pi (TType (UVar 36))) (Bind (MN 0 "B") (Pi (TType (UVar 38))) (Bind (MN 0 "a") (Pi (V 1)) (Bind (MN 0 "b") (Pi (V 1)) (App (App (P (TCon 0 0) (MN 0 "__Pair") (Bind (MN 1 "A") (Pi (TType (UVar 28))) (Bind (MN 1 "B") (Pi (TType (UVar 30))) (TType (UVar 32))))) (V 3)) (V 2))))))) (TType (UVar 108))) (TType (UVar 110))) (TType (UVar 110))) (TType (UVar 110))))
diff --git a/test/quasiquote001/run b/test/quasiquote001/run
new file mode 100644
--- /dev/null
+++ b/test/quasiquote001/run
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+idris $@ QuasiquoteBasics.idr -o quasiquote001
+./quasiquote001
+rm -f quasiquote001 *.ibc
diff --git a/test/quasiquote002/GoalQQuote.idr b/test/quasiquote002/GoalQQuote.idr
new file mode 100644
--- /dev/null
+++ b/test/quasiquote002/GoalQQuote.idr
@@ -0,0 +1,30 @@
+module GoalQQuote
+
+import Language.Reflection
+import Language.Reflection.Utils
+
+uCon : TT
+uCon = `(() : ())
+
+uTy : TT
+uTy = `(() : Type)
+
+isDefault : TT -> Bool
+isDefault `(()) = True
+isDefault _ = False
+
+pTy : TT -> TT -> TT
+pTy a b = `((~a, ~b) : Type)
+
+pair : TT -> TT -> TT
+pair a b = `((~a, ~b) : (Nat, Nat))
+
+vect : TT
+vect = `([1,2] : Vect 2 Nat)
+
+namespace Main
+  main : IO ()
+  main = putStrLn $
+           if isDefault uCon then "con"
+                             else if isDefault uTy then "ty"
+                                                   else "neither"
diff --git a/test/quasiquote002/expected b/test/quasiquote002/expected
new file mode 100644
--- /dev/null
+++ b/test/quasiquote002/expected
@@ -0,0 +1,1 @@
+con
diff --git a/test/quasiquote002/run b/test/quasiquote002/run
new file mode 100644
--- /dev/null
+++ b/test/quasiquote002/run
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+idris $@ GoalQQuote.idr -o quasiquote002
+./quasiquote002
+rm -f quasiquote002 *.ibc
diff --git a/test/quasiquote003/NoInfer.idr b/test/quasiquote003/NoInfer.idr
new file mode 100644
--- /dev/null
+++ b/test/quasiquote003/NoInfer.idr
@@ -0,0 +1,10 @@
+module NoInfer
+
+import Language.Reflection
+import Language.Reflection.Utils
+
+zzz2 : TT
+zzz2 = `(fZ : Fin 3)
+
+zzz : TT
+zzz = `(fZ)
diff --git a/test/quasiquote003/expected b/test/quasiquote003/expected
new file mode 100644
--- /dev/null
+++ b/test/quasiquote003/expected
@@ -0,0 +1,2 @@
+NoInfer.idr:10:5:When elaborating right hand side of zzz:
+No such variable k
diff --git a/test/quasiquote003/run b/test/quasiquote003/run
new file mode 100644
--- /dev/null
+++ b/test/quasiquote003/run
@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+idris $@ --check NoInfer.idr
+rm -f *.ibc
diff --git a/test/records003/records003.idr b/test/records003/records003.idr
--- a/test/records003/records003.idr
+++ b/test/records003/records003.idr
@@ -45,4 +45,3 @@
           print (record { organiser->age } idm_gbg)
           print (record { year } idm_gbg)
 
-
diff --git a/test/reg003/expected b/test/reg003/expected
--- a/test/reg003/expected
+++ b/test/reg003/expected
@@ -1,2 +1,2 @@
-reg003a.idr:4:20:When elaborating constructor Main.ECons:
+reg003a.idr:4:11:When elaborating type of Main.ECons:
 No such variable OddList
diff --git a/test/reg008/expected b/test/reg008/expected
deleted file mode 100644
--- a/test/reg008/expected
+++ /dev/null
diff --git a/test/reg008/reg008.idr b/test/reg008/reg008.idr
deleted file mode 100644
--- a/test/reg008/reg008.idr
+++ /dev/null
@@ -1,15 +0,0 @@
-module NatCmp
-
-data Cmp : Nat -> Nat -> Type where
-     cmpLT : (y : _) -> Cmp x (x + S y)
-     cmpEQ : Cmp x x
-     cmpGT : (x : _) -> Cmp (y + S x) y
-
-total cmp : (x, y : Nat) -> Cmp x y
-cmp Z Z     = cmpEQ
-cmp Z (S k) = cmpLT _
-cmp (S k) Z = cmpGT _
-cmp (S x) (S y) with (cmp x y)
-  cmp (S x) (S (x + (S k))) | cmpLT k = cmpLT k
-  cmp (S x) (S x)           | cmpEQ   = cmpEQ
-  cmp (S (y + (S k))) (S y) | cmpGT k = cmpGT k
diff --git a/test/reg008/run b/test/reg008/run
deleted file mode 100644
--- a/test/reg008/run
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/env bash
-idris $@ reg008.idr --check
-rm -f *.ibc
diff --git a/test/reg029/reg029.idr b/test/reg029/reg029.idr
--- a/test/reg029/reg029.idr
+++ b/test/reg029/reg029.idr
@@ -2,6 +2,7 @@
 
 import System
 
+-- necessary to find the getenv symbol
 %dynamic "libm"
 
 main : IO ()
diff --git a/test/reg029/run b/test/reg029/run
--- a/test/reg029/run
+++ b/test/reg029/run
@@ -1,7 +1,17 @@
 #!/usr/bin/env bash
+
 idris $@ reg029.idr -o reg029
 unset IDRIS_REG029_NONEXISTENT_VAR
 export IDRIS_REG029_EXISTENT_VAR='exists!'
-./reg029
+
+IsJava=`echo "$@" | grep -E "\-\-codegen([[:space:]]+)Java\>"`
+if [ -z "$IsJava" ]
+then
+  ./reg029
+else
+  javac -cp reg029:. Reg029Wrapper.java
+  java -cp reg029:. Reg029Wrapper
+fi
 idris $@ reg029.idr --execute
-rm -f reg029 *.ibc
+rm -f reg029 *.ibc *.class
+
diff --git a/test/reg034/expected b/test/reg034/expected
--- a/test/reg034/expected
+++ b/test/reg034/expected
@@ -1,24 +1,24 @@
 reg034.idr:6:5:When elaborating left hand side of bar:
 When elaborating an application of main.bar:
         Can't unify
-                length ys = length ys
+                length ys = length ys
         with
-                length xs = length ys
+                length xs = length ys
         
         Specifically:
                 Can't unify
-                        length ys
+                        length ys
                 with
                         length xs
 reg034.idr:9:5:When elaborating left hand side of foo:
 When elaborating an application of main.foo:
         Can't unify
-                f y = f y
+                f y = f y
         with
-                f x = f y
+                f x = f y
         
         Specifically:
                 Can't unify
-                        f y
+                        f y
                 with
                         f x
diff --git a/test/reg043/expected b/test/reg043/expected
deleted file mode 100644
--- a/test/reg043/expected
+++ /dev/null
@@ -1,1 +0,0 @@
-take : (m : Fin 3) -> Vect 2 Nat -> Vect (finToNat m) Nat
diff --git a/test/reg043/run b/test/reg043/run
deleted file mode 100644
--- a/test/reg043/run
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/env bash
-idris $@ --nocolour -e "Vect.take {n=2} {a=Nat}"
-
diff --git a/test/reg046/expected b/test/reg046/expected
new file mode 100644
--- /dev/null
+++ b/test/reg046/expected
diff --git a/test/reg046/reg046.idr b/test/reg046/reg046.idr
new file mode 100644
--- /dev/null
+++ b/test/reg046/reg046.idr
@@ -0,0 +1,19 @@
+module test
+
+data MyList : (A : Type) -> Type where
+    nil : (A : Type) -> MyList A
+    cons : (A : Type) -> A -> MyList A -> MyList A
+
+elimList : (A : Type) ->
+           (m : MyList A -> Type) ->
+           (f1 : m (nil A)) ->
+           (f2 : (a : A) -> (as : MyList A) -> m as -> m (cons A a as)) ->
+           (e : MyList A) ->
+           m e
+elimList A m f1 f2 (nil A) = f1
+elimList A m f1 f2 (cons A a as) = f2 a as (elimList A m f1 f2 as)
+
+append : (A : Type) ->  (b : MyList A) ->  (c : MyList A) ->  MyList A
+append A b c = (elimList A (\ d =>  MyList A) c
+                (\ d =>  \ e =>  \ f =>  cons A d f)
+                b)
diff --git a/test/reg046/run b/test/reg046/run
new file mode 100644
--- /dev/null
+++ b/test/reg046/run
@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+idris $@ reg046.idr --check
+rm -f reg046 *.ibc
diff --git a/test/reg047/expected b/test/reg047/expected
new file mode 100644
--- /dev/null
+++ b/test/reg047/expected
diff --git a/test/reg047/reg047.idr b/test/reg047/reg047.idr
new file mode 100644
--- /dev/null
+++ b/test/reg047/reg047.idr
@@ -0,0 +1,18 @@
+module test
+
+data TTSigma : (A : Type) -> (B : A -> Type) -> Type where
+    sigma : (A : Type) -> (B : A -> Type) -> (a : A) -> B a -> TTSigma A B
+
+data Nat = zero | succ Nat
+
+Id : (A : Type) -> A -> A -> Type
+Id A = (=) {a0 = A} {b0 = A}
+
+Refl : (A : Type) -> (a : A) -> Id A a a
+Refl A a = refl {a}
+
+zzz : Id Nat zero zero
+zzz = Refl Nat zero
+
+eep : TTSigma Nat (\ a =>  Id Nat a zero)
+eep = sigma Nat (\ a =>  Id Nat a zero) zero zzz
diff --git a/test/reg047/reg047a.idr b/test/reg047/reg047a.idr
new file mode 100644
--- /dev/null
+++ b/test/reg047/reg047a.idr
@@ -0,0 +1,24 @@
+module test
+
+data TTSigma : (A : Type) -> (B : A -> Type) -> Type where
+    sigma : (A : Type) -> (B : A -> Type) -> (a : A) -> B a -> TTSigma A B
+
+data MNat = zero | succ MNat
+
+Id : (A : Type) -> A -> A -> Type
+Id = \A,x,y => x = y --  {a = A} {b = A}
+
+Refl : (A : Type) -> (a : A) -> Id A a a
+Refl A a = refl {a}
+
+zzzz : Id MNat zero zero
+zzzz = Refl MNat zero
+
+eep : TTSigma MNat (\ c =>  Id MNat c zero)
+eep = (sigma MNat (\b => Id MNat b zero) zero zzzz)
+
+eep2 : TTSigma MNat (\ c =>  Id MNat c zero)
+eep2 = (sigma MNat (\b => Id MNat b zero) zero (Refl MNat zero))
+
+
+
diff --git a/test/reg047/run b/test/reg047/run
new file mode 100644
--- /dev/null
+++ b/test/reg047/run
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+idris $@ reg047.idr --check --nobuiltins
+idris $@ reg047a.idr --check
+rm -f *.ibc