[Pkg-haskell-commits] [agda] 02/10: Imported Upstream version 2.4.2.2

Iain Lane laney at moszumanska.debian.org
Wed May 20 11:51:58 UTC 2015


This is an automated email from the git hooks/post-receive script.

laney pushed a commit to branch master
in repository agda.

commit daa6a3eae84eb9e50a4463afe4f30ac26c8fb7aa
Author: Iain Lane <laney at debian.org>
Date:   Wed May 20 10:45:09 2015 +0100

    Imported Upstream version 2.4.2.2
---
 Agda.cabal                                         |  150 +-
 CHANGELOG                                          |  216 +++
 dist/build/Agda/Syntax/Parser/Lexer.hs             |  172 +-
 dist/build/Agda/Syntax/Parser/Parser.hs            | 1831 ++++++++++----------
 src/data/agda.sty                                  |   25 +-
 src/data/emacs-mode/agda2-highlight.el             |  112 +-
 src/data/emacs-mode/agda2-mode.el                  |   18 +-
 src/full/Agda/Auto/Auto.hs                         |  710 ++++----
 src/full/Agda/Auto/CaseSplit.hs                    |   36 +-
 src/full/Agda/Auto/Convert.hs                      |  110 +-
 src/full/Agda/Auto/NarrowingSearch.hs              |   16 +-
 src/full/Agda/Auto/SearchControl.hs                |   54 +-
 src/full/Agda/Auto/Syntax.hs                       |    7 +-
 src/full/Agda/Auto/Typecheck.hs                    |   32 +-
 src/full/Agda/Compiler/CallCompiler.hs             |    2 +-
 src/full/Agda/Compiler/Epic/AuxAST.hs              |   28 +-
 src/full/Agda/Compiler/Epic/CompileState.hs        |   51 +-
 src/full/Agda/Compiler/Epic/Compiler.hs            |   55 +-
 src/full/Agda/Compiler/Epic/Epic.hs                |    2 +-
 src/full/Agda/Compiler/Epic/Erasure.hs             |   34 +-
 src/full/Agda/Compiler/Epic/ForceConstrs.hs        |    4 +-
 src/full/Agda/Compiler/Epic/Forcing.hs             |   18 +-
 src/full/Agda/Compiler/Epic/FromAgda.hs            |   14 +-
 src/full/Agda/Compiler/Epic/Injection.hs           |   87 +-
 src/full/Agda/Compiler/Epic/Interface.hs           |    3 +-
 src/full/Agda/Compiler/Epic/NatDetection.hs        |    7 +-
 src/full/Agda/Compiler/Epic/Primitive.hs           |   28 +-
 src/full/Agda/Compiler/Epic/Smashing.hs            |   20 +-
 src/full/Agda/Compiler/Epic/Static.hs              |   26 +-
 src/full/Agda/Compiler/HaskellTypes.hs             |    5 +-
 src/full/Agda/Compiler/JS/Case.hs                  |    2 +-
 src/full/Agda/Compiler/JS/Compiler.hs              |   18 +-
 src/full/Agda/Compiler/JS/Syntax.hs                |    1 +
 src/full/Agda/Compiler/MAlonzo/Compiler.hs         |  121 +-
 src/full/Agda/Compiler/MAlonzo/Encode.hs           |    3 +
 src/full/Agda/Compiler/MAlonzo/Misc.hs             |   43 +-
 src/full/Agda/Compiler/MAlonzo/Pretty.hs           |   10 +-
 src/full/Agda/Compiler/MAlonzo/Primitives.hs       |   34 +-
 src/full/Agda/ImpossibleTest.hs                    |    1 +
 src/full/Agda/Interaction/BasicOps.hs              |  104 +-
 .../Agda/Interaction/CommandLine/CommandLine.hs    |  208 +--
 src/full/Agda/Interaction/EmacsCommand.hs          |    8 +-
 src/full/Agda/Interaction/EmacsTop.hs              |    2 -
 src/full/Agda/Interaction/Exceptions.hs            |    3 +-
 src/full/Agda/Interaction/FindFile.hs              |    5 +-
 src/full/Agda/Interaction/Highlighting/Dot.hs      |    4 +-
 src/full/Agda/Interaction/Highlighting/Emacs.hs    |   16 +-
 src/full/Agda/Interaction/Highlighting/Generate.hs |  254 ++-
 src/full/Agda/Interaction/Highlighting/HTML.hs     |   14 +-
 src/full/Agda/Interaction/Highlighting/LaTeX.hs    |   62 +-
 src/full/Agda/Interaction/Highlighting/Precise.hs  |  113 +-
 src/full/Agda/Interaction/Highlighting/Range.hs    |   10 +-
 src/full/Agda/Interaction/Highlighting/Vim.hs      |   60 +-
 src/full/Agda/Interaction/Imports.hs               |  188 +-
 src/full/Agda/Interaction/InteractionTop.hs        |   81 +-
 src/full/Agda/Interaction/MakeCase.hs              |   85 +-
 src/full/Agda/Interaction/Monad.hs                 |    9 +-
 src/full/Agda/Interaction/Options.hs               |  410 +++--
 src/full/Agda/Interaction/Options/Lenses.hs        |    8 +-
 src/full/Agda/Interaction/Response.hs              |   10 +-
 src/full/Agda/Main.hs                              |   36 +-
 src/full/Agda/Syntax/Abstract.hs                   |  638 ++++---
 src/full/Agda/Syntax/Abstract/Copatterns.hs        |   19 +-
 src/full/Agda/Syntax/Abstract/Name.hs              |  130 +-
 src/full/Agda/Syntax/Abstract/Pretty.hs            |    1 +
 src/full/Agda/Syntax/Abstract/Views.hs             |   97 +-
 src/full/Agda/Syntax/Common.hs                     |   44 +-
 src/full/Agda/Syntax/Concrete.hs                   |  698 ++++----
 src/full/Agda/Syntax/Concrete/Definitions.hs       |  454 +++--
 src/full/Agda/Syntax/Concrete/Generic.hs           |   10 +-
 src/full/Agda/Syntax/Concrete/Name.hs              |   40 +-
 src/full/Agda/Syntax/Concrete/Operators.hs         |  173 +-
 src/full/Agda/Syntax/Concrete/Operators/Parser.hs  |   62 +-
 src/full/Agda/Syntax/Concrete/Pretty.hs            |  438 ++---
 src/full/Agda/Syntax/Fixity.hs                     |  153 +-
 src/full/Agda/Syntax/Info.hs                       |  106 +-
 src/full/Agda/Syntax/Internal.hs                   |  154 +-
 src/full/Agda/Syntax/Internal/Defs.hs              |    6 +-
 src/full/Agda/Syntax/Internal/Generic.hs           |    6 +-
 src/full/Agda/Syntax/Internal/Pattern.hs           |  116 +-
 src/full/Agda/Syntax/Literal.hs                    |   15 +-
 src/full/Agda/Syntax/Notation.hs                   |  164 +-
 src/full/Agda/Syntax/Parser.hs                     |   12 +-
 src/full/Agda/Syntax/Parser/Alex.hs                |   43 +-
 src/full/Agda/Syntax/Parser/Comments.hs            |   28 +-
 src/full/Agda/Syntax/Parser/Layout.hs              |   76 +-
 src/full/Agda/Syntax/Parser/LexActions.hs          |  124 +-
 src/full/Agda/Syntax/Parser/Lexer.x                |  170 +-
 src/full/Agda/Syntax/Parser/LookAhead.hs           |   63 +-
 src/full/Agda/Syntax/Parser/Monad.hs               |  173 +-
 src/full/Agda/Syntax/Parser/Parser.y               |  551 +++---
 src/full/Agda/Syntax/Parser/StringLiterals.hs      |  137 +-
 src/full/Agda/Syntax/Parser/Tokens.hs              |   71 +-
 src/full/Agda/Syntax/Position.hs                   |  210 ++-
 src/full/Agda/Syntax/Scope/Base.hs                 |  319 ++--
 src/full/Agda/Syntax/Scope/Monad.hs                |  226 ++-
 .../Agda/Syntax/Translation/AbstractToConcrete.hs  |   42 +-
 .../Agda/Syntax/Translation/ConcreteToAbstract.hs  |  389 +++--
 .../Agda/Syntax/Translation/InternalToAbstract.hs  |   35 +-
 src/full/Agda/Termination/CallGraph.hs             |   34 +-
 src/full/Agda/Termination/CallMatrix.hs            |   18 +-
 src/full/Agda/Termination/Inlining.hs              |    6 +-
 src/full/Agda/Termination/Monad.hs                 |   78 +-
 src/full/Agda/Termination/Order.hs                 |   18 +-
 src/full/Agda/Termination/RecCheck.hs              |    4 +-
 src/full/Agda/Termination/Semiring.hs              |    3 +
 src/full/Agda/Termination/SparseMatrix.hs          |   31 +-
 src/full/Agda/Termination/TermCheck.hs             |  215 ++-
 src/full/Agda/Termination/Termination.hs           |    2 +-
 src/full/Agda/Tests.hs                             |   21 +-
 src/full/Agda/TheTypeChecker.hs                    |    1 -
 src/full/Agda/TypeChecking/Abstract.hs             |   10 +-
 src/full/Agda/TypeChecking/CheckInternal.hs        |   21 +-
 src/full/Agda/TypeChecking/CompiledClause.hs       |   62 +-
 .../Agda/TypeChecking/CompiledClause/Compile.hs    |    7 +-
 src/full/Agda/TypeChecking/CompiledClause/Match.hs |    4 +-
 src/full/Agda/TypeChecking/Constraints.hs          |   13 +-
 src/full/Agda/TypeChecking/Conversion.hs           |  111 +-
 src/full/Agda/TypeChecking/Coverage.hs             |  238 +--
 src/full/Agda/TypeChecking/Coverage/Match.hs       |    6 +-
 src/full/Agda/TypeChecking/Coverage/SplitTree.hs   |    3 +-
 src/full/Agda/TypeChecking/Datatypes.hs            |   10 +-
 src/full/Agda/TypeChecking/DisplayForm.hs          |   19 +-
 src/full/Agda/TypeChecking/DropArgs.hs             |    6 +-
 src/full/Agda/TypeChecking/Errors.hs               |  688 ++++----
 src/full/Agda/TypeChecking/EtaContract.hs          |    8 +-
 src/full/Agda/TypeChecking/Forcing.hs              |    2 +-
 src/full/Agda/TypeChecking/Free.hs                 |  285 ++-
 src/full/Agda/TypeChecking/Implicit.hs             |   10 +-
 src/full/Agda/TypeChecking/Injectivity.hs          |   46 +-
 src/full/Agda/TypeChecking/InstanceArguments.hs    |   42 +-
 src/full/Agda/TypeChecking/Level.hs                |    6 +-
 src/full/Agda/TypeChecking/LevelConstraints.hs     |    2 +-
 src/full/Agda/TypeChecking/MetaVars.hs             |  132 +-
 src/full/Agda/TypeChecking/MetaVars.hs-boot        |    8 +-
 src/full/Agda/TypeChecking/MetaVars/Mention.hs     |    7 +-
 src/full/Agda/TypeChecking/MetaVars/Occurs.hs      |   40 +-
 src/full/Agda/TypeChecking/Monad/Base.hs           | 1013 +++++++----
 src/full/Agda/TypeChecking/Monad/Base/Benchmark.hs |   11 +-
 src/full/Agda/TypeChecking/Monad/Base/KillRange.hs |    8 +-
 src/full/Agda/TypeChecking/Monad/Benchmark.hs      |    2 +-
 src/full/Agda/TypeChecking/Monad/Builtin.hs        |  206 ++-
 src/full/Agda/TypeChecking/Monad/Closure.hs        |    1 -
 src/full/Agda/TypeChecking/Monad/Constraints.hs    |   20 +-
 src/full/Agda/TypeChecking/Monad/Context.hs        |   24 +-
 src/full/Agda/TypeChecking/Monad/Debug.hs          |    1 -
 src/full/Agda/TypeChecking/Monad/Env.hs            |   27 +-
 src/full/Agda/TypeChecking/Monad/Exception.hs      |    9 +-
 src/full/Agda/TypeChecking/Monad/Imports.hs        |   43 +-
 src/full/Agda/TypeChecking/Monad/MetaVars.hs       |   60 +-
 src/full/Agda/TypeChecking/Monad/Mutual.hs         |   14 +-
 src/full/Agda/TypeChecking/Monad/Open.hs           |   13 +-
 src/full/Agda/TypeChecking/Monad/Options.hs        |   33 +-
 src/full/Agda/TypeChecking/Monad/Sharing.hs        |    2 +-
 src/full/Agda/TypeChecking/Monad/Signature.hs      |  107 +-
 src/full/Agda/TypeChecking/Monad/SizedTypes.hs     |   21 +-
 src/full/Agda/TypeChecking/Monad/State.hs          |   91 +-
 src/full/Agda/TypeChecking/Monad/Statistics.hs     |   33 +-
 src/full/Agda/TypeChecking/Monad/Trace.hs          |    9 +-
 src/full/Agda/TypeChecking/Patterns/Abstract.hs    |   48 +-
 src/full/Agda/TypeChecking/Patterns/Match.hs       |   60 +-
 src/full/Agda/TypeChecking/Polarity.hs             |   10 +-
 src/full/Agda/TypeChecking/Positivity.hs           |   22 +-
 src/full/Agda/TypeChecking/Pretty.hs               |  132 +-
 src/full/Agda/TypeChecking/Pretty.hs-boot          |    4 +-
 src/full/Agda/TypeChecking/Primitive.hs            |  243 +--
 src/full/Agda/TypeChecking/ProjectionLike.hs       |    8 +-
 src/full/Agda/TypeChecking/Quote.hs                |  461 +----
 src/full/Agda/TypeChecking/RecordPatterns.hs       |   12 +-
 src/full/Agda/TypeChecking/Records.hs              |    8 +-
 src/full/Agda/TypeChecking/Reduce.hs               |  289 ++-
 src/full/Agda/TypeChecking/Reduce/Monad.hs         |   34 +-
 src/full/Agda/TypeChecking/Rewriting.hs            |    2 +-
 src/full/Agda/TypeChecking/Rules/Builtin.hs        |   12 +-
 .../Agda/TypeChecking/Rules/Builtin/Coinduction.hs |    9 +-
 src/full/Agda/TypeChecking/Rules/Data.hs           |  140 +-
 src/full/Agda/TypeChecking/Rules/Decl.hs           |  199 ++-
 src/full/Agda/TypeChecking/Rules/Def.hs            |  215 +--
 src/full/Agda/TypeChecking/Rules/Def.hs-boot       |    6 +-
 src/full/Agda/TypeChecking/Rules/LHS.hs            |  731 ++++----
 src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs   |   22 +-
 .../Agda/TypeChecking/Rules/LHS/Instantiate.hs     |   32 +-
 src/full/Agda/TypeChecking/Rules/LHS/Problem.hs    |   75 +-
 .../Agda/TypeChecking/Rules/LHS/ProblemRest.hs     |    4 +-
 src/full/Agda/TypeChecking/Rules/LHS/Split.hs      |  369 ++--
 src/full/Agda/TypeChecking/Rules/LHS/Unify.hs      |  184 +-
 src/full/Agda/TypeChecking/Rules/Record.hs         |  117 +-
 src/full/Agda/TypeChecking/Rules/Term.hs           |  347 ++--
 src/full/Agda/TypeChecking/Rules/Term.hs-boot      |    4 +-
 src/full/Agda/TypeChecking/Serialise.hs            | 1155 ++++++++----
 src/full/Agda/TypeChecking/SizedTypes.hs           |   21 +-
 src/full/Agda/TypeChecking/SizedTypes/Solve.hs     |   18 +-
 src/full/Agda/TypeChecking/SizedTypes/Syntax.hs    |   18 +-
 src/full/Agda/TypeChecking/SizedTypes/Tests.hs     |   94 +-
 src/full/Agda/TypeChecking/SizedTypes/Utils.hs     |   10 +-
 .../Agda/TypeChecking/SizedTypes/WarshallSolver.hs |   43 +-
 src/full/Agda/TypeChecking/Substitute.hs           |  194 ++-
 src/full/Agda/TypeChecking/SyntacticEquality.hs    |   12 +-
 src/full/Agda/TypeChecking/Telescope.hs            |   42 +-
 src/full/Agda/TypeChecking/Test/Generators.hs      |  192 +-
 src/full/Agda/TypeChecking/Tests.hs                |   17 +-
 src/full/Agda/TypeChecking/Unquote.hs              |  403 +++++
 src/full/Agda/TypeChecking/With.hs                 |    8 +-
 src/full/Agda/Utils/AssocList.hs                   |   79 +
 src/full/Agda/Utils/Bag.hs                         |  217 +++
 src/full/Agda/Utils/BiMap.hs                       |   15 +-
 src/full/Agda/Utils/Char.hs                        |   46 +-
 src/full/Agda/Utils/Cluster.hs                     |   91 +-
 src/full/Agda/Utils/Either.hs                      |   59 +-
 src/full/Agda/Utils/Empty.hs                       |   24 +
 src/full/Agda/Utils/Except.hs                      |   62 +
 src/full/Agda/Utils/Favorites.hs                   |   13 +-
 src/full/Agda/Utils/FileName.hs                    |   11 +-
 src/full/Agda/Utils/Fresh.hs                       |   23 -
 src/full/Agda/Utils/Function.hs                    |   47 +-
 src/full/Agda/Utils/Functor.hs                     |   13 +
 src/full/Agda/Utils/Geniplate.hs                   |    5 +
 src/full/Agda/Utils/Graph/AdjacencyMap.hs          |    6 +-
 .../Utils/Graph/AdjacencyMap/Unidirectional.hs     |   29 +-
 src/full/Agda/Utils/HashMap.hs                     |    1 -
 src/full/Agda/Utils/IO/UTF8.hs                     |   17 +-
 src/full/Agda/Utils/IORef.hs                       |   29 +
 src/full/Agda/Utils/Lens.hs                        |   68 +
 src/full/Agda/Utils/Lens/Examples.hs               |   18 +
 src/full/Agda/Utils/List.hs                        |   88 +-
 src/full/Agda/Utils/Map.hs                         |   22 +-
 src/full/Agda/Utils/Maybe.hs                       |    2 +-
 src/full/Agda/Utils/Maybe/Strict.hs                |    4 +-
 src/full/Agda/Utils/Monad.hs                       |   58 +-
 src/full/Agda/Utils/Null.hs                        |   20 +
 src/full/Agda/Utils/PartialOrd.hs                  |   41 +-
 src/full/Agda/Utils/Permutation.hs                 |   84 +-
 src/full/Agda/Utils/Permutation/Tests.hs           |  117 ++
 src/full/Agda/Utils/Pointer.hs                     |    1 +
 src/full/Agda/Utils/Pretty.hs                      |   49 +-
 src/full/Agda/Utils/ReadP.hs                       |   17 +-
 src/full/Agda/Utils/SemiRing.hs                    |    1 -
 src/full/Agda/Utils/Size.hs                        |   56 +-
 src/full/Agda/Utils/String.hs                      |    5 +-
 src/full/Agda/Utils/Suffix.hs                      |   32 +-
 src/full/Agda/Utils/Time.hs                        |   26 +-
 src/full/Agda/Utils/Trie.hs                        |   13 +-
 src/full/Agda/Utils/Tuple.hs                       |    6 +-
 src/full/Agda/Utils/Unicode.hs                     |   26 -
 src/full/Agda/Utils/Update.hs                      |    1 +
 src/full/Agda/Utils/VarSet.hs                      |   19 +-
 src/full/Agda/Utils/Warshall.hs                    |   28 +-
 src/full/Agda/Version.hs                           |    1 -
 src/full/{Agda => }/undefined.h                    |    0
 249 files changed, 13467 insertions(+), 10103 deletions(-)

diff --git a/Agda.cabal b/Agda.cabal
index 7499eef..56c6023 100644
--- a/Agda.cabal
+++ b/Agda.cabal
@@ -1,5 +1,5 @@
 name:            Agda
-version:         2.4.2
+version:         2.4.2.2
 cabal-version:   >= 1.8
 build-type:      Custom
 license:         OtherLicense
@@ -32,11 +32,11 @@ description:
   Note that the Agda library does not follow the package versioning
   policy, because it is not intended to be used by third-party
   packages.
-tested-with:        GHC == 7.2.2
+tested-with:        GHC == 7.0.4
                     GHC == 7.4.2
                     GHC == 7.6.3
                     GHC == 7.8.3
-extra-source-files: src/full/Agda/undefined.h
+extra-source-files: src/full/undefined.h
                     README.md
                     CHANGELOG
 data-dir:           src/data
@@ -56,7 +56,12 @@ source-repository head
 source-repository this
   type:     git
   location: https://github.com/agda/agda
-  tag:      2.4.2
+  tag:      2.4.2.2
+
+flag cpphs
+  default:     True
+  manual:      True
+  description: Use cpphs instead of cpp.
 
 flag epic
   default: False
@@ -66,55 +71,67 @@ flag epic
 
 library
   hs-source-dirs:   src/full
+  include-dirs:     src/full
   if flag(epic)
     build-depends:  epic >= 0.1.13 && < 0.10
 
   if os(windows)
     build-depends:  Win32 >= 2.2 && < 2.4
 
-  build-depends:    base >= 4.2 && < 4.8,
-                    transformers == 0.3.*,
-                    -- mtl-2.1 contains a severe bug
-                    mtl >= 2.1.1 && < 2.2,
-                    QuickCheck >= 2.7.5 && < 2.8,
-                    haskell-src-exts >= 1.9.6 && < 1.16,
-                    containers >= 0.1 && < 0.6,
-                    unordered-containers == 0.2.*,
-                    pretty >= 1.0 && < 1.2,
-                    bytestring >= 0.9.0.1 && < 0.11,
-                    array >= 0.1 && < 0.6,
-                    binary >= 0.6 && < 0.8,
-                    zlib >= 0.4.0.1 && < 0.6,
-                    filepath >= 1.1 && < 1.4,
-                    process >= 1.0.1.0 && < 1.3,
-                    haskeline >= 0.7 && < 0.8,
-                    data-hash == 0.2.0.0,
-                    xhtml == 3000.2.*,
-                    -- hashable 1.2.0.10 makes library-test 10x
-                    -- slower. The issue was fixed in hashable 1.2.1.0.
-                    -- https://github.com/tibbe/hashable/issues/57.
-                    hashable >= 1.1.2.3 && < 1.2 || >= 1.2.1.0 && < 1.3,
-                    hashtables >= 1.0 && < 1.2,
-                    geniplate >= 0.6.0.3 && < 0.7,
-                    -- parsec >= 3.1 && < 3.2,  -- only for Agda.TypeChecking.SizedTypes.Parser, which is not included
-                    parallel < 3.3,
-                    deepseq == 1.3.*,
-                    strict >= 0.3.2 && < 0.4,
-                    STMonadTrans >= 0.3.2 && < 0.4,
-                    equivalence >= 0.2.4  && < 0.3,
-                    boxes >= 0.1.3 && < 0.2,
-                    text >= 0.11 && < 1.2
+  build-depends:
+    array >= 0.1 && < 0.6
+    , base >= 4.2 && < 4.8
+    , binary >= 0.6 && < 0.8
+    , boxes >= 0.1.3 && < 0.2
+    -- NFData ByteString is only available from bytestring >= 0.10
+    -- but bytestring-0.10 is not accepted by travis build for ghc <= 7.4
+    -- as it breaks the accompanying haskell-platform
+    -- even though it builds with older ghcs.
+    , bytestring >= 0.9.0.1 && < 0.11
+    , containers >= 0.1 && < 0.6
+    , data-hash == 0.2.0.0
+    , deepseq == 1.3.*
+    , equivalence >= 0.2.5  && < 0.3
+    , filepath >= 1.1 && < 1.4
+    , geniplate >= 0.6.0.3 && < 0.7
+    -- hashable 1.2.0.10 makes library-test 10x slower. The issue was
+    -- fixed in hashable 1.2.1.0.
+    -- https://github.com/tibbe/hashable/issues/57.
+    , hashable >= 1.1.2.3 && < 1.2 || >= 1.2.1.0 && < 1.3
+    , hashtables >= 1.0 && < 1.2
+    , haskeline >= 0.7 && < 0.8
+    , haskell-src-exts >= 1.9.6 && < 1.17
+    -- mtl-2.1 contains a severe bug.
+    --
+    -- mtl >= 2.2 && < 2.2.1 doesn't export Control.Monad.Except.
+    , mtl >= 2.1.1 && <= 2.1.3.1 || >= 2.2.1 && < 2.3
+    , parallel < 3.3
+    -- , parsec >= 3.1 && < 3.2,  -- only for Agda.TypeChecking.SizedTypes.Parser, which is not included
+    , pretty >= 1.0 && < 1.2
+    , process >= 1.0.1.0 && < 1.3
+    , QuickCheck >= 2.7.5 && < 2.8
+    , STMonadTrans >= 0.3.2 && < 0.4
+    , strict >= 0.3.2 && < 0.4
+    , template-haskell >= 2.5 && < 2.10
+    , text >= 0.11 && < 1.3
+    -- tranformers 0.4.0.0 was deprecated.
+    , transformers >= 0.3 && < 0.4 || >= 0.4.1.0 && < 0.5
+    , unordered-containers == 0.2.*
+    , xhtml == 3000.2.*
+    , zlib >= 0.4.0.1 && < 0.6
 
   if impl(ghc < 7.6)
-    build-depends:  old-time >= 1.0 && < 1.2,
-                    directory >= 1.0 && < 1.2
+    build-depends:
+      directory >= 1.0 && < 1.2
+      , old-time >= 1.0 && < 1.2
   else
-      build-depends:  time == 1.4.*,
-                      directory == 1.2.*
+      build-depends:
+        directory == 1.2.*
+        , time == 1.4.*
 
-  build-tools:      happy >= 1.19.3 && < 2,
-                    alex >= 3.1.0 && < 3.2,
-                    cpphs >= 1.18.5 && < 1.19
+  build-tools:
+    alex >= 3.1.0 && < 3.2
+    , happy >= 1.19.3 && < 2
 
   exposed-modules:  Agda.Main
                     Agda.ImpossibleTest
@@ -313,14 +330,18 @@ library
                     Agda.TypeChecking.Test.Generators
                     Agda.TypeChecking.Tests
 --                    Agda.TypeChecking.UniversePolymorphism -- RETIRED
+                    Agda.TypeChecking.Unquote
                     Agda.TypeChecking.With
+                    Agda.Utils.AssocList
+                    Agda.Utils.Bag
                     Agda.Utils.BiMap
                     Agda.Utils.Char
                     Agda.Utils.Cluster
+                    Agda.Utils.Empty
+                    Agda.Utils.Except
                     Agda.Utils.Either
                     Agda.Utils.Favorites
                     Agda.Utils.FileName
-                    Agda.Utils.Fresh
                     Agda.Utils.Functor
                     Agda.Utils.Function
                     Agda.Utils.Geniplate
@@ -331,6 +352,9 @@ library
                     Agda.Utils.Impossible
                     Agda.Utils.IO.Binary
                     Agda.Utils.IO.UTF8
+                    Agda.Utils.IORef
+                    Agda.Utils.Lens
+                    Agda.Utils.Lens.Examples
                     Agda.Utils.List
                     Agda.Utils.Map
                     Agda.Utils.Maybe
@@ -339,6 +363,7 @@ library
                     Agda.Utils.Null
                     Agda.Utils.PartialOrd
                     Agda.Utils.Permutation
+                    Agda.Utils.Permutation.Tests
                     Agda.Utils.Pointer
                     Agda.Utils.Pointed
                     Agda.Utils.Pretty
@@ -352,7 +377,6 @@ library
                     Agda.Utils.Time
                     Agda.Utils.Trie
                     Agda.Utils.Tuple
-                    Agda.Utils.Unicode
                     Agda.Utils.Update
                     Agda.Utils.VarSet
                     Agda.Utils.Warshall
@@ -376,20 +400,27 @@ library
                     -fwarn-incomplete-patterns
                     -fwarn-missing-fields
                     -fwarn-missing-methods
+                    -fwarn-missing-signatures
                     -fwarn-monomorphism-restriction
+                    -fwarn-tabs
                     -fwarn-overlapping-patterns
                     -fwarn-unrecognised-pragmas
                     -fwarn-warnings-deprecations
-                    -- Using cpphs as the C preprocessor.
-                    -pgmPcpphs -optP--cpp
+
+  if flag(cpphs)
+    build-tools: cpphs >= 1.18.6 && < 1.19
+    ghc-options: -pgmPcpphs -optP--cpp
 
   -- The Cabal-generated module Paths_Agda triggers a warning under
   -- GHC 7.2.1/7.2.2 (at least when certain versions of Cabal are
   -- used).
-  -- Issue 1103: Termination.SparseMatrix triggers a warning under GHC 7.0.4.
-  -- -Werror is for developers only, who are assumed to use a recent GHC.
+  --
+  -- Issue 1103: Some files (e.g. Syntax.Scope.Monad,
+  -- Termination.SparseMatrix and Utils.Cluster) trigger a warning
+  -- under GHC 7.0.4.  -Werror is for developers only, who are assumed
+  -- to use a recent GHC.
   -- if impl(ghc > 7.2.2)
-  --   ghc-options:    -Werror
+  --    ghc-options:    -Werror
   if impl(ghc >= 6.12)
     ghc-options:    -fwarn-dodgy-exports
                     -fwarn-wrong-do-bind
@@ -410,10 +441,11 @@ library
 executable agda
   hs-source-dirs: src/main
   main-is:        Main.hs
-  build-depends:  Agda == 2.4.2,
-                  -- Nothing is used from the following package, except
-                  -- for the prelude.
-                  base >= 3 && < 6
+  build-depends:
+    Agda == 2.4.2.2
+    -- Nothing is used from the following package, except for the
+    -- prelude.
+    , base >= 3 && < 6
   if impl(ghc >= 7)
     -- If someone installs Agda with the setuid bit set, then the
     -- presence of +RTS may be a security problem (see GHC bug #3910).
@@ -426,7 +458,9 @@ executable agda-mode
   hs-source-dirs:   src/agda-mode
   main-is:          Main.hs
   other-modules:    Paths_Agda
-  build-depends:    base >= 4.2 && < 4.8,
-                    filepath >= 1.1 && < 1.4,
-                    process >= 1.0.1.0 && < 1.3,
-                    directory >= 1.0 && < 1.3
+  build-depends:
+    base >= 4.2 && < 4.8
+    , directory >= 1.0 && < 1.3
+    , filepath >= 1.1 && < 1.4
+    , process >= 1.0.1.0 && < 1.3
+
diff --git a/CHANGELOG b/CHANGELOG
index 309096d..6378f89 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,4 +1,220 @@
 ------------------------------------------------------------------------
+-- Release notes for Agda version 2.4.2.2
+------------------------------------------------------------------------
+
+Important changes since 2.4.2.1:
+
+Bug fixes
+=========
+
+* Compilation on Windows fixed.
+
+* Other issues fixed ( see https://code.google.com/p/agda/issues )
+  1332
+  1353
+  1360
+  1366
+  1369
+
+------------------------------------------------------------------------
+-- Release notes for Agda version 2.4.2.1
+------------------------------------------------------------------------
+
+Important changes since 2.4.2:
+
+Pragmas and options
+===================
+
+* New pragma {-# TERMINATING #-} replacing {-# NO_TERMINATION_CHECK #-}
+
+  Complements the existing pragma {-# NON_TERMINATING #-}.
+  Skips termination check for the associated definitions and marks
+  them as terminating.  Thus, it is a replacement for
+  {-# NO_TERMINATION_CHECK #-} with the same semantics.
+
+  You can no longer use pragma {-# NO_TERMINATION_CHECK #-} to skip
+  the termination check, but must label your definitions as either
+  {-# TERMINATING #-} or {-# NON_TERMINATING #-} instead.
+
+  Note: {-# OPTION --no-termination-check #-} labels all your
+  definitions as {-# TERMINATING #-}, putting you in the danger zone
+  of a loop in the type checker.
+
+Language
+========
+
+* Referring to a local variable shadowed by module opening is now
+  an error.  Previous behavior was preferring the local over the
+  imported definitions. [Issue 1266]
+
+  Note that module parameters are locals as well as variables bound by
+  λ, dependent function type, patterns, and let.
+
+  Example:
+
+    module M where
+      A = Set1
+
+    test : (A : Set) → let open M in A
+
+  The last A produces an error, since it could refer to the local
+  variable A or to the definition imported from module M.
+
+* `with` on a variable bound by a module telescope or a pattern of a
+  parent function is now forbidden.  [Issue 1342]
+
+    data Unit : Set where
+      unit : Unit
+
+    id : (A : Set) → A → A
+    id A a = a
+
+    module M (x : Unit) where
+
+      dx : Unit → Unit
+      dx unit = x
+
+      g : ∀ u → x ≡ dx u
+      g with x
+      g | unit  = id (∀ u → unit ≡ dx u) ?
+
+  Even though this code looks right, Agda complains about the type
+  expression `∀ u → unit ≡ dx u`.  If you ask Agda what should go
+  there instead, it happily tells you that it wants
+  `∀ u → unit ≡ dx u`. In fact what you do not see and Agda
+  will never show you is that the two expressions actually differ in
+  the invisible first argument to `dx`, which is visible only outside
+  module `M`.  What Agda wants is an invisible `unit` after `dx`, but all
+  you can write is an invisible `x` (which is inserted behind the
+  scenes).
+
+  To avoid those kinds of paradoxes, `with` is now outlawed on module
+  parameters.  This should ensure that the invisible arguments are
+  always exactly the module parameters.
+
+  Since a `where` block is desugared as module with pattern variables
+  of the parent clause as module parameters, the same strikes you for
+  uses of `with` on pattern variables of the parent function.
+
+    f : Unit → Unit
+    f x = unit
+      where
+        dx : Unit → Unit
+        dx unit = x
+
+        g : ∀ u → x ≡ dx u
+        g with x
+        g | unit  = id ((u : Unit) → unit ≡ dx u) ?
+
+  The `with` on pattern variable `x` of the parent clause `f x = unit`
+  is outlawed now.
+
+Type checking
+=============
+
+* Termination check failure is now a proper error.
+
+  We no longer continue type checking after termination check failures.
+  Use pragmas {-# NON_TERMINATING #-} and {-# NO_TERMINATION_CHECK #-}
+  near the offending definitions if you want to do so.
+  Or switch off the termination checker altogether with
+  {-# OPTIONS --no-termination-check #-} (at your own risk!).
+
+* (Since Agda 2.4.2:) Termination checking --without-K restricts
+  structural descent to arguments ending in data types or `Size`.
+  Likewise, guardedness is only tracked when result type is data or
+  record type.
+
+    mutual
+      data WOne : Set where wrap : FOne → WOne
+      FOne = ⊥ → WOne
+
+    noo : (X : Set) → (WOne ≡ X) → X → ⊥
+    noo .WOne refl (wrap f) = noo FOne iso f
+
+  `noo` is rejected since at type `X` the structural descent
+  `f < wrap f` is discounted --without-K.
+
+    data Pandora : Set where
+      C : ∞ ⊥ → Pandora
+
+    loop : (A : Set) → A ≡ Pandora → A
+    loop .Pandora refl = C (♯ (loop ⊥ foo))
+
+  `loop` is rejected since guardedness is not tracked at type `A`
+  --without-K.
+
+  See issues 1023, 1264, 1292.
+
+Termination checking
+====================
+
+* The termination checker can now recognize simple subterms in dot
+  patterns.
+
+    data Subst : (d : Nat) → Set where
+      c₁ : ∀ {d} → Subst d → Subst d
+      c₂ : ∀ {d₁ d₂} → Subst d₁ → Subst d₂ → Subst (suc d₁ + d₂)
+
+    postulate
+      comp : ∀ {d₁ d₂} → Subst d₁ → Subst d₂ → Subst (d₁ + d₂)
+
+    lookup : ∀ d → Nat → Subst d → Set₁
+    lookup d             zero    (c₁ ρ)             = Set
+    lookup d             (suc v) (c₁ ρ)             = lookup d v ρ
+    lookup .(suc d₁ + d₂) v      (c₂ {d₁} {d₂} ρ σ) = lookup (d₁ + d₂) v (comp ρ σ)
+
+  The dot pattern here is actually normalized, so it is
+
+    suc (d₁ + d₂)
+
+  and the corresponding recursive call argument is (d₁ + d₂).
+  In such simple cases, Agda can now recognize that the pattern is
+  constructor applied to call argument, which is valid descent.
+
+  Note however, that Agda only looks for syntactic equality when
+  identifying subterms, since it is not allowed to normalize terms on
+  the rhs during termination checking.
+
+  Actually writing the dot pattern has no effect, this works as well,
+  and looks pretty magical... ;-)
+
+    hidden : ∀{d} → Nat → Subst d → Set₁
+    hidden zero    (c₁ ρ)   = Set
+    hidden (suc v) (c₁ ρ)   = hidden v ρ
+    hidden v       (c₂ ρ σ) = hidden v (comp ρ σ)
+
+Tools
+=====
+
+LaTeX-backend
+-------------
+
+* Fixed the issue of identifiers containing operators being typeset with
+  excessive math spacing.
+
+Bug fixes
+=========
+
+* Issue 1194
+
+* Issue 836:  Fields and constructors can be qualified by the
+  record/data *type* as well as by their record/data module.
+  This now works also for record/data type imported from
+  parametrized modules:
+
+    module M (_ : Set₁) where
+
+      record R : Set₁ where
+        field
+          X : Set
+
+    open M Set using (R)  -- rather than using (module R)
+
+    X : R → Set
+    X = R.X
+
+------------------------------------------------------------------------
 -- Release notes for Agda version 2.4.2
 ------------------------------------------------------------------------
 
diff --git a/dist/build/Agda/Syntax/Parser/Lexer.hs b/dist/build/Agda/Syntax/Parser/Lexer.hs
index a5ad87d..1b7cd64 100644
--- a/dist/build/Agda/Syntax/Parser/Lexer.hs
+++ b/dist/build/Agda/Syntax/Parser/Lexer.hs
@@ -1,9 +1,13 @@
 {-# LANGUAGE CPP,MagicHash #-}
 {-# LINE 1 "src/full/Agda/Syntax/Parser/Lexer.x" #-}
 
-{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -fno-warn-deprecated-flags   #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_GHC -fno-warn-tabs               #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports     #-}
+
 {-# LANGUAGE BangPatterns #-}
+
 {-| The lexer is generated by Alex (<http://www.haskell.org/alex>) and is an
     adaptation of GHC's lexer. The main lexing function 'lexer' is called by
     the "Agda.Syntax.Parser.Parser" to get the next token from the input.
@@ -51,19 +55,19 @@ import GHC.Exts
 import GlaExts
 #endif
 alex_base :: AlexAddr
-alex_base = AlexA# "\xf7\xff\xff\xff\x6c\x00\x00\x00\xe1\x00\x00\x00\x55\x01\x00\x00\xca\x01\x00\x00\x3f\x02\x00\x00\xb5\x02\x00\x00\xab\x03\x00\x00\x88\xff\xff\xff\xd9\xff\xff\xff\x8a\x04\x00\x00\xe8\x04\x00\x00\x46\x05\x00\x00\xb6\x02\x00\x00\xa2\x05\x00\x00\x9d\x03\x00\x00\xfe\x05\x00\x00\xfd\x05\x00\x00\x7d\x06\x00\x00\xa2\xff\xff\xff\xfd\x06\x00\x00\xdc\x07\x00\x00\xdb\x07\x00\x00\x5b\x08\x00\x00\xdb\x08\x00\x00\x5b\x09\x00\x00\x3a\x0a\x00\x00\x96\x0a\x00\x00\xf2\x0a\x00\x00\xf1\x0a [...]
+alex_base = AlexA# "\xf7\xff\xff\xff\x6c\x00\x00\x00\xe1\x00\x00\x00\x55\x01\x00\x00\xca\x01\x00\x00\x3f\x02\x00\x00\xb5\x02\x00\x00\xab\x03\x00\x00\x88\xff\xff\xff\xd9\xff\xff\xff\x8a\x04\x00\x00\xe8\x04\x00\x00\x46\x05\x00\x00\xb6\x02\x00\x00\xa2\x05\x00\x00\x9d\x03\x00\x00\xfe\x05\x00\x00\xfd\x05\x00\x00\x7d\x06\x00\x00\xa2\xff\xff\xff\xfd\x06\x00\x00\xdc\x07\x00\x00\xdb\x07\x00\x00\x5b\x08\x00\x00\xdb\x08\x00\x00\x5b\x09\x00\x00\x3a\x0a\x00\x00\x96\x0a\x00\x00\xf2\x0a\x00\x00\xf1\x0a [...]
 
 alex_table :: AlexAddr
-alex_table = AlexA# "\x00\x00\xde\x00\x54\x00\x54\x00\x54\x00\x53\x00\xd1\x00\x08\x00\x27\x00\x1e\x00\x1f\x00\x22\x00\x20\x00\x13\x00\x43\x00\x56\x00\x0e\x01\x0f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x90\x01\x20\x01\x90\x01\x90\x01\x90\x01\x90\x01\x1f\x01\x17\x01\x18\x01\x90\x01\x90\x01\x90\x01\x32\x01\x10\x01\x90\x01\x25\x01\x24\x01\x24\x01\x24\x01\x24\x01\x24\x01\x24\x01\x24\x01\x24\x01\x24\x01\x12\x01\x11\x01\x90\x01\x13\x01\x90\x01\x15\x01\x1b\x01\x90\x01\x90\x01\x90\x0 [...]
+alex_table = AlexA# "\x00\x00\xe9\x00\x54\x00\x54\x00\x54\x00\x53\x00\xdc\x00\x08\x00\x27\x00\x1e\x00\x1f\x00\x22\x00\x20\x00\x13\x00\x43\x00\x56\x00\x19\x01\x1a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x9b\x01\x2b\x01\x9b\x01\x9b\x01\x9b\x01\x9b\x01\x2a\x01\x22\x01\x23\x01\x9b\x01\x9b\x01\x9b\x01\x3d\x01\x1b\x01\x9b\x01\x30\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x2f\x01\x1d\x01\x1c\x01\x9b\x01\x1e\x01\x9b\x01\x20\x01\x26\x01\x9b\x01\x9b\x01\x9b\x0 [...]
 
 alex_check :: AlexAddr
-alex_check = AlexA# "\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7d\x00\x2d\x00\x65\x00\x6f\x00\x63\x00\x7b\x00\x6e\x00\x64\x00\x64\x00\x0a\x00\x23\x00\x2e\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x0 [...]
+alex_check = AlexA# "\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7d\x00\x2d\x00\x65\x00\x6f\x00\x63\x00\x7b\x00\x6e\x00\x64\x00\x64\x00\x0a\x00\x23\x00\x2e\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x0 [...]
 
 alex_deflt :: AlexAddr
-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa7\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\x2c\x00\x2e\x00\x2e\x00\xff\xff\x30\x00\x30\x00\x32\x00\x32\x00\x37\x00\x37\x00\x3a\x00\x3a\x00\x3d\x00\x3d\x00\x42\x00\x42\x00\xff\xff\xd7\x00\xd7\x00\xd7\x00\xa7\x00\xa7\x00\xa7\x0 [...]
+alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xae\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\x2c\x00\x2e\x00\x2e\x00\xff\xff\x30\x00\x30\x00\x32\x00\x32\x00\x37\x00\x37\x00\x3a\x00\x3a\x00\x3d\x00\x3d\x00\x42\x00\x42\x00\xff\xff\xe2\x00\xe2\x00\xe2\x00\xae\x00\xae\x00\xae\x0 [...]
 
-alex_accept = listArray (0::Int,486) [AlexAccNone,AlexAccPred  (alex_action_36) ( not' eof )(AlexAccNone),AlexAccNone,AlexAcc (alex_action_39),AlexAccNone,AlexAcc (alex_action_38),AlexAccNone,AlexAccPred  (alex_action_4) ( eof )(AlexAccNone),AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNon [...]
-{-# LINE 228 "src/full/Agda/Syntax/Parser/Lexer.x" #-}
+alex_accept = listArray (0::Int,497) [AlexAccNone,AlexAccPred  (alex_action_37) ( not' eof )(AlexAccNone),AlexAccNone,AlexAcc (alex_action_40),AlexAccNone,AlexAcc (alex_action_39),AlexAccNone,AlexAccPred  (alex_action_4) ( eof )(AlexAccNone),AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNon [...]
+{-# LINE 236 "src/full/Agda/Syntax/Parser/Lexer.x" #-}
 
 
 -- | This is the initial state for parsing a literate file. Code blocks
@@ -169,84 +173,86 @@ alex_action_22 =  keyword KwIMPOSSIBLE
 alex_action_23 =  keyword KwETA 
 alex_action_24 =  keyword KwNO_TERMINATION_CHECK 
 alex_action_25 =  keyword KwNON_TERMINATING 
-alex_action_26 =  keyword KwMEASURE 
-alex_action_27 =  keyword KwLINE 
-alex_action_28 =  withInterval $ TokString 
-alex_action_29 =  nestedComment 
-alex_action_30 =  symbol SymEndComment 
+alex_action_26 =  keyword KwTERMINATING 
+alex_action_27 =  keyword KwMEASURE 
+alex_action_28 =  keyword KwLINE 
+alex_action_29 =  withInterval $ TokString 
+alex_action_30 =  nestedComment 
 alex_action_31 =  symbol SymEndComment 
-alex_action_32 =  withInterval TokComment 
-alex_action_34 =  begin bol_ 
-alex_action_36 =  offsideRule 
-alex_action_38 =  endWith newLayoutContext 
-alex_action_39 =  emptyLayout 
-alex_action_40 =  keyword KwLet 
-alex_action_41 =  keyword KwIn 
-alex_action_42 =  keyword KwWhere 
-alex_action_43 =  keyword KwField 
-alex_action_44 =  keyword KwWith 
-alex_action_45 =  keyword KwRewrite 
-alex_action_46 =  keyword KwPostulate 
-alex_action_47 =  keyword KwPrimitive 
-alex_action_48 =  keyword KwOpen 
-alex_action_49 =  keyword KwImport 
-alex_action_50 =  keyword KwModule 
-alex_action_51 =  keyword KwData 
-alex_action_52 =  keyword KwCoData 
-alex_action_53 =  keyword KwRecord 
-alex_action_54 =  keyword KwConstructor 
-alex_action_55 =  keyword KwInductive 
-alex_action_56 =  keyword KwCoInductive 
-alex_action_57 =  keyword KwInfix 
-alex_action_58 =  keyword KwInfixL 
-alex_action_59 =  keyword KwInfixR 
-alex_action_60 =  keyword KwMutual 
-alex_action_61 =  keyword KwAbstract 
-alex_action_62 =  keyword KwPrivate 
-alex_action_63 =  keyword KwInstance 
-alex_action_64 =  keyword KwSet 
-alex_action_65 =  keyword KwProp 
-alex_action_66 =  keyword KwForall 
-alex_action_67 =  withInterval' (read . drop 3) TokSetN 
-alex_action_68 =  keyword KwQuoteGoal 
-alex_action_69 =  keyword KwQuoteContext 
-alex_action_70 =  keyword KwQuote 
-alex_action_71 =  keyword KwQuoteTerm 
-alex_action_72 =  keyword KwUnquote 
-alex_action_73 =  keyword KwUnquoteDecl 
-alex_action_74 =  keyword KwTactic 
-alex_action_75 =  keyword KwSyntax 
-alex_action_76 =  keyword KwPatternSyn 
-alex_action_77 =  keyword KwUsing 
-alex_action_78 =  keyword KwHiding 
-alex_action_79 =  keyword KwRenaming 
-alex_action_80 =  endWith $ keyword KwTo 
-alex_action_81 =  keyword KwPublic 
-alex_action_82 =  hole 
-alex_action_83 =  symbol SymEllipsis 
-alex_action_84 =  symbol SymDotDot 
-alex_action_85 =  symbol SymDot 
-alex_action_86 =  symbol SymSemi 
-alex_action_87 =  symbol SymColon 
-alex_action_88 =  symbol SymEqual 
-alex_action_89 =  symbol SymUnderscore 
-alex_action_90 =  symbol SymQuestionMark 
-alex_action_91 =  symbol SymBar 
-alex_action_92 =  symbol SymOpenParen 
-alex_action_93 =  symbol SymCloseParen 
-alex_action_94 =  symbol SymArrow 
-alex_action_95 =  symbol SymLambda 
-alex_action_96 =  symbol SymAs 
-alex_action_97 =  symbol SymDoubleOpenBrace 
-alex_action_98 =  symbol SymOpenBrace 
-alex_action_99 =  symbol SymCloseBrace 
-alex_action_100 =  litChar 
-alex_action_101 =  litString 
-alex_action_102 =  literal LitInt 
-alex_action_103 =  literal LitFloat 
-alex_action_104 =  identifier 
+alex_action_32 =  symbol SymEndComment 
+alex_action_33 =  withInterval TokComment 
+alex_action_35 =  begin bol_ 
+alex_action_37 =  offsideRule 
+alex_action_39 =  endWith newLayoutContext 
+alex_action_40 =  emptyLayout 
+alex_action_41 =  keyword KwLet 
+alex_action_42 =  keyword KwIn 
+alex_action_43 =  keyword KwWhere 
+alex_action_44 =  keyword KwField 
+alex_action_45 =  keyword KwWith 
+alex_action_46 =  keyword KwRewrite 
+alex_action_47 =  keyword KwPostulate 
+alex_action_48 =  keyword KwPrimitive 
+alex_action_49 =  keyword KwOpen 
+alex_action_50 =  keyword KwImport 
+alex_action_51 =  keyword KwModule 
+alex_action_52 =  keyword KwData 
+alex_action_53 =  keyword KwCoData 
+alex_action_54 =  keyword KwRecord 
+alex_action_55 =  keyword KwConstructor 
+alex_action_56 =  keyword KwInductive 
+alex_action_57 =  keyword KwCoInductive 
+alex_action_58 =  keyword KwInfix 
+alex_action_59 =  keyword KwInfixL 
+alex_action_60 =  keyword KwInfixR 
+alex_action_61 =  keyword KwMutual 
+alex_action_62 =  keyword KwAbstract 
+alex_action_63 =  keyword KwPrivate 
+alex_action_64 =  keyword KwInstance 
+alex_action_65 =  keyword KwSet 
+alex_action_66 =  keyword KwProp 
+alex_action_67 =  keyword KwForall 
+alex_action_68 =  withInterval' (read . drop 3) TokSetN 
+alex_action_69 =  keyword KwQuoteGoal 
+alex_action_70 =  keyword KwQuoteContext 
+alex_action_71 =  keyword KwQuote 
+alex_action_72 =  keyword KwQuoteTerm 
+alex_action_73 =  keyword KwUnquote 
+alex_action_74 =  keyword KwUnquoteDecl 
+alex_action_75 =  keyword KwTactic 
+alex_action_76 =  keyword KwSyntax 
+alex_action_77 =  keyword KwPatternSyn 
+alex_action_78 =  keyword KwUsing 
+alex_action_79 =  keyword KwHiding 
+alex_action_80 =  keyword KwRenaming 
+alex_action_81 =  endWith $ keyword KwTo 
+alex_action_82 =  keyword KwPublic 
+alex_action_83 =  hole 
+alex_action_84 =  symbol SymEllipsis 
+alex_action_85 =  symbol SymDotDot 
+alex_action_86 =  symbol SymDot 
+alex_action_87 =  symbol SymSemi 
+alex_action_88 =  symbol SymColon 
+alex_action_89 =  symbol SymEqual 
+alex_action_90 =  symbol SymUnderscore 
+alex_action_91 =  symbol SymQuestionMark 
+alex_action_92 =  symbol SymBar 
+alex_action_93 =  symbol SymOpenParen 
+alex_action_94 =  symbol SymCloseParen 
+alex_action_95 =  symbol SymArrow 
+alex_action_96 =  symbol SymLambda 
+alex_action_97 =  symbol SymAs 
+alex_action_98 =  symbol SymDoubleOpenBrace 
+alex_action_99 =  symbol SymOpenBrace 
+alex_action_100 =  symbol SymCloseBrace 
+alex_action_101 =  litChar 
+alex_action_102 =  litString 
+alex_action_103 =  literal LitInt 
+alex_action_104 =  literal LitFloat 
+alex_action_105 =  identifier 
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
 {-# LINE 1 "<command-line>" #-}
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
 -- -----------------------------------------------------------------------------
diff --git a/dist/build/Agda/Syntax/Parser/Parser.hs b/dist/build/Agda/Syntax/Parser/Parser.hs
index 5cca40d..cb83147 100644
--- a/dist/build/Agda/Syntax/Parser/Parser.hs
+++ b/dist/build/Agda/Syntax/Parser/Parser.hs
@@ -814,10 +814,10 @@ happyIn131 x = Happy_GHC_Exts.unsafeCoerce# x
 happyOut131 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
 happyOut131 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut131 #-}
-happyIn132 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn132 :: (Pragma) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn132 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn132 #-}
-happyOut132 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypeSignature])
+happyOut132 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Pragma)
 happyOut132 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut132 #-}
 happyIn133 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
@@ -826,10 +826,10 @@ happyIn133 x = Happy_GHC_Exts.unsafeCoerce# x
 happyOut133 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypeSignature])
 happyOut133 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut133 #-}
-happyIn134 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn134 :: ([TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn134 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn134 #-}
-happyOut134 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg TypeSignature])
+happyOut134 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([TypeSignature])
 happyOut134 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut134 #-}
 happyIn135 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
@@ -838,28 +838,28 @@ happyIn135 x = Happy_GHC_Exts.unsafeCoerce# x
 happyOut135 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg TypeSignature])
 happyOut135 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut135 #-}
-happyIn136 :: ([Constructor]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn136 :: ([Arg TypeSignature]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn136 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn136 #-}
-happyOut136 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Constructor])
+happyOut136 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Arg TypeSignature])
 happyOut136 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut136 #-}
-happyIn137 :: ((Maybe (Ranged Induction), Maybe Name, [Declaration])) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn137 :: ([Constructor]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn137 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn137 #-}
-happyOut137 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((Maybe (Ranged Induction), Maybe Name, [Declaration]))
+happyOut137 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Constructor])
 happyOut137 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut137 #-}
-happyIn138 :: (Ranged Induction) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn138 :: ((Maybe (Ranged Induction), Maybe Name, [Declaration])) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn138 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn138 #-}
-happyOut138 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Ranged Induction)
+happyOut138 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ((Maybe (Ranged Induction), Maybe Name, [Declaration]))
 happyOut138 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut138 #-}
-happyIn139 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn139 :: (Ranged Induction) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyIn139 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyIn139 #-}
-happyOut139 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
+happyOut139 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> (Ranged Induction)
 happyOut139 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut139 #-}
 happyIn140 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
@@ -880,6 +880,12 @@ happyIn142 x = Happy_GHC_Exts.unsafeCoerce# x
 happyOut142 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
 happyOut142 x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyOut142 #-}
+happyIn143 :: ([Declaration]) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
+happyIn143 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn143 #-}
+happyOut143 :: (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72) -> ([Declaration])
+happyOut143 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut143 #-}
 happyInTok :: (Token) -> (HappyAbsSyn t10 t11 t12 t32 t35 t38 t39 t40 t44 t45 t72)
 happyInTok x = Happy_GHC_Exts.unsafeCoerce# x
 {-# INLINE happyInTok #-}
@@ -889,21 +895,21 @@ happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x
 
 
 happyActOffsets :: HappyAddr
-happyActOffsets = HappyA# "\x00\x00\x05\x09\xb7\x05\x00\x00\xdd\x04\xc0\x05\x85\x04\xc2\x05\x00\x00\xbf\x05\xc3\x05\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x01\x00\x00\x00\x00\xd5\x08\xac\x08\xb2\x05\x00\x00\x1d\x03\xb1\x05\x0a\x0b\x00\x00\x00\x00\x38\x0f\xa8\x05\xa8\x05\x00\x00\x00\x00\xe3\x0a\x00\x00\x00\x00\xd3\x02\xbc\x0a\x00\x00\x00\x00\x28\x0f\x6a\x06\x2b\x06\x6e\x07\x00\x00\x00\x00\x00\x00\x9d\x05\xae\x05\x00\x00\xa6\x05\xba\x01\xa4\x05\x00\x00\x00\x00\x9a\x02\x9a\x02\x00\x00\xa0\x05\ [...]
+happyActOffsets = HappyA# "\x00\x00\x4b\x09\xd7\x05\x00\x00\xe7\x04\xdb\x05\x8e\x04\xde\x05\x00\x00\xcc\x05\xd4\x05\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x01\x00\x00\x00\x00\x1a\x09\xf0\x08\xce\x05\x00\x00\xbe\x01\xc3\x05\x6b\x0b\x00\x00\x00\x00\x6f\x0f\xb9\x05\xb9\x05\x00\x00\x00\x00\x43\x0b\x00\x00\x00\x00\x0e\x02\x20\x0b\x00\x00\x00\x00\x42\x0b\x7a\x06\x3a\x06\x83\x07\x00\x00\x00\x00\x00\x00\xa9\x05\xbe\x05\x00\x00\xbb\x05\xa9\x02\xb6\x05\x00\x00\x00\x00\x9a\x02\x9a\x02\x00\x00\xb4\x05\ [...]
 
 happyGotoOffsets :: HappyAddr
-happyGotoOffsets = HappyA# "\x37\x04\xe3\x0e\x8c\x04\x8d\x04\x87\x04\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x02\xc8\x0e\x00\x00\x00\x00\x0d\x04\xff\x03\xf1\x00\x00\x00\x00\x00\x66\x01\x79\x04\x78\x04\x00\x00\x00\x00\xc3\x02\x00\x00\x00\x00\x00\x00\xd8\x02\x00\x00\x00\x00\xf2\x00\xa8\x03\x33\x06\xb3\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x04\x72\x04\x00\x00\x00\x00 [...]
+happyGotoOffsets = HappyA# "\x83\x03\x81\x0f\x7a\x04\x79\x04\x76\x04\x00\x00\xec\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x08\x66\x0f\x00\x00\x00\x00\x58\x03\xe0\x03\x9f\x00\x00\x00\x00\x00\xda\x01\x6e\x04\x5e\x04\x00\x00\x00\x00\x8d\x05\x00\x00\x00\x00\x00\x00\xe4\x02\x00\x00\x00\x00\x69\x01\xb0\x03\x42\x06\xe3\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x04\x5d\x04\x00\x00\x00\x00 [...]
 
 happyDefActions :: HappyAddr
-happyDefActions = HappyA# "\xfa\xff\x00\x00\x00\x00\x00\x00\xfc\xff\x00\x00\xa7\xfe\x80\xff\x5b\xff\x00\x00\x6f\xff\x6e\xff\x6c\xff\x6b\xff\x68\xff\x00\x00\x49\xff\x48\xff\x66\xff\x00\x00\x00\x00\x41\xff\x3f\xff\x00\x00\x00\x00\x57\xff\x56\xff\x00\x00\x00\x00\x00\x00\x55\xff\x54\xff\x00\x00\x53\xff\x52\xff\x00\x00\x00\x00\x58\xff\x59\xff\x00\x00\xa7\xfe\x00\x00\x00\x00\x98\xff\x81\xff\x5a\xff\x00\x00\x00\x00\x7a\xff\x00\x00\x79\xff\x00\x00\x5c\xff\x4e\xff\x00\x00\x00\x00\x95\xff\x00\x00\ [...]
+happyDefActions = HappyA# "\xfa\xff\x00\x00\x00\x00\x00\x00\xfc\xff\x00\x00\xa6\xfe\x7f\xff\x5a\xff\x00\x00\x6e\xff\x6d\xff\x6b\xff\x6a\xff\x67\xff\x00\x00\x48\xff\x47\xff\x65\xff\x00\x00\x00\x00\x40\xff\x3e\xff\x00\x00\x00\x00\x56\xff\x55\xff\x00\x00\x00\x00\x00\x00\x54\xff\x53\xff\x00\x00\x52\xff\x51\xff\x00\x00\x00\x00\x57\xff\x58\xff\x00\x00\xa6\xfe\x00\x00\x00\x00\x97\xff\x80\xff\x59\xff\x00\x00\x00\x00\x79\xff\x00\x00\x78\xff\x00\x00\x5b\xff\x4d\xff\x00\x00\x00\x00\x94\xff\x00\x00\ [...]
 
 happyCheck :: HappyAddr
-happyCheck = HappyA# "\xff\xff\x05\x00\x05\x00\x09\x00\x0a\x00\x09\x00\x09\x00\x0a\x00\x09\x00\x05\x00\x09\x00\x0f\x00\x00\x00\x25\x00\x0f\x00\x10\x00\x09\x00\x43\x00\x11\x00\x0c\x00\x0d\x00\x02\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x3f\x00\x09\x00\x09\x00\x54\x00\x55\x00\x0c\x00\x09\x00\x0e\x00\x09\x00\x0a\x00\x09\x00\x29\x00\x0f\x00\x10\x00\x09\x00\x2d\x00\x0f\x00\x10\x00\x03\x00\x46\x00\x0f\x00\x54\x00\x00\x00\x05\x00\x36\x00\x37\x00\x09\x00\x0f\x [...]
+happyCheck = HappyA# "\xff\xff\x05\x00\x05\x00\x09\x00\x0f\x00\x09\x00\x09\x00\x0a\x00\x09\x00\x03\x00\x09\x00\x0f\x00\x00\x00\x40\x00\x0f\x00\x10\x00\x7f\x00\x09\x00\x11\x00\x02\x00\x83\x00\x0f\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x09\x00\x03\x00\x09\x00\x55\x00\x44\x00\x0c\x00\x09\x00\x0e\x00\x09\x00\x0a\x00\x09\x00\x29\x00\x0f\x00\x10\x00\x00\x00\x2d\x00\x0f\x00\x10\x00\x42\x00\x7f\x00\x47\x00\x55\x00\x56\x00\x83\x00\x36\x00\x37\x00\x09\x00\x40\x [...]
 
 happyTable :: HappyAddr
-happyTable = HappyA# "\x00\x00\x8b\x02\x94\x02\xb3\x01\xb4\x01\x07\x00\xb3\x01\xb4\x01\x32\x01\xd3\x02\x41\x00\x08\x00\xa9\x01\xee\x01\x33\x01\x58\x02\xc3\x01\x37\x01\x42\x00\x0e\x02\x6c\x02\x51\x01\x77\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x78\x00\x10\x00\x11\x00\x12\x00\x11\x02\x37\x02\xc3\x01\x2c\x00\x2d\x00\xc4\x01\x32\x01\xc5\x01\xb3\x01\xb4\x01\x32\x01\x73\x01\x33\x01\x34\x01\x07\x00\xd8\x01\x33\x01\x58\x02\xb1\x01\x08\x02\x08\x00\x2c\x00\xa9\x01\xce\x02\x75\x01\x63\x00\x41\x00\x9f\x [...]
+happyTable = HappyA# "\x00\x00\x8f\x02\x98\x02\x9e\x02\xa9\x02\x07\x00\xb6\x01\xb7\x01\x35\x01\xb4\x01\x41\x00\x08\x00\xac\x01\x15\x02\x36\x01\x5c\x02\x60\x02\xd0\x02\x42\x00\x54\x01\xb8\x02\xb5\x01\x77\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x78\x00\x10\x00\x11\x00\x12\x00\x3b\x02\x21\x02\xc6\x01\x2c\x00\x3a\x01\xc7\x01\x35\x01\xc8\x01\xb6\x01\xb7\x01\x35\x01\x76\x01\x36\x01\x37\x01\xac\x01\xdb\x01\x36\x01\x5c\x02\x8a\x01\x60\x02\x0c\x02\x2c\x00\x2d\x00\xb9\x02\x78\x01\x63\x00\xd1\x02\x9f\x [...]
 
-happyReduceArr = Happy_Data_Array.array (3, 416) [
+happyReduceArr = Happy_Data_Array.array (3, 419) [
 	(3 , happyReduce_3),
 	(4 , happyReduce_4),
 	(5 , happyReduce_5),
@@ -1317,11 +1323,14 @@ happyReduceArr = Happy_Data_Array.array (3, 416) [
 	(413 , happyReduce_413),
 	(414 , happyReduce_414),
 	(415 , happyReduce_415),
-	(416 , happyReduce_416)
+	(416 , happyReduce_416),
+	(417 , happyReduce_417),
+	(418 , happyReduce_418),
+	(419 , happyReduce_419)
 	]
 
-happy_n_terms = 89 :: Int
-happy_n_nonterms = 137 :: Int
+happy_n_terms = 90 :: Int
+happy_n_nonterms = 138 :: Int
 
 happyReduce_3 = happySpecReduce_1  0# happyReduction_3
 happyReduction_3 happy_x_1
@@ -1689,272 +1698,279 @@ happyReduction_54 happy_x_1
 
 happyReduce_55 = happySpecReduce_1  2# happyReduction_55
 happyReduction_55 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwMEASURE happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwTERMINATING happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwMEASURE happy_var_1
+		 (TokKeyword KwTERMINATING happy_var_1
 	)}
 
 happyReduce_56 = happySpecReduce_1  2# happyReduction_56
 happyReduction_56 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteGoal happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwMEASURE happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwQuoteGoal happy_var_1
+		 (TokKeyword KwMEASURE happy_var_1
 	)}
 
 happyReduce_57 = happySpecReduce_1  2# happyReduction_57
 happyReduction_57 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteContext happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteGoal happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwQuoteContext happy_var_1
+		 (TokKeyword KwQuoteGoal happy_var_1
 	)}
 
 happyReduce_58 = happySpecReduce_1  2# happyReduction_58
 happyReduction_58 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteContext happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwQuote happy_var_1
+		 (TokKeyword KwQuoteContext happy_var_1
 	)}
 
 happyReduce_59 = happySpecReduce_1  2# happyReduction_59
 happyReduction_59 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwQuoteTerm happy_var_1
+		 (TokKeyword KwQuote happy_var_1
 	)}
 
 happyReduce_60 = happySpecReduce_1  2# happyReduction_60
 happyReduction_60 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwTactic happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwTactic happy_var_1
+		 (TokKeyword KwQuoteTerm happy_var_1
 	)}
 
 happyReduce_61 = happySpecReduce_1  2# happyReduction_61
 happyReduction_61 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwTactic happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwUnquote happy_var_1
+		 (TokKeyword KwTactic happy_var_1
 	)}
 
 happyReduce_62 = happySpecReduce_1  2# happyReduction_62
 happyReduction_62 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUnquoteDecl happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) -> 
 	happyIn8
-		 (TokKeyword KwUnquoteDecl happy_var_1
+		 (TokKeyword KwUnquote happy_var_1
 	)}
 
 happyReduce_63 = happySpecReduce_1  2# happyReduction_63
 happyReduction_63 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSetN happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUnquoteDecl happy_var_1) -> 
 	happyIn8
-		 (TokSetN happy_var_1
+		 (TokKeyword KwUnquoteDecl happy_var_1
 	)}
 
 happyReduce_64 = happySpecReduce_1  2# happyReduction_64
 happyReduction_64 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokTeX happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSetN happy_var_1) -> 
 	happyIn8
-		 (TokTeX happy_var_1
+		 (TokSetN happy_var_1
 	)}
 
 happyReduce_65 = happySpecReduce_1  2# happyReduction_65
 happyReduction_65 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokComment happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokTeX happy_var_1) -> 
 	happyIn8
-		 (TokComment happy_var_1
+		 (TokTeX happy_var_1
 	)}
 
 happyReduce_66 = happySpecReduce_1  2# happyReduction_66
 happyReduction_66 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokComment happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymEllipsis happy_var_1
+		 (TokComment happy_var_1
 	)}
 
 happyReduce_67 = happySpecReduce_1  2# happyReduction_67
 happyReduction_67 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDotDot happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEllipsis happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymDotDot happy_var_1
+		 (TokSymbol SymEllipsis happy_var_1
 	)}
 
 happyReduce_68 = happySpecReduce_1  2# happyReduction_68
 happyReduction_68 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDotDot happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymDot happy_var_1
+		 (TokSymbol SymDotDot happy_var_1
 	)}
 
 happyReduce_69 = happySpecReduce_1  2# happyReduction_69
 happyReduction_69 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymSemi happy_var_1
+		 (TokSymbol SymDot happy_var_1
 	)}
 
 happyReduce_70 = happySpecReduce_1  2# happyReduction_70
 happyReduction_70 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymColon happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymColon happy_var_1
+		 (TokSymbol SymSemi happy_var_1
 	)}
 
 happyReduce_71 = happySpecReduce_1  2# happyReduction_71
 happyReduction_71 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEqual happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymColon happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymEqual happy_var_1
+		 (TokSymbol SymColon happy_var_1
 	)}
 
 happyReduce_72 = happySpecReduce_1  2# happyReduction_72
 happyReduction_72 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymEqual happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymUnderscore happy_var_1
+		 (TokSymbol SymEqual happy_var_1
 	)}
 
 happyReduce_73 = happySpecReduce_1  2# happyReduction_73
 happyReduction_73 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymQuestionMark happy_var_1
+		 (TokSymbol SymUnderscore happy_var_1
 	)}
 
 happyReduce_74 = happySpecReduce_1  2# happyReduction_74
 happyReduction_74 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymArrow happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymArrow happy_var_1
+		 (TokSymbol SymQuestionMark happy_var_1
 	)}
 
 happyReduce_75 = happySpecReduce_1  2# happyReduction_75
 happyReduction_75 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymArrow happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymLambda happy_var_1
+		 (TokSymbol SymArrow happy_var_1
 	)}
 
 happyReduce_76 = happySpecReduce_1  2# happyReduction_76
 happyReduction_76 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymAs happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymAs happy_var_1
+		 (TokSymbol SymLambda happy_var_1
 	)}
 
 happyReduce_77 = happySpecReduce_1  2# happyReduction_77
 happyReduction_77 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymBar happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymAs happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymBar happy_var_1
+		 (TokSymbol SymAs happy_var_1
 	)}
 
 happyReduce_78 = happySpecReduce_1  2# happyReduction_78
 happyReduction_78 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymBar happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymOpenParen happy_var_1
+		 (TokSymbol SymBar happy_var_1
 	)}
 
 happyReduce_79 = happySpecReduce_1  2# happyReduction_79
 happyReduction_79 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseParen happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymCloseParen happy_var_1
+		 (TokSymbol SymOpenParen happy_var_1
 	)}
 
 happyReduce_80 = happySpecReduce_1  2# happyReduction_80
 happyReduction_80 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseParen happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymDoubleOpenBrace happy_var_1
+		 (TokSymbol SymCloseParen happy_var_1
 	)}
 
 happyReduce_81 = happySpecReduce_1  2# happyReduction_81
 happyReduction_81 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymDoubleCloseBrace happy_var_1
+		 (TokSymbol SymDoubleOpenBrace happy_var_1
 	)}
 
 happyReduce_82 = happySpecReduce_1  2# happyReduction_82
 happyReduction_82 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymOpenBrace happy_var_1
+		 (TokSymbol SymDoubleCloseBrace happy_var_1
 	)}
 
 happyReduce_83 = happySpecReduce_1  2# happyReduction_83
 happyReduction_83 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymCloseBrace happy_var_1
+		 (TokSymbol SymOpenBrace happy_var_1
 	)}
 
 happyReduce_84 = happySpecReduce_1  2# happyReduction_84
 happyReduction_84 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenVirtualBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymOpenVirtualBrace happy_var_1
+		 (TokSymbol SymCloseBrace happy_var_1
 	)}
 
 happyReduce_85 = happySpecReduce_1  2# happyReduction_85
 happyReduction_85 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseVirtualBrace happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenVirtualBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymCloseVirtualBrace happy_var_1
+		 (TokSymbol SymOpenVirtualBrace happy_var_1
 	)}
 
 happyReduce_86 = happySpecReduce_1  2# happyReduction_86
 happyReduction_86 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymCloseVirtualBrace happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymVirtualSemi happy_var_1
+		 (TokSymbol SymCloseVirtualBrace happy_var_1
 	)}
 
 happyReduce_87 = happySpecReduce_1  2# happyReduction_87
 happyReduction_87 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymOpenPragma happy_var_1
+		 (TokSymbol SymVirtualSemi happy_var_1
 	)}
 
 happyReduce_88 = happySpecReduce_1  2# happyReduction_88
 happyReduction_88 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokSymbol SymClosePragma happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
 	happyIn8
-		 (TokSymbol SymClosePragma happy_var_1
+		 (TokSymbol SymOpenPragma happy_var_1
 	)}
 
 happyReduce_89 = happySpecReduce_1  2# happyReduction_89
 happyReduction_89 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokId happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymClosePragma happy_var_1) -> 
 	happyIn8
-		 (TokId happy_var_1
+		 (TokSymbol SymClosePragma happy_var_1
 	)}
 
 happyReduce_90 = happySpecReduce_1  2# happyReduction_90
 happyReduction_90 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokQId happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokId happy_var_1) -> 
 	happyIn8
-		 (TokQId happy_var_1
+		 (TokId happy_var_1
 	)}
 
 happyReduce_91 = happySpecReduce_1  2# happyReduction_91
 happyReduction_91 happy_x_1
-	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
+	 =  case happyOutTok happy_x_1 of { (TokQId happy_var_1) -> 
 	happyIn8
-		 (TokString happy_var_1
+		 (TokQId happy_var_1
 	)}
 
 happyReduce_92 = happySpecReduce_1  2# happyReduction_92
 happyReduction_92 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
+	happyIn8
+		 (TokString happy_var_1
+	)}
+
+happyReduce_93 = happySpecReduce_1  2# happyReduction_93
+happyReduction_93 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> 
 	happyIn8
 		 (TokLiteral happy_var_1
 	)}
 
-happyReduce_93 = happySpecReduce_3  3# happyReduction_93
-happyReduction_93 happy_x_3
+happyReduce_94 = happySpecReduce_3  3# happyReduction_94
+happyReduction_94 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut113 happy_x_2 of { happy_var_2 -> 
@@ -1962,79 +1978,79 @@ happyReduction_93 happy_x_3
 		 (takeOptionsPragmas happy_var_2
 	)}
 
-happyReduce_94 = happySpecReduce_0  4# happyReduction_94
-happyReduction_94  =  happyIn10
+happyReduce_95 = happySpecReduce_0  4# happyReduction_95
+happyReduction_95  =  happyIn10
 		 (()
 	)
 
-happyReduce_95 = happySpecReduce_1  4# happyReduction_95
-happyReduction_95 happy_x_1
+happyReduce_96 = happySpecReduce_1  4# happyReduction_96
+happyReduction_96 happy_x_1
 	 =  happyIn10
 		 (()
 	)
 
-happyReduce_96 = happySpecReduce_1  5# happyReduction_96
-happyReduction_96 happy_x_1
+happyReduce_97 = happySpecReduce_1  5# happyReduction_97
+happyReduction_97 happy_x_1
 	 =  happyIn11
 		 (()
 	)
 
-happyReduce_97 = happyMonadReduce 1# 5# happyReduction_97
-happyReduction_97 (happy_x_1 `HappyStk`
+happyReduce_98 = happyMonadReduce 1# 5# happyReduction_98
+happyReduction_98 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (( popContext)
 	) (\r -> happyReturn (happyIn11 r))
 
-happyReduce_98 = happySpecReduce_1  6# happyReduction_98
-happyReduction_98 happy_x_1
+happyReduce_99 = happySpecReduce_1  6# happyReduction_99
+happyReduction_99 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymSemi happy_var_1) -> 
 	happyIn12
 		 (happy_var_1
 	)}
 
-happyReduce_99 = happySpecReduce_1  6# happyReduction_99
-happyReduction_99 happy_x_1
+happyReduce_100 = happySpecReduce_1  6# happyReduction_100
+happyReduction_100 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymVirtualSemi happy_var_1) -> 
 	happyIn12
 		 (happy_var_1
 	)}
 
-happyReduce_100 = happyMonadReduce 0# 7# happyReduction_100
-happyReduction_100 (happyRest) tk
+happyReduce_101 = happyMonadReduce 0# 7# happyReduction_101
+happyReduction_101 (happyRest) tk
 	 = happyThen (( pushLexState imp_dir)
 	) (\r -> happyReturn (happyIn13 r))
 
-happyReduce_101 = happyMonadReduce 1# 8# happyReduction_101
-happyReduction_101 (happy_x_1 `HappyStk`
+happyReduce_102 = happyMonadReduce 1# 8# happyReduction_102
+happyReduction_102 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> 
 	( case happy_var_1 of {
-		     LitInt _ i	-> return i;
-		     _		-> fail $ "Expected integer"
-		   })}
+                     LitInt _ i -> return i;
+                     _          -> fail $ "Expected integer"
+                   })}
 	) (\r -> happyReturn (happyIn14 r))
 
-happyReduce_102 = happyMonadReduce 1# 8# happyReduction_102
-happyReduction_102 (happy_x_1 `HappyStk`
+happyReduce_103 = happyMonadReduce 1# 8# happyReduction_103
+happyReduction_103 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokId happy_var_1) -> 
 	( case happy_var_1 of {
              (_, s) -> case readM s of {
                          Right i  -> return i;
-		         Left (err :: String) -> fail $ "Expected integer"
-		       }
+                         Left (err :: String) -> fail $ "Expected integer"
+                       }
            })}
 	) (\r -> happyReturn (happyIn14 r))
 
-happyReduce_103 = happyMonadReduce 1# 9# happyReduction_103
-happyReduction_103 (happy_x_1 `HappyStk`
+happyReduce_104 = happyMonadReduce 1# 9# happyReduction_104
+happyReduction_104 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokId happy_var_1) -> 
 	( mkName happy_var_1)}
 	) (\r -> happyReturn (happyIn15 r))
 
-happyReduce_104 = happySpecReduce_2  10# happyReduction_104
-happyReduction_104 happy_x_2
+happyReduce_105 = happySpecReduce_2  10# happyReduction_105
+happyReduction_105 happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	case happyOut16 happy_x_2 of { happy_var_2 -> 
@@ -2042,51 +2058,51 @@ happyReduction_104 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_105 = happySpecReduce_1  10# happyReduction_105
-happyReduction_105 happy_x_1
+happyReduce_106 = happySpecReduce_1  10# happyReduction_106
+happyReduction_106 happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	happyIn16
 		 ([happy_var_1]
 	)}
 
-happyReduce_106 = happySpecReduce_1  11# happyReduction_106
-happyReduction_106 happy_x_1
+happyReduce_107 = happySpecReduce_1  11# happyReduction_107
+happyReduction_107 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleCloseBrace happy_var_1) -> 
 	happyIn17
 		 (getRange happy_var_1
 	)}
 
-happyReduce_107 = happyMonadReduce 2# 11# happyReduction_107
-happyReduction_107 (happy_x_2 `HappyStk`
+happyReduce_108 = happyMonadReduce 2# 11# happyReduction_108
+happyReduction_108 (happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokSymbol SymCloseBrace happy_var_1) -> 
 	case happyOutTok happy_x_2 of { (TokSymbol SymCloseBrace happy_var_2) -> 
 	(
       if posPos (fromJust (rEnd (getRange happy_var_2))) -
-	 posPos (fromJust (rStart (getRange happy_var_1))) > 2
+         posPos (fromJust (rStart (getRange happy_var_1))) > 2
       then parseErrorAt (fromJust (rStart (getRange happy_var_2)))
-	 "Expecting '}}', found separated '}'s."
+         "Expecting '}}', found separated '}'s."
       else return $ getRange (happy_var_1, happy_var_2))}}
 	) (\r -> happyReturn (happyIn17 r))
 
-happyReduce_108 = happySpecReduce_2  12# happyReduction_108
-happyReduction_108 happy_x_2
+happyReduce_109 = happySpecReduce_2  12# happyReduction_109
+happyReduction_109 happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_2 of { happy_var_2 -> 
 	happyIn18
 		 (setRelevance Irrelevant $ defaultArg happy_var_2
 	)}
 
-happyReduce_109 = happySpecReduce_1  12# happyReduction_109
-happyReduction_109 happy_x_1
+happyReduce_110 = happySpecReduce_1  12# happyReduction_110
+happyReduction_110 happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	happyIn18
 		 (defaultArg happy_var_1
 	)}
 
-happyReduce_110 = happySpecReduce_2  13# happyReduction_110
-happyReduction_110 happy_x_2
+happyReduce_111 = happySpecReduce_2  13# happyReduction_111
+happyReduction_111 happy_x_2
 	happy_x_1
 	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
 	case happyOut19 happy_x_2 of { happy_var_2 -> 
@@ -2094,15 +2110,15 @@ happyReduction_110 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_111 = happySpecReduce_1  13# happyReduction_111
-happyReduction_111 happy_x_1
+happyReduce_112 = happySpecReduce_1  13# happyReduction_112
+happyReduction_112 happy_x_1
 	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
 	happyIn19
 		 ([happy_var_1]
 	)}
 
-happyReduce_112 = happySpecReduce_2  14# happyReduction_112
-happyReduction_112 happy_x_2
+happyReduce_113 = happySpecReduce_2  14# happyReduction_113
+happyReduction_113 happy_x_2
 	happy_x_1
 	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
 	case happyOut20 happy_x_2 of { happy_var_2 -> 
@@ -2110,15 +2126,15 @@ happyReduction_112 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_113 = happySpecReduce_1  14# happyReduction_113
-happyReduction_113 happy_x_1
+happyReduce_114 = happySpecReduce_1  14# happyReduction_114
+happyReduction_114 happy_x_1
 	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
 	happyIn20
 		 ([happy_var_1]
 	)}
 
-happyReduce_114 = happyReduce 4# 14# happyReduction_114
-happyReduction_114 (happy_x_4 `HappyStk`
+happyReduce_115 = happyReduce 4# 14# happyReduction_115
+happyReduction_115 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2129,8 +2145,8 @@ happyReduction_114 (happy_x_4 `HappyStk`
 		 (map makeInstance happy_var_2 ++ happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_115 = happySpecReduce_3  14# happyReduction_115
-happyReduction_115 happy_x_3
+happyReduce_116 = happySpecReduce_3  14# happyReduction_116
+happyReduction_116 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut19 happy_x_2 of { happy_var_2 -> 
@@ -2138,8 +2154,8 @@ happyReduction_115 happy_x_3
 		 (map makeInstance happy_var_2
 	)}
 
-happyReduce_116 = happyReduce 4# 14# happyReduction_116
-happyReduction_116 (happy_x_4 `HappyStk`
+happyReduce_117 = happyReduce 4# 14# happyReduction_117
+happyReduction_117 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2150,8 +2166,8 @@ happyReduction_116 (happy_x_4 `HappyStk`
 		 (map hide happy_var_2 ++ happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_117 = happySpecReduce_3  14# happyReduction_117
-happyReduction_117 happy_x_3
+happyReduce_118 = happySpecReduce_3  14# happyReduction_118
+happyReduction_118 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut19 happy_x_2 of { happy_var_2 -> 
@@ -2159,8 +2175,8 @@ happyReduction_117 happy_x_3
 		 (map hide happy_var_2
 	)}
 
-happyReduce_118 = happyReduce 5# 14# happyReduction_118
-happyReduction_118 (happy_x_5 `HappyStk`
+happyReduce_119 = happyReduce 5# 14# happyReduction_119
+happyReduction_119 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -2172,8 +2188,8 @@ happyReduction_118 (happy_x_5 `HappyStk`
 		 (map (hide . setRelevance Irrelevant . defaultArg) happy_var_3 ++ happy_var_5
 	) `HappyStk` happyRest}}
 
-happyReduce_119 = happyReduce 4# 14# happyReduction_119
-happyReduction_119 (happy_x_4 `HappyStk`
+happyReduce_120 = happyReduce 4# 14# happyReduction_120
+happyReduction_120 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2183,8 +2199,8 @@ happyReduction_119 (happy_x_4 `HappyStk`
 		 (map (hide . setRelevance Irrelevant . defaultArg) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_120 = happyReduce 5# 14# happyReduction_120
-happyReduction_120 (happy_x_5 `HappyStk`
+happyReduce_121 = happyReduce 5# 14# happyReduction_121
+happyReduction_121 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -2196,8 +2212,8 @@ happyReduction_120 (happy_x_5 `HappyStk`
 		 (map (makeInstance . setRelevance Irrelevant . defaultArg) happy_var_3 ++ happy_var_5
 	) `HappyStk` happyRest}}
 
-happyReduce_121 = happyReduce 4# 14# happyReduction_121
-happyReduction_121 (happy_x_4 `HappyStk`
+happyReduce_122 = happyReduce 4# 14# happyReduction_122
+happyReduction_122 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2207,8 +2223,8 @@ happyReduction_121 (happy_x_4 `HappyStk`
 		 (map (makeInstance . setRelevance Irrelevant . defaultArg) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_122 = happyReduce 5# 14# happyReduction_122
-happyReduction_122 (happy_x_5 `HappyStk`
+happyReduce_123 = happyReduce 5# 14# happyReduction_123
+happyReduction_123 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -2220,8 +2236,8 @@ happyReduction_122 (happy_x_5 `HappyStk`
 		 (map (hide . setRelevance NonStrict . defaultArg) happy_var_3 ++ happy_var_5
 	) `HappyStk` happyRest}}
 
-happyReduce_123 = happyReduce 4# 14# happyReduction_123
-happyReduction_123 (happy_x_4 `HappyStk`
+happyReduce_124 = happyReduce 4# 14# happyReduction_124
+happyReduction_124 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2231,8 +2247,8 @@ happyReduction_123 (happy_x_4 `HappyStk`
 		 (map (hide . setRelevance NonStrict . defaultArg) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_124 = happyReduce 5# 14# happyReduction_124
-happyReduction_124 (happy_x_5 `HappyStk`
+happyReduce_125 = happyReduce 5# 14# happyReduction_125
+happyReduction_125 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -2244,8 +2260,8 @@ happyReduction_124 (happy_x_5 `HappyStk`
 		 (map (makeInstance . setRelevance NonStrict . defaultArg) happy_var_3 ++ happy_var_5
 	) `HappyStk` happyRest}}
 
-happyReduce_125 = happyReduce 4# 14# happyReduction_125
-happyReduction_125 (happy_x_4 `HappyStk`
+happyReduce_126 = happyReduce 4# 14# happyReduction_126
+happyReduction_126 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2255,43 +2271,43 @@ happyReduction_125 (happy_x_4 `HappyStk`
 		 (map (makeInstance . setRelevance NonStrict . defaultArg) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_126 = happyMonadReduce 1# 15# happyReduction_126
-happyReduction_126 (happy_x_1 `HappyStk`
+happyReduce_127 = happyMonadReduce 1# 15# happyReduction_127
+happyReduction_127 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokQId happy_var_1) -> 
 	( mkQName happy_var_1)}
 	) (\r -> happyReturn (happyIn21 r))
 
-happyReduce_127 = happySpecReduce_1  15# happyReduction_127
-happyReduction_127 happy_x_1
+happyReduce_128 = happySpecReduce_1  15# happyReduction_128
+happyReduction_128 happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	happyIn21
 		 (QName happy_var_1
 	)}
 
-happyReduce_128 = happySpecReduce_1  16# happyReduction_128
-happyReduction_128 happy_x_1
+happyReduce_129 = happySpecReduce_1  16# happyReduction_129
+happyReduction_129 happy_x_1
 	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
 	happyIn22
 		 (happy_var_1
 	)}
 
-happyReduce_129 = happySpecReduce_1  17# happyReduction_129
-happyReduction_129 happy_x_1
+happyReduce_130 = happySpecReduce_1  17# happyReduction_130
+happyReduction_130 happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	happyIn23
 		 (happy_var_1
 	)}
 
-happyReduce_130 = happySpecReduce_1  17# happyReduction_130
-happyReduction_130 happy_x_1
+happyReduce_131 = happySpecReduce_1  17# happyReduction_131
+happyReduction_131 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> 
 	happyIn23
 		 (Name (getRange happy_var_1) [Hole]
 	)}
 
-happyReduce_131 = happySpecReduce_2  18# happyReduction_131
-happyReduction_131 happy_x_2
+happyReduce_132 = happySpecReduce_2  18# happyReduction_132
+happyReduction_132 happy_x_2
 	happy_x_1
 	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
 	case happyOut24 happy_x_2 of { happy_var_2 -> 
@@ -2299,15 +2315,15 @@ happyReduction_131 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_132 = happySpecReduce_1  18# happyReduction_132
-happyReduction_132 happy_x_1
+happyReduce_133 = happySpecReduce_1  18# happyReduction_133
+happyReduction_133 happy_x_1
 	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
 	happyIn24
 		 ([happy_var_1]
 	)}
 
-happyReduce_133 = happySpecReduce_1  19# happyReduction_133
-happyReduction_133 happy_x_1
+happyReduce_134 = happySpecReduce_1  19# happyReduction_134
+happyReduction_134 happy_x_1
 	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
 	happyIn25
 		 (case happy_var_1 of
@@ -2315,14 +2331,14 @@ happyReduction_133 happy_x_1
       Right _ -> fail $ "expected sequence of bound identifiers, not absurd pattern"
 	)}
 
-happyReduce_134 = happyMonadReduce 1# 20# happyReduction_134
-happyReduction_134 (happy_x_1 `HappyStk`
+happyReduce_135 = happyMonadReduce 1# 20# happyReduction_135
+happyReduction_135 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> 
 	(
     let getName (Ident (QName x)) = Just x
-	getName (Underscore r _)  = Just (Name r [Hole])
-	getName _		  = Nothing
+        getName (Underscore r _)  = Just (Name r [Hole])
+        getName _                 = Nothing
 
         containsAbsurd (Absurd _) = True
         containsAbsurd (HiddenArg _ (Named _ e)) = containsAbsurd e
@@ -2333,17 +2349,17 @@ happyReduction_134 (happy_x_1 `HappyStk`
     in
     if isJust $ find containsAbsurd happy_var_1 then return $ Right happy_var_1 else
     case partition isJust $ map getName happy_var_1 of
-	(good, []) -> return $ Left $ map fromJust good
-	_	   -> fail $ "expected sequence of bound identifiers")}
+        (good, []) -> return $ Left $ map fromJust good
+        _          -> fail $ "expected sequence of bound identifiers")}
 	) (\r -> happyReturn (happyIn26 r))
 
-happyReduce_135 = happySpecReduce_0  21# happyReduction_135
-happyReduction_135  =  happyIn27
+happyReduce_136 = happySpecReduce_0  21# happyReduction_136
+happyReduction_136  =  happyIn27
 		 ([]
 	)
 
-happyReduce_136 = happySpecReduce_2  21# happyReduction_136
-happyReduction_136 happy_x_2
+happyReduce_137 = happySpecReduce_2  21# happyReduction_137
+happyReduction_137 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
 	case happyOut27 happy_x_2 of { happy_var_2 -> 
@@ -2351,29 +2367,29 @@ happyReduction_136 happy_x_2
 		 (snd happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_137 = happySpecReduce_1  22# happyReduction_137
-happyReduction_137 happy_x_1
+happyReduce_138 = happySpecReduce_1  22# happyReduction_138
+happyReduction_138 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
 	happyIn28
 		 (snd happy_var_1
 	)}
 
-happyReduce_138 = happyMonadReduce 1# 23# happyReduction_138
-happyReduction_138 (happy_x_1 `HappyStk`
+happyReduce_139 = happyMonadReduce 1# 23# happyReduction_139
+happyReduction_139 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
 	( mkName happy_var_1)}
 	) (\r -> happyReturn (happyIn29 r))
 
-happyReduce_139 = happyMonadReduce 1# 24# happyReduction_139
-happyReduction_139 (happy_x_1 `HappyStk`
+happyReduce_140 = happyMonadReduce 1# 24# happyReduction_140
+happyReduction_140 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokString happy_var_1) -> 
 	( fmap QName (mkName happy_var_1))}
 	) (\r -> happyReturn (happyIn30 r))
 
-happyReduce_140 = happySpecReduce_2  25# happyReduction_140
-happyReduction_140 happy_x_2
+happyReduce_141 = happySpecReduce_2  25# happyReduction_141
+happyReduction_141 happy_x_2
 	happy_x_1
 	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
 	case happyOut31 happy_x_2 of { happy_var_2 -> 
@@ -2381,8 +2397,8 @@ happyReduction_140 happy_x_2
 		 (Pi happy_var_1 happy_var_2
 	)}}
 
-happyReduce_141 = happySpecReduce_3  25# happyReduction_141
-happyReduction_141 happy_x_3
+happyReduce_142 = happySpecReduce_3  25# happyReduction_142
+happyReduction_142 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut57 happy_x_2 of { happy_var_2 -> 
@@ -2391,8 +2407,8 @@ happyReduction_141 happy_x_3
 		 (forallPi happy_var_2 happy_var_3
 	)}}
 
-happyReduce_142 = happySpecReduce_3  25# happyReduction_142
-happyReduction_142 happy_x_3
+happyReduce_143 = happySpecReduce_3  25# happyReduction_143
+happyReduction_143 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
@@ -2404,8 +2420,8 @@ happyReduction_142 happy_x_3
                                               happy_var_3
 	)}}}
 
-happyReduce_143 = happySpecReduce_3  25# happyReduction_143
-happyReduction_143 happy_x_3
+happyReduce_144 = happySpecReduce_3  25# happyReduction_144
+happyReduction_144 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
@@ -2415,26 +2431,26 @@ happyReduction_143 happy_x_3
 		 (Equal (getRange (happy_var_1, happy_var_2, happy_var_3)) happy_var_1 happy_var_3
 	)}}}
 
-happyReduce_144 = happySpecReduce_1  25# happyReduction_144
-happyReduction_144 happy_x_1
+happyReduce_145 = happySpecReduce_1  25# happyReduction_145
+happyReduction_145 happy_x_1
 	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
 	happyIn31
 		 (happy_var_1
 	)}
 
-happyReduce_145 = happyMonadReduce 1# 26# happyReduction_145
-happyReduction_145 (happy_x_1 `HappyStk`
+happyReduce_146 = happyMonadReduce 1# 26# happyReduction_146
+happyReduction_146 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut33 happy_x_1 of { happy_var_1 -> 
 	( case happy_var_1 of
-		      { [e]    -> return e
-		      ; e : es -> return $ WithApp (fuseRange e es) e es
-		      ; []     -> fail "impossible: empty with expressions"
-		      })}
+                      { [e]    -> return e
+                      ; e : es -> return $ WithApp (fuseRange e es) e es
+                      ; []     -> fail "impossible: empty with expressions"
+                      })}
 	) (\r -> happyReturn (happyIn32 r))
 
-happyReduce_146 = happySpecReduce_3  27# happyReduction_146
-happyReduction_146 happy_x_3
+happyReduce_147 = happySpecReduce_3  27# happyReduction_147
+happyReduction_147 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
@@ -2443,22 +2459,22 @@ happyReduction_146 happy_x_3
 		 (RawApp (getRange happy_var_1) happy_var_1 :  happy_var_3
 	)}}
 
-happyReduce_147 = happySpecReduce_1  27# happyReduction_147
-happyReduction_147 happy_x_1
+happyReduce_148 = happySpecReduce_1  27# happyReduction_148
+happyReduction_148 happy_x_1
 	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
 	happyIn33
 		 ([RawApp (getRange happy_var_1) happy_var_1]
 	)}
 
-happyReduce_148 = happySpecReduce_1  28# happyReduction_148
-happyReduction_148 happy_x_1
+happyReduce_149 = happySpecReduce_1  28# happyReduction_149
+happyReduction_149 happy_x_1
 	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
 	happyIn34
 		 ([happy_var_1]
 	)}
 
-happyReduce_149 = happySpecReduce_2  28# happyReduction_149
-happyReduction_149 happy_x_2
+happyReduce_150 = happySpecReduce_2  28# happyReduction_150
+happyReduction_150 happy_x_2
 	happy_x_1
 	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
 	case happyOut34 happy_x_2 of { happy_var_2 -> 
@@ -2466,8 +2482,8 @@ happyReduction_149 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_150 = happySpecReduce_3  29# happyReduction_150
-happyReduction_150 happy_x_3
+happyReduce_151 = happySpecReduce_3  29# happyReduction_151
+happyReduction_151 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> 
@@ -2477,36 +2493,36 @@ happyReduction_150 happy_x_3
 		 (Lam (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_2 happy_var_3
 	)}}}
 
-happyReduce_151 = happySpecReduce_1  29# happyReduction_151
-happyReduction_151 happy_x_1
+happyReduce_152 = happySpecReduce_1  29# happyReduction_152
+happyReduction_152 happy_x_1
 	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
 	happyIn35
 		 (happy_var_1
 	)}
 
-happyReduce_152 = happyReduce 4# 29# happyReduction_152
-happyReduction_152 (happy_x_4 `HappyStk`
+happyReduce_153 = happyReduce 4# 29# happyReduction_153
+happyReduction_153 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOutTok happy_x_1 of { (TokKeyword KwLet happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	case happyOutTok happy_x_3 of { (TokKeyword KwIn happy_var_3) -> 
 	case happyOut31 happy_x_4 of { happy_var_4 -> 
 	happyIn35
 		 (Let (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}}}
 
-happyReduce_153 = happySpecReduce_1  29# happyReduction_153
-happyReduction_153 happy_x_1
+happyReduce_154 = happySpecReduce_1  29# happyReduction_154
+happyReduction_154 happy_x_1
 	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
 	happyIn35
 		 (happy_var_1
 	)}
 
-happyReduce_154 = happyReduce 4# 29# happyReduction_154
-happyReduction_154 (happy_x_4 `HappyStk`
+happyReduce_155 = happyReduce 4# 29# happyReduction_155
+happyReduction_155 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2519,8 +2535,8 @@ happyReduction_154 (happy_x_4 `HappyStk`
 		 (QuoteGoal (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}}}
 
-happyReduce_155 = happyReduce 4# 29# happyReduction_155
-happyReduction_155 (happy_x_4 `HappyStk`
+happyReduce_156 = happyReduce 4# 29# happyReduction_156
+happyReduction_156 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2533,8 +2549,8 @@ happyReduction_155 (happy_x_4 `HappyStk`
 		 (QuoteContext (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}}}
 
-happyReduce_156 = happySpecReduce_2  29# happyReduction_156
-happyReduction_156 happy_x_2
+happyReduce_157 = happySpecReduce_2  29# happyReduction_157
+happyReduction_157 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwTactic happy_var_1) -> 
 	case happyOut37 happy_x_2 of { happy_var_2 -> 
@@ -2542,8 +2558,8 @@ happyReduction_156 happy_x_2
 		 (Tactic (getRange (happy_var_1, happy_var_2)) (RawApp (getRange happy_var_2) happy_var_2) []
 	)}}
 
-happyReduce_157 = happyReduce 4# 29# happyReduction_157
-happyReduction_157 (happy_x_4 `HappyStk`
+happyReduce_158 = happyReduce 4# 29# happyReduction_158
+happyReduction_158 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2556,8 +2572,8 @@ happyReduction_157 (happy_x_4 `HappyStk`
 		 (Tactic (getRange (happy_var_1, happy_var_2, happy_var_3, happy_var_4)) (RawApp (getRange happy_var_2) happy_var_2) happy_var_4
 	) `HappyStk` happyRest}}}}
 
-happyReduce_158 = happyReduce 4# 30# happyReduction_158
-happyReduction_158 (happy_x_4 `HappyStk`
+happyReduce_159 = happyReduce 4# 30# happyReduction_159
+happyReduction_159 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2570,8 +2586,8 @@ happyReduction_158 (happy_x_4 `HappyStk`
 		 (ExtendedLam (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) (reverse happy_var_3)
 	) `HappyStk` happyRest}}}}
 
-happyReduce_159 = happyMonadReduce 2# 30# happyReduction_159
-happyReduction_159 (happy_x_2 `HappyStk`
+happyReduce_160 = happyMonadReduce 2# 30# happyReduction_160
+happyReduction_160 (happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOutTok happy_x_1 of { (TokSymbol SymLambda happy_var_1) -> 
@@ -2580,21 +2596,21 @@ happyReduction_159 (happy_x_2 `HappyStk`
                                        Left (bs, h) -> if null bs then return $ AbsurdLam r h else
                                                        return $ Lam r bs (AbsurdLam r h)
                                                          where r = fuseRange happy_var_1 bs
-    				       Right es -> do -- it is of the form @\ { p1 ... () }@
+                                       Right es -> do -- it is of the form @\ { p1 ... () }@
                                                      p <- exprToLHS (RawApp (getRange es) es);
                                                      return $ ExtendedLam (fuseRange happy_var_1 es)
                                                                      [(p [] [], AbsurdRHS, NoWhere)])}}
 	) (\r -> happyReturn (happyIn36 r))
 
-happyReduce_160 = happySpecReduce_1  31# happyReduction_160
-happyReduction_160 happy_x_1
+happyReduce_161 = happySpecReduce_1  31# happyReduction_161
+happyReduction_161 happy_x_1
 	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
 	happyIn37
 		 ([happy_var_1]
 	)}
 
-happyReduce_161 = happySpecReduce_2  31# happyReduction_161
-happyReduction_161 happy_x_2
+happyReduce_162 = happySpecReduce_2  31# happyReduction_162
+happyReduction_162 happy_x_2
 	happy_x_1
 	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
 	case happyOut37 happy_x_2 of { happy_var_2 -> 
@@ -2602,8 +2618,8 @@ happyReduction_161 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_162 = happySpecReduce_3  32# happyReduction_162
-happyReduction_162 happy_x_3
+happyReduce_163 = happySpecReduce_3  32# happyReduction_163
+happyReduction_163 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> 
@@ -2613,8 +2629,8 @@ happyReduction_162 happy_x_3
 		 (HiddenArg (getRange (happy_var_1,happy_var_2,happy_var_3)) (maybeNamed happy_var_2)
 	)}}}
 
-happyReduce_163 = happySpecReduce_2  32# happyReduction_163
-happyReduction_163 happy_x_2
+happyReduce_164 = happySpecReduce_2  32# happyReduction_164
+happyReduction_164 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> 
 	case happyOutTok happy_x_2 of { (TokSymbol SymCloseBrace happy_var_2) -> 
@@ -2622,78 +2638,78 @@ happyReduction_163 happy_x_2
 		 (let r = fuseRange happy_var_1 happy_var_2 in HiddenArg r $ unnamed $ Absurd r
 	)}}
 
-happyReduce_164 = happySpecReduce_1  33# happyReduction_164
-happyReduction_164 happy_x_1
+happyReduce_165 = happySpecReduce_1  33# happyReduction_165
+happyReduction_165 happy_x_1
 	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
 	happyIn39
 		 (Ident happy_var_1
 	)}
 
-happyReduce_165 = happySpecReduce_1  33# happyReduction_165
-happyReduction_165 happy_x_1
+happyReduce_166 = happySpecReduce_1  33# happyReduction_166
+happyReduction_166 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokLiteral happy_var_1) -> 
 	happyIn39
 		 (Lit happy_var_1
 	)}
 
-happyReduce_166 = happySpecReduce_1  33# happyReduction_166
-happyReduction_166 happy_x_1
+happyReduce_167 = happySpecReduce_1  33# happyReduction_167
+happyReduction_167 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymQuestionMark happy_var_1) -> 
 	happyIn39
 		 (QuestionMark (getRange happy_var_1) Nothing
 	)}
 
-happyReduce_167 = happySpecReduce_1  33# happyReduction_167
-happyReduction_167 happy_x_1
+happyReduce_168 = happySpecReduce_1  33# happyReduction_168
+happyReduction_168 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> 
 	happyIn39
 		 (Underscore (getRange happy_var_1) Nothing
 	)}
 
-happyReduce_168 = happySpecReduce_1  33# happyReduction_168
-happyReduction_168 happy_x_1
+happyReduce_169 = happySpecReduce_1  33# happyReduction_169
+happyReduction_169 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwProp happy_var_1) -> 
 	happyIn39
 		 (Prop (getRange happy_var_1)
 	)}
 
-happyReduce_169 = happySpecReduce_1  33# happyReduction_169
-happyReduction_169 happy_x_1
+happyReduce_170 = happySpecReduce_1  33# happyReduction_170
+happyReduction_170 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwSet happy_var_1) -> 
 	happyIn39
 		 (Set (getRange happy_var_1)
 	)}
 
-happyReduce_170 = happySpecReduce_1  33# happyReduction_170
-happyReduction_170 happy_x_1
+happyReduce_171 = happySpecReduce_1  33# happyReduction_171
+happyReduction_171 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuote happy_var_1) -> 
 	happyIn39
 		 (Quote (getRange happy_var_1)
 	)}
 
-happyReduce_171 = happySpecReduce_1  33# happyReduction_171
-happyReduction_171 happy_x_1
+happyReduce_172 = happySpecReduce_1  33# happyReduction_172
+happyReduction_172 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwQuoteTerm happy_var_1) -> 
 	happyIn39
 		 (QuoteTerm (getRange happy_var_1)
 	)}
 
-happyReduce_172 = happySpecReduce_1  33# happyReduction_172
-happyReduction_172 happy_x_1
+happyReduce_173 = happySpecReduce_1  33# happyReduction_173
+happyReduction_173 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwUnquote happy_var_1) -> 
 	happyIn39
 		 (Unquote (getRange happy_var_1)
 	)}
 
-happyReduce_173 = happySpecReduce_1  33# happyReduction_173
-happyReduction_173 happy_x_1
+happyReduce_174 = happySpecReduce_1  33# happyReduction_174
+happyReduction_174 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSetN happy_var_1) -> 
 	happyIn39
 		 (SetN (getRange (fst happy_var_1)) (snd happy_var_1)
 	)}
 
-happyReduce_174 = happySpecReduce_3  33# happyReduction_174
-happyReduction_174 happy_x_3
+happyReduce_175 = happySpecReduce_3  33# happyReduction_175
+happyReduction_175 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) -> 
@@ -2704,8 +2720,8 @@ happyReduction_174 happy_x_3
                                                           (maybeNamed happy_var_2)
 	)}}}
 
-happyReduce_175 = happySpecReduce_3  33# happyReduction_175
-happyReduction_175 happy_x_3
+happyReduce_176 = happySpecReduce_3  33# happyReduction_176
+happyReduction_176 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
@@ -2715,8 +2731,8 @@ happyReduction_175 happy_x_3
 		 (Paren (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_2
 	)}}}
 
-happyReduce_176 = happySpecReduce_2  33# happyReduction_176
-happyReduction_176 happy_x_2
+happyReduce_177 = happySpecReduce_2  33# happyReduction_177
+happyReduction_177 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
 	case happyOutTok happy_x_2 of { (TokSymbol SymCloseParen happy_var_2) -> 
@@ -2724,8 +2740,8 @@ happyReduction_176 happy_x_2
 		 (Absurd (fuseRange happy_var_1 happy_var_2)
 	)}}
 
-happyReduce_177 = happySpecReduce_2  33# happyReduction_177
-happyReduction_177 happy_x_2
+happyReduce_178 = happySpecReduce_2  33# happyReduction_178
+happyReduction_178 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) -> 
 	case happyOut17 happy_x_2 of { happy_var_2 -> 
@@ -2733,8 +2749,8 @@ happyReduction_177 happy_x_2
 		 (let r = fuseRange happy_var_1 happy_var_2 in InstanceArg r $ unnamed $ Absurd r
 	)}}
 
-happyReduce_178 = happySpecReduce_3  33# happyReduction_178
-happyReduction_178 happy_x_3
+happyReduce_179 = happySpecReduce_3  33# happyReduction_179
+happyReduction_179 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
@@ -2744,8 +2760,8 @@ happyReduction_178 happy_x_3
 		 (As (getRange (happy_var_1,happy_var_2,happy_var_3)) happy_var_1 happy_var_3
 	)}}}
 
-happyReduce_179 = happySpecReduce_2  33# happyReduction_179
-happyReduction_179 happy_x_2
+happyReduce_180 = happySpecReduce_2  33# happyReduction_180
+happyReduction_180 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDot happy_var_1) -> 
 	case happyOut40 happy_x_2 of { happy_var_2 -> 
@@ -2753,8 +2769,8 @@ happyReduction_179 happy_x_2
 		 (Dot (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_180 = happyReduce 4# 33# happyReduction_180
-happyReduction_180 (happy_x_4 `HappyStk`
+happyReduce_181 = happyReduce 4# 33# happyReduction_181
+happyReduction_181 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2767,8 +2783,8 @@ happyReduction_180 (happy_x_4 `HappyStk`
 		 (Rec (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}}
 
-happyReduce_181 = happyReduce 5# 33# happyReduction_181
-happyReduction_181 (happy_x_5 `HappyStk`
+happyReduce_182 = happyReduce 5# 33# happyReduction_182
+happyReduction_182 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -2783,41 +2799,41 @@ happyReduction_181 (happy_x_5 `HappyStk`
 		 (RecUpdate (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_182 = happySpecReduce_1  34# happyReduction_182
-happyReduction_182 happy_x_1
+happyReduce_183 = happySpecReduce_1  34# happyReduction_183
+happyReduction_183 happy_x_1
 	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
 	happyIn40
 		 (happy_var_1
 	)}
 
-happyReduce_183 = happySpecReduce_1  34# happyReduction_183
-happyReduction_183 happy_x_1
+happyReduce_184 = happySpecReduce_1  34# happyReduction_184
+happyReduction_184 happy_x_1
 	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
 	happyIn40
 		 (happy_var_1
 	)}
 
-happyReduce_184 = happySpecReduce_0  35# happyReduction_184
-happyReduction_184  =  happyIn41
+happyReduce_185 = happySpecReduce_0  35# happyReduction_185
+happyReduction_185  =  happyIn41
 		 ([]
 	)
 
-happyReduce_185 = happySpecReduce_1  35# happyReduction_185
-happyReduction_185 happy_x_1
+happyReduce_186 = happySpecReduce_1  35# happyReduction_186
+happyReduction_186 happy_x_1
 	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
 	happyIn41
 		 (happy_var_1
 	)}
 
-happyReduce_186 = happySpecReduce_1  36# happyReduction_186
-happyReduction_186 happy_x_1
+happyReduce_187 = happySpecReduce_1  36# happyReduction_187
+happyReduction_187 happy_x_1
 	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
 	happyIn42
 		 ([happy_var_1]
 	)}
 
-happyReduce_187 = happySpecReduce_3  36# happyReduction_187
-happyReduction_187 happy_x_3
+happyReduce_188 = happySpecReduce_3  36# happyReduction_188
+happyReduction_188 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
@@ -2826,8 +2842,8 @@ happyReduction_187 happy_x_3
 		 (happy_var_1 : happy_var_3
 	)}}
 
-happyReduce_188 = happySpecReduce_3  37# happyReduction_188
-happyReduction_188 happy_x_3
+happyReduce_189 = happySpecReduce_3  37# happyReduction_189
+happyReduction_189 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
@@ -2836,23 +2852,23 @@ happyReduction_188 happy_x_3
 		 ((happy_var_1, happy_var_3)
 	)}}
 
-happyReduce_189 = happySpecReduce_2  38# happyReduction_189
-happyReduction_189 happy_x_2
+happyReduce_190 = happySpecReduce_2  38# happyReduction_190
+happyReduction_190 happy_x_2
 	happy_x_1
 	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
 	happyIn44
 		 (happy_var_1
 	)}
 
-happyReduce_190 = happySpecReduce_1  39# happyReduction_190
-happyReduction_190 happy_x_1
+happyReduce_191 = happySpecReduce_1  39# happyReduction_191
+happyReduction_191 happy_x_1
 	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
 	happyIn45
 		 ({-TeleBind-} happy_var_1
 	)}
 
-happyReduce_191 = happySpecReduce_2  40# happyReduction_191
-happyReduction_191 happy_x_2
+happyReduce_192 = happySpecReduce_2  40# happyReduction_192
+happyReduction_192 happy_x_2
 	happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	case happyOut46 happy_x_2 of { happy_var_2 -> 
@@ -2860,15 +2876,15 @@ happyReduction_191 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_192 = happySpecReduce_1  40# happyReduction_192
-happyReduction_192 happy_x_1
+happyReduce_193 = happySpecReduce_1  40# happyReduction_193
+happyReduction_193 happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	happyIn46
 		 ([happy_var_1]
 	)}
 
-happyReduce_193 = happyReduce 4# 41# happyReduction_193
-happyReduction_193 (happy_x_4 `HappyStk`
+happyReduce_194 = happyReduce 4# 41# happyReduction_194
+happyReduction_194 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2881,8 +2897,8 @@ happyReduction_193 (happy_x_4 `HappyStk`
                                            (setRelevance Irrelevant $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_194 = happyReduce 4# 41# happyReduction_194
-happyReduction_194 (happy_x_4 `HappyStk`
+happyReduce_195 = happyReduce 4# 41# happyReduction_195
+happyReduction_195 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2895,8 +2911,8 @@ happyReduction_194 (happy_x_4 `HappyStk`
                                            (hide $ setRelevance Irrelevant $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_195 = happyReduce 4# 41# happyReduction_195
-happyReduction_195 (happy_x_4 `HappyStk`
+happyReduce_196 = happyReduce 4# 41# happyReduction_196
+happyReduction_196 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2909,8 +2925,8 @@ happyReduction_195 (happy_x_4 `HappyStk`
                                                        (makeInstance $ setRelevance Irrelevant $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_196 = happyReduce 4# 41# happyReduction_196
-happyReduction_196 (happy_x_4 `HappyStk`
+happyReduce_197 = happyReduce 4# 41# happyReduction_197
+happyReduction_197 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2923,8 +2939,8 @@ happyReduction_196 (happy_x_4 `HappyStk`
                                             (setRelevance NonStrict $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_197 = happyReduce 4# 41# happyReduction_197
-happyReduction_197 (happy_x_4 `HappyStk`
+happyReduce_198 = happyReduce 4# 41# happyReduction_198
+happyReduction_198 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2937,8 +2953,8 @@ happyReduction_197 (happy_x_4 `HappyStk`
                                             (hide $ setRelevance NonStrict $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_198 = happyReduce 4# 41# happyReduction_198
-happyReduction_198 (happy_x_4 `HappyStk`
+happyReduce_199 = happyReduce 4# 41# happyReduction_199
+happyReduction_199 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -2951,8 +2967,8 @@ happyReduction_198 (happy_x_4 `HappyStk`
                                                         (makeInstance $ setRelevance NonStrict $ defaultColoredArg happy_var_3)
 	) `HappyStk` happyRest}}}
 
-happyReduce_199 = happySpecReduce_3  41# happyReduction_199
-happyReduction_199 happy_x_3
+happyReduce_200 = happySpecReduce_3  41# happyReduction_200
+happyReduction_200 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
@@ -2963,8 +2979,8 @@ happyReduction_199 happy_x_3
                                            (defaultColoredArg happy_var_2)
 	)}}}
 
-happyReduce_200 = happySpecReduce_3  41# happyReduction_200
-happyReduction_200 happy_x_3
+happyReduce_201 = happySpecReduce_3  41# happyReduction_201
+happyReduction_201 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymDoubleOpenBrace happy_var_1) -> 
@@ -2975,8 +2991,8 @@ happyReduction_200 happy_x_3
                                                        (makeInstance $ defaultColoredArg happy_var_2)
 	)}}}
 
-happyReduce_201 = happySpecReduce_3  41# happyReduction_201
-happyReduction_201 happy_x_3
+happyReduce_202 = happySpecReduce_3  41# happyReduction_202
+happyReduction_202 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenBrace happy_var_1) -> 
@@ -2987,8 +3003,8 @@ happyReduction_201 happy_x_3
                                            (hide $ defaultColoredArg happy_var_2)
 	)}}}
 
-happyReduce_202 = happySpecReduce_3  41# happyReduction_202
-happyReduction_202 happy_x_3
+happyReduce_203 = happySpecReduce_3  41# happyReduction_203
+happyReduction_203 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
@@ -2998,21 +3014,21 @@ happyReduction_202 happy_x_3
 		 (tLet (getRange (happy_var_1,happy_var_3)) happy_var_2
 	)}}}
 
-happyReduce_203 = happyReduce 4# 41# happyReduction_203
-happyReduction_203 (happy_x_4 `HappyStk`
+happyReduce_204 = happyReduce 4# 41# happyReduction_204
+happyReduction_204 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOutTok happy_x_1 of { (TokSymbol SymOpenParen happy_var_1) -> 
-	case happyOut139 happy_x_3 of { happy_var_3 -> 
+	case happyOut140 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokSymbol SymCloseParen happy_var_4) -> 
 	happyIn47
 		 (tLet (getRange (happy_var_1,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}
 
-happyReduce_204 = happySpecReduce_3  42# happyReduction_204
-happyReduction_204 happy_x_3
+happyReduce_205 = happySpecReduce_3  42# happyReduction_205
+happyReduction_205 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
@@ -3022,20 +3038,20 @@ happyReduction_204 happy_x_3
 		 (( [], TBind (getRange (happy_var_1,happy_var_2,happy_var_3))    (map mkBoundName_ happy_var_1) happy_var_3 )
 	)}}}
 
-happyReduce_205 = happyMonadReduce 2# 43# happyReduction_205
-happyReduction_205 (happy_x_2 `HappyStk`
+happyReduce_206 = happyMonadReduce 2# 43# happyReduction_206
+happyReduction_206 (happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> 
 	(
       case reverse happy_var_1 of
         Left _ : _ -> parseError "Absurd lambda cannot have a body."
-	_ : _      -> return [ b | Right b <- happy_var_1 ]
+        _ : _      -> return [ b | Right b <- happy_var_1 ]
         []         -> parsePanic "Empty LamBinds")}
 	) (\r -> happyReturn (happyIn49 r))
 
-happyReduce_206 = happyMonadReduce 1# 44# happyReduction_206
-happyReduction_206 (happy_x_1 `HappyStk`
+happyReduce_207 = happyMonadReduce 1# 44# happyReduction_207
+happyReduction_207 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut52 happy_x_1 of { happy_var_1 -> 
 	(
@@ -3047,8 +3063,8 @@ happyReduction_206 (happy_x_1 `HappyStk`
       Right es -> return $ Right es)}
 	) (\r -> happyReturn (happyIn50 r))
 
-happyReduce_207 = happySpecReduce_2  45# happyReduction_207
-happyReduction_207 happy_x_2
+happyReduce_208 = happySpecReduce_2  45# happyReduction_208
+happyReduction_208 happy_x_2
 	happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	case happyOut51 happy_x_2 of { happy_var_2 -> 
@@ -3056,8 +3072,8 @@ happyReduction_207 happy_x_2
 		 (map Right happy_var_1 ++ happy_var_2
 	)}}
 
-happyReduce_208 = happySpecReduce_2  45# happyReduction_208
-happyReduction_208 happy_x_2
+happyReduce_209 = happySpecReduce_2  45# happyReduction_209
+happyReduction_209 happy_x_2
 	happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	case happyOut51 happy_x_2 of { happy_var_2 -> 
@@ -3065,43 +3081,43 @@ happyReduction_208 happy_x_2
 		 (Right (DomainFull happy_var_1) : happy_var_2
 	)}}
 
-happyReduce_209 = happySpecReduce_1  45# happyReduction_209
-happyReduction_209 happy_x_1
+happyReduce_210 = happySpecReduce_1  45# happyReduction_210
+happyReduction_210 happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	happyIn51
 		 (map Right happy_var_1
 	)}
 
-happyReduce_210 = happySpecReduce_1  45# happyReduction_210
-happyReduction_210 happy_x_1
+happyReduce_211 = happySpecReduce_1  45# happyReduction_211
+happyReduction_211 happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	happyIn51
 		 ([Right $ DomainFull happy_var_1]
 	)}
 
-happyReduce_211 = happySpecReduce_2  45# happyReduction_211
-happyReduction_211 happy_x_2
+happyReduce_212 = happySpecReduce_2  45# happyReduction_212
+happyReduction_212 happy_x_2
 	happy_x_1
 	 =  happyIn51
 		 ([Left NotHidden]
 	)
 
-happyReduce_212 = happySpecReduce_2  45# happyReduction_212
-happyReduction_212 happy_x_2
+happyReduce_213 = happySpecReduce_2  45# happyReduction_213
+happyReduction_213 happy_x_2
 	happy_x_1
 	 =  happyIn51
 		 ([Left Hidden]
 	)
 
-happyReduce_213 = happySpecReduce_2  45# happyReduction_213
-happyReduction_213 happy_x_2
+happyReduce_214 = happySpecReduce_2  45# happyReduction_214
+happyReduction_214 happy_x_2
 	happy_x_1
 	 =  happyIn51
 		 ([Left Instance]
 	)
 
-happyReduce_214 = happySpecReduce_2  46# happyReduction_214
-happyReduction_214 happy_x_2
+happyReduce_215 = happySpecReduce_2  46# happyReduction_215
+happyReduction_215 happy_x_2
 	happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	case happyOut51 happy_x_2 of { happy_var_2 -> 
@@ -3109,8 +3125,8 @@ happyReduction_214 happy_x_2
 		 (Left $ map Right happy_var_1 ++ happy_var_2
 	)}}
 
-happyReduce_215 = happySpecReduce_2  46# happyReduction_215
-happyReduction_215 happy_x_2
+happyReduce_216 = happySpecReduce_2  46# happyReduction_216
+happyReduction_216 happy_x_2
 	happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	case happyOut51 happy_x_2 of { happy_var_2 -> 
@@ -3118,8 +3134,8 @@ happyReduction_215 happy_x_2
 		 (Left $ Right (DomainFull happy_var_1) : happy_var_2
 	)}}
 
-happyReduce_216 = happySpecReduce_1  46# happyReduction_216
-happyReduction_216 happy_x_1
+happyReduce_217 = happySpecReduce_1  46# happyReduction_217
+happyReduction_217 happy_x_1
 	 =  case happyOut61 happy_x_1 of { happy_var_1 -> 
 	happyIn52
 		 (case happy_var_1 of
@@ -3127,36 +3143,36 @@ happyReduction_216 happy_x_1
                                     Right es -> Right es
 	)}
 
-happyReduce_217 = happySpecReduce_1  46# happyReduction_217
-happyReduction_217 happy_x_1
+happyReduce_218 = happySpecReduce_1  46# happyReduction_218
+happyReduction_218 happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	happyIn52
 		 (Left [Right $ DomainFull happy_var_1]
 	)}
 
-happyReduce_218 = happySpecReduce_2  46# happyReduction_218
-happyReduction_218 happy_x_2
+happyReduce_219 = happySpecReduce_2  46# happyReduction_219
+happyReduction_219 happy_x_2
 	happy_x_1
 	 =  happyIn52
 		 (Left [Left NotHidden]
 	)
 
-happyReduce_219 = happySpecReduce_2  46# happyReduction_219
-happyReduction_219 happy_x_2
+happyReduce_220 = happySpecReduce_2  46# happyReduction_220
+happyReduction_220 happy_x_2
 	happy_x_1
 	 =  happyIn52
 		 (Left [Left Hidden]
 	)
 
-happyReduce_220 = happySpecReduce_2  46# happyReduction_220
-happyReduction_220 happy_x_2
+happyReduce_221 = happySpecReduce_2  46# happyReduction_221
+happyReduction_221 happy_x_2
 	happy_x_1
 	 =  happyIn52
 		 (Left [Left Instance]
 	)
 
-happyReduce_221 = happyMonadReduce 3# 47# happyReduction_221
-happyReduction_221 (happy_x_3 `HappyStk`
+happyReduce_222 = happyMonadReduce 3# 47# happyReduction_222
+happyReduction_222 (happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
@@ -3167,8 +3183,8 @@ happyReduction_221 (happy_x_3 `HappyStk`
       return (p [] [], RHS happy_var_3, NoWhere))}}
 	) (\r -> happyReturn (happyIn53 r))
 
-happyReduce_222 = happyMonadReduce 1# 48# happyReduction_222
-happyReduction_222 (happy_x_1 `HappyStk`
+happyReduce_223 = happyMonadReduce 1# 48# happyReduction_223
+happyReduction_223 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut34 happy_x_1 of { happy_var_1 -> 
 	( do
@@ -3176,22 +3192,22 @@ happyReduction_222 (happy_x_1 `HappyStk`
       return (p [] [], AbsurdRHS, NoWhere))}
 	) (\r -> happyReturn (happyIn54 r))
 
-happyReduce_223 = happySpecReduce_1  49# happyReduction_223
-happyReduction_223 happy_x_1
+happyReduce_224 = happySpecReduce_1  49# happyReduction_224
+happyReduction_224 happy_x_1
 	 =  case happyOut53 happy_x_1 of { happy_var_1 -> 
 	happyIn55
 		 (happy_var_1
 	)}
 
-happyReduce_224 = happySpecReduce_1  49# happyReduction_224
-happyReduction_224 happy_x_1
+happyReduce_225 = happySpecReduce_1  49# happyReduction_225
+happyReduction_225 happy_x_1
 	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
 	happyIn55
 		 (happy_var_1
 	)}
 
-happyReduce_225 = happySpecReduce_3  50# happyReduction_225
-happyReduction_225 happy_x_3
+happyReduce_226 = happySpecReduce_3  50# happyReduction_226
+happyReduction_226 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
@@ -3200,8 +3216,8 @@ happyReduction_225 happy_x_3
 		 (happy_var_3 : happy_var_1
 	)}}
 
-happyReduce_226 = happySpecReduce_3  50# happyReduction_226
-happyReduction_226 happy_x_3
+happyReduce_227 = happySpecReduce_3  50# happyReduction_227
+happyReduction_227 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
@@ -3210,23 +3226,23 @@ happyReduction_226 happy_x_3
 		 ([happy_var_3, happy_var_1]
 	)}}
 
-happyReduce_227 = happySpecReduce_1  50# happyReduction_227
-happyReduction_227 happy_x_1
+happyReduce_228 = happySpecReduce_1  50# happyReduction_228
+happyReduction_228 happy_x_1
 	 =  case happyOut53 happy_x_1 of { happy_var_1 -> 
 	happyIn56
 		 ([happy_var_1]
 	)}
 
-happyReduce_228 = happySpecReduce_2  51# happyReduction_228
-happyReduction_228 happy_x_2
+happyReduce_229 = happySpecReduce_2  51# happyReduction_229
+happyReduction_229 happy_x_2
 	happy_x_1
 	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
 	happyIn57
 		 (happy_var_1
 	)}
 
-happyReduce_229 = happySpecReduce_2  52# happyReduction_229
-happyReduction_229 happy_x_2
+happyReduce_230 = happySpecReduce_2  52# happyReduction_230
+happyReduction_230 happy_x_2
 	happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	case happyOut58 happy_x_2 of { happy_var_2 -> 
@@ -3234,8 +3250,8 @@ happyReduction_229 happy_x_2
 		 (happy_var_1 ++ happy_var_2
 	)}}
 
-happyReduce_230 = happySpecReduce_2  52# happyReduction_230
-happyReduction_230 happy_x_2
+happyReduce_231 = happySpecReduce_2  52# happyReduction_231
+happyReduction_231 happy_x_2
 	happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	case happyOut58 happy_x_2 of { happy_var_2 -> 
@@ -3243,22 +3259,22 @@ happyReduction_230 happy_x_2
 		 (DomainFull happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_231 = happySpecReduce_1  52# happyReduction_231
-happyReduction_231 happy_x_1
+happyReduce_232 = happySpecReduce_1  52# happyReduction_232
+happyReduction_232 happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	happyIn58
 		 (happy_var_1
 	)}
 
-happyReduce_232 = happySpecReduce_1  52# happyReduction_232
-happyReduction_232 happy_x_1
+happyReduce_233 = happySpecReduce_1  52# happyReduction_233
+happyReduction_233 happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	happyIn58
 		 ([DomainFull happy_var_1]
 	)}
 
-happyReduce_233 = happySpecReduce_2  53# happyReduction_233
-happyReduction_233 happy_x_2
+happyReduce_234 = happySpecReduce_2  53# happyReduction_234
+happyReduction_234 happy_x_2
 	happy_x_1
 	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
 	case happyOut59 happy_x_2 of { happy_var_2 -> 
@@ -3266,8 +3282,8 @@ happyReduction_233 happy_x_2
 		 (happy_var_1 ++ happy_var_2
 	)}}
 
-happyReduce_234 = happySpecReduce_2  53# happyReduction_234
-happyReduction_234 happy_x_2
+happyReduce_235 = happySpecReduce_2  53# happyReduction_235
+happyReduction_235 happy_x_2
 	happy_x_1
 	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
 	case happyOut59 happy_x_2 of { happy_var_2 -> 
@@ -3275,13 +3291,13 @@ happyReduction_234 happy_x_2
 		 (DomainFull happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_235 = happySpecReduce_0  53# happyReduction_235
-happyReduction_235  =  happyIn59
+happyReduce_236 = happySpecReduce_0  53# happyReduction_236
+happyReduction_236  =  happyIn59
 		 ([]
 	)
 
-happyReduce_236 = happySpecReduce_1  54# happyReduction_236
-happyReduction_236 happy_x_1
+happyReduce_237 = happySpecReduce_1  54# happyReduction_237
+happyReduction_237 happy_x_1
 	 =  case happyOut61 happy_x_1 of { happy_var_1 -> 
 	happyIn60
 		 (case happy_var_1 of
@@ -3289,31 +3305,31 @@ happyReduction_236 happy_x_1
                              Right _ -> fail "expected sequence of bound identifiers, not absurd pattern"
 	)}
 
-happyReduce_237 = happySpecReduce_1  55# happyReduction_237
-happyReduction_237 happy_x_1
+happyReduce_238 = happySpecReduce_1  55# happyReduction_238
+happyReduction_238 happy_x_1
 	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
 	happyIn61
 		 (Left [DomainFree defaultArgInfo $ mkBoundName_ happy_var_1]
 	)}
 
-happyReduce_238 = happySpecReduce_2  55# happyReduction_238
-happyReduction_238 happy_x_2
+happyReduce_239 = happySpecReduce_2  55# happyReduction_239
+happyReduction_239 happy_x_2
 	happy_x_1
 	 =  case happyOut23 happy_x_2 of { happy_var_2 -> 
 	happyIn61
 		 (Left [DomainFree (setRelevance Irrelevant $ defaultArgInfo) $ mkBoundName_ happy_var_2]
 	)}
 
-happyReduce_239 = happySpecReduce_2  55# happyReduction_239
-happyReduction_239 happy_x_2
+happyReduce_240 = happySpecReduce_2  55# happyReduction_240
+happyReduction_240 happy_x_2
 	happy_x_1
 	 =  case happyOut23 happy_x_2 of { happy_var_2 -> 
 	happyIn61
 		 (Left [DomainFree (setRelevance NonStrict $ defaultArgInfo) $ mkBoundName_ happy_var_2]
 	)}
 
-happyReduce_240 = happySpecReduce_3  55# happyReduction_240
-happyReduction_240 happy_x_3
+happyReduce_241 = happySpecReduce_3  55# happyReduction_241
+happyReduction_241 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut26 happy_x_2 of { happy_var_2 -> 
@@ -3321,8 +3337,8 @@ happyReduction_240 happy_x_3
 		 (either (Left . map (DomainFree (setHiding Hidden $ defaultArgInfo) . mkBoundName_)) Right happy_var_2
 	)}
 
-happyReduce_241 = happySpecReduce_3  55# happyReduction_241
-happyReduction_241 happy_x_3
+happyReduce_242 = happySpecReduce_3  55# happyReduction_242
+happyReduction_242 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut25 happy_x_2 of { happy_var_2 -> 
@@ -3330,8 +3346,8 @@ happyReduction_241 happy_x_3
 		 (Left $ map (DomainFree (setHiding Instance $ defaultArgInfo) . mkBoundName_) happy_var_2
 	)}
 
-happyReduce_242 = happyReduce 4# 55# happyReduction_242
-happyReduction_242 (happy_x_4 `HappyStk`
+happyReduce_243 = happyReduce 4# 55# happyReduction_243
+happyReduction_243 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3341,8 +3357,8 @@ happyReduction_242 (happy_x_4 `HappyStk`
 		 (Left $ map (DomainFree (setHiding Hidden $ setRelevance Irrelevant $ defaultArgInfo) . mkBoundName_) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_243 = happyReduce 4# 55# happyReduction_243
-happyReduction_243 (happy_x_4 `HappyStk`
+happyReduce_244 = happyReduce 4# 55# happyReduction_244
+happyReduction_244 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3352,8 +3368,8 @@ happyReduction_243 (happy_x_4 `HappyStk`
 		 (Left $ map (DomainFree (setHiding Instance $ setRelevance Irrelevant $ defaultArgInfo) . mkBoundName_) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_244 = happyReduce 4# 55# happyReduction_244
-happyReduction_244 (happy_x_4 `HappyStk`
+happyReduce_245 = happyReduce 4# 55# happyReduction_245
+happyReduction_245 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3363,8 +3379,8 @@ happyReduction_244 (happy_x_4 `HappyStk`
 		 (Left $ map (DomainFree (setHiding Hidden $ setRelevance NonStrict $ defaultArgInfo) . mkBoundName_) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_245 = happyReduce 4# 55# happyReduction_245
-happyReduction_245 (happy_x_4 `HappyStk`
+happyReduce_246 = happyReduce 4# 55# happyReduction_246
+happyReduction_246 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3374,15 +3390,15 @@ happyReduction_245 (happy_x_4 `HappyStk`
 		 (Left $ map (DomainFree  (setHiding Instance $ setRelevance NonStrict $ defaultArgInfo) . mkBoundName_) happy_var_3
 	) `HappyStk` happyRest}
 
-happyReduce_246 = happyMonadReduce 1# 56# happyReduction_246
-happyReduction_246 (happy_x_1 `HappyStk`
+happyReduce_247 = happyMonadReduce 1# 56# happyReduction_247
+happyReduction_247 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut63 happy_x_1 of { happy_var_1 -> 
 	( mergeImportDirectives happy_var_1)}
 	) (\r -> happyReturn (happyIn62 r))
 
-happyReduce_247 = happySpecReduce_2  57# happyReduction_247
-happyReduction_247 happy_x_2
+happyReduce_248 = happySpecReduce_2  57# happyReduction_248
+happyReduction_248 happy_x_2
 	happy_x_1
 	 =  case happyOut64 happy_x_1 of { happy_var_1 -> 
 	case happyOut63 happy_x_2 of { happy_var_2 -> 
@@ -3390,34 +3406,34 @@ happyReduction_247 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_248 = happySpecReduce_0  57# happyReduction_248
-happyReduction_248  =  happyIn63
+happyReduce_249 = happySpecReduce_0  57# happyReduction_249
+happyReduction_249  =  happyIn63
 		 ([]
 	)
 
-happyReduce_249 = happySpecReduce_1  58# happyReduction_249
-happyReduction_249 happy_x_1
+happyReduce_250 = happySpecReduce_1  58# happyReduction_250
+happyReduction_250 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPublic happy_var_1) -> 
 	happyIn64
 		 (defaultImportDir { importDirRange = getRange happy_var_1, publicOpen = True }
 	)}
 
-happyReduce_250 = happySpecReduce_1  58# happyReduction_250
-happyReduction_250 happy_x_1
+happyReduce_251 = happySpecReduce_1  58# happyReduction_251
+happyReduction_251 happy_x_1
 	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
 	happyIn64
 		 (defaultImportDir { importDirRange = snd happy_var_1, usingOrHiding = fst happy_var_1 }
 	)}
 
-happyReduce_251 = happySpecReduce_1  58# happyReduction_251
-happyReduction_251 happy_x_1
+happyReduce_252 = happySpecReduce_1  58# happyReduction_252
+happyReduction_252 happy_x_1
 	 =  case happyOut66 happy_x_1 of { happy_var_1 -> 
 	happyIn64
 		 (defaultImportDir { importDirRange = snd happy_var_1, renaming = fst happy_var_1 }
 	)}
 
-happyReduce_252 = happyReduce 4# 59# happyReduction_252
-happyReduction_252 (happy_x_4 `HappyStk`
+happyReduce_253 = happyReduce 4# 59# happyReduction_253
+happyReduction_253 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3430,8 +3446,8 @@ happyReduction_252 (happy_x_4 `HappyStk`
 		 ((Using happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
 	) `HappyStk` happyRest}}}}
 
-happyReduce_253 = happyReduce 4# 59# happyReduction_253
-happyReduction_253 (happy_x_4 `HappyStk`
+happyReduce_254 = happyReduce 4# 59# happyReduction_254
+happyReduction_254 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3444,8 +3460,8 @@ happyReduction_253 (happy_x_4 `HappyStk`
 		 ((Hiding happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
 	) `HappyStk` happyRest}}}}
 
-happyReduce_254 = happyReduce 4# 60# happyReduction_254
-happyReduction_254 (happy_x_4 `HappyStk`
+happyReduce_255 = happyReduce 4# 60# happyReduction_255
+happyReduction_255 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3458,8 +3474,8 @@ happyReduction_254 (happy_x_4 `HappyStk`
 		 ((happy_var_3 , getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4))
 	) `HappyStk` happyRest}}}}
 
-happyReduce_255 = happySpecReduce_3  60# happyReduction_255
-happyReduction_255 happy_x_3
+happyReduce_256 = happySpecReduce_3  60# happyReduction_256
+happyReduction_256 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwRenaming happy_var_1) -> 
@@ -3469,8 +3485,8 @@ happyReduction_255 happy_x_3
 		 (([] , getRange (happy_var_1,happy_var_2,happy_var_3))
 	)}}}
 
-happyReduce_256 = happySpecReduce_3  61# happyReduction_256
-happyReduction_256 happy_x_3
+happyReduce_257 = happySpecReduce_3  61# happyReduction_257
+happyReduction_257 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut68 happy_x_1 of { happy_var_1 -> 
@@ -3479,15 +3495,15 @@ happyReduction_256 happy_x_3
 		 (happy_var_1 : happy_var_3
 	)}}
 
-happyReduce_257 = happySpecReduce_1  61# happyReduction_257
-happyReduction_257 happy_x_1
+happyReduce_258 = happySpecReduce_1  61# happyReduction_258
+happyReduction_258 happy_x_1
 	 =  case happyOut68 happy_x_1 of { happy_var_1 -> 
 	happyIn67
 		 ([happy_var_1]
 	)}
 
-happyReduce_258 = happySpecReduce_3  62# happyReduction_258
-happyReduction_258 happy_x_3
+happyReduce_259 = happySpecReduce_3  62# happyReduction_259
+happyReduction_259 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
@@ -3497,16 +3513,16 @@ happyReduction_258 happy_x_3
 		 (Renaming happy_var_1 happy_var_3 (getRange happy_var_2)
 	)}}}
 
-happyReduce_259 = happySpecReduce_2  63# happyReduction_259
-happyReduction_259 happy_x_2
+happyReduce_260 = happySpecReduce_2  63# happyReduction_260
+happyReduction_260 happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_2 of { happy_var_2 -> 
 	happyIn69
 		 (ImportedName happy_var_2
 	)}
 
-happyReduce_260 = happySpecReduce_3  63# happyReduction_260
-happyReduction_260 happy_x_3
+happyReduce_261 = happySpecReduce_3  63# happyReduction_261
+happyReduction_261 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_3 of { happy_var_3 -> 
@@ -3514,42 +3530,42 @@ happyReduction_260 happy_x_3
 		 (ImportedModule happy_var_3
 	)}
 
-happyReduce_261 = happySpecReduce_1  64# happyReduction_261
-happyReduction_261 happy_x_1
+happyReduce_262 = happySpecReduce_1  64# happyReduction_262
+happyReduction_262 happy_x_1
 	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
 	happyIn70
 		 (ImportedName happy_var_1
 	)}
 
-happyReduce_262 = happySpecReduce_2  64# happyReduction_262
-happyReduction_262 happy_x_2
+happyReduce_263 = happySpecReduce_2  64# happyReduction_263
+happyReduction_263 happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_2 of { happy_var_2 -> 
 	happyIn70
 		 (ImportedModule happy_var_2
 	)}
 
-happyReduce_263 = happySpecReduce_0  65# happyReduction_263
-happyReduction_263  =  happyIn71
+happyReduce_264 = happySpecReduce_0  65# happyReduction_264
+happyReduction_264  =  happyIn71
 		 ([]
 	)
 
-happyReduce_264 = happySpecReduce_1  65# happyReduction_264
-happyReduction_264 happy_x_1
+happyReduce_265 = happySpecReduce_1  65# happyReduction_265
+happyReduction_265 happy_x_1
 	 =  case happyOut72 happy_x_1 of { happy_var_1 -> 
 	happyIn71
 		 (happy_var_1
 	)}
 
-happyReduce_265 = happySpecReduce_1  66# happyReduction_265
-happyReduction_265 happy_x_1
+happyReduce_266 = happySpecReduce_1  66# happyReduction_266
+happyReduction_266 happy_x_1
 	 =  case happyOut70 happy_x_1 of { happy_var_1 -> 
 	happyIn72
 		 ([happy_var_1]
 	)}
 
-happyReduce_266 = happySpecReduce_3  66# happyReduction_266
-happyReduction_266 happy_x_3
+happyReduce_267 = happySpecReduce_3  66# happyReduction_267
+happyReduction_267 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut70 happy_x_1 of { happy_var_1 -> 
@@ -3558,8 +3574,8 @@ happyReduction_266 happy_x_3
 		 (happy_var_1 : happy_var_3
 	)}}
 
-happyReduce_267 = happyMonadReduce 3# 67# happyReduction_267
-happyReduction_267 (happy_x_3 `HappyStk`
+happyReduce_268 = happyMonadReduce 3# 67# happyReduction_268
+happyReduction_268 (happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
@@ -3569,8 +3585,8 @@ happyReduction_267 (happy_x_3 `HappyStk`
 	( exprToLHS happy_var_1 >>= \p -> return (p happy_var_2 happy_var_3))}}}
 	) (\r -> happyReturn (happyIn73 r))
 
-happyReduce_268 = happyReduce 4# 67# happyReduction_268
-happyReduction_268 (happy_x_4 `HappyStk`
+happyReduce_269 = happyReduce 4# 67# happyReduction_269
+happyReduction_269 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -3583,227 +3599,227 @@ happyReduction_268 (happy_x_4 `HappyStk`
 		 (Ellipsis (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_2 happy_var_3 happy_var_4
 	) `HappyStk` happyRest}}}}
 
-happyReduce_269 = happySpecReduce_0  68# happyReduction_269
-happyReduction_269  =  happyIn74
+happyReduce_270 = happySpecReduce_0  68# happyReduction_270
+happyReduction_270  =  happyIn74
 		 ([]
 	)
 
-happyReduce_270 = happyMonadReduce 3# 68# happyReduction_270
-happyReduction_270 (happy_x_3 `HappyStk`
+happyReduce_271 = happyMonadReduce 3# 68# happyReduction_271
+happyReduction_271 (happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut37 happy_x_2 of { happy_var_2 -> 
 	case happyOut74 happy_x_3 of { happy_var_3 -> 
 	( exprToPattern (RawApp (getRange happy_var_2) happy_var_2) >>= \p ->
-		   return (p : happy_var_3))}}
+                   return (p : happy_var_3))}}
 	) (\r -> happyReturn (happyIn74 r))
 
-happyReduce_271 = happySpecReduce_0  69# happyReduction_271
-happyReduction_271  =  happyIn75
+happyReduce_272 = happySpecReduce_0  69# happyReduction_272
+happyReduction_272  =  happyIn75
 		 ([]
 	)
 
-happyReduce_272 = happySpecReduce_2  69# happyReduction_272
-happyReduction_272 happy_x_2
+happyReduce_273 = happySpecReduce_2  69# happyReduction_273
+happyReduction_273 happy_x_2
 	happy_x_1
 	 =  case happyOut31 happy_x_2 of { happy_var_2 -> 
 	happyIn75
 		 (case happy_var_2 of { WithApp _ e es -> e : es; e -> [e] }
 	)}
 
-happyReduce_273 = happySpecReduce_0  70# happyReduction_273
-happyReduction_273  =  happyIn76
+happyReduce_274 = happySpecReduce_0  70# happyReduction_274
+happyReduction_274  =  happyIn76
 		 ([]
 	)
 
-happyReduce_274 = happySpecReduce_2  70# happyReduction_274
-happyReduction_274 happy_x_2
+happyReduce_275 = happySpecReduce_2  70# happyReduction_275
+happyReduction_275 happy_x_2
 	happy_x_1
 	 =  case happyOut32 happy_x_2 of { happy_var_2 -> 
 	happyIn76
 		 (case happy_var_2 of { WithApp _ e es -> e : es; e -> [e] }
 	)}
 
-happyReduce_275 = happySpecReduce_0  71# happyReduction_275
-happyReduction_275  =  happyIn77
+happyReduce_276 = happySpecReduce_0  71# happyReduction_276
+happyReduction_276  =  happyIn77
 		 (NoWhere
 	)
 
-happyReduce_276 = happySpecReduce_2  71# happyReduction_276
-happyReduction_276 happy_x_2
+happyReduce_277 = happySpecReduce_2  71# happyReduction_277
+happyReduction_277 happy_x_2
 	happy_x_1
-	 =  case happyOut140 happy_x_2 of { happy_var_2 -> 
+	 =  case happyOut141 happy_x_2 of { happy_var_2 -> 
 	happyIn77
 		 (AnyWhere happy_var_2
 	)}
 
-happyReduce_277 = happyReduce 4# 71# happyReduction_277
-happyReduction_277 (happy_x_4 `HappyStk`
+happyReduce_278 = happyReduce 4# 71# happyReduction_278
+happyReduction_278 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut15 happy_x_2 of { happy_var_2 -> 
-	case happyOut140 happy_x_4 of { happy_var_4 -> 
+	case happyOut141 happy_x_4 of { happy_var_4 -> 
 	happyIn77
 		 (SomeWhere happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_278 = happyReduce 4# 71# happyReduction_278
-happyReduction_278 (happy_x_4 `HappyStk`
+happyReduce_279 = happyReduce 4# 71# happyReduction_279
+happyReduction_279 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut112 happy_x_2 of { happy_var_2 -> 
-	case happyOut140 happy_x_4 of { happy_var_4 -> 
+	case happyOut141 happy_x_4 of { happy_var_4 -> 
 	happyIn77
 		 (SomeWhere happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_279 = happySpecReduce_1  72# happyReduction_279
-happyReduction_279 happy_x_1
-	 =  case happyOut89 happy_x_1 of { happy_var_1 -> 
-	happyIn78
-		 (happy_var_1
-	)}
-
 happyReduce_280 = happySpecReduce_1  72# happyReduction_280
 happyReduction_280 happy_x_1
-	 =  case happyOut81 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut89 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 (happy_var_1
 	)}
 
 happyReduce_281 = happySpecReduce_1  72# happyReduction_281
 happyReduction_281 happy_x_1
-	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut81 happy_x_1 of { happy_var_1 -> 
 	happyIn78
-		 ([happy_var_1]
+		 (happy_var_1
 	)}
 
 happyReduce_282 = happySpecReduce_1  72# happyReduction_282
 happyReduction_282 happy_x_1
-	 =  case happyOut84 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_283 = happySpecReduce_1  72# happyReduction_283
 happyReduction_283 happy_x_1
-	 =  case happyOut85 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut84 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_284 = happySpecReduce_1  72# happyReduction_284
 happyReduction_284 happy_x_1
-	 =  case happyOut86 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut85 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_285 = happySpecReduce_1  72# happyReduction_285
 happyReduction_285 happy_x_1
-	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut86 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_286 = happySpecReduce_1  72# happyReduction_286
 happyReduction_286 happy_x_1
-	 =  case happyOut90 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_287 = happySpecReduce_1  72# happyReduction_287
 happyReduction_287 happy_x_1
-	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut90 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_288 = happySpecReduce_1  72# happyReduction_288
 happyReduction_288 happy_x_1
-	 =  case happyOut92 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_289 = happySpecReduce_1  72# happyReduction_289
 happyReduction_289 happy_x_1
-	 =  case happyOut93 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut92 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_290 = happySpecReduce_1  72# happyReduction_290
 happyReduction_290 happy_x_1
-	 =  case happyOut94 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut93 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_291 = happySpecReduce_1  72# happyReduction_291
 happyReduction_291 happy_x_1
-	 =  case happyOut95 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut94 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_292 = happySpecReduce_1  72# happyReduction_292
 happyReduction_292 happy_x_1
-	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut95 happy_x_1 of { happy_var_1 -> 
 	happyIn78
-		 (happy_var_1
+		 ([happy_var_1]
 	)}
 
 happyReduce_293 = happySpecReduce_1  72# happyReduction_293
 happyReduction_293 happy_x_1
-	 =  case happyOut110 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
 	happyIn78
-		 ([happy_var_1]
+		 (happy_var_1
 	)}
 
 happyReduce_294 = happySpecReduce_1  72# happyReduction_294
 happyReduction_294 happy_x_1
-	 =  case happyOut111 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut110 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_295 = happySpecReduce_1  72# happyReduction_295
 happyReduction_295 happy_x_1
-	 =  case happyOut114 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut111 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_296 = happySpecReduce_1  72# happyReduction_296
 happyReduction_296 happy_x_1
-	 =  case happyOut97 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut114 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_297 = happySpecReduce_1  72# happyReduction_297
 happyReduction_297 happy_x_1
-	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut97 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
 happyReduce_298 = happySpecReduce_1  72# happyReduction_298
 happyReduction_298 happy_x_1
+	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	happyIn78
+		 ([happy_var_1]
+	)}
+
+happyReduce_299 = happySpecReduce_1  72# happyReduction_299
+happyReduction_299 happy_x_1
 	 =  case happyOut96 happy_x_1 of { happy_var_1 -> 
 	happyIn78
 		 ([happy_var_1]
 	)}
 
-happyReduce_299 = happySpecReduce_3  73# happyReduction_299
-happyReduction_299 happy_x_3
+happyReduce_300 = happySpecReduce_3  73# happyReduction_300
+happyReduction_300 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
@@ -3812,8 +3828,8 @@ happyReduction_299 happy_x_3
 		 (map (flip (TypeSig defaultArgInfo) happy_var_3) happy_var_1
 	)}}
 
-happyReduce_300 = happySpecReduce_3  74# happyReduction_300
-happyReduction_300 happy_x_3
+happyReduce_301 = happySpecReduce_3  74# happyReduction_301
+happyReduction_301 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
@@ -3822,8 +3838,8 @@ happyReduction_300 happy_x_3
 		 (map (fmap (flip (TypeSig defaultArgInfo) happy_var_3)) happy_var_1
 	)}}
 
-happyReduce_301 = happyMonadReduce 3# 75# happyReduction_301
-happyReduction_301 (happy_x_3 `HappyStk`
+happyReduce_302 = happyMonadReduce 3# 75# happyReduction_302
+happyReduction_302 (happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest) tk
@@ -3833,29 +3849,29 @@ happyReduction_301 (happy_x_3 `HappyStk`
 	( funClauseOrTypeSigs happy_var_1 happy_var_2 happy_var_3)}}}
 	) (\r -> happyReturn (happyIn81 r))
 
-happyReduce_302 = happySpecReduce_2  76# happyReduction_302
-happyReduction_302 happy_x_2
+happyReduce_303 = happySpecReduce_2  76# happyReduction_303
+happyReduction_303 happy_x_2
 	happy_x_1
 	 =  case happyOut31 happy_x_2 of { happy_var_2 -> 
 	happyIn82
 		 (JustRHS (RHS happy_var_2)
 	)}
 
-happyReduce_303 = happySpecReduce_2  76# happyReduction_303
-happyReduction_303 happy_x_2
+happyReduce_304 = happySpecReduce_2  76# happyReduction_304
+happyReduction_304 happy_x_2
 	happy_x_1
 	 =  case happyOut31 happy_x_2 of { happy_var_2 -> 
 	happyIn82
 		 (TypeSigsRHS happy_var_2
 	)}
 
-happyReduce_304 = happySpecReduce_0  76# happyReduction_304
-happyReduction_304  =  happyIn82
+happyReduce_305 = happySpecReduce_0  76# happyReduction_305
+happyReduction_305  =  happyIn82
 		 (JustRHS AbsurdRHS
 	)
 
-happyReduce_305 = happyReduce 7# 77# happyReduction_305
-happyReduction_305 (happy_x_7 `HappyStk`
+happyReduce_306 = happyReduce 7# 77# happyReduction_306
+happyReduction_306 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -3869,13 +3885,13 @@ happyReduction_305 (happy_x_7 `HappyStk`
 	case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) -> 
 	case happyOut31 happy_x_5 of { happy_var_5 -> 
 	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> 
-	case happyOut136 happy_x_7 of { happy_var_7 -> 
+	case happyOut137 happy_x_7 of { happy_var_7 -> 
 	happyIn83
 		 (Data (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5,happy_var_6,happy_var_7)) Inductive happy_var_2 happy_var_3 (Just happy_var_5) happy_var_7
 	) `HappyStk` happyRest}}}}}}}
 
-happyReduce_306 = happyReduce 7# 77# happyReduction_306
-happyReduction_306 (happy_x_7 `HappyStk`
+happyReduce_307 = happyReduce 7# 77# happyReduction_307
+happyReduction_307 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -3889,13 +3905,13 @@ happyReduction_306 (happy_x_7 `HappyStk`
 	case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) -> 
 	case happyOut31 happy_x_5 of { happy_var_5 -> 
 	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> 
-	case happyOut136 happy_x_7 of { happy_var_7 -> 
+	case happyOut137 happy_x_7 of { happy_var_7 -> 
 	happyIn83
 		 (Data (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5,happy_var_6,happy_var_7)) CoInductive happy_var_2 happy_var_3 (Just happy_var_5) happy_var_7
 	) `HappyStk` happyRest}}}}}}}
 
-happyReduce_307 = happyReduce 5# 77# happyReduction_307
-happyReduction_307 (happy_x_5 `HappyStk`
+happyReduce_308 = happyReduce 5# 77# happyReduction_308
+happyReduction_308 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -3905,13 +3921,13 @@ happyReduction_307 (happy_x_5 `HappyStk`
 	case happyOut15 happy_x_2 of { happy_var_2 -> 
 	case happyOut59 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> 
-	case happyOut136 happy_x_5 of { happy_var_5 -> 
+	case happyOut137 happy_x_5 of { happy_var_5 -> 
 	happyIn83
 		 (Data (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) Inductive happy_var_2 happy_var_3 Nothing happy_var_5
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_308 = happyReduce 5# 77# happyReduction_308
-happyReduction_308 (happy_x_5 `HappyStk`
+happyReduce_309 = happyReduce 5# 77# happyReduction_309
+happyReduction_309 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -3921,13 +3937,13 @@ happyReduction_308 (happy_x_5 `HappyStk`
 	case happyOut15 happy_x_2 of { happy_var_2 -> 
 	case happyOut59 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> 
-	case happyOut136 happy_x_5 of { happy_var_5 -> 
+	case happyOut137 happy_x_5 of { happy_var_5 -> 
 	happyIn83
 		 (Data (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) CoInductive happy_var_2 happy_var_3 Nothing happy_var_5
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_309 = happyReduce 5# 78# happyReduction_309
-happyReduction_309 (happy_x_5 `HappyStk`
+happyReduce_310 = happyReduce 5# 78# happyReduction_310
+happyReduction_310 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -3942,8 +3958,8 @@ happyReduction_309 (happy_x_5 `HappyStk`
 		 (DataSig (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) Inductive happy_var_2 happy_var_3 happy_var_5
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_310 = happyMonadReduce 7# 79# happyReduction_310
-happyReduction_310 (happy_x_7 `HappyStk`
+happyReduce_311 = happyMonadReduce 7# 79# happyReduction_311
+happyReduction_311 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -3957,12 +3973,12 @@ happyReduction_310 (happy_x_7 `HappyStk`
 	case happyOutTok happy_x_4 of { (TokSymbol SymColon happy_var_4) -> 
 	case happyOut31 happy_x_5 of { happy_var_5 -> 
 	case happyOutTok happy_x_6 of { (TokKeyword KwWhere happy_var_6) -> 
-	case happyOut137 happy_x_7 of { happy_var_7 -> 
+	case happyOut138 happy_x_7 of { happy_var_7 -> 
 	( exprToName happy_var_2 >>= \ n -> return $ Record (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5,happy_var_6,happy_var_7)) n (fst3 happy_var_7) (snd3 happy_var_7) happy_var_3 (Just happy_var_5) (thd3 happy_var_7))}}}}}}}
 	) (\r -> happyReturn (happyIn85 r))
 
-happyReduce_311 = happyMonadReduce 5# 79# happyReduction_311
-happyReduction_311 (happy_x_5 `HappyStk`
+happyReduce_312 = happyMonadReduce 5# 79# happyReduction_312
+happyReduction_312 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -3972,12 +3988,12 @@ happyReduction_311 (happy_x_5 `HappyStk`
 	case happyOut39 happy_x_2 of { happy_var_2 -> 
 	case happyOut59 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> 
-	case happyOut137 happy_x_5 of { happy_var_5 -> 
+	case happyOut138 happy_x_5 of { happy_var_5 -> 
 	( exprToName happy_var_2 >>= \ n -> return $ Record (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) n (fst3 happy_var_5) (snd3 happy_var_5) happy_var_3 Nothing (thd3 happy_var_5))}}}}}
 	) (\r -> happyReturn (happyIn85 r))
 
-happyReduce_312 = happyMonadReduce 5# 80# happyReduction_312
-happyReduction_312 (happy_x_5 `HappyStk`
+happyReduce_313 = happyMonadReduce 5# 80# happyReduction_313
+happyReduction_313 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -3991,16 +4007,16 @@ happyReduction_312 (happy_x_5 `HappyStk`
 	( exprToName happy_var_2 >>= \ n -> return $ RecordSig (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) n happy_var_3 happy_var_5)}}}}}
 	) (\r -> happyReturn (happyIn86 r))
 
-happyReduce_313 = happySpecReduce_2  81# happyReduction_313
-happyReduction_313 happy_x_2
+happyReduce_314 = happySpecReduce_2  81# happyReduction_314
+happyReduction_314 happy_x_2
 	happy_x_1
 	 =  case happyOut15 happy_x_2 of { happy_var_2 -> 
 	happyIn87
 		 (happy_var_2
 	)}
 
-happyReduce_314 = happySpecReduce_3  82# happyReduction_314
-happyReduction_314 happy_x_3
+happyReduce_315 = happySpecReduce_3  82# happyReduction_315
+happyReduction_315 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfix happy_var_1) -> 
@@ -4010,8 +4026,8 @@ happyReduction_314 happy_x_3
 		 (Infix (NonAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
 	)}}}
 
-happyReduce_315 = happySpecReduce_3  82# happyReduction_315
-happyReduction_315 happy_x_3
+happyReduce_316 = happySpecReduce_3  82# happyReduction_316
+happyReduction_316 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixL happy_var_1) -> 
@@ -4021,8 +4037,8 @@ happyReduction_315 happy_x_3
 		 (Infix (LeftAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
 	)}}}
 
-happyReduce_316 = happySpecReduce_3  82# happyReduction_316
-happyReduction_316 happy_x_3
+happyReduce_317 = happySpecReduce_3  82# happyReduction_317
+happyReduction_317 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInfixR happy_var_1) -> 
@@ -4032,70 +4048,70 @@ happyReduction_316 happy_x_3
 		 (Infix (RightAssoc (getRange (happy_var_1,happy_var_3)) happy_var_2) happy_var_3
 	)}}}
 
-happyReduce_317 = happySpecReduce_2  83# happyReduction_317
-happyReduction_317 happy_x_2
+happyReduce_318 = happySpecReduce_2  83# happyReduction_318
+happyReduction_318 happy_x_2
 	happy_x_1
-	 =  case happyOut134 happy_x_2 of { happy_var_2 -> 
+	 =  case happyOut135 happy_x_2 of { happy_var_2 -> 
 	happyIn89
 		 (let toField (Common.Arg info (TypeSig _ x t)) = Field x (Common.Arg info t) in map toField happy_var_2
 	)}
 
-happyReduce_318 = happySpecReduce_2  84# happyReduction_318
-happyReduction_318 happy_x_2
+happyReduce_319 = happySpecReduce_2  84# happyReduction_319
+happyReduction_319 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwMutual happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	happyIn90
 		 (Mutual (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_319 = happySpecReduce_2  85# happyReduction_319
-happyReduction_319 happy_x_2
+happyReduce_320 = happySpecReduce_2  85# happyReduction_320
+happyReduction_320 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwAbstract happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	happyIn91
 		 (Abstract (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_320 = happySpecReduce_2  86# happyReduction_320
-happyReduction_320 happy_x_2
+happyReduce_321 = happySpecReduce_2  86# happyReduction_321
+happyReduction_321 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrivate happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	happyIn92
 		 (Private (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_321 = happySpecReduce_2  87# happyReduction_321
-happyReduction_321 happy_x_2
+happyReduce_322 = happySpecReduce_2  87# happyReduction_322
+happyReduction_322 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInstance happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	happyIn93
 		 (InstanceB (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_322 = happySpecReduce_2  88# happyReduction_322
-happyReduction_322 happy_x_2
+happyReduce_323 = happySpecReduce_2  88# happyReduction_323
+happyReduction_323 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPostulate happy_var_1) -> 
-	case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut140 happy_x_2 of { happy_var_2 -> 
 	happyIn94
 		 (Postulate (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_323 = happySpecReduce_2  89# happyReduction_323
-happyReduction_323 happy_x_2
+happyReduce_324 = happySpecReduce_2  89# happyReduction_324
+happyReduction_324 happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwPrimitive happy_var_1) -> 
-	case happyOut132 happy_x_2 of { happy_var_2 -> 
+	case happyOut133 happy_x_2 of { happy_var_2 -> 
 	happyIn95
 		 (Primitive (fuseRange happy_var_1 happy_var_2) happy_var_2
 	)}}
 
-happyReduce_324 = happyReduce 4# 90# happyReduction_324
-happyReduction_324 (happy_x_4 `HappyStk`
+happyReduce_325 = happyReduce 4# 90# happyReduction_325
+happyReduction_325 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4107,8 +4123,8 @@ happyReduction_324 (happy_x_4 `HappyStk`
 		 (UnquoteDecl (fuseRange happy_var_1 happy_var_4) happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}}
 
-happyReduce_325 = happyMonadReduce 5# 91# happyReduction_325
-happyReduction_325 (happy_x_5 `HappyStk`
+happyReduce_326 = happyMonadReduce 5# 91# happyReduction_326
+happyReduction_326 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4120,13 +4136,13 @@ happyReduction_325 (happy_x_5 `HappyStk`
 	(
   case happy_var_2 of
     Name _ [_] -> case mkNotation happy_var_3 (map rangedThing happy_var_5) of
-      Left err -> parseError $ "malformed syntax declaration: " ++ err
+      Left err -> parseError $ "Malformed syntax declaration: " ++ err
       Right n -> return $ Syntax happy_var_2 n
-    _ -> parseError "syntax declarations are allowed only for simple names (without holes)")}}}
+    _ -> parseError "Syntax declarations are allowed only for simple names (without holes)")}}}
 	) (\r -> happyReturn (happyIn97 r))
 
-happyReduce_326 = happyMonadReduce 5# 92# happyReduction_326
-happyReduction_326 (happy_x_5 `HappyStk`
+happyReduce_327 = happyMonadReduce 5# 92# happyReduction_327
+happyReduction_327 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4142,27 +4158,27 @@ happyReduction_326 (happy_x_5 `HappyStk`
   return (PatternSyn (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) happy_var_2 happy_var_3 p))}}}}}
 	) (\r -> happyReturn (happyIn98 r))
 
-happyReduce_327 = happySpecReduce_0  93# happyReduction_327
-happyReduction_327  =  happyIn99
+happyReduce_328 = happySpecReduce_0  93# happyReduction_328
+happyReduction_328  =  happyIn99
 		 ([]
 	)
 
-happyReduce_328 = happyMonadReduce 1# 93# happyReduction_328
-happyReduction_328 (happy_x_1 `HappyStk`
+happyReduce_329 = happyMonadReduce 1# 93# happyReduction_329
+happyReduction_329 (happy_x_1 `HappyStk`
 	happyRest) tk
 	 = happyThen (case happyOut51 happy_x_1 of { happy_var_1 -> 
 	( patternSynArgs happy_var_1)}
 	) (\r -> happyReturn (happyIn99 r))
 
-happyReduce_329 = happySpecReduce_1  94# happyReduction_329
-happyReduction_329 happy_x_1
+happyReduce_330 = happySpecReduce_1  94# happyReduction_330
+happyReduction_330 happy_x_1
 	 =  case happyOut105 happy_x_1 of { happy_var_1 -> 
 	happyIn100
 		 ([happy_var_1]
 	)}
 
-happyReduce_330 = happySpecReduce_2  94# happyReduction_330
-happyReduction_330 happy_x_2
+happyReduce_331 = happySpecReduce_2  94# happyReduction_331
+happyReduction_331 happy_x_2
 	happy_x_1
 	 =  case happyOut100 happy_x_1 of { happy_var_1 -> 
 	case happyOut105 happy_x_2 of { happy_var_2 -> 
@@ -4170,15 +4186,15 @@ happyReduction_330 happy_x_2
 		 (happy_var_1 ++ [happy_var_2]
 	)}}
 
-happyReduce_331 = happySpecReduce_1  95# happyReduction_331
-happyReduction_331 happy_x_1
+happyReduce_332 = happySpecReduce_1  95# happyReduction_332
+happyReduction_332 happy_x_1
 	 =  case happyOut102 happy_x_1 of { happy_var_1 -> 
 	happyIn101
 		 ([happy_var_1]
 	)}
 
-happyReduce_332 = happySpecReduce_2  95# happyReduction_332
-happyReduction_332 happy_x_2
+happyReduce_333 = happySpecReduce_2  95# happyReduction_333
+happyReduction_333 happy_x_2
 	happy_x_1
 	 =  case happyOut101 happy_x_1 of { happy_var_1 -> 
 	case happyOut102 happy_x_2 of { happy_var_2 -> 
@@ -4186,15 +4202,15 @@ happyReduction_332 happy_x_2
 		 (happy_var_1 ++ [happy_var_2]
 	)}}
 
-happyReduce_333 = happySpecReduce_1  96# happyReduction_333
-happyReduction_333 happy_x_1
+happyReduce_334 = happySpecReduce_1  96# happyReduction_334
+happyReduction_334 happy_x_1
 	 =  case happyOut103 happy_x_1 of { happy_var_1 -> 
 	happyIn102
 		 (defaultNamedArg happy_var_1
 	)}
 
-happyReduce_334 = happySpecReduce_3  96# happyReduction_334
-happyReduction_334 happy_x_3
+happyReduce_335 = happySpecReduce_3  96# happyReduction_335
+happyReduction_335 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut104 happy_x_2 of { happy_var_2 -> 
@@ -4202,8 +4218,8 @@ happyReduction_334 happy_x_3
 		 (setHiding Hidden   $ defaultNamedArg happy_var_2
 	)}
 
-happyReduce_335 = happySpecReduce_3  96# happyReduction_335
-happyReduction_335 happy_x_3
+happyReduce_336 = happySpecReduce_3  96# happyReduction_336
+happyReduction_336 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut104 happy_x_2 of { happy_var_2 -> 
@@ -4211,8 +4227,8 @@ happyReduction_335 happy_x_3
 		 (setHiding Instance $ defaultNamedArg happy_var_2
 	)}
 
-happyReduce_336 = happyReduce 5# 96# happyReduction_336
-happyReduction_336 (happy_x_5 `HappyStk`
+happyReduce_337 = happyReduce 5# 96# happyReduction_337
+happyReduction_337 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4224,8 +4240,8 @@ happyReduction_336 (happy_x_5 `HappyStk`
 		 (setHiding Hidden   $ defaultArg $ named happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_337 = happyReduce 5# 96# happyReduction_337
-happyReduction_337 (happy_x_5 `HappyStk`
+happyReduce_338 = happyReduce 5# 96# happyReduction_338
+happyReduction_338 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4237,15 +4253,15 @@ happyReduction_337 (happy_x_5 `HappyStk`
 		 (setHiding Instance $ defaultArg $ named happy_var_2 happy_var_4
 	) `HappyStk` happyRest}}
 
-happyReduce_338 = happySpecReduce_1  97# happyReduction_338
-happyReduction_338 happy_x_1
+happyReduce_339 = happySpecReduce_1  97# happyReduction_339
+happyReduction_339 happy_x_1
 	 =  case happyOut105 happy_x_1 of { happy_var_1 -> 
 	happyIn103
 		 (ExprHole (rangedThing happy_var_1)
 	)}
 
-happyReduce_339 = happyReduce 6# 97# happyReduction_339
-happyReduction_339 (happy_x_6 `HappyStk`
+happyReduce_340 = happyReduce 6# 97# happyReduction_340
+happyReduction_340 (happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
@@ -4258,15 +4274,15 @@ happyReduction_339 (happy_x_6 `HappyStk`
 		 (LambdaHole (rangedThing happy_var_3) (rangedThing happy_var_5)
 	) `HappyStk` happyRest}}
 
-happyReduce_340 = happySpecReduce_1  98# happyReduction_340
-happyReduction_340 happy_x_1
+happyReduce_341 = happySpecReduce_1  98# happyReduction_341
+happyReduction_341 happy_x_1
 	 =  case happyOut105 happy_x_1 of { happy_var_1 -> 
 	happyIn104
 		 (ExprHole (rangedThing happy_var_1)
 	)}
 
-happyReduce_341 = happyReduce 4# 98# happyReduction_341
-happyReduction_341 (happy_x_4 `HappyStk`
+happyReduce_342 = happyReduce 4# 98# happyReduction_342
+happyReduction_342 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4277,27 +4293,27 @@ happyReduction_341 (happy_x_4 `HappyStk`
 		 (LambdaHole (rangedThing happy_var_2) (rangedThing happy_var_4)
 	) `HappyStk` happyRest}}
 
-happyReduce_342 = happySpecReduce_1  99# happyReduction_342
-happyReduction_342 happy_x_1
+happyReduce_343 = happySpecReduce_1  99# happyReduction_343
+happyReduction_343 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokId happy_var_1) -> 
 	happyIn105
 		 (Ranged (getRange $ fst happy_var_1) (stringToRawName $ snd happy_var_1)
 	)}
 
-happyReduce_343 = happySpecReduce_1  100# happyReduction_343
-happyReduction_343 happy_x_1
+happyReduce_344 = happySpecReduce_1  100# happyReduction_344
+happyReduction_344 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwOpen happy_var_1) -> 
 	happyIn106
 		 (Just (getRange happy_var_1)
 	)}
 
-happyReduce_344 = happySpecReduce_0  100# happyReduction_344
-happyReduction_344  =  happyIn106
+happyReduce_345 = happySpecReduce_0  100# happyReduction_345
+happyReduction_345  =  happyIn106
 		 (Nothing
 	)
 
-happyReduce_345 = happyMonadReduce 5# 101# happyReduction_345
-happyReduction_345 (happy_x_5 `HappyStk`
+happyReduce_346 = happyMonadReduce 5# 101# happyReduction_346
+happyReduction_346 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4355,8 +4371,8 @@ happyReduction_345 (happy_x_5 `HappyStk`
       })}}}}}
 	) (\r -> happyReturn (happyIn107 r))
 
-happyReduce_346 = happyReduce 4# 101# happyReduction_346
-happyReduction_346 (happy_x_4 `HappyStk`
+happyReduce_347 = happyReduce 4# 101# happyReduction_347
+happyReduction_347 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4374,15 +4390,15 @@ happyReduction_346 (happy_x_4 `HappyStk`
     [ case es of
       { []  -> Open r m dir
       ; _   -> Private r [ ModuleMacro r (noName $ beginningOf $ getRange m)
-			     (SectionApp (getRange (m , es)) [] (RawApp (fuseRange m es) (Ident m : es)))
-			     DoOpen dir
+                             (SectionApp (getRange (m , es)) [] (RawApp (fuseRange m es) (Ident m : es)))
+                             DoOpen dir
                          ]
       }
     ]
 	) `HappyStk` happyRest}}}
 
-happyReduce_347 = happyReduce 6# 101# happyReduction_347
-happyReduction_347 (happy_x_6 `HappyStk`
+happyReduce_348 = happyReduce 6# 101# happyReduction_348
+happyReduction_348 (happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
@@ -4394,18 +4410,18 @@ happyReduction_347 (happy_x_6 `HappyStk`
 	happyIn107
 		 (let r = getRange happy_var_2 in
     [ Private r [ ModuleMacro r (noName $ beginningOf $ getRange happy_var_2)
-    	      	(RecordModuleIFS r happy_var_2) DoOpen happy_var_6
+                (RecordModuleIFS r happy_var_2) DoOpen happy_var_6
                 ]
     ]
 	) `HappyStk` happyRest}}
 
-happyReduce_348 = happySpecReduce_0  102# happyReduction_348
-happyReduction_348  =  happyIn108
+happyReduce_349 = happySpecReduce_0  102# happyReduction_349
+happyReduction_349  =  happyIn108
 		 ([]
 	)
 
-happyReduce_349 = happySpecReduce_2  102# happyReduction_349
-happyReduction_349 happy_x_2
+happyReduce_350 = happySpecReduce_2  102# happyReduction_350
+happyReduction_350 happy_x_2
 	happy_x_1
 	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
 	case happyOut108 happy_x_2 of { happy_var_2 -> 
@@ -4413,8 +4429,8 @@ happyReduction_349 happy_x_2
 		 (happy_var_1 : happy_var_2
 	)}}
 
-happyReduce_350 = happyReduce 4# 103# happyReduction_350
-happyReduction_350 (happy_x_4 `HappyStk`
+happyReduce_351 = happyReduce 4# 103# happyReduction_351
+happyReduction_351 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4425,12 +4441,12 @@ happyReduction_350 (happy_x_4 `HappyStk`
 	case happyOut17 happy_x_4 of { happy_var_4 -> 
 	happyIn109
 		 ((\ts ->
-		    if null ts then return $ RecordModuleIFS (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_1
-		    else parseError "No bindings allowed for record module with non-canonical implicits" )
+                    if null ts then return $ RecordModuleIFS (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_1
+                    else parseError "No bindings allowed for record module with non-canonical implicits" )
 	) `HappyStk` happyRest}}}}
 
-happyReduce_351 = happySpecReduce_2  103# happyReduction_351
-happyReduction_351 happy_x_2
+happyReduce_352 = happySpecReduce_2  103# happyReduction_352
+happyReduction_352 happy_x_2
 	happy_x_1
 	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
 	case happyOut108 happy_x_2 of { happy_var_2 -> 
@@ -4438,8 +4454,8 @@ happyReduction_351 happy_x_2
 		 ((\ts -> return $ SectionApp (getRange (happy_var_1, happy_var_2)) ts (RawApp (fuseRange happy_var_1 happy_var_2) (Ident happy_var_1 : happy_var_2)) )
 	)}}
 
-happyReduce_352 = happyMonadReduce 6# 104# happyReduction_352
-happyReduction_352 (happy_x_6 `HappyStk`
+happyReduce_353 = happyMonadReduce 6# 104# happyReduction_353
+happyReduction_353 (happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
@@ -4456,8 +4472,8 @@ happyReduction_352 (happy_x_6 `HappyStk`
                           ; return $ ModuleMacro (getRange (happy_var_1, happy_var_2, ma, happy_var_6)) name ma DontOpen happy_var_6 })}}}}}
 	) (\r -> happyReturn (happyIn110 r))
 
-happyReduce_353 = happyMonadReduce 7# 104# happyReduction_353
-happyReduction_353 (happy_x_7 `HappyStk`
+happyReduce_354 = happyMonadReduce 7# 104# happyReduction_354
+happyReduction_354 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -4474,8 +4490,8 @@ happyReduction_353 (happy_x_7 `HappyStk`
 	( do {ma <- happy_var_6 (map addType happy_var_4); return $ ModuleMacro (getRange (happy_var_1, happy_var_2, happy_var_3, ma, happy_var_7)) happy_var_3 ma DoOpen happy_var_7 })}}}}}}
 	) (\r -> happyReturn (happyIn110 r))
 
-happyReduce_354 = happyReduce 5# 105# happyReduction_354
-happyReduction_354 (happy_x_5 `HappyStk`
+happyReduce_355 = happyReduce 5# 105# happyReduction_355
+happyReduction_355 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4485,13 +4501,13 @@ happyReduction_354 (happy_x_5 `HappyStk`
 	case happyOut22 happy_x_2 of { happy_var_2 -> 
 	case happyOut59 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> 
-	case happyOut140 happy_x_5 of { happy_var_5 -> 
+	case happyOut141 happy_x_5 of { happy_var_5 -> 
 	happyIn111
 		 (Module (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) happy_var_2 (map addType happy_var_3) happy_var_5
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_355 = happyReduce 5# 105# happyReduction_355
-happyReduction_355 (happy_x_5 `HappyStk`
+happyReduce_356 = happyReduce 5# 105# happyReduction_356
+happyReduction_356 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4501,98 +4517,91 @@ happyReduction_355 (happy_x_5 `HappyStk`
 	case happyOut112 happy_x_2 of { happy_var_2 -> 
 	case happyOut59 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokKeyword KwWhere happy_var_4) -> 
-	case happyOut140 happy_x_5 of { happy_var_5 -> 
+	case happyOut141 happy_x_5 of { happy_var_5 -> 
 	happyIn111
 		 (Module (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) (QName happy_var_2) (map addType happy_var_3) happy_var_5
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_356 = happySpecReduce_1  106# happyReduction_356
-happyReduction_356 happy_x_1
+happyReduce_357 = happySpecReduce_1  106# happyReduction_357
+happyReduction_357 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymUnderscore happy_var_1) -> 
 	happyIn112
 		 (noName (getRange happy_var_1)
 	)}
 
-happyReduce_357 = happySpecReduce_1  107# happyReduction_357
-happyReduction_357 happy_x_1
-	 =  case happyOut142 happy_x_1 of { happy_var_1 -> 
+happyReduce_358 = happySpecReduce_1  107# happyReduction_358
+happyReduction_358 happy_x_1
+	 =  case happyOut143 happy_x_1 of { happy_var_1 -> 
 	happyIn113
 		 (figureOutTopLevelModule happy_var_1
 	)}
 
-happyReduce_358 = happySpecReduce_1  108# happyReduction_358
-happyReduction_358 happy_x_1
+happyReduce_359 = happySpecReduce_1  108# happyReduction_359
+happyReduction_359 happy_x_1
 	 =  case happyOut115 happy_x_1 of { happy_var_1 -> 
 	happyIn114
 		 (Pragma happy_var_1
 	)}
 
-happyReduce_359 = happySpecReduce_1  109# happyReduction_359
-happyReduction_359 happy_x_1
-	 =  case happyOut117 happy_x_1 of { happy_var_1 -> 
-	happyIn115
-		 (happy_var_1
-	)}
-
 happyReduce_360 = happySpecReduce_1  109# happyReduction_360
 happyReduction_360 happy_x_1
-	 =  case happyOut118 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut117 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_361 = happySpecReduce_1  109# happyReduction_361
 happyReduction_361 happy_x_1
-	 =  case happyOut119 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut118 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_362 = happySpecReduce_1  109# happyReduction_362
 happyReduction_362 happy_x_1
-	 =  case happyOut120 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut119 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_363 = happySpecReduce_1  109# happyReduction_363
 happyReduction_363 happy_x_1
-	 =  case happyOut122 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut120 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_364 = happySpecReduce_1  109# happyReduction_364
 happyReduction_364 happy_x_1
-	 =  case happyOut121 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut122 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_365 = happySpecReduce_1  109# happyReduction_365
 happyReduction_365 happy_x_1
-	 =  case happyOut123 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut121 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_366 = happySpecReduce_1  109# happyReduction_366
 happyReduction_366 happy_x_1
-	 =  case happyOut124 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut123 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_367 = happySpecReduce_1  109# happyReduction_367
 happyReduction_367 happy_x_1
-	 =  case happyOut125 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut124 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_368 = happySpecReduce_1  109# happyReduction_368
 happyReduction_368 happy_x_1
-	 =  case happyOut130 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut125 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
@@ -4606,41 +4615,55 @@ happyReduction_369 happy_x_1
 
 happyReduce_370 = happySpecReduce_1  109# happyReduction_370
 happyReduction_370 happy_x_1
-	 =  case happyOut126 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut132 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_371 = happySpecReduce_1  109# happyReduction_371
 happyReduction_371 happy_x_1
-	 =  case happyOut128 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut126 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_372 = happySpecReduce_1  109# happyReduction_372
 happyReduction_372 happy_x_1
-	 =  case happyOut127 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut129 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_373 = happySpecReduce_1  109# happyReduction_373
 happyReduction_373 happy_x_1
-	 =  case happyOut129 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut128 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
 happyReduce_374 = happySpecReduce_1  109# happyReduction_374
 happyReduction_374 happy_x_1
+	 =  case happyOut127 happy_x_1 of { happy_var_1 -> 
+	happyIn115
+		 (happy_var_1
+	)}
+
+happyReduce_375 = happySpecReduce_1  109# happyReduction_375
+happyReduction_375 happy_x_1
+	 =  case happyOut130 happy_x_1 of { happy_var_1 -> 
+	happyIn115
+		 (happy_var_1
+	)}
+
+happyReduce_376 = happySpecReduce_1  109# happyReduction_376
+happyReduction_376 happy_x_1
 	 =  case happyOut116 happy_x_1 of { happy_var_1 -> 
 	happyIn115
 		 (happy_var_1
 	)}
 
-happyReduce_375 = happyReduce 4# 110# happyReduction_375
-happyReduction_375 (happy_x_4 `HappyStk`
+happyReduce_377 = happyReduce 4# 110# happyReduction_377
+happyReduction_377 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4653,8 +4676,8 @@ happyReduction_375 (happy_x_4 `HappyStk`
 		 (OptionsPragma (getRange (happy_var_1,happy_var_2,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}}
 
-happyReduce_376 = happyReduce 5# 111# happyReduction_376
-happyReduction_376 (happy_x_5 `HappyStk`
+happyReduce_378 = happyReduce 5# 111# happyReduction_378
+happyReduction_378 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4669,8 +4692,8 @@ happyReduction_376 (happy_x_5 `HappyStk`
 		 (BuiltinPragma (getRange (happy_var_1,happy_var_2,fst happy_var_3,happy_var_4,happy_var_5)) (snd happy_var_3) (Ident happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_377 = happyReduce 5# 111# happyReduction_377
-happyReduction_377 (happy_x_5 `HappyStk`
+happyReduce_379 = happyReduce 5# 111# happyReduction_379
+happyReduction_379 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4685,8 +4708,8 @@ happyReduction_377 (happy_x_5 `HappyStk`
 		 (BuiltinPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4,happy_var_5)) "REWRITE" (Ident happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_378 = happyReduce 4# 112# happyReduction_378
-happyReduction_378 (happy_x_4 `HappyStk`
+happyReduce_380 = happyReduce 4# 112# happyReduction_380
+happyReduction_380 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4699,8 +4722,8 @@ happyReduction_378 (happy_x_4 `HappyStk`
 		 (RewritePragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}}
 
-happyReduce_379 = happyReduce 5# 113# happyReduction_379
-happyReduction_379 (happy_x_5 `HappyStk`
+happyReduce_381 = happyReduce 5# 113# happyReduction_381
+happyReduction_381 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4715,8 +4738,8 @@ happyReduction_379 (happy_x_5 `HappyStk`
 		 (CompiledPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_380 = happyReduce 5# 114# happyReduction_380
-happyReduction_380 (happy_x_5 `HappyStk`
+happyReduce_382 = happyReduce 5# 114# happyReduction_382
+happyReduction_382 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4731,8 +4754,8 @@ happyReduction_380 (happy_x_5 `HappyStk`
 		 (CompiledExportPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 happy_var_4
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_381 = happyReduce 5# 115# happyReduction_381
-happyReduction_381 (happy_x_5 `HappyStk`
+happyReduce_383 = happyReduce 5# 115# happyReduction_383
+happyReduction_383 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4747,8 +4770,8 @@ happyReduction_381 (happy_x_5 `HappyStk`
 		 (CompiledTypePragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_382 = happyReduce 6# 116# happyReduction_382
-happyReduction_382 (happy_x_6 `HappyStk`
+happyReduce_384 = happyReduce 6# 116# happyReduction_384
+happyReduction_384 (happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
@@ -4765,8 +4788,8 @@ happyReduction_382 (happy_x_6 `HappyStk`
 		 (CompiledDataPragma (getRange (happy_var_1,happy_var_2,happy_var_3,fst happy_var_4,happy_var_6)) happy_var_3 (snd happy_var_4) happy_var_5
 	) `HappyStk` happyRest}}}}}}
 
-happyReduce_383 = happyReduce 5# 117# happyReduction_383
-happyReduction_383 (happy_x_5 `HappyStk`
+happyReduce_385 = happyReduce 5# 117# happyReduction_385
+happyReduction_385 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4781,8 +4804,8 @@ happyReduction_383 (happy_x_5 `HappyStk`
 		 (CompiledEpicPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_384 = happyReduce 5# 118# happyReduction_384
-happyReduction_384 (happy_x_5 `HappyStk`
+happyReduce_386 = happyReduce 5# 118# happyReduction_386
+happyReduction_386 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
@@ -4797,8 +4820,8 @@ happyReduction_384 (happy_x_5 `HappyStk`
 		 (CompiledJSPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_5)) happy_var_3 (unwords happy_var_4)
 	) `HappyStk` happyRest}}}}}
 
-happyReduce_385 = happyReduce 4# 119# happyReduction_385
-happyReduction_385 (happy_x_4 `HappyStk`
+happyReduce_387 = happyReduce 4# 119# happyReduction_387
+happyReduction_387 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4811,8 +4834,8 @@ happyReduction_385 (happy_x_4 `HappyStk`
 		 (StaticPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}}
 
-happyReduce_386 = happyReduce 4# 120# happyReduction_386
-happyReduction_386 (happy_x_4 `HappyStk`
+happyReduce_388 = happyReduce 4# 120# happyReduction_388
+happyReduction_388 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4825,8 +4848,8 @@ happyReduction_386 (happy_x_4 `HappyStk`
 		 (EtaPragma (getRange (happy_var_1,happy_var_2,happy_var_3,happy_var_4)) happy_var_3
 	) `HappyStk` happyRest}}}}
 
-happyReduce_387 = happySpecReduce_3  121# happyReduction_387
-happyReduction_387 happy_x_3
+happyReduce_389 = happySpecReduce_3  121# happyReduction_389
+happyReduction_389 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
@@ -4836,8 +4859,8 @@ happyReduction_387 happy_x_3
 		 (TerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3)) NoTerminationCheck
 	)}}}
 
-happyReduce_388 = happySpecReduce_3  122# happyReduction_388
-happyReduction_388 happy_x_3
+happyReduce_390 = happySpecReduce_3  122# happyReduction_390
+happyReduction_390 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
@@ -4847,8 +4870,19 @@ happyReduction_388 happy_x_3
 		 (TerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3)) NonTerminating
 	)}}}
 
-happyReduce_389 = happyReduce 4# 123# happyReduction_389
-happyReduction_389 (happy_x_4 `HappyStk`
+happyReduce_391 = happySpecReduce_3  123# happyReduction_391
+happyReduction_391 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
+	case happyOutTok happy_x_2 of { (TokKeyword KwTERMINATING happy_var_2) -> 
+	case happyOutTok happy_x_3 of { (TokSymbol SymClosePragma happy_var_3) -> 
+	happyIn129
+		 (TerminationCheckPragma (getRange (happy_var_1,happy_var_2,happy_var_3)) Terminating
+	)}}}
+
+happyReduce_392 = happyReduce 4# 124# happyReduction_392
+happyReduction_392 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4857,13 +4891,13 @@ happyReduction_389 (happy_x_4 `HappyStk`
 	case happyOutTok happy_x_2 of { (TokKeyword KwMEASURE happy_var_2) -> 
 	case happyOut29 happy_x_3 of { happy_var_3 -> 
 	case happyOutTok happy_x_4 of { (TokSymbol SymClosePragma happy_var_4) -> 
-	happyIn129
+	happyIn130
 		 (let r = getRange (happy_var_1, happy_var_2, happy_var_3, happy_var_4) in
       TerminationCheckPragma r (TerminationMeasure r happy_var_3)
 	) `HappyStk` happyRest}}}}
 
-happyReduce_390 = happyMonadReduce 4# 124# happyReduction_390
-happyReduction_390 (happy_x_4 `HappyStk`
+happyReduce_393 = happyMonadReduce 4# 125# happyReduction_393
+happyReduction_393 (happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
@@ -4876,147 +4910,147 @@ happyReduction_390 (happy_x_4 `HappyStk`
        if validHaskellModuleName s
        then return $ ImportPragma (getRange (happy_var_1,happy_var_2,fst happy_var_3,happy_var_4)) s
        else parseError $ "Malformed module name: " ++ s ++ ".")}}}}
-	) (\r -> happyReturn (happyIn130 r))
+	) (\r -> happyReturn (happyIn131 r))
 
-happyReduce_391 = happySpecReduce_3  125# happyReduction_391
-happyReduction_391 happy_x_3
+happyReduce_394 = happySpecReduce_3  126# happyReduction_394
+happyReduction_394 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokSymbol SymOpenPragma happy_var_1) -> 
 	case happyOutTok happy_x_2 of { (TokKeyword KwIMPOSSIBLE happy_var_2) -> 
 	case happyOutTok happy_x_3 of { (TokSymbol SymClosePragma happy_var_3) -> 
-	happyIn131
+	happyIn132
 		 (ImpossiblePragma (getRange (happy_var_1,happy_var_2,happy_var_3))
 	)}}}
 
-happyReduce_392 = happySpecReduce_3  126# happyReduction_392
-happyReduction_392 happy_x_3
+happyReduce_395 = happySpecReduce_3  127# happyReduction_395
+happyReduction_395 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut133 happy_x_2 of { happy_var_2 -> 
-	happyIn132
+	 =  case happyOut134 happy_x_2 of { happy_var_2 -> 
+	happyIn133
 		 (reverse happy_var_2
 	)}
 
-happyReduce_393 = happySpecReduce_3  127# happyReduction_393
-happyReduction_393 happy_x_3
+happyReduce_396 = happySpecReduce_3  128# happyReduction_396
+happyReduction_396 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut133 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut134 happy_x_1 of { happy_var_1 -> 
 	case happyOut79 happy_x_3 of { happy_var_3 -> 
-	happyIn133
+	happyIn134
 		 (reverse happy_var_3 ++ happy_var_1
 	)}}
 
-happyReduce_394 = happySpecReduce_1  127# happyReduction_394
-happyReduction_394 happy_x_1
+happyReduce_397 = happySpecReduce_1  128# happyReduction_397
+happyReduction_397 happy_x_1
 	 =  case happyOut79 happy_x_1 of { happy_var_1 -> 
-	happyIn133
+	happyIn134
 		 (reverse happy_var_1
 	)}
 
-happyReduce_395 = happySpecReduce_3  128# happyReduction_395
-happyReduction_395 happy_x_3
+happyReduce_398 = happySpecReduce_3  129# happyReduction_398
+happyReduction_398 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut135 happy_x_2 of { happy_var_2 -> 
-	happyIn134
+	 =  case happyOut136 happy_x_2 of { happy_var_2 -> 
+	happyIn135
 		 (reverse happy_var_2
 	)}
 
-happyReduce_396 = happySpecReduce_3  129# happyReduction_396
-happyReduction_396 happy_x_3
+happyReduce_399 = happySpecReduce_3  130# happyReduction_399
+happyReduction_399 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut135 happy_x_1 of { happy_var_1 -> 
+	 =  case happyOut136 happy_x_1 of { happy_var_1 -> 
 	case happyOut80 happy_x_3 of { happy_var_3 -> 
-	happyIn135
+	happyIn136
 		 (reverse happy_var_3 ++ happy_var_1
 	)}}
 
-happyReduce_397 = happySpecReduce_1  129# happyReduction_397
-happyReduction_397 happy_x_1
+happyReduce_400 = happySpecReduce_1  130# happyReduction_400
+happyReduction_400 happy_x_1
 	 =  case happyOut80 happy_x_1 of { happy_var_1 -> 
-	happyIn135
+	happyIn136
 		 (reverse happy_var_1
 	)}
 
-happyReduce_398 = happySpecReduce_2  130# happyReduction_398
-happyReduction_398 happy_x_2
+happyReduce_401 = happySpecReduce_2  131# happyReduction_401
+happyReduction_401 happy_x_2
 	happy_x_1
-	 =  happyIn136
+	 =  happyIn137
 		 ([]
 	)
 
-happyReduce_399 = happySpecReduce_1  130# happyReduction_399
-happyReduction_399 happy_x_1
-	 =  case happyOut132 happy_x_1 of { happy_var_1 -> 
-	happyIn136
+happyReduce_402 = happySpecReduce_1  131# happyReduction_402
+happyReduction_402 happy_x_1
+	 =  case happyOut133 happy_x_1 of { happy_var_1 -> 
+	happyIn137
 		 (happy_var_1
 	)}
 
-happyReduce_400 = happySpecReduce_2  131# happyReduction_400
-happyReduction_400 happy_x_2
+happyReduce_403 = happySpecReduce_2  132# happyReduction_403
+happyReduction_403 happy_x_2
 	happy_x_1
-	 =  happyIn137
+	 =  happyIn138
 		 ((Nothing, Nothing, [])
 	)
 
-happyReduce_401 = happySpecReduce_3  131# happyReduction_401
-happyReduction_401 happy_x_3
+happyReduce_404 = happySpecReduce_3  132# happyReduction_404
+happyReduction_404 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut87 happy_x_2 of { happy_var_2 -> 
-	happyIn137
+	happyIn138
 		 ((Nothing, Just happy_var_2, [])
 	)}
 
-happyReduce_402 = happyReduce 5# 131# happyReduction_402
-happyReduction_402 (happy_x_5 `HappyStk`
+happyReduce_405 = happyReduce 5# 132# happyReduction_405
+happyReduction_405 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
 	 = case happyOut87 happy_x_2 of { happy_var_2 -> 
-	case happyOut141 happy_x_4 of { happy_var_4 -> 
-	happyIn137
+	case happyOut142 happy_x_4 of { happy_var_4 -> 
+	happyIn138
 		 ((Nothing, Just happy_var_2, happy_var_4)
 	) `HappyStk` happyRest}}
 
-happyReduce_403 = happySpecReduce_3  131# happyReduction_403
-happyReduction_403 happy_x_3
+happyReduce_406 = happySpecReduce_3  132# happyReduction_406
+happyReduction_406 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut141 happy_x_2 of { happy_var_2 -> 
-	happyIn137
+	 =  case happyOut142 happy_x_2 of { happy_var_2 -> 
+	happyIn138
 		 ((Nothing, Nothing, happy_var_2)
 	)}
 
-happyReduce_404 = happySpecReduce_3  131# happyReduction_404
-happyReduction_404 happy_x_3
+happyReduce_407 = happySpecReduce_3  132# happyReduction_407
+happyReduction_407 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut138 happy_x_2 of { happy_var_2 -> 
-	happyIn137
+	 =  case happyOut139 happy_x_2 of { happy_var_2 -> 
+	happyIn138
 		 ((Just happy_var_2, Nothing, [])
 	)}
 
-happyReduce_405 = happyReduce 5# 131# happyReduction_405
-happyReduction_405 (happy_x_5 `HappyStk`
+happyReduce_408 = happyReduce 5# 132# happyReduction_408
+happyReduction_408 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
-	 = case happyOut138 happy_x_2 of { happy_var_2 -> 
+	 = case happyOut139 happy_x_2 of { happy_var_2 -> 
 	case happyOut87 happy_x_4 of { happy_var_4 -> 
-	happyIn137
+	happyIn138
 		 ((Just happy_var_2, Just happy_var_4, [])
 	) `HappyStk` happyRest}}
 
-happyReduce_406 = happyReduce 7# 131# happyReduction_406
-happyReduction_406 (happy_x_7 `HappyStk`
+happyReduce_409 = happyReduce 7# 132# happyReduction_409
+happyReduction_409 (happy_x_7 `HappyStk`
 	happy_x_6 `HappyStk`
 	happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
@@ -5024,89 +5058,89 @@ happyReduction_406 (happy_x_7 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
-	 = case happyOut138 happy_x_2 of { happy_var_2 -> 
+	 = case happyOut139 happy_x_2 of { happy_var_2 -> 
 	case happyOut87 happy_x_4 of { happy_var_4 -> 
-	case happyOut141 happy_x_6 of { happy_var_6 -> 
-	happyIn137
+	case happyOut142 happy_x_6 of { happy_var_6 -> 
+	happyIn138
 		 ((Just happy_var_2, Just happy_var_4, happy_var_6)
 	) `HappyStk` happyRest}}}
 
-happyReduce_407 = happyReduce 5# 131# happyReduction_407
-happyReduction_407 (happy_x_5 `HappyStk`
+happyReduce_410 = happyReduce 5# 132# happyReduction_410
+happyReduction_410 (happy_x_5 `HappyStk`
 	happy_x_4 `HappyStk`
 	happy_x_3 `HappyStk`
 	happy_x_2 `HappyStk`
 	happy_x_1 `HappyStk`
 	happyRest)
-	 = case happyOut138 happy_x_2 of { happy_var_2 -> 
-	case happyOut141 happy_x_4 of { happy_var_4 -> 
-	happyIn137
+	 = case happyOut139 happy_x_2 of { happy_var_2 -> 
+	case happyOut142 happy_x_4 of { happy_var_4 -> 
+	happyIn138
 		 ((Just happy_var_2, Nothing, happy_var_4)
 	) `HappyStk` happyRest}}
 
-happyReduce_408 = happySpecReduce_1  132# happyReduction_408
-happyReduction_408 happy_x_1
+happyReduce_411 = happySpecReduce_1  133# happyReduction_411
+happyReduction_411 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwInductive happy_var_1) -> 
-	happyIn138
+	happyIn139
 		 (Ranged (getRange happy_var_1) Inductive
 	)}
 
-happyReduce_409 = happySpecReduce_1  132# happyReduction_409
-happyReduction_409 happy_x_1
+happyReduce_412 = happySpecReduce_1  133# happyReduction_412
+happyReduction_412 happy_x_1
 	 =  case happyOutTok happy_x_1 of { (TokKeyword KwCoInductive happy_var_1) -> 
-	happyIn138
+	happyIn139
 		 (Ranged (getRange happy_var_1) CoInductive
 	)}
 
-happyReduce_410 = happySpecReduce_3  133# happyReduction_410
-happyReduction_410 happy_x_3
+happyReduce_413 = happySpecReduce_3  134# happyReduction_413
+happyReduction_413 happy_x_3
 	happy_x_2
 	happy_x_1
-	 =  case happyOut141 happy_x_2 of { happy_var_2 -> 
-	happyIn139
+	 =  case happyOut142 happy_x_2 of { happy_var_2 -> 
+	happyIn140
 		 (happy_var_2
 	)}
 
-happyReduce_411 = happySpecReduce_2  134# happyReduction_411
-happyReduction_411 happy_x_2
+happyReduce_414 = happySpecReduce_2  135# happyReduction_414
+happyReduction_414 happy_x_2
 	happy_x_1
-	 =  happyIn140
+	 =  happyIn141
 		 ([]
 	)
 
-happyReduce_412 = happySpecReduce_1  134# happyReduction_412
-happyReduction_412 happy_x_1
-	 =  case happyOut139 happy_x_1 of { happy_var_1 -> 
-	happyIn140
+happyReduce_415 = happySpecReduce_1  135# happyReduction_415
+happyReduction_415 happy_x_1
+	 =  case happyOut140 happy_x_1 of { happy_var_1 -> 
+	happyIn141
 		 (happy_var_1
 	)}
 
-happyReduce_413 = happySpecReduce_3  135# happyReduction_413
-happyReduction_413 happy_x_3
+happyReduce_416 = happySpecReduce_3  136# happyReduction_416
+happyReduction_416 happy_x_3
 	happy_x_2
 	happy_x_1
 	 =  case happyOut78 happy_x_1 of { happy_var_1 -> 
-	case happyOut141 happy_x_3 of { happy_var_3 -> 
-	happyIn141
+	case happyOut142 happy_x_3 of { happy_var_3 -> 
+	happyIn142
 		 (happy_var_1 ++ happy_var_3
 	)}}
 
-happyReduce_414 = happySpecReduce_1  135# happyReduction_414
-happyReduction_414 happy_x_1
+happyReduce_417 = happySpecReduce_1  136# happyReduction_417
+happyReduction_417 happy_x_1
 	 =  case happyOut78 happy_x_1 of { happy_var_1 -> 
-	happyIn141
+	happyIn142
 		 (happy_var_1
 	)}
 
-happyReduce_415 = happySpecReduce_0  136# happyReduction_415
-happyReduction_415  =  happyIn142
+happyReduce_418 = happySpecReduce_0  137# happyReduction_418
+happyReduction_418  =  happyIn143
 		 ([]
 	)
 
-happyReduce_416 = happySpecReduce_1  136# happyReduction_416
-happyReduction_416 happy_x_1
-	 =  case happyOut141 happy_x_1 of { happy_var_1 -> 
-	happyIn142
+happyReduce_419 = happySpecReduce_1  137# happyReduction_419
+happyReduction_419 happy_x_1
+	 =  case happyOut142 happy_x_1 of { happy_var_1 -> 
+	happyIn143
 		 (happy_var_1
 	)}
 
@@ -5114,7 +5148,7 @@ happyNewToken action sts stk
 	= lexer(\tk -> 
 	let cont i = happyDoAction i tk action sts stk in
 	case tk of {
-	TokEOF -> happyDoAction 88# tk action sts stk;
+	TokEOF -> happyDoAction 89# tk action sts stk;
 	TokKeyword KwLet happy_dollar_dollar -> cont 1#;
 	TokKeyword KwIn happy_dollar_dollar -> cont 2#;
 	TokKeyword KwWhere happy_dollar_dollar -> cont 3#;
@@ -5157,55 +5191,56 @@ happyNewToken action sts stk
 	TokKeyword KwETA happy_dollar_dollar -> cont 40#;
 	TokKeyword KwNO_TERMINATION_CHECK happy_dollar_dollar -> cont 41#;
 	TokKeyword KwNON_TERMINATING happy_dollar_dollar -> cont 42#;
-	TokKeyword KwMEASURE happy_dollar_dollar -> cont 43#;
-	TokKeyword KwCOMPILED happy_dollar_dollar -> cont 44#;
-	TokKeyword KwCOMPILED_EXPORT happy_dollar_dollar -> cont 45#;
-	TokKeyword KwCOMPILED_DATA happy_dollar_dollar -> cont 46#;
-	TokKeyword KwCOMPILED_TYPE happy_dollar_dollar -> cont 47#;
-	TokKeyword KwCOMPILED_EPIC happy_dollar_dollar -> cont 48#;
-	TokKeyword KwCOMPILED_JS happy_dollar_dollar -> cont 49#;
-	TokKeyword KwSTATIC happy_dollar_dollar -> cont 50#;
-	TokKeyword KwQuoteGoal happy_dollar_dollar -> cont 51#;
-	TokKeyword KwQuoteContext happy_dollar_dollar -> cont 52#;
-	TokKeyword KwQuote happy_dollar_dollar -> cont 53#;
-	TokKeyword KwQuoteTerm happy_dollar_dollar -> cont 54#;
-	TokKeyword KwTactic happy_dollar_dollar -> cont 55#;
-	TokKeyword KwUnquote happy_dollar_dollar -> cont 56#;
-	TokKeyword KwUnquoteDecl happy_dollar_dollar -> cont 57#;
-	TokSetN happy_dollar_dollar -> cont 58#;
-	TokTeX happy_dollar_dollar -> cont 59#;
-	TokComment happy_dollar_dollar -> cont 60#;
-	TokSymbol SymEllipsis happy_dollar_dollar -> cont 61#;
-	TokSymbol SymDotDot happy_dollar_dollar -> cont 62#;
-	TokSymbol SymDot happy_dollar_dollar -> cont 63#;
-	TokSymbol SymSemi happy_dollar_dollar -> cont 64#;
-	TokSymbol SymColon happy_dollar_dollar -> cont 65#;
-	TokSymbol SymEqual happy_dollar_dollar -> cont 66#;
-	TokSymbol SymUnderscore happy_dollar_dollar -> cont 67#;
-	TokSymbol SymQuestionMark happy_dollar_dollar -> cont 68#;
-	TokSymbol SymArrow happy_dollar_dollar -> cont 69#;
-	TokSymbol SymLambda happy_dollar_dollar -> cont 70#;
-	TokSymbol SymAs happy_dollar_dollar -> cont 71#;
-	TokSymbol SymBar happy_dollar_dollar -> cont 72#;
-	TokSymbol SymOpenParen happy_dollar_dollar -> cont 73#;
-	TokSymbol SymCloseParen happy_dollar_dollar -> cont 74#;
-	TokSymbol SymDoubleOpenBrace happy_dollar_dollar -> cont 75#;
-	TokSymbol SymDoubleCloseBrace happy_dollar_dollar -> cont 76#;
-	TokSymbol SymOpenBrace happy_dollar_dollar -> cont 77#;
-	TokSymbol SymCloseBrace happy_dollar_dollar -> cont 78#;
-	TokSymbol SymOpenVirtualBrace happy_dollar_dollar -> cont 79#;
-	TokSymbol SymCloseVirtualBrace happy_dollar_dollar -> cont 80#;
-	TokSymbol SymVirtualSemi happy_dollar_dollar -> cont 81#;
-	TokSymbol SymOpenPragma happy_dollar_dollar -> cont 82#;
-	TokSymbol SymClosePragma happy_dollar_dollar -> cont 83#;
-	TokId happy_dollar_dollar -> cont 84#;
-	TokQId happy_dollar_dollar -> cont 85#;
-	TokString happy_dollar_dollar -> cont 86#;
-	TokLiteral happy_dollar_dollar -> cont 87#;
+	TokKeyword KwTERMINATING happy_dollar_dollar -> cont 43#;
+	TokKeyword KwMEASURE happy_dollar_dollar -> cont 44#;
+	TokKeyword KwCOMPILED happy_dollar_dollar -> cont 45#;
+	TokKeyword KwCOMPILED_EXPORT happy_dollar_dollar -> cont 46#;
+	TokKeyword KwCOMPILED_DATA happy_dollar_dollar -> cont 47#;
+	TokKeyword KwCOMPILED_TYPE happy_dollar_dollar -> cont 48#;
+	TokKeyword KwCOMPILED_EPIC happy_dollar_dollar -> cont 49#;
+	TokKeyword KwCOMPILED_JS happy_dollar_dollar -> cont 50#;
+	TokKeyword KwSTATIC happy_dollar_dollar -> cont 51#;
+	TokKeyword KwQuoteGoal happy_dollar_dollar -> cont 52#;
+	TokKeyword KwQuoteContext happy_dollar_dollar -> cont 53#;
+	TokKeyword KwQuote happy_dollar_dollar -> cont 54#;
+	TokKeyword KwQuoteTerm happy_dollar_dollar -> cont 55#;
+	TokKeyword KwTactic happy_dollar_dollar -> cont 56#;
+	TokKeyword KwUnquote happy_dollar_dollar -> cont 57#;
+	TokKeyword KwUnquoteDecl happy_dollar_dollar -> cont 58#;
+	TokSetN happy_dollar_dollar -> cont 59#;
+	TokTeX happy_dollar_dollar -> cont 60#;
+	TokComment happy_dollar_dollar -> cont 61#;
+	TokSymbol SymEllipsis happy_dollar_dollar -> cont 62#;
+	TokSymbol SymDotDot happy_dollar_dollar -> cont 63#;
+	TokSymbol SymDot happy_dollar_dollar -> cont 64#;
+	TokSymbol SymSemi happy_dollar_dollar -> cont 65#;
+	TokSymbol SymColon happy_dollar_dollar -> cont 66#;
+	TokSymbol SymEqual happy_dollar_dollar -> cont 67#;
+	TokSymbol SymUnderscore happy_dollar_dollar -> cont 68#;
+	TokSymbol SymQuestionMark happy_dollar_dollar -> cont 69#;
+	TokSymbol SymArrow happy_dollar_dollar -> cont 70#;
+	TokSymbol SymLambda happy_dollar_dollar -> cont 71#;
+	TokSymbol SymAs happy_dollar_dollar -> cont 72#;
+	TokSymbol SymBar happy_dollar_dollar -> cont 73#;
+	TokSymbol SymOpenParen happy_dollar_dollar -> cont 74#;
+	TokSymbol SymCloseParen happy_dollar_dollar -> cont 75#;
+	TokSymbol SymDoubleOpenBrace happy_dollar_dollar -> cont 76#;
+	TokSymbol SymDoubleCloseBrace happy_dollar_dollar -> cont 77#;
+	TokSymbol SymOpenBrace happy_dollar_dollar -> cont 78#;
+	TokSymbol SymCloseBrace happy_dollar_dollar -> cont 79#;
+	TokSymbol SymOpenVirtualBrace happy_dollar_dollar -> cont 80#;
+	TokSymbol SymCloseVirtualBrace happy_dollar_dollar -> cont 81#;
+	TokSymbol SymVirtualSemi happy_dollar_dollar -> cont 82#;
+	TokSymbol SymOpenPragma happy_dollar_dollar -> cont 83#;
+	TokSymbol SymClosePragma happy_dollar_dollar -> cont 84#;
+	TokId happy_dollar_dollar -> cont 85#;
+	TokQId happy_dollar_dollar -> cont 86#;
+	TokString happy_dollar_dollar -> cont 87#;
+	TokLiteral happy_dollar_dollar -> cont 88#;
 	_ -> happyError' tk
 	})
 
-happyError_ 88# tk = happyError' tk
+happyError_ 89# tk = happyError' tk
 happyError_ _ tk = happyError' tk
 
 happyThen :: () => Parser a -> (a -> Parser b) -> Parser b
@@ -5286,17 +5321,17 @@ mkName (i, s) = do
     unless (alternating xs) $ fail $ "a name cannot contain two consecutive underscores"
     return $ Name (getRange i) xs
     where
-	isValidId Hole   = return ()
-	isValidId (Id y) = do
+        isValidId Hole   = return ()
+        isValidId (Id y) = do
           let x = rawNameToString y
           case parse defaultParseFlags [0] (lexer return) x of
-	    ParseOk _ (TokId _) -> return ()
-	    _			-> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"
+            ParseOk _ (TokId _) -> return ()
+            _                   -> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"
 
-	-- we know that there are no two Ids in a row
-	alternating (Hole : Hole : _) = False
-	alternating (_ : xs)	      = alternating xs
-	alternating []		      = True
+        -- we know that there are no two Ids in a row
+        alternating (Hole : Hole : _) = False
+        alternating (_ : xs)          = alternating xs
+        alternating []                = True
 
 -- | Create a qualified name from a list of strings
 mkQName :: [(Interval, String)] -> Parser QName
@@ -5311,8 +5346,8 @@ ensureUnqual q at Qual{}  = parseError' (rStart $ getRange q) "Qualified name not a
 -- | Match a particular name.
 isName :: String -> (Interval, String) -> Parser ()
 isName s (_,s')
-    | s == s'	= return ()
-    | otherwise	= fail $ "expected " ++ s ++ ", found " ++ s'
+    | s == s'   = return ()
+    | otherwise = fail $ "expected " ++ s ++ ", found " ++ s'
 
 -- | Build a forall pi (forall x y z -> ...)
 forallPi :: [LamBinding] -> Expr -> Expr
@@ -5324,7 +5359,7 @@ tLet r = TypedBindings r . Common.Arg defaultArgInfo . TLet r
 
 -- | Converts lambda bindings to typed bindings.
 addType :: LamBinding -> TypedBindings
-addType (DomainFull b)	 = b
+addType (DomainFull b)   = b
 addType (DomainFree info x) = TypedBindings r $ Common.Arg info $ TBind r [x] $ Underscore r Nothing
   where r = getRange x
 
@@ -5353,22 +5388,22 @@ mergeImportDirectives is = do
 verifyImportDirective :: ImportDirective -> Parser ImportDirective
 verifyImportDirective i =
     case filter ((>1) . length)
-	 $ group
-	 $ sort xs
+         $ group
+         $ sort xs
     of
-	[]  -> return i
-	yss -> let Just pos = rStart $ getRange $ head $ concat yss in
+        []  -> return i
+        yss -> let Just pos = rStart $ getRange $ head $ concat yss in
                parseErrorAt pos $
-		"repeated name" ++ s ++ " in import directive: " ++
-		concat (intersperse ", " $ map (show . head) yss)
-	    where
-		s = case yss of
-			[_] -> ""
-			_   -> "s"
+                "Repeated name" ++ s ++ " in import directive: " ++
+                concat (intersperse ", " $ map (show . head) yss)
+            where
+                s = case yss of
+                        [_] -> ""
+                        _   -> "s"
     where
-	xs = names (usingOrHiding i) ++ map renFrom (renaming i)
-	names (Using xs)    = xs
-	names (Hiding xs)   = xs
+        xs = names (usingOrHiding i) ++ map renFrom (renaming i)
+        names (Using xs)    = xs
+        names (Hiding xs)   = xs
 
 -- | Breaks up a string into substrings. Returns every maximal
 -- subsequence of zero or more characters distinct from @'.'@.
@@ -5416,34 +5451,34 @@ validHaskellModuleName = all ok . splitOnDots
 exprToLHS :: Expr -> Parser ([Expr] -> [Expr] -> LHS)
 exprToLHS e = case e of
   WithApp r e es -> LHS <$> exprToPattern e <*> mapM exprToPattern es
-  _		 -> LHS <$> exprToPattern e <*> return []
+  _              -> LHS <$> exprToPattern e <*> return []
 
 -- | Turn an expression into a pattern. Fails if the expression is not a
 --   valid pattern.
 exprToPattern :: Expr -> Parser Pattern
 exprToPattern e =
     case e of
-	Ident x			-> return $ IdentP x
-	App _ e1 e2		-> AppP <$> exprToPattern e1
-					<*> T.mapM (T.mapM exprToPattern) e2
-	Paren r e		-> ParenP r
-					<$> exprToPattern e
-	Underscore r _		-> return $ WildP r
-	Absurd r		-> return $ AbsurdP r
-	As r x e		-> AsP r x <$> exprToPattern e
-	Dot r (HiddenArg _ e)	-> return $ HiddenP r $ fmap (DotP r) e
-	Dot r e			-> return $ DotP r e
-	Lit l			-> return $ LitP l
-	HiddenArg r e		-> HiddenP r <$> T.mapM exprToPattern e
-	InstanceArg r e		-> InstanceP r <$> T.mapM exprToPattern e
-	RawApp r es		-> RawAppP r <$> mapM exprToPattern es
+        Ident x                 -> return $ IdentP x
+        App _ e1 e2             -> AppP <$> exprToPattern e1
+                                        <*> T.mapM (T.mapM exprToPattern) e2
+        Paren r e               -> ParenP r
+                                        <$> exprToPattern e
+        Underscore r _          -> return $ WildP r
+        Absurd r                -> return $ AbsurdP r
+        As r x e                -> AsP r x <$> exprToPattern e
+        Dot r (HiddenArg _ e)   -> return $ HiddenP r $ fmap (DotP r) e
+        Dot r e                 -> return $ DotP r e
+        Lit l                   -> return $ LitP l
+        HiddenArg r e           -> HiddenP r <$> T.mapM exprToPattern e
+        InstanceArg r e         -> InstanceP r <$> T.mapM exprToPattern e
+        RawApp r es             -> RawAppP r <$> mapM exprToPattern es
         Quote r                 -> return $ QuoteP r
-	_			->
+        _                       ->
           let Just pos = rStart $ getRange e in
           parseErrorAt pos $ "Not a valid pattern: " ++ show e
 
 opAppExprToPattern :: OpApp Expr -> Parser Pattern
-opAppExprToPattern (SyntaxBindingLambda _ _ _) = parseError "syntax binding lambda cannot appear in a pattern"
+opAppExprToPattern (SyntaxBindingLambda _ _ _) = parseError "Syntax binding lambda cannot appear in a pattern"
 opAppExprToPattern (Ordinary e) = exprToPattern e
 
 -- | Turn an expression into a name. Fails if the expression is not a
@@ -5489,6 +5524,7 @@ data RHSOrTypeSigs = JustRHS RHS
 
 namesOfPattern :: Pattern -> Maybe [(C.ArgInfo, Name)]
 namesOfPattern (IdentP (QName i))         = Just [(defaultArgInfo, i)]
+namesOfPattern (WildP r)                  = Just [(defaultArgInfo, C.noName r)]
 namesOfPattern (DotP _ (Ident (QName i))) = Just [(setRelevance Irrelevant defaultArgInfo, i)]
 namesOfPattern (RawAppP _ ps)             = fmap concat $ mapM namesOfPattern ps
 namesOfPattern _                          = Nothing
@@ -5512,6 +5548,7 @@ tests = runTests "Agda.Syntax.Parser.Parser"
   ]
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
 {-# LINE 1 "<command-line>" #-}
 {-# LINE 1 "templates/GenericTemplate.hs" #-}
 -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
diff --git a/src/data/agda.sty b/src/data/agda.sty
index dd7fff4..be21d8f 100644
--- a/src/data/agda.sty
+++ b/src/data/agda.sty
@@ -286,28 +286,31 @@
 \newcommand{\AgdaOperator}    [1]{\AgdaFontStyle{\textcolor{AgdaOperator}{#1}}}
 
 % NameKind commands.
+\newcommand{\AgdaNoSpaceMath}[1]
+    {\begingroup\thickmuskip=0mu\medmuskip=0mu#1\endgroup}
+
 \newcommand{\AgdaBound}[1]
-    {\AgdaBoundFontStyle{\textcolor{AgdaBound}{#1}}}
+    {\AgdaNoSpaceMath{\AgdaBoundFontStyle{\textcolor{AgdaBound}{#1}}}}
 \newcommand{\AgdaInductiveConstructor}[1]
-    {\AgdaFontStyle{\textcolor{AgdaInductiveConstructor}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaInductiveConstructor}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaCoinductiveConstructor}[1]
-    {\AgdaFontStyle{\textcolor{AgdaCoinductiveConstructor}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaCoinductiveConstructor}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaDatatype}[1]
-    {\AgdaFontStyle{\textcolor{AgdaDatatype}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaDatatype}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaField}[1]
-    {\AgdaFontStyle{\textcolor{AgdaField}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaField}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaFunction}[1]
-    {\AgdaFontStyle{\textcolor{AgdaFunction}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaFunction}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaModule}[1]
-    {\AgdaFontStyle{\textcolor{AgdaModule}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaModule}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaPostulate}[1]
-    {\AgdaFontStyle{\textcolor{AgdaPostulate}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaPostulate}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaPrimitive}[1]
-    {\AgdaFontStyle{\textcolor{AgdaPrimitive}{#1}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaPrimitive}{#1}}}}
 \newcommand{\AgdaRecord}[1]
-    {\AgdaFontStyle{\textcolor{AgdaRecord}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaRecord}{\AgdaLink{#1}}}}}
 \newcommand{\AgdaArgument}[1]
-    {\AgdaFontStyle{\textcolor{AgdaArgument}{\AgdaLink{#1}}}}
+    {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaArgument}{\AgdaLink{#1}}}}}
 
 % Other aspect commands.
 \newcommand{\AgdaDottedPattern}     [1]{\textcolor{AgdaDottedPattern}{#1}}
diff --git a/src/data/emacs-mode/agda2-highlight.el b/src/data/emacs-mode/agda2-highlight.el
index 37dc105..2314530 100644
--- a/src/data/emacs-mode/agda2-highlight.el
+++ b/src/data/emacs-mode/agda2-highlight.el
@@ -59,8 +59,8 @@ If the face does not exist, then it is created first."
 
 (defvar agda2-highlight-face-attributes-list
   '(:family :width :height :weight :slant :foreground :background
-	    :inverse-video :stipple :underline :overline :strike-through
-	    :inherit :box :font)
+            :inverse-video :stipple :underline :overline :strike-through
+            :inherit :box :font)
   "The attributes considered by `agda2-highlight-face-attributes'.")
 
 (defun agda2-highlight-face-attributes (face)
@@ -133,61 +133,61 @@ Also sets the default value of VARIABLE to GROUP."
             (agda2-highlight-typechecks-face
              :foreground "black"
              :background "light blue")))
-	 ((equal group 'default-faces)
+         ((equal group 'default-faces)
           (list (cons 'agda2-highlight-keyword-face
-		      (agda2-highlight-face-attributes
-		       font-lock-keyword-face))
-		(cons 'agda2-highlight-string-face
-		      (agda2-highlight-face-attributes
-		       font-lock-string-face))
-		(cons 'agda2-highlight-number-face
-		      (agda2-highlight-face-attributes
-		       font-lock-constant-face))
-		(cons 'agda2-highlight-symbol-face
-		      (agda2-highlight-face-attributes
-		       font-lock-keyword-face))
-		(cons 'agda2-highlight-primitive-type-face
-		      (agda2-highlight-face-attributes
-		       font-lock-keyword-face))
-		(cons 'agda2-highlight-bound-variable-face
-		      (agda2-highlight-face-attributes
-		       font-lock-variable-name-face))
-		(cons 'agda2-highlight-inductive-constructor-face
-		      (agda2-highlight-face-attributes
-		       font-lock-type-face))
-		(cons 'agda2-highlight-coinductive-constructor-face
-		      (agda2-highlight-face-attributes
-		       font-lock-type-face))
-		(cons 'agda2-highlight-datatype-face
-		      (agda2-highlight-face-attributes
-		       font-lock-type-face))
-		(cons 'agda2-highlight-field-face
-		      (agda2-highlight-face-attributes
-		       font-lock-variable-name-face))
-		(cons 'agda2-highlight-function-face
-		      (agda2-highlight-face-attributes
-		       font-lock-function-name-face))
-		(cons 'agda2-highlight-module-face
-		      (agda2-highlight-face-attributes
-		       font-lock-type-face))
-		(cons 'agda2-highlight-postulate-face
-		      (agda2-highlight-face-attributes
-		       font-lock-type-face))
-		(cons 'agda2-highlight-primitive-face
-		      (agda2-highlight-face-attributes
-		       font-lock-constant-face))
-		(cons 'agda2-highlight-record-face
-		      (agda2-highlight-face-attributes
-		       font-lock-variable-name-face))
-		(cons 'agda2-highlight-dotted-face
-		      (agda2-highlight-face-attributes
-		       font-lock-variable-name-face))
-		(cons 'agda2-highlight-operator-face
-		      (agda2-highlight-face-attributes
-		       font-lock-function-name-face))
-		(cons 'agda2-highlight-error-face
-		      (agda2-highlight-face-attributes
-		       font-lock-warning-face))
+                      (agda2-highlight-face-attributes
+                       font-lock-keyword-face))
+                (cons 'agda2-highlight-string-face
+                      (agda2-highlight-face-attributes
+                       font-lock-string-face))
+                (cons 'agda2-highlight-number-face
+                      (agda2-highlight-face-attributes
+                       font-lock-constant-face))
+                (cons 'agda2-highlight-symbol-face
+                      (agda2-highlight-face-attributes
+                       font-lock-keyword-face))
+                (cons 'agda2-highlight-primitive-type-face
+                      (agda2-highlight-face-attributes
+                       font-lock-keyword-face))
+                (cons 'agda2-highlight-bound-variable-face
+                      (agda2-highlight-face-attributes
+                       font-lock-variable-name-face))
+                (cons 'agda2-highlight-inductive-constructor-face
+                      (agda2-highlight-face-attributes
+                       font-lock-type-face))
+                (cons 'agda2-highlight-coinductive-constructor-face
+                      (agda2-highlight-face-attributes
+                       font-lock-type-face))
+                (cons 'agda2-highlight-datatype-face
+                      (agda2-highlight-face-attributes
+                       font-lock-type-face))
+                (cons 'agda2-highlight-field-face
+                      (agda2-highlight-face-attributes
+                       font-lock-variable-name-face))
+                (cons 'agda2-highlight-function-face
+                      (agda2-highlight-face-attributes
+                       font-lock-function-name-face))
+                (cons 'agda2-highlight-module-face
+                      (agda2-highlight-face-attributes
+                       font-lock-type-face))
+                (cons 'agda2-highlight-postulate-face
+                      (agda2-highlight-face-attributes
+                       font-lock-type-face))
+                (cons 'agda2-highlight-primitive-face
+                      (agda2-highlight-face-attributes
+                       font-lock-constant-face))
+                (cons 'agda2-highlight-record-face
+                      (agda2-highlight-face-attributes
+                       font-lock-variable-name-face))
+                (cons 'agda2-highlight-dotted-face
+                      (agda2-highlight-face-attributes
+                       font-lock-variable-name-face))
+                (cons 'agda2-highlight-operator-face
+                      (agda2-highlight-face-attributes
+                       font-lock-function-name-face))
+                (cons 'agda2-highlight-error-face
+                      (agda2-highlight-face-attributes
+                       font-lock-warning-face))
                 (cons 'agda2-highlight-typechecks-face
                       (agda2-highlight-face-attributes
                        font-lock-type-face))
diff --git a/src/data/emacs-mode/agda2-mode.el b/src/data/emacs-mode/agda2-mode.el
index 4f1c162..a9ac767 100644
--- a/src/data/emacs-mode/agda2-mode.el
+++ b/src/data/emacs-mode/agda2-mode.el
@@ -10,7 +10,7 @@
 
 ;;; Code:
 
-(defvar agda2-version "2.4.2"
+(defvar agda2-version "2.4.2.2"
   "The version of the Agda mode.
 Note that the same version of the Agda executable must be used.")
 
@@ -817,7 +817,7 @@ of new goals."
   "Refine the pattern variables given in the goal.
 Assumes that <clause> = {!<variables>!} is on one line."
   (interactive)
-  (agda2-goal-cmd "Cmd_make_case" "pattern variables to case"))
+  (agda2-goal-cmd "Cmd_make_case" "pattern variables to case (empty for split on result)"))
 
 (defun agda2-make-case-action (newcls)
   "Replace the line at point with new clauses NEWCLS and reload."
@@ -840,19 +840,19 @@ Assumes that <clause> = {!<variables>!} is on one line."
   "Replace definition of extended lambda with new clauses NEWCLS and reload."
   (agda2-forget-all-goals);; we reload later anyway.
   (let* ((pmax (- (re-search-forward "\\([^!]}\\)\\|;") 1))
-	 (bracketCount 0)
-	 cl)
+         (bracketCount 0)
+         cl)
     (re-search-backward "{!")
       (while (and (not (equal (preceding-char) ?\;)) (>= bracketCount 0))
-	(backward-char)
-	(if (equal (preceding-char) ?}) (incf bracketCount))
-	(if (equal (preceding-char) ?{) (decf bracketCount)))
+        (backward-char)
+        (if (equal (preceding-char) ?}) (incf bracketCount))
+        (if (equal (preceding-char) ?{) (decf bracketCount)))
     (let ((p (point)))
       (delete-region (point) pmax)
       (insert " ")
       (while (setq cl (pop newcls))
-	(insert cl)
-	(if newcls (insert " ; ")))
+        (insert cl)
+        (if newcls (insert " ; ")))
       (insert " ")
       (goto-char p)))
   (agda2-load))
diff --git a/src/full/Agda/Auto/Auto.hs b/src/full/Agda/Auto/Auto.hs
index 2e15192..d18b0ff 100644
--- a/src/full/Agda/Auto/Auto.hs
+++ b/src/full/Agda/Auto/Auto.hs
@@ -1,16 +1,18 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
+{-# LANGUAGE TupleSections #-}
 
 module Agda.Auto.Auto (auto) where
 
-import Control.Monad.Error
+import Prelude hiding (null)
+
 import Control.Monad.State
-import Data.List
+import Data.List hiding (null)
 import qualified Data.Map as Map
 import Data.IORef
 import qualified System.Timeout
-import Data.Maybe (catMaybes, isNothing)
-import Data.Tuple (swap)
+import Data.Maybe
 import Data.Functor
+import qualified Data.Traversable as Trav
 
 import Agda.Utils.Permutation (permute, takeP)
 import Agda.TypeChecking.Monad.Base
@@ -28,10 +30,10 @@ import Agda.Syntax.Translation.AbstractToConcrete (abstractToConcreteEnv, abstra
 import Agda.Interaction.BasicOps hiding (refine)
 import Agda.TypeChecking.Reduce (normalise)
 import Agda.Syntax.Common
-import qualified Agda.Syntax.Scope.Base
+import qualified Agda.Syntax.Scope.Base as Scope
 import Agda.Syntax.Scope.Monad (withCurrentModule)
 import qualified Agda.Syntax.Abstract.Name as AN
-import qualified Agda.TypeChecking.Monad.Base as MB
+import qualified Agda.TypeChecking.Monad.Base as TCM
 import Agda.TypeChecking.EtaContract (etaContract)
 import qualified Agda.Utils.HashMap as HMap
 
@@ -43,8 +45,15 @@ import Agda.Auto.Typecheck
 
 import Agda.Auto.CaseSplit
 
-#include "../undefined.h"
+import Agda.Utils.Except ( runExceptT, MonadError(catchError) )
+import Agda.Utils.Functor
 import Agda.Utils.Impossible
+import Agda.Utils.Lens
+import Agda.Utils.Maybe
+import Agda.Utils.Null
+import Agda.Utils.Tuple
+
+#include "undefined.h"
 
 insertAbsurdPattern :: String -> String
 insertAbsurdPattern [] = []
@@ -54,9 +63,14 @@ insertAbsurdPattern (c:s) = c : insertAbsurdPattern s
 getName :: A.Expr -> Maybe (Bool, I.QName)
 getName (A.ScopedExpr _ e) = getName e
 getName (A.Def qname) = Just (False, qname)
+getName (A.Proj qname) = Just (False, qname)
 getName (A.Con qname) = Just (True, head $ I.unAmbQ qname)
 getName _ = Nothing
 
+dispmsg :: String ->
+           TCM (Either [(InteractionId, String)]
+                       (Either [String] String)
+               , Maybe String)
 dispmsg msg = return (Left [], Just msg)
 
 -- | Entry point for Auto tactic (Agsy).
@@ -78,351 +92,353 @@ dispmsg msg = return (Left [], Just msg)
 --   3. @Right (Right s)@
 --      A refinement for the interaction id @ii@ in which Auto was invoked.
 
-auto :: InteractionId -> Range -> String -> TCM (Either [(InteractionId, String)] (Either [String] String), Maybe String)
-auto ii rng argstr = liftTCM $ do
-         let (hints, timeout, pick, mode, hintmode) = parseargs argstr
-         ahints <- mapM (parseExprIn ii rng) (case mode of {MRefine{} -> []; _ -> hints})
-
-         eqstuff <- liftM (maybe Nothing (mapM getName)) $
-                    catchError (liftM Just $ mapM (parseExprIn ii rng) ["_≡_", "begin_", "_≡⟨_⟩_", "_∎", "sym", "cong"]) (\_ -> return Nothing)
-
-         case mapM getName ahints of
-          Nothing -> dispmsg "Hints must be a list of constant names"
-          Just ehints -> do
-           mi <- lookupInteractionId ii
-           --thisdefinfo <- catchError (liftM Just $ findClause mi) (\_ -> return Nothing)
-           thisdefinfo <- findClauseDeep mi
-           ehints <- liftM (ehints ++) $ autohints hintmode mi (case thisdefinfo of {Just (def, _, _) -> Just def; Nothing -> Nothing})
-           mrectyp <- case thisdefinfo of
-            Nothing -> return []
-            Just (def, _, _) -> do
-             recdef <- getConstInfo def
-             let rectyp = MB.defType recdef
-             rectyp <- normalise rectyp
-             return [rectyp]
-
-           let ehints' = ehints ++ maybe [] id eqstuff
-
-
-           (myhints', mymrectyp, tccons, eqcons, cmap) <- tomy mi ehints' mrectyp
-
-           let myhints = take (length myhints' - (length ehints' - length ehints)) myhints'
-               meqr = case eqstuff of
-                       Nothing -> Nothing
-                       Just _ -> let [c1, c2, c3, c4, c5, c6] = drop (length myhints' - (length ehints' - length ehints)) myhints'
-                                 in Just $ EqReasoningConsts c1 c2 c3 c4 c5 c6
-
-
-           let tcSearchSC isdep ctx typ trm =
-
-                                     (case meqr of
-                                      Nothing -> id
-                                      Just eqr -> mpret . Sidecondition (calcEqRState eqr trm)
-                                     )
-
-                                     (tcSearch isdep ctx typ trm)
-           let (mainm, _, _, _) = tccons Map.! mi
-           case mode of
-            MNormal listmode disprove -> do
-               sols <- liftIO $ newIORef ([] :: [[I.Term]])
-               nsol <- liftIO $ newIORef (if listmode then (pick + 10) else (pick + 1))
-               let hsol =
-
-
-                       if listmode then do
-                        nsol' <- readIORef nsol
-                        when (nsol' <= 10) $ runErrorT (mapM (\(m, _, _, _) -> frommy (Meta m)) (Map.elems tccons)) >>= \trms -> case trms of {Left{} -> writeIORef nsol $! nsol' + 1; Right trms -> modifyIORef sols (trms :)}
-                       else do
-                        nsol' <- readIORef nsol
-                        when (nsol' == 1) $ runErrorT (mapM (\(m, _, _, _) -> frommy (Meta m)) (Map.elems tccons)) >>= \trms -> case trms of {Left{} -> writeIORef nsol $! nsol' + 1; Right trms -> writeIORef sols [trms]}
-               ticks <- liftIO $ newIORef 0
-               let exsearch initprop recinfo defdfv = liftIO $ System.Timeout.timeout (timeout * 1000000) (
-                    let r d = do
-                         let rechint x = case recinfo of
-                                          Nothing -> x
-                                          Just (_, recdef) -> (recdef, HMRecCall) : x
-                             env = RIEnv {rieHints = rechint $ map (\x -> (x, HMNormal)) myhints,
-                                          rieDefFreeVars = defdfv
-
-                                          , rieEqReasoningConsts = meqr
-
-                                         }
-                         depreached <- topSearch ticks nsol hsol env (initprop) d costIncrease
-                         nsol' <- readIORef nsol
-                         if nsol' /= 0 && depreached then
-                           r (d + costIncrease)
-                          else
-                           return depreached
-                    in r 0)
-               let getsols sol = do
-                    exprs <- mapM (\(mi, e) -> do
-                               mv <- lookupMeta mi
-                               e <- etaContract e
-                               expr <- liftM modifyAbstractExpr $ withMetaInfo (getMetaInfo mv) $ reify e
-                               return (mi, expr)
-                              ) (zip (Map.keys tccons) sol)
-                    let r :: I.MetaId -> StateT [I.MetaId] TCM [(I.MetaId, A.Expr)]
-                        r midx = do
-                         let (m, _, _, deps) = tccons Map.! midx
-                         asolss <- mapM r deps
-                         dones <- get
-                         asols <- if (midx `notElem` dones) then do
-                           put (midx : dones)
-                           return [(midx, let Just e = lookup midx exprs in e)]
-                          else
-                           return []
-                         return $ concat asolss ++ asols
-                    (asols, _) <- runStateT (r mi) []
-                    return asols
-               if disprove then
-                 case eqcons of
-                  [] -> case Map.elems tccons of
-                   (m, mytype, mylocalVars, _) : [] -> do
-                       defdfv <- case thisdefinfo of
-                                  Just (def, _, _) -> getdfv mi def
-                                  Nothing -> return 0
-                       ee <- liftIO $ newIORef $ ConstDef {cdname = "T", cdorigin = __IMPOSSIBLE__, cdtype = NotM $ Sort (Set 0), cdcont = Postulate, cddeffreevars = 0}
-                       let modargs = drop (length mylocalVars - defdfv) mylocalVars
-                           restargs = take (length mylocalVars - defdfv) mylocalVars
-                           mytype' = foldl (\x y -> NotM $ Pi Nothing Agda.Auto.Syntax.NotHidden (freeIn 0 y) y (Abs NoId x)) mytype restargs
-                           htyp = negtype ee mytype'
-                           sctx = (Id "h", closify htyp) : map (\x -> (NoId, closify x)) modargs
-                           ntt = closify (NotM $ App Nothing (NotM OKVal) (Const ee) (NotM ALNil))
-                       res <- exsearch (tcSearchSC False sctx ntt (Meta m)) Nothing defdfv
-                       rsols <- liftM reverse $ liftIO $ readIORef sols
-                       if null rsols then do
-                         nsol' <- liftIO $ readIORef nsol
-                         dispmsg $ insuffsols (pick + (if listmode then 10 else 1) - nsol')
-                        else do
-                         aexprss <- mapM getsols rsols
-                         cexprss <- mapM (mapM (\(mi, e) -> lookupMeta mi >>= \mv -> withMetaInfo (getMetaInfo mv) $ abstractToConcrete_ e >>= \e' -> return (mi, e'))) aexprss
-                         let ss = dropWhile (== ' ') . dropWhile (/= ' ') . show
-                             disp [(_, cexpr)] = ss cexpr
-                             disp cexprs = concat (map (\(mi, cexpr) -> ss cexpr ++ " ") cexprs)
-                         ticks <- liftIO $ readIORef ticks
-                         dispmsg $ "Listing disproof(s) " ++ show pick ++ "-" ++ show (pick + length rsols - 1) ++
-
-
-                                   "\n" ++ unlines (map (\(x, y) -> show y ++ "  " ++ disp x) $ zip cexprss [pick..])
-                   _ -> dispmsg "Metavariable dependencies not allowed in disprove mode"
-                  _ -> dispmsg "Metavariable dependencies not allowed in disprove mode"
-                else do
-                 (recinfo, defdfv) <-
-                  case thisdefinfo of
-                   Just (def, clause, _) -> do
-                    let [rectyp'] = mymrectyp
-                    defdfv <- getdfv mi def
-                    myrecdef <- liftIO $ newIORef $ ConstDef {cdname = "", cdorigin = (Nothing, def), cdtype = rectyp', cdcont = Postulate, cddeffreevars = defdfv}
-                    (_, pats) <- constructPats cmap mi clause
-                    defdfv <- getdfv mi def
-                    return $ if contains_constructor pats then
-                      (Just (pats, myrecdef), defdfv)
-                     else
-                      (Nothing, defdfv)
-                   Nothing -> return (Nothing, 0)
-                 let tc (m, mytype, mylocalVars) isdep = tcSearchSC isdep (map (\x -> (NoId, closify x)) mylocalVars) (closify mytype) (Meta m)
-                     initprop =
-                       foldl (\x (ineq, e, i) -> mpret $ And Nothing x (comp' ineq (closify e) (closify i)))
-                        (foldl (\x (m, mt, mlv, _) ->
-                          if hequalMetavar m mainm then
-                           case recinfo of
-                            Just (recpats, recdef) ->
-                             mpret $ Sidecondition (localTerminationSidecond (localTerminationEnv recpats) recdef (Meta m))
-                                                   (tc (m, mt, mlv) False)
-                            Nothing -> mpret $ And Nothing x (tc (m, mt, mlv) False)
-                          else
-                           mpret $ And Nothing x (tc (m, mt, mlv) True)
-                         )
-                         (mpret OK)
-                         (Map.elems tccons)
-                        ) eqcons
-                 res <- exsearch initprop recinfo defdfv
-                 riis <- map swap <$> getInteractionIdsAndMetas
-                 let timeoutString | isNothing res = " after timeout (" ++ show timeout ++ "s)"
-                                   | otherwise     = ""
-                 if listmode then do
-                   rsols <- liftM reverse $ liftIO $ readIORef sols
-                   if null rsols then do
-                     nsol' <- liftIO $ readIORef nsol
-                     dispmsg $ insuffsols (pick + 10 - nsol') ++ timeoutString
-                    else do
-                     aexprss <- mapM getsols rsols
-                     cexprss <- mapM (mapM (\(mi, e) -> lookupMeta mi >>= \mv -> withMetaInfo (getMetaInfo mv) $ abstractToConcrete_ e >>= \e' -> return (mi, e'))) aexprss
-                     let disp [(_, cexpr)] = show cexpr
-                         disp cexprs = concat (map (\(mi, cexpr) -> case lookup mi riis of {Nothing -> show mi; Just ii -> show ii} ++ " := " ++ show cexpr ++ " ") cexprs)
-                     ticks <- liftIO $ readIORef ticks
-                     dispmsg $ "Listing solution(s) " ++ show pick ++ "-" ++ show (pick + length rsols - 1) ++ timeoutString ++
-                               "\n" ++ unlines (map (\(x, y) -> show y ++ "  " ++ disp x) $ zip cexprss [pick..])
-                  else
-                   case res of
-                    Nothing -> do
-                     nsol' <- liftIO $ readIORef nsol
-                     dispmsg $ insuffsols (pick + 1 - nsol') ++ timeoutString
-                    Just depthreached -> do
-                     ticks <- liftIO $ readIORef ticks
-                     rsols <- liftIO $ readIORef sols
-                     case rsols of
-                      [] -> do
-                       nsol' <- liftIO $ readIORef nsol
-                       dispmsg $ insuffsols (pick + 1 - nsol')
-                      (term : _) -> do
-                       exprs <- getsols term
-                       giveress <-
-                        mapM (\(mi, expr) ->
-                         case lookup mi riis of
-                          Nothing ->
-                           catchError
-                            (giveExpr mi expr >>= \_ -> return (Nothing, Nothing))
-                            (\_ -> return (Nothing, Just ("Failed to give expr for side solution of " ++ show mi)))
-                          Just ii' -> do ae <- give ii' Nothing expr
-                                         mv <- lookupMeta mi
-                                         let scope = getMetaScope mv
-                                         ce <- abstractToConcreteEnv (makeEnv scope) ae
-                                         let cmnt = if ii' == ii then agsyinfo ticks else ""
-                                         return (Just (ii', show ce ++ cmnt), Nothing)
-                         ) exprs
-                       let msg = if length exprs == 1 then
-                                  Nothing
-                                 else
-                                  Just $ "Also gave solution(s) for hole(s)" ++
-                                          concatMap (\(mi', _) ->
-                                           if mi' == mi then "" else (" " ++ case lookup mi' riis of {Nothing -> show mi'; Just ii -> show ii})
-                                          ) exprs
-                       let msgs = catMaybes $ msg : map snd giveress
-                           msg' = case msgs of
-                                   [] -> Nothing
-                                   _ -> Just $ unlines msgs
-                       return (Left $ catMaybes $ map fst giveress, msg')
-
-            MCaseSplit -> do
-             case thisdefinfo of
-              Just (def, clause, True) ->
-               case Map.elems tccons of
-                ((m, mytype, mylocalVars, _) : []) | null eqcons -> do
-
-
-                 (ids, pats) <- constructPats cmap mi clause
-                 let ctx = map (\((hid, id), t) -> HI hid (id, t)) (zip ids mylocalVars)
-                 ticks <- liftIO $ newIORef 0
-                 let [rectyp'] = mymrectyp
-                 defdfv <- getdfv mi def
-                 myrecdef <- liftIO $ newIORef $ ConstDef {cdname = "", cdorigin = (Nothing, def), cdtype = rectyp', cdcont = Postulate, cddeffreevars = defdfv}
-                 sols <- liftIO $ System.Timeout.timeout (timeout * 1000000) (
-                    let r d = do
-                         sols <- liftIO $ caseSplitSearch ticks __IMPOSSIBLE__ myhints meqr __IMPOSSIBLE__ d myrecdef ctx mytype pats
-                         case sols of
-                          [] -> r (d + costIncrease)
-                          (_:_) -> return sols
-                    in r 0)
-                 case sols of
-                  Just (cls : _) -> withInteractionId ii $ do
-                   cls' <- liftIO $ runErrorT (mapM frommyClause cls)
-                   case cls' of
-                    Left{} -> dispmsg "No solution found"
-                    Right cls' -> do
-                     cls'' <- forM cls' $ \ (I.Clause _ tel perm ps body t) -> do
-                       withCurrentModule (AN.qnameModule def) $ do
-                        -- Normalise the dot patterns
-                        ps <- addCtxTel tel $ normalise ps
-                        body <- etaContractBody body
-                        liftM modifyAbstractClause $ inContext [] $ reify $ AN.QNamed def $ I.Clause noRange tel perm ps body t
-                     pcs <- withInteractionId ii $ mapM prettyA cls''
-                     ticks <- liftIO $ readIORef ticks
-
-
-                     return (Right $ Left (map (insertAbsurdPattern . PP.renderStyle (PP.style { PP.mode = PP.OneLineMode })) pcs), Nothing)
-
-                  Just [] -> dispmsg "No solution found" -- case not possible at the moment because case split doesnt care about search exhaustiveness
-                  Nothing -> dispmsg $ "No solution found at time out (" ++ show timeout ++ "s)"
-                _ -> dispmsg "Metavariable dependencies not allowed in case split mode"
-              _ -> dispmsg "Metavariable is not at top level of clause RHS"
-
-            MRefine listmode -> do
-             mv <- lookupMeta mi
-             let tt = jMetaType $ mvJudgement mv
-                 minfo = getMetaInfo mv
-             targettyp <- withMetaInfo minfo $ do
-              vs <- getContextArgs
-              let targettype = tt `piApply` permute (takeP (length vs) $ mvPermutation mv) vs
-              normalise targettype
-             let tctx = length $ envContext $ clEnv minfo
-
-             hits <- if elem "-a" hints then do
-               st <- liftTCM $ join $ pureTCM $ \st _ -> return st
-               let defs = sigDefinitions $ stSignature st
-                   idefs = sigDefinitions $ stImports st
-                   alldefs = HMap.keys defs ++ HMap.keys idefs
-               liftM catMaybes $ mapM (\n ->
-                 case thisdefinfo of
-                  Just (def, _, _) | def == n -> return Nothing
-                  _ -> do
-                   cn <- withMetaInfo minfo $ runAbsToCon $ toConcrete n
-                   if head (show cn) == '.' then -- not in scope
-                     return Nothing
-                    else do
-                     c <- getConstInfo n
-                     ctyp <- normalise $ defType c
-                     cdfv <- withMetaInfo minfo $ getDefFreeVars n
-                     return $ case matchType cdfv tctx ctyp targettyp of
-                      Nothing -> Nothing
-                      Just score -> Just (show cn, score)
-                ) alldefs
-              else do
-               let scopeinfo = clScope (getMetaInfo mv)
-                   namespace = Agda.Syntax.Scope.Base.everythingInScope scopeinfo
-                   names = Agda.Syntax.Scope.Base.nsNames namespace
-                   qnames = map (\(x, y) -> (x, Agda.Syntax.Scope.Base.anameName $ head y)) $ Map.toList names
-                   modnames = case thisdefinfo of
-                               Just (def, _, _) -> filter (\(_, n) -> n /= def) qnames
-                               Nothing -> qnames
-               liftM catMaybes $ mapM (\(cn, n) -> do
-                 c <- getConstInfo n
-                 ctyp <- normalise $ defType c
-                 cdfv <- withMetaInfo minfo $ getDefFreeVars n
-                 return $ case matchType cdfv tctx ctyp targettyp of
-                  Nothing -> Nothing
-                  Just score -> Just (show cn, score)
-                ) modnames
-
-             let sorthits = sortBy (\(_, (pa1, pb1)) (_, (pa2, pb2)) -> case compare pa2 pa1 of {EQ -> compare pb1 pb2; o -> o}) hits
-             if listmode || pick == (-1) then
-               let pick' = max 0 pick
-               in if pick' >= length sorthits then
-                    dispmsg $ insuffcands $ length sorthits
-                   else
-                    let showhits = take 10 $ drop pick' sorthits
-                    in dispmsg $ "Listing candidate(s) " ++ show pick' ++ "-" ++ show (pick' + length showhits - 1) ++ " (found " ++ show (length sorthits) ++ " in total)\n" ++
-                                  unlines (map (\(i, (cn, _)) -> show i ++ "  " ++ cn) (zip [pick'..pick' + length showhits - 1] showhits))
-              else
-               if pick >= length sorthits then
-                dispmsg $ insuffcands $ length sorthits
-               else
-                return (Right $ Right (fst $ sorthits !! pick), Nothing)
- where
-
-
-  agsyinfo ticks = ""
+auto
+  :: InteractionId
+  -> Range
+  -> String
+  -> TCM ( Either [(InteractionId, String)]
+                  (Either [String] String)
+         , Maybe String)
+auto ii rng argstr = do
+
+  -- Parse hints and other configuration.
+  let (hints, timeout, pick, mode, hintmode) = parseargs argstr
+  ahints <- case mode of
+    MRefine{} -> return []
+    _         -> mapM (parseExprIn ii rng) hints
+  let failHints = dispmsg "Hints must be a list of constant names"
+  caseMaybe (mapM getName ahints) failHints $ \ ehints -> do
+
+  -- Get names for equality reasoning.
+  -- @eqstuff == []@ if any of these names is not defined.
+  eqstuffExprs <- mapM (parseExprIn ii rng) ["_≡_", "begin_", "_≡⟨_⟩_", "_∎", "sym", "cong"]
+    `catchError`
+      (\_ -> return [])
+  let eqstuff = fromMaybe [] $ mapM getName eqstuffExprs
+
+  -- Get the meta variable for the interaction point we are trying to fill.
+  -- Add the @autohints@ for that meta to the hints collection.
+  mi <- lookupInteractionId ii
+  --thisdefinfo <- catchError (liftM Just $ findClause mi) (\_ -> return Nothing)
+  thisdefinfo <- findClauseDeep mi
+  ehints <- (ehints ++) <$> do autohints hintmode mi $ fmap fst3 thisdefinfo
+
+  -- If @thisdefinfo /= Nothing@ get the its type (normalized).
+  mrectyp <- maybeToList <$> do
+    Trav.forM thisdefinfo $ \ (def, _, _) -> do
+      normalise =<< do TCM.defType <$> getConstInfo def
+
+  (myhints', mymrectyp, tccons, eqcons, cmap) <- tomy mi (ehints ++ eqstuff) mrectyp
+
+  let (myhints, c1to6) = splitAt (length myhints' - length eqstuff) myhints'
+      meqr = ifNull eqstuff Nothing $ \ _ -> {- else -}
+               let [c1, c2, c3, c4, c5, c6] = c1to6
+               in  Just $ EqReasoningConsts c1 c2 c3 c4 c5 c6
+
+
+  let tcSearchSC isdep ctx typ trm = caseMaybe meqr a $ \ eqr ->
+        mpret $ Sidecondition (calcEqRState eqr trm) a
+        where a = tcSearch isdep ctx typ trm
+
+  let (mainm, _, _, _) = tccons Map.! mi
+  case mode of
+   MNormal listmode disprove -> do
+      sols <- liftIO $ newIORef ([] :: [[I.Term]])
+      nsol <- liftIO $ newIORef $ if listmode then pick + 10 else pick + 1
+      let hsol = do
+           nsol' <- readIORef nsol
+           let cond = if listmode then nsol' <= 10 else nsol' == 1
+           when cond $ do
+             trms <- runExceptT $ mapM (\ (m, _, _, _) -> frommy (Meta m)) $ Map.elems tccons
+             case trms of
+               Left{}     -> writeIORef nsol $! nsol' + 1
+               Right trms -> if listmode then modifyIORef sols (trms :)
+                                         else writeIORef sols [trms]
+      ticks <- liftIO $ newIORef 0
+
+      let exsearch initprop recinfo defdfv =
+           liftIO $ System.Timeout.timeout (timeout * 1000000) $ loop 0
+           where
+             loop d = do
+               let rechint x = case recinfo of
+                                Nothing -> x
+                                Just (_, recdef) -> (recdef, HMRecCall) : x
+                   env = RIEnv { rieHints             = rechint $ map (,HMNormal) myhints
+                               , rieDefFreeVars       = defdfv
+                               , rieEqReasoningConsts = meqr
+                               }
+               depreached <- topSearch ticks nsol hsol env (initprop) d costIncrease
+               nsol' <- readIORef nsol
+               if nsol' /= 0 && depreached then loop (d + costIncrease) else return depreached
+
+      let getsols sol = do
+           exprs <- forM (zip (Map.keys tccons) sol) $ \ (mi, e) -> do
+             mv   <- lookupMeta mi
+             e    <- etaContract e
+             expr <- modifyAbstractExpr <$> do withMetaInfo (getMetaInfo mv) $ reify e
+             return (mi, expr)
+
+           let loop :: I.MetaId -> StateT [I.MetaId] TCM [(I.MetaId, A.Expr)]
+               loop midx = do
+                 let (m, _, _, deps) = tccons Map.! midx
+                 asolss <- mapM loop deps
+                 dones  <- get
+                 asols  <- if midx `elem` dones then return [] else do
+                   put (midx : dones)
+                   return [(midx, fromMaybe __IMPOSSIBLE__ $ lookup midx exprs)]
+                 return $ concat asolss ++ asols
+           (asols, _) <- runStateT (loop mi) []
+           return asols
+
+      if disprove then
+        case eqcons of
+         [] -> case Map.elems tccons of
+          (m, mytype, mylocalVars, _) : [] -> do
+              defdfv <- case thisdefinfo of
+                         Just (def, _, _) -> getdfv mi def
+                         Nothing -> return 0
+              ee <- liftIO $ newIORef $ ConstDef {cdname = "T", cdorigin = __IMPOSSIBLE__, cdtype = NotM $ Sort (Set 0), cdcont = Postulate, cddeffreevars = 0}
+              let (restargs, modargs) = splitAt (length mylocalVars - defdfv) mylocalVars
+                  mytype' = foldl (\x y -> NotM $ Pi Nothing Agda.Auto.Syntax.NotHidden (freeIn 0 y) y (Abs NoId x)) mytype restargs
+                  htyp = negtype ee mytype'
+                  sctx = (Id "h", closify htyp) : map (\x -> (NoId, closify x)) modargs
+                  ntt = closify (NotM $ App Nothing (NotM OKVal) (Const ee) (NotM ALNil))
+              res <- exsearch (tcSearchSC False sctx ntt (Meta m)) Nothing defdfv
+              rsols <- liftM reverse $ liftIO $ readIORef sols
+              if null rsols then do
+                nsol' <- liftIO $ readIORef nsol
+                dispmsg $ insuffsols (pick + (if listmode then 10 else 1) - nsol')
+               else do
+                aexprss <- mapM getsols rsols
+                cexprss <- forM aexprss $ mapM $ \(mi, e) -> do
+                  mv <- lookupMeta mi
+                  withMetaInfo (getMetaInfo mv) $ do
+                    (mi,) <$> abstractToConcrete_ e
+                let ss = dropWhile (== ' ') . dropWhile (/= ' ') . show
+                    disp [(_, cexpr)] = ss cexpr
+                    disp cexprs = concat $ map (\ (mi, cexpr) -> ss cexpr ++ " ") cexprs
+                ticks <- liftIO $ readIORef ticks
+                dispmsg $ unlines $
+                  ("Listing disproof(s) " ++ show pick ++ "-" ++ show (pick + length rsols - 1)) :
+                  for (zip cexprss [pick..]) (\ (x, y) -> show y ++ "  " ++ disp x)
+          _ -> dispmsg "Metavariable dependencies not allowed in disprove mode"
+         _ -> dispmsg "Metavariable dependencies not allowed in disprove mode"
+       else do
+        (recinfo, defdfv) <-
+         case thisdefinfo of
+          Just (def, clause, _) -> do
+           let [rectyp'] = mymrectyp
+           defdfv <- getdfv mi def
+           myrecdef <- liftIO $ newIORef $ ConstDef {cdname = "", cdorigin = (Nothing, def), cdtype = rectyp', cdcont = Postulate, cddeffreevars = defdfv}
+           (_, pats) <- constructPats cmap mi clause
+           defdfv <- getdfv mi def
+           return $ if contains_constructor pats then
+             (Just (pats, myrecdef), defdfv)
+            else
+             (Nothing, defdfv)
+          Nothing -> return (Nothing, 0)
+        let tc (m, mytype, mylocalVars) isdep = tcSearchSC isdep (map (\x -> (NoId, closify x)) mylocalVars) (closify mytype) (Meta m)
+            initprop =
+              foldl (\x (ineq, e, i) -> mpret $ And Nothing x (comp' ineq (closify e) (closify i)))
+               (foldl (\x (m, mt, mlv, _) ->
+                 if hequalMetavar m mainm then
+                  case recinfo of
+                   Just (recpats, recdef) ->
+                    mpret $ Sidecondition (localTerminationSidecond (localTerminationEnv recpats) recdef (Meta m))
+                                          (tc (m, mt, mlv) False)
+                   Nothing -> mpret $ And Nothing x (tc (m, mt, mlv) False)
+                 else
+                  mpret $ And Nothing x (tc (m, mt, mlv) True)
+                )
+                (mpret OK)
+                (Map.elems tccons)
+               ) eqcons
+        res <- exsearch initprop recinfo defdfv
+        riis <- map swap <$> getInteractionIdsAndMetas
+        let timeoutString | isNothing res = " after timeout (" ++ show timeout ++ "s)"
+                          | otherwise     = ""
+        if listmode then do
+          rsols <- liftM reverse $ liftIO $ readIORef sols
+          if null rsols then do
+            nsol' <- liftIO $ readIORef nsol
+            dispmsg $ insuffsols (pick + 10 - nsol') ++ timeoutString
+           else do
+            aexprss <- mapM getsols rsols
+            cexprss <- mapM (mapM (\(mi, e) -> lookupMeta mi >>= \mv -> withMetaInfo (getMetaInfo mv) $ abstractToConcrete_ e >>= \e' -> return (mi, e'))) aexprss
+            let disp [(_, cexpr)] = show cexpr
+                disp cexprs = concat (map (\(mi, cexpr) -> case lookup mi riis of {Nothing -> show mi; Just ii -> show ii} ++ " := " ++ show cexpr ++ " ") cexprs)
+            ticks <- liftIO $ readIORef ticks
+            dispmsg $ "Listing solution(s) " ++ show pick ++ "-" ++ show (pick + length rsols - 1) ++ timeoutString ++
+                      "\n" ++ unlines (map (\(x, y) -> show y ++ "  " ++ disp x) $ zip cexprss [pick..])
+         else
+          case res of
+           Nothing -> do
+            nsol' <- liftIO $ readIORef nsol
+            dispmsg $ insuffsols (pick + 1 - nsol') ++ timeoutString
+           Just depthreached -> do
+            ticks <- liftIO $ readIORef ticks
+            rsols <- liftIO $ readIORef sols
+            case rsols of
+             [] -> do
+              nsol' <- liftIO $ readIORef nsol
+              dispmsg $ insuffsols (pick + 1 - nsol')
+             (term : _) -> do
+              exprs <- getsols term
+              giveress <-
+               mapM (\(mi, expr) ->
+                case lookup mi riis of
+                 Nothing ->
+                  catchError
+                   (giveExpr mi expr >>= \_ -> return (Nothing, Nothing))
+                   (\_ -> return (Nothing, Just ("Failed to give expr for side solution of " ++ show mi)))
+                 Just ii' -> do ae <- give ii' Nothing expr
+                                mv <- lookupMeta mi
+                                let scope = getMetaScope mv
+                                ce <- abstractToConcreteEnv (makeEnv scope) ae
+                                let cmnt = if ii' == ii then agsyinfo ticks else ""
+                                return (Just (ii', show ce ++ cmnt), Nothing)
+                ) exprs
+              let msg = if length exprs == 1 then
+                         Nothing
+                        else
+                         Just $ "Also gave solution(s) for hole(s)" ++
+                                 concatMap (\(mi', _) ->
+                                  if mi' == mi then "" else (" " ++ case lookup mi' riis of {Nothing -> show mi'; Just ii -> show ii})
+                                 ) exprs
+              let msgs = catMaybes $ msg : map snd giveress
+                  msg' = case msgs of
+                          [] -> Nothing
+                          _ -> Just $ unlines msgs
+              return (Left $ catMaybes $ map fst giveress, msg')
+
+   MCaseSplit -> do
+    case thisdefinfo of
+     Just (def, clause, True) ->
+      case Map.elems tccons of
+       [(m, mytype, mylocalVars, _)] | null eqcons -> do
+        (ids, pats) <- constructPats cmap mi clause
+        let ctx = map (\((hid, id), t) -> HI hid (id, t)) (zip ids mylocalVars)
+        ticks <- liftIO $ newIORef 0
+        let [rectyp'] = mymrectyp
+        defdfv <- getdfv mi def
+        myrecdef <- liftIO $ newIORef $ ConstDef {cdname = "", cdorigin = (Nothing, def), cdtype = rectyp', cdcont = Postulate, cddeffreevars = defdfv}
+        sols <- liftIO $ System.Timeout.timeout (timeout * 1000000) (
+           let r d = do
+                sols <- liftIO $ caseSplitSearch ticks __IMPOSSIBLE__ myhints meqr __IMPOSSIBLE__ d myrecdef ctx mytype pats
+                case sols of
+                 [] -> r (d + costIncrease)
+                 (_:_) -> return sols
+           in r 0)
+        case sols of
+         Just (cls : _) -> withInteractionId ii $ do
+          cls' <- liftIO $ runExceptT (mapM frommyClause cls)
+          case cls' of
+           Left{} -> dispmsg "No solution found"
+           Right cls' -> do
+            cls'' <- forM cls' $ \ (I.Clause _ tel perm ps body t) -> do
+              withCurrentModule (AN.qnameModule def) $ do
+               -- Normalise the dot patterns
+               ps <- addCtxTel tel $ normalise ps
+               body <- etaContractBody body
+               liftM modifyAbstractClause $ inContext [] $ reify $ AN.QNamed def $ I.Clause noRange tel perm ps body t
+            pcs <- withInteractionId ii $ mapM prettyA cls''
+            ticks <- liftIO $ readIORef ticks
+
+
+            return (Right $ Left (map (insertAbsurdPattern . PP.renderStyle (PP.style { PP.mode = PP.OneLineMode })) pcs), Nothing)
+
+         Just [] -> dispmsg "No solution found" -- case not possible at the moment because case split doesnt care about search exhaustiveness
+         Nothing -> dispmsg $ "No solution found at time out (" ++ show timeout ++ "s)"
+       _ -> dispmsg "Metavariable dependencies not allowed in case split mode"
+     _ -> dispmsg "Metavariable is not at top level of clause RHS"
+
+   MRefine listmode -> do
+    mv <- lookupMeta mi
+    let tt = jMetaType $ mvJudgement mv
+        minfo = getMetaInfo mv
+    targettyp <- withMetaInfo minfo $ do
+     vs <- getContextArgs
+     let targettype = tt `piApply` permute (takeP (length vs) $ mvPermutation mv) vs
+     normalise targettype
+    let tctx = length $ envContext $ clEnv minfo
+
+    hits <- if elem "-a" hints then do
+      st <- liftTCM $ join $ pureTCM $ \st _ -> return st
+      let defs = sigDefinitions $ st^.stSignature
+          idefs = sigDefinitions $ st^.stImports
+          alldefs = HMap.keys defs ++ HMap.keys idefs
+      liftM catMaybes $ mapM (\n ->
+        case thisdefinfo of
+         Just (def, _, _) | def == n -> return Nothing
+         _ -> do
+          cn <- withMetaInfo minfo $ runAbsToCon $ toConcrete n
+          if head (show cn) == '.' then -- not in scope
+            return Nothing
+           else do
+            c <- getConstInfo n
+            ctyp <- normalise $ defType c
+            cdfv <- withMetaInfo minfo $ getDefFreeVars n
+            return $ case matchType cdfv tctx ctyp targettyp of
+             Nothing -> Nothing
+             Just score -> Just (show cn, score)
+       ) alldefs
+     else do
+      let scopeinfo = clScope (getMetaInfo mv)
+          namespace = Scope.everythingInScope scopeinfo
+          names = Scope.nsNames namespace
+          qnames = map (\(x, y) -> (x, Scope.anameName $ head y)) $ Map.toList names
+          modnames = case thisdefinfo of
+                      Just (def, _, _) -> filter (\(_, n) -> n /= def) qnames
+                      Nothing -> qnames
+      liftM catMaybes $ mapM (\(cn, n) -> do
+        c <- getConstInfo n
+        ctyp <- normalise $ defType c
+        cdfv <- withMetaInfo minfo $ getDefFreeVars n
+        return $ case matchType cdfv tctx ctyp targettyp of
+         Nothing -> Nothing
+         Just score -> Just (show cn, score)
+       ) modnames
+
+    let sorthits = sortBy (\(_, (pa1, pb1)) (_, (pa2, pb2)) -> case compare pa2 pa1 of {EQ -> compare pb1 pb2; o -> o}) hits
+    if listmode || pick == (-1) then
+      let pick' = max 0 pick
+      in if pick' >= length sorthits then
+           dispmsg $ insuffcands $ length sorthits
+          else
+           let showhits = take 10 $ drop pick' sorthits
+           in dispmsg $ "Listing candidate(s) " ++ show pick' ++ "-" ++ show (pick' + length showhits - 1) ++ " (found " ++ show (length sorthits) ++ " in total)\n" ++
+                         unlines (map (\(i, (cn, _)) -> show i ++ "  " ++ cn) (zip [pick'..pick' + length showhits - 1] showhits))
+     else
+      if pick >= length sorthits then
+       dispmsg $ insuffcands $ length sorthits
+      else
+       return (Right $ Right (fst $ sorthits !! pick), Nothing)
+  where
+    agsyinfo ticks = ""
+
+-- Get the functions and axioms defined in the same module as @def at .
+autohints :: AutoHintMode -> I.MetaId -> Maybe AN.QName ->
+             TCM [(Bool, AN.QName)]
 autohints AHMModule mi (Just def) = do
- mv <- lookupMeta mi
- let scopeinfo = clScope (getMetaInfo mv)
-     namespace = Agda.Syntax.Scope.Base.everythingInScope scopeinfo
-     names = Agda.Syntax.Scope.Base.nsNames namespace
-     qnames = map (Agda.Syntax.Scope.Base.anameName . head) $ Map.elems names
-     modnames = filter (\n -> AN.qnameModule n == AN.qnameModule def && n /= def) qnames
- modnames' <- filterM (\n -> do
-   c <- getConstInfo n
-   return (case theDef c of
-            Axiom{} -> True
-            Function{} -> True
-            _ -> False
-          )
-  ) modnames
- return $ map (\x -> (False, x)) modnames'
+  scope <- clScope . getMetaInfo <$> lookupMeta mi
+  let names     = Scope.nsNames $ Scope.everythingInScope scope
+      qnames    = map (Scope.anameName . head) $ Map.elems names
+      modnames  = filter (\n -> AN.qnameModule n == AN.qnameModule def && n /= def) qnames
+  map (False,) <$> do
+    (`filterM` modnames) $ \ n -> do
+      c <- getConstInfo n
+      case theDef c of
+        Axiom{}    -> return True
+        Function{} -> return True
+        _          -> return False
+
 autohints _ _ _ = return []
 
+insuffsols :: Int -> String
 insuffsols 0 = "No solution found"
 insuffsols n = "Only " ++ show n ++ " solution(s) found"
 
+insuffcands :: Int -> String
 insuffcands 0 = "No candidate found"
 insuffcands n = "Only " ++ show n ++ " candidate(s) found"
 
diff --git a/src/full/Agda/Auto/CaseSplit.hs b/src/full/Agda/Auto/CaseSplit.hs
index 085aca9..5720314 100644
--- a/src/full/Agda/Auto/CaseSplit.hs
+++ b/src/full/Agda/Auto/CaseSplit.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE Rank2Types          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.Auto.CaseSplit where
@@ -14,21 +14,23 @@ import Agda.Auto.Syntax
 import Agda.Auto.SearchControl
 import Agda.Auto.Typecheck
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 abspatvarname :: String
 abspatvarname = "\0absurdPattern"
 
+costCaseSplitVeryHigh, costCaseSplitHigh, costCaseSplitLow, costAddVarDepth
+  :: Nat
 costCaseSplitVeryHigh = 10000
-costCaseSplitHigh = 5000
-costCaseSplitLow = 2000
-costAddVarDepth = 1000
-
+costCaseSplitHigh     = 5000
+costCaseSplitLow      = 2000
+costAddVarDepth       = 1000
 
 data HI a = HI FMode a
-drophid = map (\(HI _ x) -> x)
 
+drophid :: [HI a] -> [a]
+drophid = map (\(HI _ x) -> x)
 
 type CSPat o = HI (CSPatI o)
 type CSCtx o = [HI (MId, MExp o)]
@@ -195,6 +197,7 @@ caseSplitSearch' branchsearch depthinterval depth recdef ctx tt pats = do
                return $ concat (map (\sol -> map (\sol2 -> sol ++ sol2) sols2) sols)
        _ -> return [] -- split failed "scrut type is not datatype"
      _ -> return [] -- split failed "scrut type is not datatype"
+
 infertypevar :: CSCtx o -> Nat -> MExp o
 infertypevar ctx v = snd $ (drophid ctx) !! v
 replace :: Nat -> Nat -> MExp o -> MExp o -> MExp o
@@ -243,19 +246,17 @@ betareduce e args = case rm args of
 
  ALProj{} -> __IMPOSSIBLE__
 
-
  ALConPar as -> __IMPOSSIBLE__
 
-
+concatargs :: MM (ArgList o) (RefInfo o) -> MArgList o -> MArgList o
 concatargs xs ys = case rm xs of
- ALNil -> ys
- ALCons hid x xs -> mm $ ALCons hid x (concatargs xs ys)
-
- ALProj{} -> __IMPOSSIBLE__
+  ALNil -> ys
 
+  ALCons hid x xs -> mm $ ALCons hid x (concatargs xs ys)
 
- ALConPar as -> mm $ ALConPar (concatargs xs ys)
+  ALProj{} -> __IMPOSSIBLE__
 
+  ALConPar as -> mm $ ALConPar (concatargs xs ys)
 
 eqelr :: Elr o -> Elr o -> Bool
 eqelr (Var v1) (Var v2) = v1 == v2
@@ -437,8 +438,8 @@ freevars = f 0
 
    ALConPar es -> fs n es
 
-
-applyperm :: [Nat] -> CSCtx o -> MExp o -> [CSPat o] -> (CSCtx o, MExp o, [CSPat o])
+applyperm :: [Nat] -> CSCtx o -> MExp o -> [CSPat o] ->
+             (CSCtx o, MExp o, [CSPat o])
 applyperm perm ctx tt pats =
  let ctx1 = map (\(HI hid (id, t)) -> HI hid (id, rename (ren perm) t)) ctx
      ctx2 = map (\i -> ctx1 !! i) perm
@@ -447,6 +448,7 @@ applyperm perm ctx tt pats =
      pats' = map (renamep (ren perm)) pats
  in (ctx3, tt', pats')
 
+ren :: [Nat] -> Nat -> Int
 ren n i = let Just j = findIndex (== i) n in j
 
 rename :: (Nat -> Nat) -> MExp o -> MExp o
diff --git a/src/full/Agda/Auto/Convert.hs b/src/full/Agda/Auto/Convert.hs
index e5beb90..a12e5dd 100644
--- a/src/full/Agda/Auto/Convert.hs
+++ b/src/full/Agda/Auto/Convert.hs
@@ -7,10 +7,9 @@ import Data.IORef
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Control.Monad.State
-import Control.Monad.Error
 
 import qualified Agda.Syntax.Internal as I
-import qualified Agda.Syntax.Common as C
+import qualified Agda.Syntax.Common as Common
 import qualified Agda.Syntax.Abstract.Name as AN
 import qualified Agda.Syntax.Abstract as A
 import qualified Agda.Syntax.Position as SP
@@ -37,8 +36,15 @@ import Agda.Auto.Syntax
 
 import Agda.Auto.CaseSplit hiding (lift)
 
-#include "../undefined.h"
+import Agda.Utils.Except
+  ( Error(strMsg)
+  , ExceptT
+  , MonadError(catchError, throwError)
+  )
+
 import Agda.Utils.Impossible
+#include "undefined.h"
+
 
 norm :: Normalise t => t -> MB.TCM t
 norm x = normalise x
@@ -50,7 +56,11 @@ data TMode = TMAll -- can be extended to distinguish between different modes (al
  deriving Eq
 
 type MapS a b = (Map a b, [a])
+
+initMapS :: MapS a b
 initMapS = (Map.empty, [])
+
+popMapS :: (S -> (a, [b])) -> ((a, [b]) -> S -> S) -> TOM (Maybe b)
 popMapS r w = do (m, xs) <- gets r
                  case xs of
                   [] -> return Nothing
@@ -98,7 +108,7 @@ tomy imi icns typs = do
        cons2 <- mapM (\con -> getConst True con TMAll) cons
        return (Datatype cons2 [], [])
       MB.Record {MB.recFields = fields, MB.recTel = tel} -> do -- the value of recPars seems unreliable or don't know what it signifies
-       let pars n (I.El _ (I.Pi it typ)) = C.Arg (C.domInfo it) (I.var n) :
+       let pars n (I.El _ (I.Pi it typ)) = Common.Arg (Common.domInfo it) (I.var n) :
                                            pars (n - 1) (I.unAbs typ)
            pars n (I.El s (I.Shared p))  = pars n (I.El s (I.derefPtr p))
            pars _ (I.El _ _) = []
@@ -111,7 +121,7 @@ tomy imi icns typs = do
        let Datatype [con] [] = cdcont cc
        lift $ liftIO $ modifyIORef con (\cdef -> cdef {cdtype = contyp'})
 
-       projfcns <- mapM (\name -> getConst False name TMAll) (map C.unArg fields)
+       projfcns <- mapM (\name -> getConst False name TMAll) (map Common.unArg fields)
 
        return (Datatype [con] projfcns, []{-map snd fields-})
       MB.Constructor {MB.conData = dt} -> do
@@ -148,7 +158,7 @@ tomy imi icns typs = do
          modify $ \s -> s {sEqs = (Map.insert (Map.size (fst $ sEqs s)) (Just (False, Meta m, sol')) (fst $ sEqs s), snd $ sEqs s)}
        let tt = MB.jMetaType $ mvJudgement mv
            minfo = getMetaInfo mv
-           localVars = map (snd . C.unDom . ctxEntry) . envContext . clEnv $ minfo
+           localVars = map (snd . Common.unDom . ctxEntry) . envContext . clEnv $ minfo
        (targettype, localVars) <- lift $ withMetaInfo minfo $ do
         vs <- getContextArgs
         let targettype = tt `piApply` permute (takeP (length vs) $ mvPermutation mv) vs
@@ -230,6 +240,7 @@ getConst iscon name mode = do
      modify (\s -> s {sConsts = (Map.insert name (mode, c) cmap, name : snd (sConsts s))})
      return c
 
+getdfv :: I.MetaId -> A.QName -> MB.TCM Common.Nat
 getdfv mainm name = do
  mv <- lookupMeta mainm
  withMetaInfo (getMetaInfo mv) $ getDefFreeVars name
@@ -269,6 +280,7 @@ copatternsNotImplemented :: MB.TCM a
 copatternsNotImplemented = MB.typeError $ MB.NotImplemented $
   "The Agda synthesizer (Agsy) does not support copatterns yet"
 
+tomyClauses :: [I.Clause] -> TOM [([Pat O], MExp O)]
 tomyClauses [] = return []
 tomyClauses (cl:cls) = do
  cl' <- tomyClause cl
@@ -277,6 +289,7 @@ tomyClauses (cl:cls) = do
   Just cl' -> cl' : cls'
   Nothing -> cls'
 
+tomyClause :: I.Clause -> TOM (Maybe ([Pat O], MExp O))
 tomyClause cl@(I.Clause {I.clausePerm = Perm n ps, I.clauseBody = body}) = do
  let pats = I.clausePats cl
  pats' <- mapM tomyPat pats
@@ -285,20 +298,23 @@ tomyClause cl@(I.Clause {I.clausePerm = Perm n ps, I.clauseBody = body}) = do
            Just (body', _) -> Just (pats', body')
            Nothing -> Nothing
 
-tomyPat p = case C.unArg p of
+
+tomyPat :: I.Arg I.Pattern -> TOM (Pat O)
+tomyPat p = case Common.unArg p of
  I.ProjP _ -> lift $ copatternsNotImplemented
  I.VarP n -> return $ PatVar (show n)
  I.DotP _ -> return $ PatVar "_" -- because Agda includes these when referring to variables in the body
  I.ConP con _ pats -> do
   let n = I.conName con
   c <- getConst True n TMAll
-  pats' <- mapM (tomyPat . fmap C.namedThing) pats
+  pats' <- mapM (tomyPat . fmap Common.namedThing) pats
   def <- lift $ getConstInfo n
   cc <- lift $ liftIO $ readIORef c
   let Just npar = fst $ cdorigin cc
   return $ PatConApp c (replicate npar PatExp ++ pats')
  I.LitP _ -> throwError $ strMsg "Auto: Literals in patterns are not supported"
 
+tomyBody :: I.ClauseBodyF I.Term -> TOM (Maybe (MExp O, Int))
 tomyBody (I.Body t) = do
  t <- lift $ norm t
  t' <- tomyExp t
@@ -382,7 +398,7 @@ tomyExp v0 =
       cc  <- lift $ liftIO $ readIORef c
       let Just npar = fst $ cdorigin cc
       return $ NotM $ App Nothing (NotM OKVal) (Const c) (foldl (\x _ -> NotM $ ALConPar x) as' [1..npar])
-    I.Pi (C.Dom info x) b -> do
+    I.Pi (Common.Dom info x) b -> do
       let y    = I.absBody b
           name = I.absName b
       x' <- tomyType x
@@ -408,12 +424,14 @@ tomyExp v0 =
     I.Shared p -> tomyExp $ I.derefPtr p
     I.ExtLam{} -> __IMPOSSIBLE__
 
+tomyExps :: I.Args -> TOM (MM (ArgList O) (RefInfo O))
 tomyExps [] = return $ NotM ALNil
-tomyExps (C.Arg info a : as) = do
+tomyExps (Common.Arg info a : as) = do
  a' <- tomyExp a
  as' <- tomyExps as
  return $ NotM $ ALCons (cnvh info) a' as'
 
+tomyIneq :: MB.Comparison -> Bool
 tomyIneq MB.CmpEq = False
 tomyIneq MB.CmpLeq = True
 
@@ -429,15 +447,16 @@ fmExp m (I.Lit _) = False
 fmExp m (I.Level (I.Max as)) = any (fmLevel m) as
 fmExp m (I.Def _ as) = fmExps m $ I.argsFromElims as
 fmExp m (I.Con _ as) = fmExps m as
-fmExp m (I.Pi x y)  = fmType m (C.unDom x) || fmType m (I.unAbs y)
+fmExp m (I.Pi x y)  = fmType m (Common.unDom x) || fmType m (I.unAbs y)
 fmExp m (I.Sort _) = False
 fmExp m (I.MetaV mid _) = mid == m
 fmExp m (I.DontCare _) = False
 fmExp m (I.Shared p) = fmExp m $ I.derefPtr p
 fmExp m I.ExtLam{} = __IMPOSSIBLE__
 
+fmExps :: I.MetaId -> I.Args -> Bool
 fmExps m [] = False
-fmExps m (a : as) = fmExp m (C.unArg a) || fmExps m as
+fmExps m (a : as) = fmExp m (Common.unArg a) || fmExps m as
 
 fmLevel :: I.MetaId -> I.PlusLevel -> Bool
 fmLevel m I.ClosedLevel{} = False
@@ -449,27 +468,31 @@ fmLevel m (I.Plus _ l) = case l of
 
 -- ---------------------------------------------
 
-cnvh info = case C.getHiding info of
-    C.NotHidden -> NotHidden
-    C.Instance  -> Instance
-    C.Hidden    -> Hidden
-icnvh h = (C.setHiding h' C.defaultArgInfo)
+cnvh :: Common.LensHiding a => a -> FMode
+cnvh info = case Common.getHiding info of
+    Common.NotHidden -> NotHidden
+    Common.Instance  -> Instance
+    Common.Hidden    -> Hidden
+
+icnvh :: FMode -> I.ArgInfo
+icnvh h = (Common.setHiding h' Common.defaultArgInfo)
     where
     h' = case h of
-        NotHidden -> C.NotHidden
-        Instance  -> C.Instance
-        Hidden    -> C.Hidden
+        NotHidden -> Common.NotHidden
+        Instance  -> Common.Instance
+        Hidden    -> Common.Hidden
 
 -- ---------------------------------------------
 
+frommy :: MExp O -> ExceptT String IO I.Term
 frommy = frommyExp
 
-frommyType :: MExp O -> ErrorT String IO I.Type
+frommyType :: MExp O -> ExceptT String IO I.Type
 frommyType e = do
  e' <- frommyExp e
  return $ I.El (I.mkType 0) e'  -- 0 is arbitrary, sort not read by Agda when reifying
 
-frommyExp :: MExp O -> ErrorT String IO I.Term
+frommyExp :: MExp O -> ExceptT String IO I.Term
 frommyExp (Meta m) = do
  bind <- lift $ readIORef $ mbind m
  case bind of
@@ -489,7 +512,7 @@ frommyExp (NotM e) =
         frommyExps n as v
 -}
        (ndrop, h) = case iscon of
-                      Just n -> (n, \ q -> I.Con (I.ConHead q [])) -- TODO: restore fields
+                      Just n -> (n, \ q -> I.Con (I.ConHead q Common.Inductive [])) -- TODO: restore fields
                       Nothing -> (0, \ f vs -> I.Def f $ map I.Apply vs)
    frommyExps ndrop as (h name [])
   Lam hid (Abs mid t) -> do
@@ -498,8 +521,8 @@ frommyExp (NotM e) =
   Pi _ hid _ x (Abs mid y) -> do
    x' <- frommyType x
    y' <- frommyType y
-   return $ I.Pi (C.Dom (icnvh hid) x') (I.Abs (case mid of {NoId -> "x"; Id id -> id}) y')
-   -- maybe have case for Pi where possdep is False which produces Fun (and has to unweaken y), return $ I.Fun (C.Arg (icnvh hid) x') y'
+   return $ I.Pi (Common.Dom (icnvh hid) x') (I.Abs (case mid of {NoId -> "x"; Id id -> id}) y')
+   -- maybe have case for Pi where possdep is False which produces Fun (and has to unweaken y), return $ I.Fun (Common.Arg (icnvh hid) x') y'
   Sort (Set l) ->
    return $ I.Sort (I.mkType (fromIntegral l))
   Sort Type -> __IMPOSSIBLE__
@@ -509,7 +532,7 @@ frommyExp (NotM e) =
    return $ I.Lam (icnvh hid) (I.Abs abslamvarname (I.Var 0 []))
 
 
-frommyExps :: Nat -> MArgList O -> I.Term -> ErrorT String IO I.Term
+frommyExps :: Nat -> MArgList O -> I.Term -> ExceptT String IO I.Term
 frommyExps ndrop (Meta m) trm = do
  bind <- lift $ readIORef $ mbind m
  case bind of
@@ -521,7 +544,7 @@ frommyExps ndrop (NotM as) trm =
   ALCons _ _ xs | ndrop > 0 -> frommyExps (ndrop - 1) xs trm
   ALCons hid x xs -> do
    x' <- frommyExp x
-   frommyExps ndrop xs (addend (C.Arg (icnvh hid) x') trm)
+   frommyExps ndrop xs (addend (Common.Arg (icnvh hid) x') trm)
 
   -- Andreas, 2013-10-19 TODO: restore postfix projections
   ALProj eas idx hid xs -> do
@@ -532,7 +555,7 @@ frommyExps ndrop (NotM as) trm =
    cdef <- lift $ readIORef c
    let name = snd $ cdorigin cdef
    trm2 <- frommyExps 0 eas (I.Def name [])
-   frommyExps 0 xs (addend (C.Arg (icnvh hid) trm) trm2)
+   frommyExps 0 xs (addend (Common.Arg (icnvh hid) trm) trm2)
 
   ALConPar xs | ndrop > 0 -> frommyExps (ndrop - 1) xs trm
   ALConPar _ -> __IMPOSSIBLE__
@@ -545,15 +568,16 @@ frommyExps ndrop (NotM as) trm =
 
 -- --------------------------------
 
+abslamvarname :: String
 abslamvarname = "\0absurdlambda"
 
 modifyAbstractExpr :: A.Expr -> A.Expr
 modifyAbstractExpr = f
  where
-  f (A.App i e1 (C.Arg info (C.Named n e2))) =
-        A.App i (f e1) (C.Arg info (C.Named n (f e2)))
-  f (A.Lam i (A.DomainFree info n) _) | show n == abslamvarname =
-        A.AbsurdLam i $ C.argInfoHiding info
+  f (A.App i e1 (Common.Arg info (Common.Named n e2))) =
+        A.App i (f e1) (Common.Arg info (Common.Named n (f e2)))
+  f (A.Lam i (A.DomainFree info n) _) | show (A.nameConcrete n) == abslamvarname =
+        A.AbsurdLam i $ Common.argInfoHiding info
   f (A.Lam i b e) = A.Lam i b (f e)
   f (A.Rec i xs) = A.Rec i (map (\(n, e) -> (n, f e)) xs)
   f (A.RecUpdate i e xs) = A.RecUpdate i (f e) (map (\(n, e) -> (n, f e)) xs)
@@ -575,8 +599,8 @@ constructPats cmap mainm clause = do
       (ns'', p') <- cnvp ns' p
       return (ns'', p' : ps')
      cnvp ns p =
-      let hid = cnvh $ C.argInfo p
-      in case C.namedArg p of
+      let hid = cnvh $ Common.argInfo p
+      in case Common.namedArg p of
        I.VarP n -> return ((hid, Id n) : ns, HI hid (CSPatVar $ length ns))
        I.ConP con _ ps -> do
         let c = I.conName con
@@ -594,14 +618,14 @@ constructPats cmap mainm clause = do
  return (reverse names, pats)
 
 
-frommyClause :: (CSCtx O, [CSPat O], Maybe (MExp O)) -> ErrorT String IO I.Clause
+frommyClause :: (CSCtx O, [CSPat O], Maybe (MExp O)) -> ExceptT String IO I.Clause
 frommyClause (ids, pats, mrhs) = do
  let ctel [] = return I.EmptyTel
      ctel (HI hid (mid, t) : ctx) = do
       let Id id = mid
       tel <- ctel ctx
       t' <- frommyType t
-      return $ I.ExtendTel (C.Dom (icnvh hid) t') (I.Abs id tel)
+      return $ I.ExtendTel (Common.Dom (icnvh hid) t') (I.Abs id tel)
  tel <- ctel $ reverse ids
  let getperms 0 [] perm nv = return (perm, nv)
      getperms n [] _ _ = __IMPOSSIBLE__
@@ -642,14 +666,14 @@ frommyClause (ids, pats, mrhs) = do
         cdef <- lift $ readIORef c
         let (Just ndrop, name) = cdorigin cdef
         ps' <- cnvps ndrop ps
-        let con = I.ConHead name [] -- TODO: restore record fields!
+        let con = I.ConHead name Common.Inductive [] -- TODO: restore record fields!
         return (I.ConP con Nothing ps')
        CSPatExp e -> do
         e' <- frommyExp e {- renm e -} -- renaming before adding to clause below
         return (I.DotP e')
        CSAbsurd -> __IMPOSSIBLE__ -- CSAbsurd not used
        _ -> __IMPOSSIBLE__
-      return $ C.Arg (icnvh hid) $ C.unnamed p'   -- TODO: recover names
+      return $ Common.Arg (icnvh hid) $ Common.unnamed p'   -- TODO: recover names
  ps <- cnvps 0 pats
  body <- case mrhs of
           Nothing -> return $ I.NoBody
@@ -747,13 +771,13 @@ findClauseDeep m = do
       I.Level (I.Max as) -> any (fmLevel m) as
       I.Def _ es -> findMetas $ I.argsFromElims es
       I.Con _ as -> findMetas as
-      I.Pi it ot -> findMetat (C.unDom it) || findMetat (I.unAbs ot)
+      I.Pi it ot -> findMetat (Common.unDom it) || findMetat (I.unAbs ot)
       I.Sort{} -> False
       I.MetaV m' _  -> m == m'
       I.DontCare _ -> False
       I.Shared{} -> __IMPOSSIBLE__
       I.ExtLam{} -> __IMPOSSIBLE__
-    findMetas = any (findMeta . C.unArg)
+    findMetas = any (findMeta . Common.unArg)
     findMetat (I.El _ e) = findMeta e
     toplevel e =
      case I.ignoreSharing e of
@@ -793,15 +817,15 @@ matchType cdfv tctx ctyp ttyp = trmodps cdfv ctyp
       (I.Lit lit1, I.Lit lit2) | lit1 == lit2 -> c (n + 1)
       (I.Def n1 as1, I.Def n2 as2) | n1 == n2 -> fes nl (n + 1) c as1 as2
       (I.Con n1 as1, I.Con n2 as2) | n1 == n2 -> fs nl (n + 1) c as1 as2
-      (I.Pi (C.Dom info1 it1) ot1, I.Pi (C.Dom info2 it2) ot2) | C.argInfoHiding info1 == C.argInfoHiding info2 -> ft nl n (\n -> ft (nl + 1) n c (I.absBody ot1) (I.absBody ot2)) it1 it2
+      (I.Pi (Common.Dom info1 it1) ot1, I.Pi (Common.Dom info2 it2) ot2) | Common.argInfoHiding info1 == Common.argInfoHiding info2 -> ft nl n (\n -> ft (nl + 1) n c (I.absBody ot1) (I.absBody ot2)) it1 it2
       (I.Sort{}, I.Sort{}) -> c n -- sloppy
       _ -> Nothing
     fs nl n c es1 es2 = case (es1, es2) of
      ([], []) -> c n
-     (C.Arg info1 e1 : es1, C.Arg info2 e2 : es2) | C.argInfoHiding info1 == C.argInfoHiding info2 -> f nl n (\n -> fs nl n c es1 es2) e1 e2
+     (Common.Arg info1 e1 : es1, Common.Arg info2 e2 : es2) | Common.argInfoHiding info1 == Common.argInfoHiding info2 -> f nl n (\n -> fs nl n c es1 es2) e1 e2
      _ -> Nothing
     fes nl n c es1 es2 = case (es1, es2) of
      ([], []) -> c n
      (I.Proj f : es1, I.Proj f' : es2) | f == f' -> fes nl n c es1 es2
-     (I.Apply (C.Arg info1 e1) : es1, I.Apply (C.Arg info2 e2) : es2) | C.argInfoHiding info1 == C.argInfoHiding info2 -> f nl n (\n -> fes nl n c es1 es2) e1 e2
+     (I.Apply (Common.Arg info1 e1) : es1, I.Apply (Common.Arg info2 e2) : es2) | Common.argInfoHiding info1 == Common.argInfoHiding info2 -> f nl n (\n -> fes nl n c es1 es2) e1 e2
      _ -> Nothing
diff --git a/src/full/Agda/Auto/NarrowingSearch.hs b/src/full/Agda/Auto/NarrowingSearch.hs
index d2cbc73..8e60324 100644
--- a/src/full/Agda/Auto/NarrowingSearch.hs
+++ b/src/full/Agda/Auto/NarrowingSearch.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE FunctionalDependencies    #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE Rank2Types                #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+-- {-# LANGUAGE UndecidableInstances      #-}
 
 module Agda.Auto.NarrowingSearch where
 
@@ -13,7 +13,7 @@ import Data.IORef hiding (writeIORef, modifyIORef)
 import qualified Data.IORef as NoUndo (writeIORef, modifyIORef)
 import Control.Monad.State
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Prio = Int
diff --git a/src/full/Agda/Auto/SearchControl.hs b/src/full/Agda/Auto/SearchControl.hs
index a4789d0..ad7d69d 100644
--- a/src/full/Agda/Auto/SearchControl.hs
+++ b/src/full/Agda/Auto/SearchControl.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 module Agda.Auto.SearchControl where
 
@@ -14,7 +14,7 @@ import Data.Maybe (mapMaybe)
 import Agda.Auto.NarrowingSearch
 import Agda.Auto.Syntax
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 instance Refinable (ArgList o) (RefInfo o) where
@@ -53,12 +53,17 @@ data ExpRefInfo o = ExpRefInfo {eriMain :: Maybe (RefInfo o), eriUnifs :: [RefIn
 
                                }
 
-getinfo = f (ExpRefInfo {eriMain = Nothing, eriUnifs = [], eriInfTypeUnknown = False, eriIsEliminand = False, eriUsedVars = Nothing,
-                         eriIotaStep = Nothing, eriPickSubsVar = False
-
-                         , eriEqRState = Nothing
-
-                        })
+getinfo :: [RefInfo o] -> ExpRefInfo o
+getinfo = f (ExpRefInfo {eriMain = Nothing
+                        , eriUnifs = []
+                        , eriInfTypeUnknown = False
+                        , eriIsEliminand = False
+                        , eriUsedVars = Nothing
+                        , eriIotaStep = Nothing
+                        , eriPickSubsVar = False
+                        , eriEqRState = Nothing
+                        }
+            )
  where
   f i [] = i
   f i (x at RIMainInfo{} : xs) = f (i {eriMain = Just x}) xs
@@ -259,7 +264,8 @@ instance Refinable (Exp o) (RefInfo o) where
       HNSort _ -> generics
    _ -> __IMPOSSIBLE__
 
-
+extraref :: UId o -> [Maybe (UId o)] -> ConstRef o ->
+            (Int, StateT (IORef [SubConstraints (RefInfo o)], Int) IO (Exp o))
 extraref meta seenuids c = (costAppExtraRef, app (head seenuids) (Const c))
  where
    app muid elr = do p <- newPlaceholder
@@ -282,7 +288,14 @@ instance Refinable (ConstRef o) (RefInfo o) where
 
 
 -- ---------------------------------
-costIotaStep, costAppExtraRef, costIncrease :: Int
+
+costIncrease, costUnificationOccurs, costUnification, costAppVar,
+  costAppVarUsed, costAppHint, costAppHintUsed, costAppRecCall,
+  costAppRecCallUsed, costAppConstructor, costAppConstructorSingle,
+  costAppExtraRef, costLam, costLamUnfold, costPi, costSort, costIotaStep,
+  costInferredTypeUnkown, costAbsurdLam
+  :: Int
+
 costIncrease = 1000
 costUnificationOccurs = 100 -- 1000001 -- 1 -- 100
 costUnification = 0000
@@ -303,17 +316,19 @@ costIotaStep = 3000 -- 1000005 -- 2 -- 100
 costInferredTypeUnkown = 1000006 -- 100
 costAbsurdLam = 0
 
+costEqStep, costEqEnd, costEqSym, costEqCong :: Int
 costEqStep = 2000
 costEqEnd = 0
 costEqSym = 0
 costEqCong = 500
 
-
-prioNo, prioTypeUnknown, prioTypecheckArgList, prioInferredTypeUnknown, prioCompBeta, prioCompBetaStructured, prioCompareArgList, prioCompIota, prioCompChoice, prioCompUnif, prioCompCopy, prioNoIota, prioAbsurdLambda :: Int
+prioNo, prioTypeUnknown, prioTypecheckArgList, prioInferredTypeUnknown,
+  prioCompBeta, prioCompBetaStructured, prioCompareArgList, prioCompIota,
+  prioCompChoice, prioCompUnif, prioCompCopy, prioNoIota, prioAbsurdLambda,
+  prioProjIndex
+  :: Int
 prioNo = (-1)
 prioTypeUnknown = 0
-prioTypecheck False = 1000
-prioTypecheck True = 0
 prioTypecheckArgList = 3000
 prioInferredTypeUnknown = 4000
 prioCompBeta = 4000
@@ -326,8 +341,11 @@ prioCompareArgList = 7000 -- 5 -- 2
 prioNoIota = 500 -- 500
 prioAbsurdLambda = 1000
 
-prioProjIndex = 3000 :: Int
+prioProjIndex = 3000
 
+prioTypecheck :: Bool -> Int
+prioTypecheck False = 1000
+prioTypecheck True = 0
 
 -- ---------------------------------
 
diff --git a/src/full/Agda/Auto/Syntax.hs b/src/full/Agda/Auto/Syntax.hs
index 606b774..849c382 100644
--- a/src/full/Agda/Auto/Syntax.hs
+++ b/src/full/Agda/Auto/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
 
 module Agda.Auto.Syntax where
@@ -7,7 +7,7 @@ import Data.IORef
 
 import Agda.Auto.NarrowingSearch
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Unique identifiers for variable occurrences in unification.
@@ -152,10 +152,9 @@ data Exp o
   | AbsurdLambda FMode
     -- ^ Absurd lambda with hiding information.
 
-
+dontCare :: Exp o
 dontCare = Sort UnknownSort
 
-
 -- | "Maybe expression":  Expression or reference to meta variable.
 type MExp o = MM (Exp o) (RefInfo o)
 
diff --git a/src/full/Agda/Auto/Typecheck.hs b/src/full/Agda/Auto/Typecheck.hs
index 945af09..f4284f0 100644
--- a/src/full/Agda/Auto/Typecheck.hs
+++ b/src/full/Agda/Auto/Typecheck.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
 
 module Agda.Auto.Typecheck where
 
@@ -12,7 +12,7 @@ import Agda.Auto.NarrowingSearch
 import Agda.Auto.Syntax
 import Agda.Auto.SearchControl
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- ---------------------------------
@@ -149,8 +149,8 @@ traversePi v t =
   HNPi _ _ _ _ (Abs _ ot) -> traversePi (v - 1) (subi (NotM $ App Nothing (NotM OKVal) (Var v) (NotM ALNil)) ot)
   _ -> mbret hnt
 
-
-tcargs :: Nat -> Bool -> Ctx o -> CExp o -> MArgList o -> MExp o -> Bool -> (CExp o -> MExp o -> EE (MyPB o)) -> EE (MyPB o)
+tcargs :: Nat -> Bool -> Ctx o -> CExp o -> MArgList o -> MExp o -> Bool ->
+          (CExp o -> MExp o -> EE (MyPB o)) -> EE (MyPB o)
 tcargs ndfv isdep ctx ityp@(TrBr ityptrs iityp) args elimtrm isconstructor cont = mmpcase (True, prioTypecheckArgList, (Just $ RICheckElim $ isdep || isconstructor)) args $ \args' -> case args' of
  ALNil -> cont ityp elimtrm
  ALCons hid a as ->
@@ -193,23 +193,26 @@ tcargs ndfv isdep ctx ityp@(TrBr ityptrs iityp) args elimtrm isconstructor cont
  where
   t = TrBr ityptrs
 
-
+addend :: FMode -> MExp o -> MM (Exp o) blk -> MM (Exp o) blk
 addend hid a (NotM (App uid okh elr as)) = NotM $ App uid okh elr (f as)
- where f (NotM ALNil) = NotM $ ALCons hid a (NotM $ ALNil)
-       f (NotM (ALCons hid a as)) = NotM $ ALCons hid a (f as)
-       f _ = __IMPOSSIBLE__
+ where
+   f (NotM ALNil)             = NotM $ ALCons hid a (NotM $ ALNil)
+   f (NotM (ALCons hid a as)) = NotM $ ALCons hid a (f as)
+   f _                        = __IMPOSSIBLE__
 addend _ _ _ = __IMPOSSIBLE__
-copyarg _ = False
 
+copyarg :: MExp o -> Bool
+copyarg _ = False
 
 -- ---------------------------------
 
-
 type HNNBlks o = [HNExp o]
 
+noblks :: HNNBlks o
 noblks = []
-addblk = (:)
 
+addblk :: HNExp o -> HNNBlks o -> HNNBlks o
+addblk = (:)
 
 hnn :: ICExp o -> EE (MyMB (HNExp o) o)
 hnn e = mbcase (hnn_blks e) $ \(hne, _) -> mbret hne
@@ -684,7 +687,8 @@ checkeliminand = f [] []
 
 -- ---------------------------------
 
-
+maybeor :: Bool -> Int -> IO (PB (RefInfo o)) -> IO (PB (RefInfo o)) ->
+           IO (PB (RefInfo o))
 maybeor _ _ mainalt _ = mainalt
 
 iotapossmeta :: ICExp o -> ICArgList o -> EE Bool
diff --git a/src/full/Agda/Compiler/CallCompiler.hs b/src/full/Agda/Compiler/CallCompiler.hs
index ca485ba..6c3e441 100644
--- a/src/full/Agda/Compiler/CallCompiler.hs
+++ b/src/full/Agda/Compiler/CallCompiler.hs
@@ -15,7 +15,7 @@ import System.Process
 
 import Agda.TypeChecking.Monad
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Calls a compiler:
diff --git a/src/full/Agda/Compiler/Epic/AuxAST.hs b/src/full/Agda/Compiler/Epic/AuxAST.hs
index 534207b..fd550d9 100644
--- a/src/full/Agda/Compiler/Epic/AuxAST.hs
+++ b/src/full/Agda/Compiler/Epic/AuxAST.hs
@@ -5,13 +5,13 @@
 module Agda.Compiler.Epic.AuxAST where
 
 import Data.Set (Set)
-import qualified Data.Set as S
+import qualified Data.Set as Set
 
 import Agda.Syntax.Abstract.Name
 
 import Agda.Compiler.Epic.Interface
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Comment  = String
@@ -145,24 +145,24 @@ substBranch x e br = br { brExpr = subst x e (brExpr br) }
 
 -- | Get the free variables in an expression
 fv :: Expr -> [Var]
-fv = S.toList . fv'
+fv = Set.toList . fv'
   where
     fv' :: Expr -> Set Var
     fv' expr = case expr of
-      Var v    -> S.singleton v
-      Lit _    -> S.empty
-      Lam v e1 -> S.delete v (fv' e1)
-      Con _ _ es -> S.unions (map fv' es)
-      App v es -> S.insert v $ S.unions (map fv' es)
-      Case e brs -> fv' e `S.union` S.unions (map fvBr brs)
-      If a b c   -> S.unions (map fv' [a,b,c])
-      Let v e e' -> fv' e `S.union` (S.delete v $ fv' e')
+      Var v      -> Set.singleton v
+      Lit _      -> Set.empty
+      Lam v e1   -> Set.delete v (fv' e1)
+      Con _ _ es -> Set.unions (map fv' es)
+      App v es   -> Set.insert v $ Set.unions (map fv' es)
+      Case e brs -> fv' e `Set.union` Set.unions (map fvBr brs)
+      If a b c   -> Set.unions (map fv' [a,b,c])
+      Let v e e' -> fv' e `Set.union` (Set.delete v $ fv' e')
       Lazy e     -> fv' e
-      UNIT       -> S.empty
-      IMPOSSIBLE -> S.empty
+      UNIT       -> Set.empty
+      IMPOSSIBLE -> Set.empty
 
     fvBr :: Branch -> Set Var
     fvBr b = case b of
-      Branch _ _ vs e -> fv' e S.\\ S.fromList vs
+      Branch _ _ vs e -> fv' e Set.\\ Set.fromList vs
       BrInt _ e       -> fv' e
       Default e       -> fv' e
diff --git a/src/full/Agda/Compiler/Epic/CompileState.hs b/src/full/Agda/Compiler/Epic/CompileState.hs
index 676e6fb..7f7bf69 100644
--- a/src/full/Agda/Compiler/Epic/CompileState.hs
+++ b/src/full/Agda/Compiler/Epic/CompileState.hs
@@ -7,12 +7,12 @@ module Agda.Compiler.Epic.CompileState where
 import Control.Applicative
 import Control.Monad.State
 import Data.List
-import Data.Map(Map)
-import qualified Data.Map as M
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
-import Data.Set(Set)
-import qualified Data.Set as S
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 import Agda.Compiler.Epic.AuxAST as AuxAST
 import Agda.Compiler.Epic.Interface
@@ -20,13 +20,14 @@ import Agda.Interaction.Options
 import Agda.Syntax.Internal
 import Agda.Syntax.Concrete(TopLevelModuleName)
 import Agda.Syntax.Common
-import Agda.TypeChecking.Monad (TCM, internalError, defType, theDef, getConstInfo, sigDefinitions, stImports, stPersistentOptions, stPersistent)
+import Agda.TypeChecking.Monad (TCM, internalError, defType, theDef, getConstInfo, sigDefinitions, stImports, stPersistentOptions, stPersistentState)
 import qualified Agda.TypeChecking.Monad as TM
 import Agda.TypeChecking.Reduce
 
 import qualified Agda.Utils.HashMap as HM
+import Agda.Utils.Lens
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Stuff we need in our compiler
@@ -42,7 +43,7 @@ data CompileState = CompileState
 initCompileState :: CompileState
 initCompileState = CompileState
     { nameSupply        = map (('h':) . show) [0 :: Integer ..]
-    , compiledModules   = M.empty
+    , compiledModules   = Map.empty
     , curModule         = mempty
     , importedModules   = mempty
     , curFun            = undefined
@@ -66,7 +67,7 @@ getsEI f = gets (f . curModule)
 -- | Returns the type of a definition given its name
 getType :: QName -> Compile TCM Type
 getType q = do
-    map <- lift (gets (sigDefinitions . stImports))
+    map <- lift (sigDefinitions <$> use stImports)
     return $ maybe __IMPOSSIBLE__ defType (HM.lookup q map)
 
 -- | Create a name which can be used in Epic code from a QName.
@@ -81,10 +82,10 @@ resetNameSupply :: Compile TCM ()
 resetNameSupply = modify $ \s -> s {nameSupply = nameSupply initCompileState}
 
 getDelayed :: QName -> Compile TCM Bool
-getDelayed q = lookInterface (M.lookup q . defDelayed) (return False)
+getDelayed q = lookInterface (Map.lookup q . defDelayed) (return False)
 
 putDelayed :: QName -> Bool -> Compile TCM ()
-putDelayed q d = modifyEI $ \s -> s {defDelayed = M.insert q d (defDelayed s)}
+putDelayed q d = modifyEI $ \s -> s {defDelayed = Map.insert q d (defDelayed s)}
 
 newName :: Compile TCM Var
 newName = do
@@ -93,7 +94,7 @@ newName = do
     return n
 
 putConstrTag :: QName -> Tag -> Compile TCM ()
-putConstrTag q t = modifyEI $ \s -> s { constrTags = M.insert q t $ constrTags s }
+putConstrTag q t = modifyEI $ \s -> s { constrTags = Map.insert q t $ constrTags s }
 
 assignConstrTag :: QName -> Compile TCM Tag
 assignConstrTag constr = assignConstrTag' constr []
@@ -108,7 +109,7 @@ assignConstrTag' constr constrs = do
 
 getConData :: QName -> Compile TCM QName
 getConData con = do
-    lmap <- lift (gets (TM.sigDefinitions . TM.stImports))
+    lmap <- lift (TM.sigDefinitions <$> use TM.stImports)
     case HM.lookup con lmap of
         Just def -> case theDef def of
             c@(TM.Constructor{}) -> return $ TM.conData c
@@ -117,7 +118,7 @@ getConData con = do
 
 getDataCon :: QName -> Compile TCM [QName]
 getDataCon con = do
-    lmap <- lift (gets (TM.sigDefinitions . TM.stImports))
+    lmap <- lift (TM.sigDefinitions <$> use TM.stImports)
     case HM.lookup con lmap of
         Just def -> case theDef def of
             d@(TM.Datatype{}) -> return $ TM.dataCons d
@@ -126,30 +127,30 @@ getDataCon con = do
         Nothing -> __IMPOSSIBLE__
 
 getConstrTag :: QName -> Compile TCM Tag
-getConstrTag con = lookInterface (M.lookup con . constrTags)
+getConstrTag con = lookInterface (Map.lookup con . constrTags)
                                  (assignConstrTag con)
 
 getConstrTag' :: QName -> Compile TCM (Maybe Tag)
 getConstrTag' con = do
     cur <- gets curModule
-    case M.lookup con (constrTags cur) of
+    case Map.lookup con (constrTags cur) of
         Just x -> return (Just x)
         Nothing -> do
             imps <- gets importedModules
-            return $ M.lookup con (constrTags imps)
+            return $ Map.lookup con (constrTags imps)
 
 addDefName :: QName -> Compile TCM ()
 addDefName q = do
-    modifyEI $ \s -> s {definitions = S.insert (unqname q) $ definitions s }
+    modifyEI $ \s -> s {definitions = Set.insert (unqname q) $ definitions s }
 
 topBindings :: Compile TCM (Set Var)
-topBindings = S.union <$> gets (definitions . importedModules) <*> gets (definitions . curModule)
+topBindings = Set.union <$> gets (definitions . importedModules) <*> gets (definitions . curModule)
 
 getConArity :: QName -> Compile TCM Int
-getConArity n = lookInterface (M.lookup n . conArity) __IMPOSSIBLE__
+getConArity n = lookInterface (Map.lookup n . conArity) __IMPOSSIBLE__
 
 putConArity :: QName -> Int -> Compile TCM ()
-putConArity n p = modifyEI $ \s -> s { conArity = M.insert n p (conArity s) }
+putConArity n p = modifyEI $ \s -> s { conArity = Map.insert n p (conArity s) }
 
 putMain :: QName -> Compile TCM ()
 putMain m = modifyEI $ \s -> s { mainName = Just m }
@@ -171,23 +172,23 @@ lookInterface f def = do
 constrInScope :: QName -> Compile TCM Bool
 constrInScope name = do
     cur <- gets curModule
-    case M.lookup name (constrTags cur) of
+    case Map.lookup name (constrTags cur) of
         Just x -> return True
         Nothing -> do
             imps <- gets importedModules
-            case M.lookup name (constrTags imps) of
+            case Map.lookup name (constrTags imps) of
                 Nothing -> return False
                 Just x  -> return True
 
 getForcedArgs :: QName -> Compile TCM ForcedArgs
-getForcedArgs q = lookInterface (M.lookup q . forcedArgs) __IMPOSSIBLE__
+getForcedArgs q = lookInterface (Map.lookup q . forcedArgs) __IMPOSSIBLE__
 
 putForcedArgs :: QName -> ForcedArgs -> Compile TCM ()
 putForcedArgs n f = do
-  b <- lift $ gets (optForcing . stPersistentOptions . stPersistent)
+  b <- lift $ gets (optForcing . stPersistentOptions . stPersistentState)
   let f' | b = f
          | otherwise = replicate (length f) NotForced
-  modifyEI $ \s -> s {forcedArgs = M.insert n f' $ forcedArgs s}
+  modifyEI $ \s -> s {forcedArgs = Map.insert n f' $ forcedArgs s}
 
 replaceAt :: Int -- ^ replace at
           -> [a] -- ^ to replace
diff --git a/src/full/Agda/Compiler/Epic/Compiler.hs b/src/full/Agda/Compiler/Epic/Compiler.hs
index 315118b..6af3220 100644
--- a/src/full/Agda/Compiler/Epic/Compiler.hs
+++ b/src/full/Agda/Compiler/Epic/Compiler.hs
@@ -7,12 +7,14 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.State
+
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.Map as M
-import Data.Set(Set)
-import qualified Data.Set as S
+import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
+import Data.Set (Set)
+import qualified Data.Set as Set
+
 import System.Directory ( canonicalizePath, createDirectoryIfMissing
                         , getCurrentDirectory, setCurrentDirectory
                         )
@@ -21,18 +23,20 @@ import System.FilePath hiding (normalise)
 import System.Process hiding (env)
 
 import Paths_Agda
-import Agda.Compiler.CallCompiler
+
 import Agda.Interaction.FindFile
 import Agda.Interaction.Options
 import Agda.Interaction.Imports
+
 import Agda.Syntax.Common (Delayed(..))
 import qualified Agda.Syntax.Concrete.Name as CN
 import Agda.Syntax.Internal hiding (Term(..))
+
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.Monad.Builtin
 import Agda.TypeChecking.Serialise
-import Agda.Utils.FileName
-import qualified Agda.Utils.HashMap as HMap
+
+import Agda.Compiler.CallCompiler
 
 import Agda.Compiler.Epic.CompileState
 import qualified Agda.Compiler.Epic.CaseOpts     as COpts
@@ -47,7 +51,12 @@ import qualified Agda.Compiler.Epic.NatDetection as ND
 import qualified Agda.Compiler.Epic.Primitive    as Prim
 import qualified Agda.Compiler.Epic.Smashing     as Smash
 
-#include "../../undefined.h"
+import Agda.Utils.FileName
+import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.List
+import Agda.Utils.Pretty ( prettyShow )
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 compilePrelude :: Compile TCM ()
@@ -74,7 +83,7 @@ compilerMain inter = do
             setEpicDir inter
             (_, imports) <- compileModule inter
             main <- getMain
-            runEpicMain main (S.toList imports) (iModuleName inter)
+            runEpicMain main (Set.toList imports) (iModuleName inter)
 
         ExitFailure _ -> internalError $ unlines
            [ "Agda cannot find the Epic compiler."
@@ -101,14 +110,14 @@ compileModule i = do
     cm <- gets compiledModules
     let moduleName = toTopLevelModuleName $ iModuleName i
     file  <- outFile moduleName
-    case M.lookup moduleName cm of
+    case Map.lookup moduleName cm of
         Just eifs -> return eifs
         Nothing  -> do
             imports <- map miInterface . catMaybes
                                       <$> mapM (lift . getVisitedModule . toTopLevelModuleName . fst)
                                                (iImportedModules i)
             (ifaces, limps) <- mapAndUnzipM compileModule imports
-            let imps = S.unions limps
+            let imps = Set.unions limps
             modify $ \s -> s { importedModules = importedModules s `mappend` mconcat ifaces }
             ifile <- maybe __IMPOSSIBLE__ filePath <$> lift (findInterfaceFile moduleName)
             let eifFile = file <.> "aei"
@@ -116,28 +125,28 @@ compileModule i = do
             (eif, imps') <- case uptodate of
                 True  -> do
                     lift $ reportSLn "" 1 $
-                        show (iModuleName i) ++ " : no compilation is needed."
+                      (prettyShow . iModuleName) i ++ " : no compilation is needed."
                     eif <- readEInterface eifFile
                     modify $ \s -> s { curModule = eif }
-                    return (eif, S.insert file imps)
+                    return (eif, Set.insert file imps)
                 False -> do
                     lift $ reportSLn "" 1 $
-                        "Compiling: " ++ show (iModuleName i)
+                        "Compiling: " ++ (prettyShow . iModuleName) i
                     resetNameSupply
                     initialAnalysis i
                     let defns = HMap.toList $ sigDefinitions $ iSignature i
                     -- Epic cannot parse files with no definitions
                     if (not $ null defns) then do
                         code <- compileDefns defns
-                        runEpic file (S.toList imps) code
+                        runEpic file (Set.toList imps) code
                         eif <- gets curModule
                         lift $ do
                             bif <- encode eif
                             liftIO $ BS.writeFile eifFile bif
-                        return (eif, S.insert file imps)
+                        return (eif, Set.insert file imps)
                      else
                         flip (,) imps <$> gets curModule
-            modify $ \s -> s { compiledModules = (M.insert moduleName (eif, imps') (compiledModules s))}
+            modify $ \s -> s { compiledModules = (Map.insert moduleName (eif, imps') (compiledModules s))}
             return (eif, imps')
 
 -- | Before running the compiler, we need to store some things in the state,
@@ -162,7 +171,7 @@ initialAnalysis inter = do
         putForcedArgs q . drop np . ForceC.makeForcedArgs $ defType def
         putConArity q =<< lift (constructorArity q)
       f@(Function{}) -> do
-        when ("main" == show (qnameName q)) $ do
+        when ("main" == (prettyShow . qnameName) q) $ do
             -- lift $ liftTCM $ checkTypeOfMain q (defType def)
             putMain q
         putDelayed q $ case funDelayed f of
@@ -174,6 +183,7 @@ initialAnalysis inter = do
           _       -> return ()
       _ -> return ()
 
+idPrint :: String -> (a -> Compile TCM b) -> a -> Compile TCM b
 idPrint s m x = do
   lift $ reportSLn "epic.phases" 10 s
   m x
@@ -202,7 +212,7 @@ setEpicDir mainI = do
     let tm = toTopLevelModuleName $ iModuleName mainI
     f <- lift $ findFile tm
     compileDir' <- lift $ gets (fromMaybe (filePath $ CN.projectRoot f tm) .
-                                  optCompileDir . stPersistentOptions . stPersistent)
+                                  optCompileDir . stPersistentOptions . stPersistentState)
     compileDir <- liftIO $ canonicalizePath compileDir'
     liftIO $ setCurrentDirectory compileDir
     liftIO $ createDirectoryIfMissing False "Epic"
@@ -232,12 +242,13 @@ runEpicMain mainName imports m = do
                        | imp <- imports'
                        ] ++ "main() -> Unit = init() ; " ++ mainName ++ "(unit)"
     liftIO $ writeFile ("main" <.> "e") code
-    let outputName  = case mnameToList m of
-          [] -> __IMPOSSIBLE__
-          ms -> last ms
+
+    let outputName :: CN.Name
+        outputName = maybe __IMPOSSIBLE__ nameConcrete $ lastMaybe $ mnameToList m
+
     callEpic'  $ \epic ->
         [ "main" <.> "e"
-        , "-o", ".." </> show outputName
+        , "-o", ".." </> prettyShow outputName
         ]
         ++ epic ++ map (<.> "o") imports'
 
diff --git a/src/full/Agda/Compiler/Epic/Epic.hs b/src/full/Agda/Compiler/Epic/Epic.hs
index 676580f..be9f8e3 100644
--- a/src/full/Agda/Compiler/Epic/Epic.hs
+++ b/src/full/Agda/Compiler/Epic/Epic.hs
@@ -15,7 +15,7 @@ import Agda.Compiler.Epic.AuxAST
 import Agda.Compiler.Epic.CompileState
 import Agda.Compiler.Epic.Interface
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- * Some auxilliary pretty-printer functions
diff --git a/src/full/Agda/Compiler/Epic/Erasure.hs b/src/full/Agda/Compiler/Epic/Erasure.hs
index 1445706..3759940 100644
--- a/src/full/Agda/Compiler/Epic/Erasure.hs
+++ b/src/full/Agda/Compiler/Epic/Erasure.hs
@@ -14,8 +14,8 @@ module Agda.Compiler.Epic.Erasure where
 
 import Control.Applicative
 import Control.Monad.State
-import Data.Map(Map)
-import qualified Data.Map as M
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Maybe
 
 import Agda.Compiler.Epic.AuxAST
@@ -28,7 +28,7 @@ import qualified Agda.Syntax.Common   as SC
 import Agda.TypeChecking.Monad (reportSDoc)
 import Agda.TypeChecking.Pretty as P
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 isIrr :: Relevance -> Bool
@@ -61,12 +61,12 @@ type Erasure = StateT ErasureState
 erasure :: [Fun] -> Compile TCM [Fun]
 erasure fs = do
     orgRel <- gets (relevantArgs . importedModules)
-    (rels, erasureState) <- flip runStateT (ErasureState orgRel M.empty) $ do
+    (rels, erasureState) <- flip runStateT (ErasureState orgRel Map.empty) $ do
         mapM_ initiate fs
         fu <- gets funs
-        M.mapKeys (fromMaybe __IMPOSSIBLE__ . flip M.lookup fu) <$> step 1
-    modifyEI $ \s -> s { relevantArgs = M.mapKeys funName rels }
-    concat <$> mapM (\f -> map (rem (relevancies erasureState)) <$> check f (M.lookup f rels)) fs
+        Map.mapKeys (fromMaybe __IMPOSSIBLE__ . flip Map.lookup fu) <$> step 1
+    modifyEI $ \s -> s { relevantArgs = Map.mapKeys funName rels }
+    concat <$> mapM (\f -> map (rem (relevancies erasureState)) <$> check f (Map.lookup f rels)) fs
   where
 
     rem rels f at Fun{} = f { funExpr = removeUnused rels (funExpr f) }
@@ -104,7 +104,7 @@ removeUnused rels t = let rem = removeUnused rels
     Lit _         -> t
     Lam v e       -> Lam v (rem e)
     Con tag qn es -> Con tag qn (map rem es)
-    App v es      -> case M.lookup v rels of
+    App v es      -> case Map.lookup v rels of
        Just re -> App v $ zipWith (\r x -> if isIrr r then UNIT else rem x)
                                   (re ++ repeat Rel) es
        Nothing    -> App v $ map rem es
@@ -119,16 +119,16 @@ removeUnused rels t = let rem = removeUnused rels
 initiate :: Fun -> Erasure (Compile TCM) ()
 initiate f@(Fun _ name mqname _ args _) = do
     let rels = replicate (length args) Irr
-    modify $ \s -> s { relevancies = M.insert name rels (relevancies s)
-                     , funs        = M.insert name f (funs s)
+    modify $ \s -> s { relevancies = Map.insert name rels (relevancies s)
+                     , funs        = Map.insert name f (funs s)
                      }
 initiate f@(EpicFun {funName = name, funQName = mqname}) = case mqname of
     Just qn -> do
         ty <- lift $ getType qn
         let rels = initialRels ty Rel
         return ()
-        modify $ \s -> s { relevancies = M.insert name rels (relevancies s)
-                         , funs        = M.insert name f (funs s)
+        modify $ \s -> s { relevancies = Map.insert name rels (relevancies s)
+                         , funs        = Map.insert name f (funs s)
                          }
     Nothing -> return ()
 
@@ -159,7 +159,7 @@ relevant var expr = case expr of
     App v es | v == var  -> return Rel
              | otherwise -> do
                 -- The variable is relevant if it is used in a relevant position
-                mvrs <- gets (M.lookup v . relevancies)
+                mvrs <- gets (Map.lookup v . relevancies)
                 case mvrs of
                   Nothing  -> relevants var es
                   Just vrs ->
@@ -195,8 +195,8 @@ relevant var expr = case expr of
 step :: Integer -> Erasure (Compile TCM) (Map Var [Relevance])
 step nrOfLoops = do
     s  <- get
-    newRels <- (M.fromList <$>) $ forM (M.toList (funs s)) $ \(v, f) -> ((,) v <$>) $ do
-               let funRels = fromMaybe __IMPOSSIBLE__ $ M.lookup v (relevancies s)
+    newRels <- (Map.fromList <$>) $ forM (Map.toList (funs s)) $ \(v, f) -> ((,) v <$>) $ do
+               let funRels = fromMaybe __IMPOSSIBLE__ $ Map.lookup v (relevancies s)
                case f of
                   EpicFun{} -> return funRels
                   Fun{} -> do
@@ -205,7 +205,7 @@ step nrOfLoops = do
                         Irr -> do
                           lift $ lift $ reportSDoc "epic.erasure" 10 $ P.text "running erasure:" P.<+> (P.text . show) (funQName f)
                           relevant x (funExpr f)
-    let relsm = newRels `M.union` relevancies s
+    let relsm = newRels `Map.union` relevancies s
     if relevancies s == relsm
        then return newRels
        else do
@@ -213,4 +213,4 @@ step nrOfLoops = do
          step (nrOfLoops + 1)
 
 diff :: (Ord k, Eq a) => Map k a -> Map k a -> [(k,(a,a))]
-diff m1 m2 = catMaybes $ zipWith (\(k, x) (_, y) -> if x == y then Nothing else Just (k, (x, y))) (M.toList m1) (M.toList m2)
+diff m1 m2 = catMaybes $ zipWith (\(k, x) (_, y) -> if x == y then Nothing else Just (k, (x, y))) (Map.toList m1) (Map.toList m2)
diff --git a/src/full/Agda/Compiler/Epic/ForceConstrs.hs b/src/full/Agda/Compiler/Epic/ForceConstrs.hs
index 66be31d..b658ea3 100644
--- a/src/full/Agda/Compiler/Epic/ForceConstrs.hs
+++ b/src/full/Agda/Compiler/Epic/ForceConstrs.hs
@@ -1,6 +1,6 @@
--- | Remove forced arguments from constructors.
 {-# LANGUAGE CPP #-}
 
+-- | Remove forced arguments from constructors.
 module Agda.Compiler.Epic.ForceConstrs where
 
 import Control.Applicative
@@ -13,7 +13,7 @@ import qualified Agda.Syntax.Common   as S
 import qualified Agda.Syntax.Internal as T
 import Agda.TypeChecking.Monad (TCM)
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Check which arguments are forced
diff --git a/src/full/Agda/Compiler/Epic/Forcing.hs b/src/full/Agda/Compiler/Epic/Forcing.hs
index ee2d942..d7a2fad 100644
--- a/src/full/Agda/Compiler/Epic/Forcing.hs
+++ b/src/full/Agda/Compiler/Epic/Forcing.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.Compiler.Epic.Forcing where
@@ -36,8 +36,9 @@ import Agda.Compiler.Epic.Epic
 import Agda.Compiler.Epic.Interface
 import qualified Agda.Compiler.Epic.FromAgda as FA
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
+import Agda.Utils.Lens
 
 -- | Returns how many parameters a datatype has
 dataParameters :: QName -> Compile TCM Nat
@@ -46,7 +47,7 @@ dataParameters = lift . dataParametersTCM
 -- | Returns how many parameters a datatype has
 dataParametersTCM :: QName -> TCM Nat
 dataParametersTCM name = do
-    m <- (gets (sigDefinitions . stImports))
+    m <- (sigDefinitions <$> use stImports)
     return $ maybe __IMPOSSIBLE__ (defnPars . theDef) (HM.lookup name m)
   where
     defnPars :: Defn -> Nat
@@ -54,8 +55,8 @@ dataParametersTCM name = do
     defnPars (Record   {recPars  = p}) = p
     defnPars d                         = 0 -- error (show d) -- __IMPOSSIBLE__ -- Not so sure about this.
 
-report n s = do
-  lift $ reportSDoc "epic.forcing" n s
+report :: Int -> TCM P.Doc -> Compile TCM ()
+report n s = lift $ reportSDoc "epic.forcing" n s
 
 piApplyM' :: Type -> Args -> TCM Type
 piApplyM' t as = do
@@ -138,11 +139,14 @@ insertTele er n ins term (ExtendTel x xs) = do
     return (ExtendTel x $ Abs (absName xs) xs' , typ)
 
 -- TODO: restore fields in ConHead
-mkCon c n = I.Con (I.ConHead c []) [ defaultArg $ I.Var (fromIntegral i) [] | i <- [n - 1, n - 2 .. 0] ]
+mkCon :: QName -> Int -> Term
+mkCon c n = I.Con (I.ConHead c Inductive [])
+                  [ defaultArg $ I.Var i [] | i <- [n - 1, n - 2 .. 0] ]
 
 unifyI :: Telescope -> FlexibleVars -> Type -> Args -> Args -> Compile TCM [Maybe Term]
 unifyI tele flex typ a1 a2 = lift $ addCtxTel tele $ unifyIndices_ flex typ a1 a2
 
+takeTele :: Int -> Telescope -> Telescope
 takeTele 0 _ = EmptyTel
 takeTele n (ExtendTel t ts) = ExtendTel t $ Abs (absName ts) $ takeTele (n-1) (unAbs ts)
 takeTele _ _ = __IMPOSSIBLE__
@@ -150,7 +154,7 @@ takeTele _ _ = __IMPOSSIBLE__
 -- | Main function for removing pattern matching on forced variables
 remForced :: [Fun] -> Compile TCM [Fun]
 remForced fs = do
-    defs <- lift (gets (sigDefinitions . stImports))
+    defs <- lift (sigDefinitions  <$> use stImports)
     forM fs $ \f -> case f of
         Fun{} -> case funQName f >>= flip HM.lookup defs of
             Nothing -> __IMPOSSIBLE__
diff --git a/src/full/Agda/Compiler/Epic/FromAgda.hs b/src/full/Agda/Compiler/Epic/FromAgda.hs
index f03c5d0..d54842e 100644
--- a/src/full/Agda/Compiler/Epic/FromAgda.hs
+++ b/src/full/Agda/Compiler/Epic/FromAgda.hs
@@ -7,7 +7,7 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.State
 import Data.Char
-import qualified Data.Map as M
+import qualified Data.Map as Map
 import Data.Maybe
 
 import Agda.Syntax.Common
@@ -28,7 +28,7 @@ import Agda.Compiler.Epic.Static
 
 import Agda.Compiler.Epic.Epic
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Convert from Agda's internal representation to our auxiliary AST.
@@ -130,8 +130,8 @@ translateDefn msharp (n, defini) =
 reverseCCBody :: Int -> CC.CompiledClauses -> CC.CompiledClauses
 reverseCCBody c cc = case cc of
     CC.Case n (CC.Branches cbr lbr cabr) -> CC.Case (c+n)
-        $ CC.Branches (M.map (fmap $ reverseCCBody c) cbr)
-          (M.map (reverseCCBody c) lbr)
+        $ CC.Branches (Map.map (fmap $ reverseCCBody c) cbr)
+          (Map.map (reverseCCBody c) lbr)
           (fmap  (reverseCCBody c) cabr)
     CC.Done i t -> CC.Done i (S.applySubst
                                 (S.parallelS $ map (flip T.Var []) $
@@ -196,16 +196,16 @@ compileClauses name nargs c = do
     compileCase :: [Var] -> Maybe Var -> Int -> CC.Case CC.CompiledClauses
                 -> Compile TCM [Branch]
     compileCase env omniDefault casedvar nc = do
-        cb <- if M.null (CC.conBranches nc)
+        cb <- if Map.null (CC.conBranches nc)
            -- Lit branch
-           then forM (M.toList (CC.litBranches nc)) $ \(l, cc) -> do
+           then forM (Map.toList (CC.litBranches nc)) $ \(l, cc) -> do
                cc' <- compileClauses' (replaceAt casedvar env []) omniDefault cc
                case l of
                    TL.LitChar _ cha -> return $ BrInt (ord cha) cc'
                    -- TODO: Handle other literals
                    _ -> epicError $ "case on literal not supported: " ++ show l
            -- Con branch
-           else forM (M.toList (CC.conBranches nc)) $ \(b, CC.WithArity ar cc) -> do
+           else forM (Map.toList (CC.conBranches nc)) $ \(b, CC.WithArity ar cc) -> do
                arit  <- getConArity b -- Andreas, 2012-10-12: is the constructor arity @ar@ from Agda the same as the one from the Epic backen?
                tag  <- getConstrTag b
                vars <- replicateM arit newName
diff --git a/src/full/Agda/Compiler/Epic/Injection.hs b/src/full/Agda/Compiler/Epic/Injection.hs
index 36f37fa..2ce0887 100644
--- a/src/full/Agda/Compiler/Epic/Injection.hs
+++ b/src/full/Agda/Compiler/Epic/Injection.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE OverlappingInstances #-}
 
@@ -10,12 +10,14 @@ module Agda.Compiler.Epic.Injection where
 import Control.Monad.State
 import Control.Monad.Reader
 
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import Data.List
-import Data.Map(Map)
-import qualified Data.Map as M
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Maybe
-import Data.Set(Set)
-import qualified Data.Set as S
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 import Agda.Syntax.Common
 import Agda.Syntax.Internal as I
@@ -35,8 +37,9 @@ import qualified Agda.Utils.HashMap as HM
 import Agda.Compiler.Epic.CompileState
 import Agda.Compiler.Epic.Interface as Interface
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
+import Agda.Utils.Lens
 
 -- | Find potentially injective functions, solve constraints to fix some constructor
 --   tags and make functions whose constraints are fulfilled injections
@@ -45,13 +48,13 @@ findInjection defs = do
     funs <- forM defs $ \(name, def) -> case theDef def of
         f@(Function{}) -> isInjective name (funClauses f)
         _              -> return Nothing
-    newNames <- M.keys <$> gets (Interface.conArity . curModule)
+    newNames <- Map.keys <$> gets (Interface.conArity . curModule)
     injFuns <- solve newNames (catMaybes funs)
     defs' <- forM defs $ \(q, def) -> case q `isIn` injFuns of
         Nothing -> return (q, def)
         Just inj@(InjectiveFun nvar arity) -> case theDef def of
             f@(Function{})   -> do
-                modifyEI $ \s -> s { injectiveFuns = M.insert q inj (injectiveFuns s) }
+                modifyEI $ \s -> s { injectiveFuns = Map.insert q inj (injectiveFuns s) }
                 let ns = replicate arity (defaultArg empty)
                 return $ (,) q $ def { theDef = f { funCompiled = Just $ Done ns $
                                                       var $ arity - nvar - 1 } }
@@ -65,11 +68,9 @@ findInjection defs = do
         (_,x):_  -> Just x
 
 replaceFunCC :: QName -> CompiledClauses -> Compile TCM ()
-replaceFunCC name cc = do
-    lift $ modify $ \s ->
-        s { stSignature = (stSignature s) { sigDefinitions = HM.adjust replaceDef name (sigDefinitions (stSignature s)) }
-          , stImports   = (stImports   s) { sigDefinitions = HM.adjust replaceDef name (sigDefinitions (stImports   s)) }
-          }
+replaceFunCC name cc = lift $ do
+    stSignature %= \sig -> sig {sigDefinitions = HM.adjust replaceDef name (sigDefinitions sig)}
+    stImports   %= \imp -> imp {sigDefinitions = HM.adjust replaceDef name (sigDefinitions imp)}
   where
     replaceDef :: Definition -> Definition
     replaceDef def = case theDef def of
@@ -154,8 +155,8 @@ isInjectiveHere nam idx clause = do
     lift $ reportSLn "epic.injection" 40 "reduced body"
     injFs <- gets (injectiveFuns . importedModules)
     lift $ reportSLn "epic.injection" 40 "calculated injFs"
-    res <- (t' <: body') `runReaderT` (M.insert nam (InjectiveFun idx
-                                                     (length (clausePats clause))) injFs)
+    res <- (t' <: body') `runReaderT` (Map.insert nam (InjectiveFun idx
+                                                      (length (clausePats clause))) injFs)
     lift $ reportSDoc "epic.injection" 20 $ vcat
       [ text "isInjective:" <+> text (show nam)
       , text "at Index   :" <+> text (show idx)
@@ -194,7 +195,7 @@ solve newNames xs = do
       sep $ text "Epic.Injection.solve" : map prettyTCM newNames
     -- Only primitive lists should be in the current module at this point,
     -- but we still want them
-    conGraph <- M.union <$> gets (constrTags . curModule) <*> gets (constrTags . importedModules)
+    conGraph <- Map.union <$> gets (constrTags . curModule) <*> gets (constrTags . importedModules)
     (funs, mconstr) <- ($ xs) $ flip foldM ([] , Just $ initialTags conGraph newNames) $ \ (xs , prev) (fun , con) -> do
          m <- foldM solvable prev con
          return $ case m of
@@ -212,22 +213,22 @@ solve newNames xs = do
 
     updateTags :: Tags -> Compile TCM ()
     updateTags tags = do
-        let (hasTags, eqs) = M.partition isTag (constrGroup tags)
+        let (hasTags, eqs) = Map.partition isTag (constrGroup tags)
             isTag (IsTag _) = True
             isTag _         = False
-        forM (M.toList hasTags) $ \ (c, tagged) -> case tagged of
+        forM (Map.toList hasTags) $ \ (c, tagged) -> case tagged of
             IsTag tag -> putCon c tag
             _         -> __IMPOSSIBLE__
-        case M.toList eqs of
+        case Map.toList eqs of
             (c, Same n) : _ -> do
-                let grp = eqGroups tags !!!! n
-                tag <- assignConstrTag' c (S.toList grp)
+                let grp = fromMaybe __IMPOSSIBLE__ $ IntMap.lookup n $ eqGroups tags
+                tag <- assignConstrTag' c (Set.toList grp)
                 updateTags . fromMaybe __IMPOSSIBLE__ =<< setTag n tag tags { constrGroup = eqs }
             _              -> return ()
     putCon :: QName -> Tag -> Compile TCM ()
     putCon con tag = do
         m <- gets (constrTags . importedModules)
-        case M.lookup con m of
+        case Map.lookup con m of
             Nothing -> putConstrTag con tag
             Just _  -> return () -- old
 
@@ -251,7 +252,7 @@ unionConstraints (Just c : cs) = do
 --   Precondition: t1 is normalised, t2 is in WHNF
 -- When reducing t2, it may become a literal, which makes this not work in some cases...
 class Injectible a where
-  (<:) :: a -> a -> ReaderT (QName :-> InjectiveFun) (Compile TCM) InjConstraints
+  (<:) :: a -> a -> ReaderT (Map QName InjectiveFun) (Compile TCM) InjConstraints
 
 instance Injectible a => Injectible (I.Arg a) where
   a1 <: a2 = unArg a1 <: unArg a2
@@ -286,7 +287,7 @@ instance Injectible Term where
       (_,  Lit l) | litInt l -> do
         l' <- lift . lift $ litToCon l
         t1 <: l'
-      (_, Def n2 es2) | Just (InjectiveFun argn arit) <- M.lookup n2 injs -> do
+      (_, Def n2 es2) | Just (InjectiveFun argn arit) <- Map.lookup n2 injs -> do
         if genericLength es2 /= arit
           then return Nothing
           else do
@@ -305,7 +306,7 @@ instance Injectible Term where
           args1' <: args2'
       _ -> return Nothing
 {-
-      (_, Def n2 args2) | Just (InjectiveFun argn arit) <- M.lookup n2 injs -> do
+      (_, Def n2 args2) | Just (InjectiveFun argn arit) <- Map.lookup n2 injs -> do
         if genericLength args2 /= arit
           then return Nothing
           else do
@@ -335,14 +336,14 @@ data TagEq
   deriving Eq
 
 data Tags = Tags
-    { eqGroups    :: Int :-> Set QName
-    , constrGroup :: QName :-> TagEq
+    { eqGroups    :: IntMap (Set QName)
+    , constrGroup :: Map QName TagEq
     }
 
 initialTags :: Map QName Tag -> [QName] -> Tags
 initialTags setTags newNames = Tags
-    { eqGroups    = M.fromList $ zip [0..] (map S.singleton newNames)
-    , constrGroup = M.map IsTag setTags `M.union` M.fromList (zip newNames (map Same [0..]))
+    { eqGroups    = IntMap.fromList $ zip [0..] (map Set.singleton newNames)
+    , constrGroup = Map.map IsTag setTags `Map.union` Map.fromList (zip newNames (map Same [0..]))
     }
 
 unify :: QName -> QName -> Tags -> Compile TCM (Maybe Tags)
@@ -359,20 +360,22 @@ unify c1 c2 ts = do
 
 setTag :: Int -> Tag -> Tags -> Compile TCM (Maybe Tags)
 setTag gid tag ts = return $ Just $ ts
-    { constrGroup = foldr (\c -> M.insert c (IsTag tag)) (constrGroup ts) (S.toList $ eqGroups ts !!!! gid)}
+    { constrGroup = foldr (\ c -> Map.insert c (IsTag tag))
+                          (constrGroup ts)
+                          (Set.toList $ fromMaybe __IMPOSSIBLE__ $ IntMap.lookup gid $ eqGroups ts) }
 
 mergeGroups :: Int -> Int -> Tags -> Compile TCM (Maybe Tags)
 mergeGroups n1 n2 ts = do
-    let g1s = eqGroups ts !!!! n1
-        g2s = eqGroups ts !!!! n2
-        gs  = S.union g1s g2s
-        g1l = S.toList g1s
-        g2l = S.toList g2s
+    let g1s = fromMaybe __IMPOSSIBLE__ $ IntMap.lookup n1 $ eqGroups ts
+        g2s = fromMaybe __IMPOSSIBLE__ $ IntMap.lookup n2 $ eqGroups ts
+        gs  = Set.union g1s g2s
+        g1l = Set.toList g1s
+        g2l = Set.toList g2s
     ifNotM (andM $ zipWith unifiable g1l g2l)
         (return Nothing) $
         return $ Just $ ts
-            { eqGroups    = M.delete n2 $ M.insert n1 gs (eqGroups ts)
-            , constrGroup = M.fromList [ (e2, Same n1) | e2 <- g2l ] `M.union` constrGroup ts
+            { eqGroups    = IntMap.delete n2 $ IntMap.insert n1 gs (eqGroups ts)
+            , constrGroup = Map.fromList [ (e2, Same n1) | e2 <- g2l ] `Map.union` constrGroup ts
             }
 
 unifiable :: QName -> QName -> Compile TCM Bool
@@ -381,7 +384,7 @@ unifiable c1 c2 = do
     d2 <- getConData c2
     return $ d1 /= d2
 
-(!!!!) :: Ord k => k :-> v -> k -> v
-m !!!!  k = case M.lookup k m of
+(!!!!) :: Ord k => Map k v -> k -> v
+m !!!!  k = case Map.lookup k m of
     Nothing -> __IMPOSSIBLE__
     Just x  -> x
diff --git a/src/full/Agda/Compiler/Epic/Interface.hs b/src/full/Agda/Compiler/Epic/Interface.hs
index 67455b3..876f7ce 100644
--- a/src/full/Agda/Compiler/Epic/Interface.hs
+++ b/src/full/Agda/Compiler/Epic/Interface.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+
 -- | Epic interface data structure, which is serialisable and stored for each
 --   compiled file
 module Agda.Compiler.Epic.Interface where
@@ -8,7 +9,7 @@ import Control.Monad
 import Data.Function
 import Data.Map(Map)
 import Data.Monoid
-import Data.Set(Set)
+import Data.Set (Set)
 import Data.Typeable
 
 import Agda.Syntax.Common (Nat)
diff --git a/src/full/Agda/Compiler/Epic/NatDetection.hs b/src/full/Agda/Compiler/Epic/NatDetection.hs
index 743ef04..705b007 100644
--- a/src/full/Agda/Compiler/Epic/NatDetection.hs
+++ b/src/full/Agda/Compiler/Epic/NatDetection.hs
@@ -23,14 +23,15 @@ import Agda.Compiler.Epic.Interface
 
 import qualified Agda.Utils.HashMap as HM
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
+import Agda.Utils.Lens
 
 -- | Get a list of all the datatypes that look like nats. The [QName] is on the
 --   form [zeroConstr, sucConstr]
 getNatish :: Compile TCM [(ForcedArgs, [QName])]
 getNatish = do
-  sig <- lift (gets (sigDefinitions . stImports))
+  sig <- lift (sigDefinitions <$> use stImports)
   let defs = HM.toList sig
   fmap catMaybes $ forM defs $ \(q, def) ->
     case theDef def of
@@ -48,7 +49,7 @@ isNatish q d = do -- A datatype ...
                 z <- zip constrs <$> mapM getForcedArgs constrs
                 case sortBy (compare `on` nrRel . snd) z of
                   [(cz,fz), (cs,fs)] -> do
-                    sig <- lift (gets (sigDefinitions . stImports))
+                    sig <- lift (sigDefinitions <$> use stImports)
                     let ts = defType $ sig HM.! cs
                         nr = dataPars d
                     return $ do
diff --git a/src/full/Agda/Compiler/Epic/Primitive.hs b/src/full/Agda/Compiler/Epic/Primitive.hs
index a6c9a34..a470c59 100644
--- a/src/full/Agda/Compiler/Epic/Primitive.hs
+++ b/src/full/Agda/Compiler/Epic/Primitive.hs
@@ -7,8 +7,8 @@ module Agda.Compiler.Epic.Primitive where
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans
-import Data.Map(Map)
-import qualified Data.Map as M
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Maybe
 
 import Agda.Syntax.Internal(QName)
@@ -22,9 +22,11 @@ import Agda.Compiler.Epic.CompileState
 import Agda.Compiler.Epic.Interface
 import Agda.Compiler.Epic.NatDetection
 
-#include "../../undefined.h"
+import Agda.Utils.List
 import Agda.Utils.Impossible
 
+#include "undefined.h"
+
 {- Stacken, Heapen -- Optimizern -}
 
 data PrimTransform = PrimTF
@@ -97,31 +99,29 @@ getBuiltins =
                 if b then return $ Just (transf names) else return Nothing
            else return Nothing
 
+defName :: T.Term -> QName
 defName (T.Def q []) = q
 defName (T.Con q []) = T.conName q
 defName _            = __IMPOSSIBLE__
 
-head'' (x:xs) e = x
-head'' _      e = e
-
 -- | Translation to primitive integer functions
 natPrimTF :: ForcedArgs -> [QName] -> PrimTransform
 natPrimTF filt [zero, suc] = PrimTF
-  { mapCon = M.fromList [(zero, prZero), (suc, prSuc)]
+  { mapCon = Map.fromList [(zero, prZero), (suc, prSuc)]
   , translateCase = \ce brs -> case brs of
         -- Assuming only the first two branches are relevant when casing on Nats
         (Branch _ n vs e:Branch _ _n' vs'' e'':_) ->
             if n == zero
-               then primNatCaseZS ce e  (head'' vs'' __IMPOSSIBLE__) e''
-               else primNatCaseZS ce e'' (head'' vs __IMPOSSIBLE__) e
+               then primNatCaseZS ce e  (headWithDefault __IMPOSSIBLE__ vs'') e''
+               else primNatCaseZS ce e'' (headWithDefault __IMPOSSIBLE__ vs) e
         (Branch _ n vs e:Default e'':_) ->
             if n == zero
                then primNatCaseZD ce e e'' -- zero
-               else primNatCaseZS ce e'' (head'' vs __IMPOSSIBLE__) e -- suc
+               else primNatCaseZS ce e'' (headWithDefault __IMPOSSIBLE__ vs) e -- suc
         [ Branch _ n vs e ] ->
             if n == zero
               then e
-              else lett (head'' vs __IMPOSSIBLE__) (App prPred [ce]) e
+              else lett (headWithDefault __IMPOSSIBLE__ vs) (App prPred [ce]) e
         _ -> __IMPOSSIBLE__
   }
 natPrimTF _ _ = __IMPOSSIBLE__
@@ -145,7 +145,7 @@ primNatCaseZD n zeroBr defBr = If (App prNatEquality [n, Var prZero]) zeroBr def
 -- | Translation to primitive bool functions
 boolPrimTF :: [QName] -> PrimTransform
 boolPrimTF [true, false] = PrimTF
-  { mapCon = M.fromList [(true, prTrue), (false, prFalse)]
+  { mapCon = Map.fromList [(true, prTrue), (false, prFalse)]
   , translateCase = \ce brs ->
     case brs of
         (Branch _ n _vs e:b':_) ->
@@ -189,7 +189,7 @@ primExpr prim ex = case ex of
     --   case, otherwise Nothing.
     testCon :: [PrimTransform] -> QName -> Maybe Var
     testCon [] _ = Nothing
-    testCon (p : ps) k = M.lookup k (mapCon p) `mplus` testCon ps k
+    testCon (p : ps) k = Map.lookup k (mapCon p) `mplus` testCon ps k
 
     -- | Test if we should transform the case, based on the branches. Returns
     --   the (first) PrimTransform that is applicable.
@@ -201,7 +201,7 @@ primExpr prim ex = case ex of
     --   Returns the PrimTransform in that case.
     check :: PrimTransform -> Branch -> Maybe PrimTransform
     check p br = case br of
-        Branch  _ n _ _ -> fmap (const p) $ M.lookup n (mapCon p)
+        Branch  _ n _ _ -> fmap (const p) $ Map.lookup n (mapCon p)
         BrInt _ _       -> Nothing
         Default _       -> Nothing
 
diff --git a/src/full/Agda/Compiler/Epic/Smashing.hs b/src/full/Agda/Compiler/Epic/Smashing.hs
index b16f734..1d923b3 100644
--- a/src/full/Agda/Compiler/Epic/Smashing.hs
+++ b/src/full/Agda/Compiler/Epic/Smashing.hs
@@ -10,8 +10,8 @@ import Control.Monad.State
 import Data.List
 import Data.Maybe
 
-import qualified Data.Set as S
 import Data.Set (Set)
+import qualified Data.Set as Set
 
 import Agda.Syntax.Common
 import Agda.Syntax.Internal as SI
@@ -25,11 +25,12 @@ import Agda.Compiler.Epic.AuxAST as AA
 import Agda.Compiler.Epic.CompileState
 import Agda.Compiler.Epic.Interface
 
+import Agda.Utils.Lens
 import Agda.Utils.Monad
 import Agda.Utils.Size
 import qualified Agda.Utils.HashMap as HM
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 defnPars :: Integral n => Defn -> n
@@ -40,7 +41,7 @@ defnPars d                           = 0
 -- | Main function, smash as much as possible
 smash'em :: [Fun] -> Compile TCM [Fun]
 smash'em funs = do
-    defs <- lift (gets (sigDefinitions . stImports))
+    defs <- lift (sigDefinitions <$> use stImports)
     funs' <- forM funs $ \f -> case f of
       AA.Fun{} -> case funQName f >>= flip HM.lookup defs of
           Nothing -> do
@@ -71,10 +72,10 @@ xs +++ ys = unflattenTel names $ map (raise (size ys)) (flattenTel xs) ++ flatte
 
 -- | Can a datatype be inferred? If so, return the only possible value.
 inferable :: Set QName -> QName -> [SI.Arg Term] ->  Compile TCM (Maybe Expr)
-inferable visited dat args | dat `S.member` visited = return Nothing
+inferable visited dat args | dat `Set.member` visited = return Nothing
 inferable visited dat args = do
   lift $ reportSLn "epic.smashing" 10 $ "  inferring:" ++ (show dat)
-  defs <- lift (gets (sigDefinitions . stImports))
+  defs <- lift (sigDefinitions <$> use stImports)
   let def = fromMaybe __IMPOSSIBLE__ $ HM.lookup dat defs
   case theDef def of
       d at Datatype{} -> do
@@ -90,7 +91,7 @@ inferable visited dat args = do
         return Nothing
   where
     inferableArgs c pars = do
-        defs <- lift (gets (sigDefinitions . stImports))
+        defs <- lift (sigDefinitions <$> use stImports)
         let def = fromMaybe __IMPOSSIBLE__ $ HM.lookup c defs
         forc <- getForcedArgs c
         TelV tel _ <- lift $ telView (defType def `apply` genericTake pars args)
@@ -101,8 +102,9 @@ inferable visited dat args = do
           , text "constr:" <+> prettyTCM c
           ]
         (AA.Con tag c <$>) <$> sequence <$> forM (notForced forc $ flattenTel tel) (inferableTerm visited' . unEl . unDom)
-    visited' = S.insert dat visited
+    visited' = Set.insert dat visited
 
+inferableTerm :: Set QName -> Term -> Compile TCM (Maybe Expr)
 inferableTerm visited t = do
   case t of
     Def q es    ->
@@ -118,11 +120,11 @@ inferableTerm visited t = do
 -- | Find the only possible value for a certain type. If we fail return Nothing
 smashable :: Int -> Type -> Compile TCM (Maybe Expr)
 smashable origArity typ = do
-    defs <- lift (gets (sigDefinitions . stImports))
+    defs <- lift (sigDefinitions <$> use stImports)
     TelV tele retType <- lift $ telView typ
     retType' <- return retType -- lift $ reduce retType
 
-    inf <- inferableTerm S.empty (unEl retType')
+    inf <- inferableTerm Set.empty (unEl retType')
     lift $ reportSDoc "epic.smashing" 10 $ nest 2 $ vcat
       [ text "Result is"
       , text "inf: " <+> (text . show) inf
diff --git a/src/full/Agda/Compiler/Epic/Static.hs b/src/full/Agda/Compiler/Epic/Static.hs
index 22747c7..bb91fe7 100644
--- a/src/full/Agda/Compiler/Epic/Static.hs
+++ b/src/full/Agda/Compiler/Epic/Static.hs
@@ -1,17 +1,16 @@
--- | Find the places where the builtin static is used and do some normalisation
---   there.
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
+-- | Find the places where the builtin static is used and do some normalisation
+--   there.
 module Agda.Compiler.Epic.Static where
 
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State
 
-import qualified Data.Map as M
+import qualified Data.Map as Map
 import Data.Traversable (traverse)
 
 import Agda.Syntax.Common
@@ -30,8 +29,9 @@ import qualified Agda.Utils.HashMap as HM
 
 import Agda.Compiler.Epic.CompileState
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
+import Agda.Utils.Lens
 
 normaliseStatic :: CompiledClauses -> Compile TCM CompiledClauses
 normaliseStatic = evaluateCC
@@ -39,14 +39,14 @@ normaliseStatic = evaluateCC
 evaluateCC :: CompiledClauses -> Compile TCM CompiledClauses
 evaluateCC ccs = case ccs of
     Case n brs -> do
-        cbrs <- forM (M.toList $ conBranches brs) $ \(c, WithArity n cc) -> (,) c <$> (WithArity n <$> evaluateCC cc)
-        lbrs <- forM (M.toList $ litBranches brs) $ \(l, cc) -> (,) l <$> evaluateCC cc
+        cbrs <- forM (Map.toList $ conBranches brs) $ \(c, WithArity n cc) -> (,) c <$> (WithArity n <$> evaluateCC cc)
+        lbrs <- forM (Map.toList $ litBranches brs) $ \(l, cc) -> (,) l <$> evaluateCC cc
         cab <- case catchAllBranch brs of
             Nothing -> return Nothing
             Just cc -> Just <$> evaluateCC cc
         return $ Case n Branches
-            { conBranches    = M.fromList cbrs
-            , litBranches    = M.fromList lbrs
+            { conBranches    = Map.fromList cbrs
+            , litBranches    = Map.fromList lbrs
             , catchAllBranch = cab
             }
     Done n t   -> Done n <$> evaluate t
@@ -54,7 +54,7 @@ evaluateCC ccs = case ccs of
 
 etaExpand :: Term -> Compile TCM Term
 etaExpand def@(Def n ts) = do
-    defs <- lift (gets (sigDefinitions . stImports))
+    defs <- lift (sigDefinitions <$> use stImports)
     let f   = maybe __IMPOSSIBLE__ theDef (HM.lookup n defs)
         len = length . clausePats . head .  funClauses $ f
         toEta :: Num a => a
@@ -115,7 +115,7 @@ instance Evaluate Term where
 -}
     isStatic :: QName -> Compile TCM Bool
     isStatic q = do
-      defs <- lift (gets (sigDefinitions . stImports))
+      defs <- lift (sigDefinitions <$> use stImports)
       return $ case fmap theDef $ HM.lookup q defs of
           Nothing -> False
           Just (f at Function{}) -> funStatic f
diff --git a/src/full/Agda/Compiler/HaskellTypes.hs b/src/full/Agda/Compiler/HaskellTypes.hs
index 924c613..ca0a5a1 100644
--- a/src/full/Agda/Compiler/HaskellTypes.hs
+++ b/src/full/Agda/Compiler/HaskellTypes.hs
@@ -6,7 +6,6 @@
 module Agda.Compiler.HaskellTypes where
 
 import Control.Applicative
-import Control.Monad.Error
 import Data.Maybe (fromMaybe)
 
 import Agda.Syntax.Common
@@ -18,9 +17,11 @@ import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Free
 
-#include "../undefined.h"
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Impossible
 
+#include "undefined.h"
+
 type HaskellKind = String
 
 hsStar :: HaskellKind
diff --git a/src/full/Agda/Compiler/JS/Case.hs b/src/full/Agda/Compiler/JS/Case.hs
index f758f4a..22e708c 100644
--- a/src/full/Agda/Compiler/JS/Case.hs
+++ b/src/full/Agda/Compiler/JS/Case.hs
@@ -14,7 +14,7 @@ import Agda.Compiler.JS.Syntax
     LocalId(LocalId), MemberId )
 import Agda.Compiler.JS.Substitution ( shiftFrom )
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible ( Impossible(Impossible), throwImpossible )
 
 -- ECMAScript doesn't support pattern-mathching case, so
diff --git a/src/full/Agda/Compiler/JS/Compiler.hs b/src/full/Agda/Compiler/JS/Compiler.hs
index c4531c4..7a758a1 100644
--- a/src/full/Agda/Compiler/JS/Compiler.hs
+++ b/src/full/Agda/Compiler/JS/Compiler.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP            #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Agda.Compiler.JS.Compiler where
@@ -21,10 +21,11 @@ import Agda.Syntax.Common ( Nat, unArg, namedArg )
 import Agda.Syntax.Concrete.Name ( projectRoot )
 import Agda.Syntax.Abstract.Name
   ( ModuleName(MName), QName,
+    mnameToConcrete,
     mnameToList, qnameName, qnameModule, isInModule, nameId )
 import Agda.Syntax.Internal
   ( Name, Args, Type,
-    Clause, Pattern(VarP,DotP,LitP,ConP,ProjP),
+    Clause, Pattern, Pattern'(VarP,DotP,LitP,ConP,ProjP),
     ClauseBodyF(Body,NoBody,Bind),ClauseBody,
     Term(Var,Lam,Lit,Level,Def,Con,Pi,Sort,MetaV,DontCare,Shared,ExtLam),
     unSpine, allApplyElims,
@@ -52,6 +53,7 @@ import Agda.TypeChecking.Reduce ( instantiateFull, normalise )
 import Agda.Utils.FileName ( filePath )
 import Agda.Utils.Function ( iterate' )
 import Agda.Utils.Monad ( (<$>), (<*>), ifM )
+import Agda.Utils.Pretty (prettyShow)
 import Agda.Utils.IO.UTF8 ( writeFile )
 import qualified Agda.Utils.HashMap as HMap
 import Agda.Compiler.MAlonzo.Misc ( curDefs, curIF, curMName, setInterface )
@@ -66,7 +68,7 @@ import Agda.Compiler.JS.Substitution
 import Agda.Compiler.JS.Case ( Tag(Tag), Case(Case), Patt(VarPatt,Tagged), lambda )
 import Agda.Compiler.JS.Pretty ( pretty )
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible ( Impossible(Impossible), throwImpossible )
 
 --------------------------------------------------
@@ -96,21 +98,23 @@ compilerMain mainI =
 compile :: Interface -> TCM ()
 compile i = do
   setInterface i
-  ifM uptodate noComp $ (yesComp >>) $ do
+  ifM uptodate noComp $ do
+    yesComp
     writeModule =<< curModule
   where
   uptodate = liftIO =<< (isNewerThan <$> outFile_ <*> ifile)
   ifile    = maybe __IMPOSSIBLE__ filePath <$>
                (findInterfaceFile . toTopLevelModuleName =<< curMName)
-  noComp   = reportSLn "" 1 . (++ " : no compilation is needed.").show =<< curMName
+  noComp   = reportSLn "" 1 . (++ " : no compilation is needed.") . prettyShow =<< curMName
   yesComp  = reportSLn "" 1 . (`repl` "Compiling <<0>> in <<1>> to <<2>>") =<<
-             sequence [show <$> curMName, ifile, outFile_] :: TCM ()
+             sequence [prettyShow <$> curMName, ifile, outFile_] :: TCM ()
 
 --------------------------------------------------
 -- Naming
 --------------------------------------------------
 
-prefix  = "jAgda"
+prefix :: [Char]
+prefix = "jAgda"
 
 jsMod :: ModuleName -> GlobalId
 jsMod m = GlobalId (prefix : map show (mnameToList m))
diff --git a/src/full/Agda/Compiler/JS/Syntax.hs b/src/full/Agda/Compiler/JS/Syntax.hs
index f361e89..bcbaf7c 100644
--- a/src/full/Agda/Compiler/JS/Syntax.hs
+++ b/src/full/Agda/Compiler/JS/Syntax.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+
 module Agda.Compiler.JS.Syntax where
 
 import Data.Typeable ( Typeable )
diff --git a/src/full/Agda/Compiler/MAlonzo/Compiler.hs b/src/full/Agda/Compiler/MAlonzo/Compiler.hs
index 06598f4..335499b 100644
--- a/src/full/Agda/Compiler/MAlonzo/Compiler.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Compiler.hs
@@ -1,17 +1,23 @@
-{-# LANGUAGE CPP           #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP              #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternGuards    #-}
 
 module Agda.Compiler.MAlonzo.Compiler where
 
 import Control.Applicative
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.List as L
-import Data.Map as M
-import Data.Set as S
+
+import Data.Generics.Geniplate
+import Data.List as List
+import Data.Map as Map
+import Data.Set as Set
+
 import qualified Language.Haskell.Exts.Extension as HS
 import qualified Language.Haskell.Exts.Parser as HS
+import qualified Language.Haskell.Exts.Pretty as HS
 import qualified Language.Haskell.Exts.Syntax as HS
+
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath hiding (normalise)
 
@@ -19,13 +25,17 @@ import Agda.Compiler.CallCompiler
 import Agda.Compiler.MAlonzo.Misc
 import Agda.Compiler.MAlonzo.Pretty
 import Agda.Compiler.MAlonzo.Primitives
+
 import Agda.Interaction.FindFile
 import Agda.Interaction.Imports
 import Agda.Interaction.Options
+
 import Agda.Syntax.Common
-import qualified Agda.Syntax.Concrete.Name as CN
+import qualified Agda.Syntax.Abstract.Name as A
+import qualified Agda.Syntax.Concrete.Name as C
 import Agda.Syntax.Internal as I
 import Agda.Syntax.Literal
+
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.Monad.Builtin
 import Agda.TypeChecking.Reduce
@@ -33,12 +43,15 @@ import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Telescope
 import Agda.TypeChecking.Level (reallyUnLevelView)
+
 import Agda.Utils.FileName
+import Agda.Utils.Lens
 import Agda.Utils.Monad
+import Agda.Utils.Pretty (prettyShow)
 import qualified Agda.Utils.IO.UTF8 as UTF8
 import qualified Agda.Utils.HashMap as HMap
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 compilerMain :: Bool -> Interface -> TCM ()
@@ -56,28 +69,29 @@ compilerMain modIsMain mainI =
         -- The default output directory is the project root.
         let tm = toTopLevelModuleName $ iModuleName mainI
         f <- findFile tm
-        return $ filePath $ CN.projectRoot f tm
+        return $ filePath $ C.projectRoot f tm
     setCommandLineOptions $
       opts { optCompileDir = Just compileDir }
 
     ignoreAbstractMode $ do
-      mapM_ (compile . miInterface) =<< (M.elems <$> getVisitedModules)
+      mapM_ (compile . miInterface) =<< (Map.elems <$> getVisitedModules)
       writeModule rteModule
       callGHC modIsMain mainI
 
 compile :: Interface -> TCM ()
 compile i = do
   setInterface i
-  ifM uptodate noComp $ (yesComp >>) $ do
+  ifM uptodate noComp $ {- else -} do
+    yesComp
     writeModule =<< decl <$> curHsMod <*> (definitions =<< curDefs) <*> imports
   where
   decl mn ds imp = HS.Module dummy mn [] Nothing Nothing imp ds
   uptodate = liftIO =<< (isNewerThan <$> outFile_ <*> ifile)
   ifile    = maybe __IMPOSSIBLE__ filePath <$>
                (findInterfaceFile . toTopLevelModuleName =<< curMName)
-  noComp   = reportSLn "" 1 . (++ " : no compilation is needed.").show =<< curMName
+  noComp   = reportSLn "" 1 . (++ " : no compilation is needed.") . show . A.mnameToConcrete =<< curMName
   yesComp  = reportSLn "" 1 . (`repl` "Compiling <<0>> in <<1>> to <<2>>") =<<
-             sequence [show <$> curMName, ifile, outFile_] :: TCM ()
+             sequence [show . A.mnameToConcrete <$> curMName, ifile, outFile_] :: TCM ()
 
 --------------------------------------------------
 -- imported modules
@@ -87,15 +101,27 @@ compile i = do
 
 imports :: TCM [HS.ImportDecl]
 imports = (++) <$> hsImps <*> imps where
-  hsImps = (L.map decl . S.toList .
-            S.insert mazRTE . S.map HS.ModuleName) <$>
+  hsImps :: TCM [HS.ImportDecl]
+  hsImps = (List.map decl . Set.toList .
+            Set.insert mazRTE . Set.map HS.ModuleName) <$>
              getHaskellImports
-  imps   = L.map decl . uniq <$>
-             ((++) <$> importsForPrim <*> (L.map mazMod <$> mnames))
+
+  imps :: TCM [HS.ImportDecl]
+  imps = List.map decl . uniq <$>
+           ((++) <$> importsForPrim <*> (List.map mazMod <$> mnames))
+
+  decl :: HS.ModuleName -> HS.ImportDecl
+#if MIN_VERSION_haskell_src_exts(1,16,0)
+  decl m = HS.ImportDecl dummy m True False False Nothing Nothing Nothing
+#else
   decl m = HS.ImportDecl dummy m True False Nothing Nothing Nothing
-  mnames = (++) <$> (S.elems <$> gets stImportedModules)
-                <*> (L.map fst . iImportedModules <$> curIF)
-  uniq   = L.map head . group . L.sort
+#endif
+  mnames :: TCM [ModuleName]
+  mnames = (++) <$> (Set.elems <$> use stImportedModules)
+                <*> (List.map fst . iImportedModules <$> curIF)
+
+  uniq :: [HS.ModuleName] -> [HS.ModuleName]
+  uniq = List.map head . group . List.sort
 
 --------------------------------------------------
 -- Main compiling clauses
@@ -150,10 +176,10 @@ definition kit Defn{defName = q, defType = ty, defCompiledRep = compiled, theDef
           b    = ihname "a" 1
           vars = [a, b]
       return [ HS.TypeDecl dummy infT
-                           (L.map HS.UnkindedVar vars)
+                           (List.map HS.UnkindedVar vars)
                            (HS.TyVar b)
              , HS.FunBind [HS.Match dummy infV
-                                    (L.map HS.PVar vars) Nothing
+                                    (List.map HS.PVar vars) Nothing
                                     (HS.UnGuardedRhs HS.unit_con)
                                     (HS.BDecls [])]
              ]
@@ -239,7 +265,7 @@ definition kit Defn{defName = q, defType = ty, defCompiledRep = compiled, theDef
                                 (HS.UnGuardedRhs $ e) (HS.BDecls [])]]
 
   axiomErr :: HS.Exp
-  axiomErr = rtmError $ "postulate evaluated: " ++ show q
+  axiomErr = rtmError $ "postulate evaluated: " ++ show (A.qnameToConcrete q)
 
 checkConstructorType :: QName -> TCM [HS.Decl]
 checkConstructorType q = do
@@ -256,7 +282,11 @@ checkCover q ty n cs = do
         (a, _) <- conArityAndPars c
         Just (HsDefn _ hsc) <- compiledHaskell . defCompiledRep <$> getConstInfo c
         let pat = HS.PApp (HS.UnQual $ HS.Ident hsc) $ genericReplicate a HS.PWildCard
+#if MIN_VERSION_haskell_src_exts(1,16,0)
+        return $ HS.Alt dummy pat (HS.UnGuardedRhs $ HS.unit_con) (HS.BDecls [])
+#else
         return $ HS.Alt dummy pat (HS.UnGuardedAlt $ HS.unit_con) (HS.BDecls [])
+#endif
   cs <- mapM makeClause cs
   let rhs = case cs of
               [] -> fakeExp "()" -- There is no empty case statement in Haskell
@@ -280,11 +310,11 @@ clause :: QName -> Maybe String -> (Nat, Bool, Clause) -> TCM HS.Decl
 clause q maybeName (i, isLast, Clause{ namedClausePats = ps, clauseBody = b }) =
   HS.FunBind . (: cont) <$> main where
   main = match <$> argpatts ps (bvars b (0::Nat)) <*> clausebody b
-  cont | isLast && any isCon ps = [match (L.map HS.PVar cvs) failrhs]
+  cont | isLast && any isCon ps = [match (List.map HS.PVar cvs) failrhs]
        | isLast                 = []
-       | otherwise              = [match (L.map HS.PVar cvs) crhs]
-  cvs  = L.map (ihname "v") [0 .. genericLength ps - 1]
-  crhs = hsCast$ L.foldl HS.App (hsVarUQ $ dsubname q (i + 1)) (L.map hsVarUQ cvs)
+       | otherwise              = [match (List.map HS.PVar cvs) crhs]
+  cvs  = List.map (ihname "v") [0 .. genericLength ps - 1]
+  crhs = hsCast$ List.foldl HS.App (hsVarUQ $ dsubname q (i + 1)) (List.map hsVarUQ cvs)
   failrhs = rtmIncompleteMatch q  -- Andreas, 2011-11-16 call to RTE instead of inlined error
 --  failrhs = rtmError $ "incomplete pattern matching: " ++ show q
   match hps rhs = HS.Match dummy (maybe (dsubname q i) HS.Ident maybeName) hps Nothing
@@ -302,16 +332,22 @@ clause q maybeName (i, isLast, Clause{ namedClausePats = ps, clauseBody = b }) =
 argpatts :: [I.NamedArg Pattern] -> [HS.Pat] -> TCM [HS.Pat]
 argpatts ps0 bvs = evalStateT (mapM pat' ps0) bvs
   where
+  pat :: Pattern -> StateT [HS.Pat] TCM HS.Pat
   pat   (ProjP _  ) = lift $ typeError $ NotImplemented $ "Compilation of copatterns"
   pat   (VarP _   ) = do v <- gets head; modify tail; return v
   pat   (DotP _   ) = pat (VarP dummy) -- WHY NOT: return HS.PWildCard -- SEE ABOVE
+#if MIN_VERSION_haskell_src_exts(1,16,0)
+  pat   (LitP l   ) = return $ HS.PLit HS.Signless $ hslit l
+#else
   pat   (LitP l   ) = return $ HS.PLit $ hslit l
+#endif
   pat p@(ConP c _ ps) = do
     -- Note that irr is applied once for every subpattern, so in the
     -- worst case it is quadratic in the size of the pattern. I
     -- suspect that this will not be a problem in practice, though.
     irrefutable <- lift $ irr p
-    let tilde = if   tildesEnabled && irrefutable
+    let tilde :: HS.Pat -> HS.Pat
+        tilde = if tildesEnabled && irrefutable
                 then HS.PParen . HS.PIrrPat
                 else id
     (tilde . HS.PParen) <$>
@@ -326,6 +362,7 @@ argpatts ps0 bvs = evalStateT (mapM pat' ps0) bvs
   -- do not match against irrelevant stuff
   pat' a | isIrrelevant a = return $ HS.PWildCard
 -}
+  pat' :: I.NamedArg Pattern -> StateT [HS.Pat] TCM HS.Pat
   pat' a = pat $ namedArg a
 
   tildesEnabled = False
@@ -338,9 +375,10 @@ argpatts ps0 bvs = evalStateT (mapM pat' ps0) bvs
   irr (LitP {})   = return False
   irr (ConP c _ ps) =
     (&&) <$> singleConstructorType (conName c)
-         <*> (andM $ L.map irr' ps)
+         <*> (andM $ List.map irr' ps)
 
   -- | Irrelevant patterns are naturally irrefutable.
+  irr' :: I.NamedArg Pattern -> TCM Bool
   irr' a | isIrrelevant a = return $ True
   irr' a = irr $ namedArg a
 
@@ -422,7 +460,11 @@ condecl q = do
 
 cdecl :: QName -> Nat -> HS.ConDecl
 cdecl q n = HS.ConDecl (unqhname "C" q)
-            [ HS.UnBangedTy $ HS.TyVar $ ihname "a" i | i <- [0 .. n - 1]]
+#if MIN_VERSION_haskell_src_exts(1,16,0)
+            [ HS.TyVar $ ihname "a" i | i <- [0 .. n - 1] ]
+#else
+            [ HS.UnBangedTy $ HS.TyVar $ ihname "a" i | i <- [0 .. n - 1] ]
+#endif
 
 tvaldecl :: QName
          -> Induction
@@ -432,7 +474,7 @@ tvaldecl q ind ntv npar cds cl =
   HS.FunBind [HS.Match dummy vn pvs Nothing
                        (HS.UnGuardedRhs HS.unit_con) (HS.BDecls [])] :
   maybe [HS.DataDecl dummy kind [] tn tvs
-                     (L.map (HS.QualConDecl dummy [] []) cds) []]
+                     (List.map (HS.QualConDecl dummy [] []) cds) []]
         (const []) cl
   where
   (tn, vn) = (unqhname "T" q, unqhname "d" q)
@@ -447,7 +489,7 @@ tvaldecl q ind ntv npar cds cl =
     _                               -> HS.DataType
 
 infodecl :: QName -> HS.Decl
-infodecl q = fakeD (unqhname "name" q) $ show (show q)
+infodecl q = fakeD (unqhname "name" q) $ show $ prettyShow q
 
 --------------------------------------------------
 -- Inserting unsafeCoerce
@@ -465,15 +507,17 @@ hsCast = addcast . go where
 -}
 
 hsCast e = mazCoerce `HS.App` hsCast' e
+
+hsCast' :: HS.Exp -> HS.Exp
 hsCast' (HS.App e1 e2)     = hsCast' e1 `HS.App` (hsCoerce $ hsCast' e2)
 hsCast' (HS.Lambda _ ps e) = HS.Lambda dummy ps $ hsCast' e
 hsCast' e = e
 
 -- No coercion for literal integers
+hsCoerce :: HS.Exp -> HS.Exp
 hsCoerce e@(HS.ExpTypeSig _ (HS.Lit (HS.Int{})) _) = e
 hsCoerce e = HS.App mazCoerce e
 
-
 --------------------------------------------------
 -- Writing out a haskell module
 --------------------------------------------------
@@ -485,7 +529,7 @@ writeModule (HS.Module l m ps w ex imp ds) = do
   liftIO $ UTF8.writeFile out $ prettyPrint $
     HS.Module l m (p : ps) w ex imp ds
   where
-  p = HS.LanguagePragma dummy $ L.map HS.Ident $
+  p = HS.LanguagePragma dummy $ List.map HS.Ident $
         [ "EmptyDataDecls"
         , "ExistentialQuantification"
         , "ScopedTypeVariables"
@@ -512,8 +556,11 @@ rteModule = ok $ parse $ unlines
   , "mazIncompleteMatch s = error (\"MAlonzo Runtime Error: incomplete pattern matching: \" ++ s)"
   ]
   where
-    parse = HS.parseWithMode
+    parse :: String -> HS.ParseResult HS.Module
+    parse = HS.parseModuleWithMode
               HS.defaultParseMode{HS.extensions = [explicitForAll]}
+
+    ok :: HS.ParseResult HS.Module -> HS.Module
     ok (HS.ParseOk d)   = d
     ok HS.ParseFailed{} = __IMPOSSIBLE__
 
@@ -536,6 +583,8 @@ compileDir = do
     Just dir -> return dir
     Nothing  -> __IMPOSSIBLE__
 
+outFile' :: (HS.Pretty a, TransformBi HS.ModuleName (Wrap a)) =>
+            a -> TCM (FilePath, FilePath)
 outFile' m = do
   mdir <- compileDir
   let (fdir, fn) = splitFileName $ repldot pathSeparator $
@@ -545,7 +594,7 @@ outFile' m = do
   liftIO $ createDirectoryIfMissing True dir
   return (mdir, fp)
   where
-  repldot c = L.map (\c' -> if c' == '.' then c else c')
+  repldot c = List.map $ \ c' -> if c' == '.' then c else c'
 
 outFile :: HS.ModuleName -> TCM FilePath
 outFile m = snd <$> outFile' m
@@ -567,7 +616,7 @@ callGHC modIsMain i = do
 
   let overridableArgs =
         [ "-O"] ++
-        (if modIsMain then ["-o", mdir </> show outputName] else []) ++
+        (if modIsMain then ["-o", mdir </> show (nameConcrete outputName)] else []) ++
         [ "-Werror"]
       otherArgs       =
         [ "-i" ++ mdir] ++
diff --git a/src/full/Agda/Compiler/MAlonzo/Encode.hs b/src/full/Agda/Compiler/MAlonzo/Encode.hs
index 3d5b9b3..1ae89cf 100644
--- a/src/full/Agda/Compiler/MAlonzo/Encode.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Encode.hs
@@ -67,6 +67,7 @@ encodeModuleName (HS.ModuleName s) = HS.ModuleName $ case splitUp s of
 -- Note: This injectivity test is quite weak. A better, dedicated
 -- generator could strengthen it.
 
+prop_encodeModuleName_injective :: M -> M -> Bool
 prop_encodeModuleName_injective (M s1) (M s2) =
   if encodeModuleName (HS.ModuleName s1) ==
      encodeModuleName (HS.ModuleName s2) then
@@ -74,6 +75,7 @@ prop_encodeModuleName_injective (M s1) (M s2) =
    else
     True
 
+prop_encodeModuleName_OK :: M -> Bool
 prop_encodeModuleName_OK (M s') =
   s ~= unM (encodeModuleName (HS.ModuleName s))
   where
@@ -88,6 +90,7 @@ prop_encodeModuleName_OK (M s') =
 
   unM (HS.ModuleName s) = s
 
+prop_encodeModuleName_preserved :: M -> Property
 prop_encodeModuleName_preserved (M m) =
   shouldBePreserved m ==>
     encodeModuleName (HS.ModuleName m) == HS.ModuleName m
diff --git a/src/full/Agda/Compiler/MAlonzo/Misc.hs b/src/full/Agda/Compiler/MAlonzo/Misc.hs
index 0d3256e..dfd22ee 100644
--- a/src/full/Agda/Compiler/MAlonzo/Misc.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Misc.hs
@@ -3,21 +3,25 @@
 module Agda.Compiler.MAlonzo.Misc where
 
 import Control.Monad.State
+
 import Data.List as List
 import Data.Map as Map
 import Data.Set as Set
 import Data.Function
+
 import qualified Language.Haskell.Exts.Syntax as HS
 
 import Agda.Syntax.Common
--- import Agda.Syntax.Abstract.Name (isAnonymousModuleName)
 import Agda.Syntax.Internal
+
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.Monad.Builtin
--- import Agda.TypeChecking.Pretty
+
+import Agda.Utils.Lens
 import Agda.Utils.Monad
+import Agda.Utils.Pretty
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 --------------------------------------------------
@@ -25,14 +29,13 @@ import Agda.Utils.Impossible
 --------------------------------------------------
 
 setInterface :: Interface -> TCM ()
-setInterface i = modify $ \s -> s
-  { stImportedModules = Set.empty
-  , stCurrentModule   = Just $ iModuleName i
-  }
+setInterface i = do
+  stImportedModules .= Set.empty
+  stCurrentModule   .= Just (iModuleName i)
 
 curIF :: TCM Interface
 curIF = do
-  mName <- stCurrentModule <$> get
+  mName <- use stCurrentModule
   case mName of
     Nothing   -> __IMPOSSIBLE__
     Just name -> do
@@ -148,12 +151,22 @@ hsVarUQ = HS.Var . HS.UnQual
 -- Hard coded module names
 --------------------------------------------------
 
-mazstr  = "MAlonzo.Code"
+mazstr :: String
+mazstr = "MAlonzo.Code"
+
+mazName :: Name
 mazName = mkName_ dummy mazstr
+
+mazMod' :: String -> HS.ModuleName
 mazMod' s = HS.ModuleName $ mazstr ++ "." ++ s
+
 mazMod :: ModuleName -> HS.ModuleName
-mazMod = mazMod' . show
+mazMod = mazMod' . prettyShow
+
+mazerror :: String -> a
 mazerror msg = error $ mazstr ++ ": " ++ msg
+
+mazCoerce :: HS.Exp
 -- mazCoerce = HS.Var $ HS.Qual unsafeCoerceMod (HS.Ident "unsafeCoerce")
 mazCoerce = HS.Var $ HS.Qual mazRTE $ HS.Ident "mazCoerce"
 
@@ -168,12 +181,20 @@ mazRTE :: HS.ModuleName
 mazRTE = HS.ModuleName "MAlonzo.RTE"
 
 -- for Runtime module: Not really used (Runtime modules has been abolished).
-rtmMod  = mazMod' "Runtime"
+rtmMod :: HS.ModuleName
+rtmMod = mazMod' "Runtime"
+
+rtmQual :: String -> HS.QName
 rtmQual = HS.UnQual . HS.Ident
+
+rtmVar :: String -> HS.Exp
 rtmVar  = HS.Var . rtmQual
+
+rtmError :: String -> HS.Exp
 rtmError s = rtmVar "error" `HS.App`
              (HS.Lit $ HS.String $ "MAlonzo Runtime Error: " ++ s)
 
+unsafeCoerceMod :: HS.ModuleName
 unsafeCoerceMod = HS.ModuleName "Unsafe.Coerce"
 
 --------------------------------------------------
diff --git a/src/full/Agda/Compiler/MAlonzo/Pretty.hs b/src/full/Agda/Compiler/MAlonzo/Pretty.hs
index 118900c..db08a8d 100644
--- a/src/full/Agda/Compiler/MAlonzo/Pretty.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Pretty.hs
@@ -1,12 +1,12 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
 ------------------------------------------------------------------------
 -- Pretty-printing of Haskell modules
 ------------------------------------------------------------------------
 
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell #-}
-
 module Agda.Compiler.MAlonzo.Pretty where
 
 import Data.Generics.Geniplate
diff --git a/src/full/Agda/Compiler/MAlonzo/Primitives.hs b/src/full/Agda/Compiler/MAlonzo/Primitives.hs
index aa7a280..5cfb6be 100644
--- a/src/full/Agda/Compiler/MAlonzo/Primitives.hs
+++ b/src/full/Agda/Compiler/MAlonzo/Primitives.hs
@@ -21,7 +21,7 @@ import Agda.TypeChecking.Pretty
 import Agda.Utils.Monad
 import qualified Agda.Utils.HashMap as HMap
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {- OLD
@@ -44,7 +44,7 @@ checkTypeOfMain q ty
 -- | Check that the main function has type IO a, for some a.
 checkTypeOfMain :: QName -> Type -> TCM [HS.Decl] -> TCM [HS.Decl]
 checkTypeOfMain q ty ret
-  | show (qnameName q) /= "main" = ret
+  | show (nameConcrete $ qnameName q) /= "main" = ret
   | otherwise = do
     Def io _ <- ignoreSharing <$> primIO
     ty <- normalise ty
@@ -131,6 +131,10 @@ declsForPrim = xForPrim $
       do cs' <- mapM pconName cs
          return $ zipWith (\ n -> fakeDS n . repl cs') [n1, n2] [b1, b2]
 
+mazNatToInteger, mazIntegerToNat, mazNatToInt, mazIntToNat, mazCharToInteger,
+  mazListToHList, mazHListToList, mazListToString, mazStringToList,
+  mazBoolToHBool, mazHBoolToBool :: String
+
 mazNatToInteger  = "mazNatToInteger"
 mazIntegerToNat  = "mazIntegerToNat"
 mazNatToInt      = "mazNatToInt"
@@ -192,19 +196,19 @@ primBody s = maybe unimplemented (either (hsVarUQ . HS.Ident) id <$>) $
 
   -- Floating point functions
   , "primIntegerToFloat"    |-> return "(fromIntegral :: Integer -> Double)"
-  , "primFloatPlus"	    |-> return "((+) :: Double -> Double -> Double)"
-  , "primFloatMinus"	    |-> return "((-) :: Double -> Double -> Double)"
-  , "primFloatTimes"	    |-> return "((*) :: Double -> Double -> Double)"
-  , "primFloatDiv"	    |-> return "((/) :: Double -> Double -> Double)"
+  , "primFloatPlus"         |-> return "((+) :: Double -> Double -> Double)"
+  , "primFloatMinus"        |-> return "((-) :: Double -> Double -> Double)"
+  , "primFloatTimes"        |-> return "((*) :: Double -> Double -> Double)"
+  , "primFloatDiv"          |-> return "((/) :: Double -> Double -> Double)"
   , "primFloatEquality"     |-> rel "(==)" "Double"
   , "primFloatLess"         |-> rel "(<)" "Double"
-  , "primRound"	            |-> return "(round :: Double -> Integer)"
-  , "primFloor"	            |-> return "(floor :: Double -> Integer)"
-  , "primCeiling"	    |-> return "(ceiling :: Double -> Integer)"
-  , "primExp"		    |-> return "(exp :: Double -> Double)"
-  , "primLog"		    |-> return "(log :: Double -> Double)"  -- partial
-  , "primSin"		    |-> return "(sin :: Double -> Double)"
-  , "primShowFloat"	    |-> return "(show :: Double -> String)"
+  , "primRound"             |-> return "(round :: Double -> Integer)"
+  , "primFloor"             |-> return "(floor :: Double -> Integer)"
+  , "primCeiling"           |-> return "(ceiling :: Double -> Integer)"
+  , "primExp"               |-> return "(exp :: Double -> Double)"
+  , "primLog"               |-> return "(log :: Double -> Double)"  -- partial
+  , "primSin"               |-> return "(sin :: Double -> Double)"
+  , "primShowFloat"         |-> return "(show :: Double -> String)"
   , "primRound"             |-> return "(round :: Double -> Integer)"
 
   -- Character functions
@@ -270,9 +274,9 @@ primBody s = maybe unimplemented (either (hsVarUQ . HS.Ident) id <$>) $
 
   lam x t = Lam (setHiding Hidden defaultArgInfo) (Abs x t)
 
-
 ----------------------
 
+repl :: [String] -> String -> String
 repl subs = go where
   go ('<':'<':c:'>':'>':s) | 0 <= i && i < length subs = subs !! i ++ go s
      where i = ord c - ord '0'
@@ -296,5 +300,5 @@ hasCompiledData (s:_) = toB =<< getBuiltin s where
   toB _         = return False
 hasCompiledData _    = return False
 
-
+bltQual' :: String -> String -> TCM String
 bltQual' b s = prettyPrint <$> bltQual b s
diff --git a/src/full/Agda/ImpossibleTest.hs b/src/full/Agda/ImpossibleTest.hs
index 1f0b874..9cbf91b 100644
--- a/src/full/Agda/ImpossibleTest.hs
+++ b/src/full/Agda/ImpossibleTest.hs
@@ -5,4 +5,5 @@ module Agda.ImpossibleTest where
 #include "undefined.h"
 import Agda.Utils.Impossible
 
+impossibleTest :: a
 impossibleTest = __IMPOSSIBLE__
diff --git a/src/full/Agda/Interaction/BasicOps.hs b/src/full/Agda/Interaction/BasicOps.hs
index 5ad70e9..03296ff 100644
--- a/src/full/Agda/Interaction/BasicOps.hs
+++ b/src/full/Agda/Interaction/BasicOps.hs
@@ -1,15 +1,14 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 module Agda.Interaction.BasicOps where
 
 import Control.Arrow ((***), first, second)
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Identity
@@ -50,7 +49,9 @@ import Agda.TypeChecking.Pretty (prettyTCM)
 import Agda.TypeChecking.Free
 import qualified Agda.TypeChecking.Pretty as TP
 
+import Agda.Utils.Except ( Error(strMsg), MonadError(catchError, throwError) )
 import Agda.Utils.Functor
+import Agda.Utils.Lens
 import Agda.Utils.List
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
@@ -58,7 +59,7 @@ import Agda.Utils.Pretty
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Parses an expression.
@@ -93,13 +94,30 @@ giveExpr mi e = do
       -- Thus, we can safely apply its type to the context variables.
       ctx <- getContextArgs
       let t' = t `piApply` permute (takeP (length ctx) $ mvPermutation mv) ctx
+      traceCall (CheckExprCall e t') $ do
       reportSDoc "interaction.give" 20 $
         TP.text "give: instantiated meta type =" TP.<+> prettyTCM t'
-      v	<- checkExpr e t'
+      v <- checkExpr e t'
       case mvInstantiation mv of
-          InstV v' -> unlessM ((Irrelevant ==) <$> asks envRelevance) $
-                        equalTerm t' v (v' `apply` ctx)
-          _	   -> updateMeta mi v
+        InstV xs v' -> unlessM ((Irrelevant ==) <$> asks envRelevance) $ do
+          reportSDoc "interaction.give" 20 $ TP.sep
+            [ TP.text "meta was already set to value v' = " TP.<+> prettyTCM v'
+              TP.<+> TP.text " with free variables " TP.<+> return (fsep $ map pretty xs)
+            , TP.text "now comparing it to given value v = " TP.<+> prettyTCM v
+            , TP.text "in context " TP.<+> inTopContext (prettyTCM ctx)
+            ]
+          -- The number of free variables should be at least the size of the context
+          -- (Ideally, if we implemented contextual type theory, it should be the same.)
+          when (length xs < size ctx) __IMPOSSIBLE__
+          -- if there are more free variables than the context has
+          -- we need to abstract over the additional ones (xs2)
+          let (_xs1, xs2) = splitAt (size ctx) xs
+          v' <- return $ foldr (\ (Arg ai x) -> I.Lam ai . I.Abs x) v' xs2
+          reportSDoc "interaction.give" 20 $ TP.sep
+            [ TP.text "in meta context, v' = " TP.<+> prettyTCM v'
+            ]
+          equalTerm t' v v'  -- Note: v' now lives in context of meta
+        _ -> updateMeta mi v
       reify v
 
 -- | Try to fill hole by expression.
@@ -120,7 +138,7 @@ give ii mr e = liftTCM $ do
   -- Try to give mi := e
   giveExpr mi e `catchError` \ err -> case err of
     -- Turn PatternErr into proper error:
-    PatternErr _ -> do
+    PatternErr{} -> do
       err <- withInteractionId ii $ TP.text "Failed to give" TP.<+> prettyTCM e
       typeError $ GenericError $ show err
     _ -> throwError err
@@ -153,7 +171,7 @@ refine ii mr e = do
     tryRefine nrOfMetas r scope e = try nrOfMetas e
       where
         try :: Int -> Expr -> TCM Expr
-        try 0 e = throwError (strMsg "Can not refine")
+        try 0 e = throwError $ strMsg "Cannot refine"
         try n e = give ii (Just r) e `catchError` (\_ -> try (n-1) =<< appMeta e)
 
         -- Apply A.Expr to a new meta
@@ -177,23 +195,23 @@ refine ii mr e = do
 evalInCurrent :: Expr -> TCM Expr
 evalInCurrent e =
     do  (v, t) <- inferExpr e
-	v' <- {- etaContract =<< -} normalise v
-	reify v'
+        v' <- {- etaContract =<< -} normalise v
+        reify v'
 
 
 evalInMeta :: InteractionId -> Expr -> TCM Expr
 evalInMeta ii e =
-   do 	m <- lookupInteractionId ii
-	mi <- getMetaInfo <$> lookupMeta m
-	withMetaInfo mi $
-	    evalInCurrent e
+   do   m <- lookupInteractionId ii
+        mi <- getMetaInfo <$> lookupMeta m
+        withMetaInfo mi $
+            evalInCurrent e
 
 
 data Rewrite =  AsIs | Instantiated | HeadNormal | Simplified | Normalised
     deriving (Read)
 
---normalForm :: Rewrite -> Term -> TCM Term
-normalForm AsIs	     t = return t
+normalForm :: Rewrite -> Type -> TCM Type
+normalForm AsIs         t = return t
 normalForm Instantiated t = return t   -- reify does instantiation
 normalForm HeadNormal   t = {- etaContract =<< -} reduce t
 normalForm Simplified   t = {- etaContract =<< -} simplify t
@@ -255,8 +273,8 @@ instance Reify Constraint (OutputConstraint Expr Expr) where
     reify (TelCmp a b cmp t t')  = CmpTeles cmp <$> (ETel <$> reify t) <*> (ETel <$> reify t')
     reify (SortCmp cmp s s')     = CmpSorts cmp <$> reify s <*> reify s'
     reify (Guarded c pid) = do
-	o  <- reify c
-	return $ Guard o pid
+        o  <- reify c
+        return $ Guard o pid
     reify (UnBlock m) = do
         mi <- mvInstantiation <$> lookupMeta m
         case mi of
@@ -366,11 +384,7 @@ instance (ToConcrete a c, ToConcrete b d) =>
 --ToDo: Move somewhere else
 instance ToConcrete InteractionId C.Expr where
     toConcrete (InteractionId i) = return $ C.QuestionMark noRange (Just i)
-{- UNUSED
-instance ToConcrete MetaId C.Expr where
-    toConcrete x@(MetaId i) = do
-      return $ C.Underscore noRange (Just $ "_" ++ show i)
--}
+
 instance ToConcrete NamedMeta C.Expr where
     toConcrete i = do
       return $ C.Underscore noRange (Just $ show i)
@@ -428,9 +442,11 @@ getSolvedInteractionPoints all = concat <$> do
 typeOfMetaMI :: Rewrite -> MetaId -> TCM (OutputConstraint Expr NamedMeta)
 typeOfMetaMI norm mi =
      do mv <- lookupMeta mi
-	withMetaInfo (getMetaInfo mv) $
-	  rewriteJudg mv (mvJudgement mv)
+        withMetaInfo (getMetaInfo mv) $
+          rewriteJudg mv (mvJudgement mv)
    where
+    rewriteJudg :: MetaVariable -> Judgement Type MetaId ->
+                   TCM (OutputConstraint Expr NamedMeta)
     rewriteJudg mv (HasType i t) = do
       ms <- getMetaNameSuggestion i
       t <- normalForm norm t
@@ -491,7 +507,7 @@ metaHelperType norm ii rng s = case words s of
           a' = renameP (reverseP perm) a
       (vs, as) <- do
         let -- We know that as does not depend on Δ₂
-            rho = parallelS (replicate (size delta2) __IMPOSSIBLE__)
+            rho = compactS __IMPOSSIBLE__ (replicate (size delta2) Nothing)
         return $ applySubst rho $ renameP (reverseP perm) (vs, as)
       a <- local (\e -> e { envPrintDomainFreePi = True }) $ do
         reify =<< cleanupType arity args =<< normalForm norm =<< withFunctionType delta1 vs as delta2 a'
@@ -518,7 +534,7 @@ metaHelperType norm ii rng s = case words s of
         b | absName b == "w"   -> I.Pi a b
         NoAbs _ b              -> unEl b
         Abs s b | 0 `freeIn` b -> I.Pi (hide a) (Abs s b)
-                | otherwise    -> subst __IMPOSSIBLE__ (unEl b)
+                | otherwise    -> strengthen __IMPOSSIBLE__ (unEl b)
       _ -> v  -- todo: handle if goal type is a Pi
 
     -- renameVars = onNames (stringToArgName <.> renameVar . argNameToString)
@@ -569,7 +585,7 @@ metaHelperType norm ii rng s = case words s of
       arg : args <- get
       put args
       return $ case arg of
-        Arg _ (Named _ (A.Var x)) -> show x
+        Arg _ (Named _ (A.Var x)) -> show $ A.nameConcrete x
         Arg _ (Named (Just x) _)  -> argNameToString $ rangedThing x
         _                         -> "w"
 
@@ -585,9 +601,9 @@ contextOfMeta ii norm = do
   withMetaInfo info $ gfilter visible <$> reifyContext (length letVars)
                                                        (letVars ++ localVars)
   where gfilter p = catMaybes . map p
-        visible (OfType x y) | show x /= "_" = Just (OfType' x y)
-                             | otherwise     = Nothing
-	visible _	     = __IMPOSSIBLE__
+        visible (OfType x y) | not (isNoName x) = Just (OfType' x y)
+                             | otherwise        = Nothing
+        visible _            = __IMPOSSIBLE__
         reifyContext skip xs =
           reverse <$> zipWithM out
                                -- don't escape context for letvars
@@ -604,7 +620,7 @@ contextOfMeta ii norm = do
 --   invoke that command in an irrelevant context.
 typeInCurrent :: Rewrite -> Expr -> TCM Expr
 typeInCurrent norm e =
-    do 	(_,t) <- wakeIrrelevantVars $ inferExpr e
+    do  (_,t) <- wakeIrrelevantVars $ inferExpr e
         v <- normalForm norm t
         reify v
 
@@ -612,10 +628,10 @@ typeInCurrent norm e =
 
 typeInMeta :: InteractionId -> Rewrite -> Expr -> TCM Expr
 typeInMeta ii norm e =
-   do 	m <- lookupInteractionId ii
-	mi <- getMetaInfo <$> lookupMeta m
-	withMetaInfo mi $
-	    typeInCurrent norm e
+   do   m <- lookupInteractionId ii
+        mi <- getMetaInfo <$> lookupMeta m
+        withMetaInfo mi $
+            typeInCurrent norm e
 
 withInteractionId :: InteractionId -> TCM a -> TCM a
 withInteractionId i ret = do
@@ -723,14 +739,14 @@ introTactic pmLambda ii = do
 atTopLevel :: TCM a -> TCM a
 atTopLevel m = inConcreteMode $ do
   let err = typeError $ GenericError "The file has not been loaded yet."
-  caseMaybeM (gets stCurrentModule) err $ \ current -> do
+  caseMaybeM (use stCurrentModule) err $ \ current -> do
     caseMaybeM (getVisitedModule $ toTopLevelModuleName current) __IMPOSSIBLE__ $ \ mi -> do
       let scope = iInsideScope $ miInterface mi
       tel <- lookupSection current
       -- Get the names of the local variables from @scope@
       -- and put them into the context.
       let names :: [A.Name]
-          names = reverse $ map snd $ scopeLocals scope
+          names = reverse $ map snd $ notShadowedLocals $ scopeLocals scope
           types :: [I.Dom I.Type]
           types = map (snd <$>) $ telToList tel
           gamma :: ListTel' A.Name
@@ -776,7 +792,7 @@ moduleContents norm rng s = do
                            Map.toList names)
   return (Map.keys modules, types)
 
-whyInScope :: String -> TCM (Maybe A.Name, [AbstractName], [AbstractModule])
+whyInScope :: String -> TCM (Maybe LocalVar, [AbstractName], [AbstractModule])
 whyInScope s = do
   x     <- parseName noRange s
   scope <- getScope
diff --git a/src/full/Agda/Interaction/CommandLine/CommandLine.hs b/src/full/Agda/Interaction/CommandLine/CommandLine.hs
index 9f44f13..37c9a30 100644
--- a/src/full/Agda/Interaction/CommandLine/CommandLine.hs
+++ b/src/full/Agda/Interaction/CommandLine/CommandLine.hs
@@ -2,7 +2,6 @@
 
 module Agda.Interaction.CommandLine.CommandLine where
 
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Applicative
 
@@ -30,9 +29,10 @@ import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Errors
 import Agda.TypeChecking.Substitute
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data ExitCode a = Continue | ContinueIn TCEnv | Return a
@@ -42,45 +42,45 @@ type Command a = (String, [String] -> TCM (ExitCode a))
 matchCommand :: String -> [Command a] -> Either [String] ([String] -> TCM (ExitCode a))
 matchCommand x cmds =
     case List.filter (isPrefixOf x . fst) cmds of
-	[(_,m)]	-> Right m
-	xs	-> Left $ List.map fst xs
+        [(_,m)] -> Right m
+        xs      -> Left $ List.map fst xs
 
 interaction :: String -> [Command a] -> (String -> TCM (ExitCode a)) -> IM a
 interaction prompt cmds eval = loop
     where
-	go (Return x)	    = return x
-	go Continue	    = loop
-	go (ContinueIn env) = local (const env) loop
-
-	loop =
-	    do	ms <- readline prompt
-		case fmap words ms of
-		    Nothing		  -> return $ error "** EOF **"
-		    Just []		  -> loop
-		    Just ((':':cmd):args) ->
-			do  case matchCommand cmd cmds of
-				Right c	-> go =<< liftTCM (c args)
-				Left []	->
-				    do	liftIO $ putStrLn $ "Unknown command '" ++ cmd ++ "'"
-					loop
-				Left xs	->
-				    do	liftIO $ putStrLn $ "More than one command match: " ++ concat (intersperse ", " xs)
-					loop
-		    Just _ ->
-			do  go =<< liftTCM (eval $ fromJust ms)
-	    `catchError` \e ->
-		do  s <- liftTCM $ prettyError e
-		    liftIO $ putStrLn s
-		    loop
+        go (Return x)       = return x
+        go Continue         = loop
+        go (ContinueIn env) = local (const env) loop
+
+        loop =
+            do  ms <- readline prompt
+                case fmap words ms of
+                    Nothing               -> return $ error "** EOF **"
+                    Just []               -> loop
+                    Just ((':':cmd):args) ->
+                        do  case matchCommand cmd cmds of
+                                Right c -> go =<< liftTCM (c args)
+                                Left [] ->
+                                    do  liftIO $ putStrLn $ "Unknown command '" ++ cmd ++ "'"
+                                        loop
+                                Left xs ->
+                                    do  liftIO $ putStrLn $ "More than one command match: " ++ concat (intersperse ", " xs)
+                                        loop
+                    Just _ ->
+                        do  go =<< liftTCM (eval $ fromJust ms)
+            `catchError` \e ->
+                do  s <- liftTCM $ prettyError e
+                    liftIO $ putStrLn s
+                    loop
 
 -- | The interaction loop.
 interactionLoop :: TCM (Maybe Interface) -> IM ()
-interactionLoop typeCheck =
+interactionLoop doTypeCheck =
     do  liftTCM reload
-	interaction "Main> " commands evalTerm
+        interaction "Main> " commands evalTerm
     where
-	reload = do
-	    mi <- typeCheck
+        reload = do
+            mi <- doTypeCheck
             -- Note that mi is Nothing if (1) there is no input file or
             -- (2) the file type checked with unsolved metas and
             -- --allow-unsolved-metas was used. In the latter case the
@@ -90,79 +90,79 @@ interactionLoop typeCheck =
             setScope $ case mi of
               Just i  -> iInsideScope i
               Nothing -> emptyScopeInfo
-	  `catchError` \e -> do
-	    s <- prettyError e
-	    liftIO $ putStrLn s
-	    liftIO $ putStrLn "Failed."
-
-	commands =
-	    [ "quit"	    |>  \_ -> return $ Return ()
-	    , "?"	    |>  \_ -> continueAfter $ liftIO $ help commands
-	    , "reload"	    |>  \_ -> do reload
-					 ContinueIn <$> ask
-	    , "constraints" |> \args -> continueAfter $ showConstraints args
-	    , "Context"	    |> \args -> continueAfter $ showContext args
-            , "give"	    |> \args -> continueAfter $ giveMeta args
-            , "Refine"	    |> \args -> continueAfter $ refineMeta args
-	    , "metas"	    |> \args -> continueAfter $ showMetas args
-            , "load"	    |> \args -> continueAfter $ loadFile reload args
-	    , "eval"	    |> \args -> continueAfter $ evalIn args
+          `catchError` \e -> do
+            s <- prettyError e
+            liftIO $ putStrLn s
+            liftIO $ putStrLn "Failed."
+
+        commands =
+            [ "quit"        |>  \_ -> return $ Return ()
+            , "?"           |>  \_ -> continueAfter $ liftIO $ help commands
+            , "reload"      |>  \_ -> do reload
+                                         ContinueIn <$> ask
+            , "constraints" |> \args -> continueAfter $ showConstraints args
+            , "Context"     |> \args -> continueAfter $ showContext args
+            , "give"        |> \args -> continueAfter $ giveMeta args
+            , "Refine"      |> \args -> continueAfter $ refineMeta args
+            , "metas"       |> \args -> continueAfter $ showMetas args
+            , "load"        |> \args -> continueAfter $ loadFile reload args
+            , "eval"        |> \args -> continueAfter $ evalIn args
             , "typeOf"      |> \args -> continueAfter $ typeOf args
             , "typeIn"      |> \args -> continueAfter $ typeIn args
-	    , "wakeup"	    |> \_ -> continueAfter $ retryConstraints
-	    , "scope"	    |> \_ -> continueAfter $ showScope
-	    ]
-	    where
-		(|>) = (,)
+            , "wakeup"      |> \_ -> continueAfter $ retryConstraints
+            , "scope"       |> \_ -> continueAfter $ showScope
+            ]
+            where
+                (|>) = (,)
 
 continueAfter :: TCM a -> TCM (ExitCode b)
 continueAfter m = m >> return Continue
 
 loadFile :: TCM () -> [String] -> TCM ()
 loadFile reload [file] =
-    do	setInputFile file
-	reload
+    do  setInputFile file
+        reload
 loadFile _ _ = liftIO $ putStrLn ":load file"
 
 showConstraints :: [String] -> TCM ()
 showConstraints [] =
-    do	cs <- BasicOps.getConstraints
-	liftIO $ putStrLn $ unlines (List.map show cs)
+    do  cs <- BasicOps.getConstraints
+        liftIO $ putStrLn $ unlines (List.map show cs)
 showConstraints _ = liftIO $ putStrLn ":constraints [cid]"
 
 
 showMetas :: [String] -> TCM ()
 showMetas [m] =
-    do	i <- InteractionId <$> readM m
-	withInteractionId i $ do
-	  s <- typeOfMeta AsIs i
-	  r <- getInteractionRange i
-	  d <- showA s
-	  liftIO $ putStrLn $ d ++ " " ++ show r
+    do  i <- InteractionId <$> readM m
+        withInteractionId i $ do
+          s <- typeOfMeta AsIs i
+          r <- getInteractionRange i
+          d <- showA s
+          liftIO $ putStrLn $ d ++ " " ++ show r
 showMetas [m,"normal"] =
-    do	i <- InteractionId <$> readM m
-	withInteractionId i $ do
-	  s <- showA =<< typeOfMeta Normalised i
-	  r <- getInteractionRange i
-	  liftIO $ putStrLn $ s ++ " " ++ show r
+    do  i <- InteractionId <$> readM m
+        withInteractionId i $ do
+          s <- showA =<< typeOfMeta Normalised i
+          r <- getInteractionRange i
+          liftIO $ putStrLn $ s ++ " " ++ show r
 showMetas [] =
     do  interactionMetas <- typesOfVisibleMetas AsIs
         hiddenMetas      <- typesOfHiddenMetas  AsIs
         mapM_ (liftIO . putStrLn) =<< mapM showII interactionMetas
-	mapM_ print' hiddenMetas
+        mapM_ print' hiddenMetas
     where
-	showII o = withInteractionId (outputFormId $ OutputForm noRange 0 o) $ showA o
-	showM  o = withMetaId (nmid $ outputFormId $ OutputForm noRange 0 o) $ showA o
-
-	metaId (OfType i _) = i
-	metaId (JustType i) = i
-	metaId (JustSort i) = i
-	metaId (Assign i e) = i
-	metaId _ = __IMPOSSIBLE__
-	print' x = do
-	    r <- getMetaRange $ nmid $ metaId x
-	    d <- showM x
-	    liftIO $ putStrLn $ d ++ "  [ at " ++ show r ++ " ]"
+        showII o = withInteractionId (outputFormId $ OutputForm noRange 0 o) $ showA o
+        showM  o = withMetaId (nmid $ outputFormId $ OutputForm noRange 0 o) $ showA o
+
+        metaId (OfType i _) = i
+        metaId (JustType i) = i
+        metaId (JustSort i) = i
+        metaId (Assign i e) = i
+        metaId _ = __IMPOSSIBLE__
+        print' x = do
+            r <- getMetaRange $ nmid $ metaId x
+            d <- showM x
+            liftIO $ putStrLn $ d ++ "  [ at " ++ show r ++ " ]"
 showMetas _ = liftIO $ putStrLn $ ":meta [metaid]"
 
 
@@ -173,15 +173,15 @@ showScope = do
 
 metaParseExpr ::  InteractionId -> String -> TCM A.Expr
 metaParseExpr ii s =
-    do	m <- lookupInteractionId ii
+    do  m <- lookupInteractionId ii
         scope <- getMetaScope <$> lookupMeta m
         r <- getRange <$> lookupMeta m
         --liftIO $ putStrLn $ show scope
         let pos = case rStart r of
                     Nothing  -> __IMPOSSIBLE__
                     Just pos -> pos
-	e <- liftIO $ parsePosString exprParser pos s
-	concreteToAbstract scope e
+        e <- liftIO $ parsePosString exprParser pos s
+        concreteToAbstract scope e
 
 actOnMeta :: [String] -> (InteractionId -> A.Expr -> TCM a) -> TCM a
 actOnMeta (is:es) f =
@@ -214,7 +214,7 @@ retryConstraints = liftTCM wakeupConstraints_
 
 evalIn :: [String] -> TCM ()
 evalIn s | length s >= 2 =
-    do	d <- actOnMeta s $ \_ e -> prettyA =<< evalInCurrent e
+    do  d <- actOnMeta s $ \_ e -> prettyA =<< evalInCurrent e
         liftIO $ print d
 evalIn _ = liftIO $ putStrLn ":eval metaid expr"
 
@@ -225,16 +225,16 @@ parseExpr s = do
 
 evalTerm :: String -> TCM (ExitCode a)
 evalTerm s =
-    do	e <- parseExpr s
+    do  e <- parseExpr s
         v <- evalInCurrent e
-	e <- prettyTCM v
-	liftIO $ putStrLn $ show e
-	return Continue
+        e <- prettyTCM v
+        liftIO $ putStrLn $ show e
+        return Continue
     where
-	evalInCurrent e = do
-	  (v,t) <- inferExpr e
-	  v'    <- normalise v
-	  return v'
+        evalInCurrent e = do
+          (v,t) <- inferExpr e
+          v'    <- normalise v
+          return v'
 
 
 typeOf :: [String] -> TCM ()
@@ -242,14 +242,14 @@ typeOf s =
     do  e  <- parseExpr (unwords s)
         e0 <- typeInCurrent Normalised e
         e1 <- typeInCurrent AsIs e
-	liftIO . putStrLn =<< showA e1
+        liftIO . putStrLn =<< showA e1
 
 typeIn :: [String] -> TCM ()
 typeIn s@(_:_:_) =
     actOnMeta s $ \i e ->
-    do	e1 <- typeInMeta i Normalised e
+    do  e1 <- typeInMeta i Normalised e
         e2 <- typeInMeta i AsIs e
-	liftIO . putStrLn =<< showA e1
+        liftIO . putStrLn =<< showA e1
 typeIn _ = liftIO $ putStrLn ":typeIn meta expr"
 
 showContext :: [String] -> TCM ()
@@ -260,12 +260,12 @@ showContext (meta:args) = do
     ctx <- List.map unDom . telToList <$> getContextTelescope
     zipWithM_ display ctx $ reverse $ zipWith const [1..] ctx
     where
-	display (x, t) n = do
-	    t <- case args of
-		    ["normal"] -> normalise $ raise n t
-		    _	       -> return $ raise n t
-	    d <- prettyTCM t
-	    liftIO $ print $ text (I.argNameToString x) <+> text ":" <+> d
+        display (x, t) n = do
+            t <- case args of
+                    ["normal"] -> normalise $ raise n t
+                    _          -> return $ raise n t
+            d <- prettyTCM t
+            liftIO $ print $ text (I.argNameToString x) <+> text ":" <+> d
 showContext _ = liftIO $ putStrLn ":Context meta"
 
 -- | The logo that prints when Agda is started in interactive mode.
@@ -290,4 +290,4 @@ help cs = putStr $ unlines $
     [ "Command overview" ] ++ List.map explain cs ++
     [ "<exp> Infer type of expression <exp> and evaluate it." ]
     where
-	explain (x,_) = ":" ++ x
+        explain (x,_) = ":" ++ x
diff --git a/src/full/Agda/Interaction/EmacsCommand.hs b/src/full/Agda/Interaction/EmacsCommand.hs
index 46e3164..0f6bd67 100644
--- a/src/full/Agda/Interaction/EmacsCommand.hs
+++ b/src/full/Agda/Interaction/EmacsCommand.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 ------------------------------------------------------------------------
 -- | Code for instructing Emacs to do things
 ------------------------------------------------------------------------
 
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-
 module Agda.Interaction.EmacsCommand
   ( Lisp(..)
   , response
@@ -34,9 +35,6 @@ instance Pretty a => Pretty (Lisp a) where
   pretty (L xs)     = parens (hsep (map pretty xs))
   pretty (Q x)      = text "'" <> pretty x
 
-instance Pretty String where
-  pretty = text
-
 instance Pretty a => Show (Lisp a) where
   show = show . pretty
 
diff --git a/src/full/Agda/Interaction/EmacsTop.hs b/src/full/Agda/Interaction/EmacsTop.hs
index e5a1d04..9f559fe 100644
--- a/src/full/Agda/Interaction/EmacsTop.hs
+++ b/src/full/Agda/Interaction/EmacsTop.hs
@@ -1,12 +1,10 @@
 -- {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.Interaction.EmacsTop
     ( mimicGHCi
     ) where
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.State
 
 import Data.Char
diff --git a/src/full/Agda/Interaction/Exceptions.hs b/src/full/Agda/Interaction/Exceptions.hs
index 2912067..8b6e37f 100644
--- a/src/full/Agda/Interaction/Exceptions.hs
+++ b/src/full/Agda/Interaction/Exceptions.hs
@@ -1,4 +1,3 @@
-
 {-| This module defines the exception handler.
 -}
 module Agda.Interaction.Exceptions where
@@ -17,4 +16,4 @@ handleParseException crash e = crash e
 failOnException :: (Range -> String -> IO a) -> IO a -> IO a
 failOnException h m = m `E.catch` handleParseException handler
     where
-	handler x = h (getRange x) (show x)
+        handler x = h (getRange x) (show x)
diff --git a/src/full/Agda/Interaction/FindFile.hs b/src/full/Agda/Interaction/FindFile.hs
index 880a563..48ed17f 100644
--- a/src/full/Agda/Interaction/FindFile.hs
+++ b/src/full/Agda/Interaction/FindFile.hs
@@ -32,6 +32,7 @@ import Agda.TypeChecking.Monad.Benchmark (billTo)
 import qualified Agda.TypeChecking.Monad.Benchmark as Bench
 import {-# SOURCE #-} Agda.TypeChecking.Monad.Options (getIncludeDirs)
 import Agda.Utils.FileName
+import Agda.Utils.Lens
 
 -- | Converts an Agda file name to the corresponding interface file
 -- name.
@@ -80,9 +81,9 @@ findFile m = do
 findFile' :: TopLevelModuleName -> TCM (Either FindError AbsolutePath)
 findFile' m = do
     dirs         <- getIncludeDirs
-    modFile      <- stModuleToSource <$> get
+    modFile      <- use stModuleToSource
     (r, modFile) <- liftIO $ findFile'' dirs m modFile
-    modify $ \s -> s { stModuleToSource = modFile }
+    stModuleToSource .= modFile
     return r
 
 -- | A variant of 'findFile'' which does not require 'TCM'.
diff --git a/src/full/Agda/Interaction/Highlighting/Dot.hs b/src/full/Agda/Interaction/Highlighting/Dot.hs
index f4bb770..7c23770 100644
--- a/src/full/Agda/Interaction/Highlighting/Dot.hs
+++ b/src/full/Agda/Interaction/Highlighting/Dot.hs
@@ -19,7 +19,7 @@ import Agda.Interaction.Options
 import Agda.Syntax.Abstract
 import Agda.TypeChecking.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Internal module identifiers for construction of dependency graph.
@@ -93,7 +93,7 @@ generateDot inter = do
     mkDot :: DotState -> String
     mkDot st = unlines $
         [ "digraph dependencies {"
-        ] ++ ["   " ++ repr ++ "[label=\"" ++ show modulename ++ "\"];"
+        ] ++ ["   " ++ repr ++ "[label=\"" ++ show (mnameToConcrete modulename) ++ "\"];"
              | (modulename, repr) <- M.toList (dsModules st)]
           ++ ["   " ++ r1 ++ " -> " ++ r2 ++ ";"
              | (r1 , r2) <- S.toList (dsConnection st) ]
diff --git a/src/full/Agda/Interaction/Highlighting/Emacs.hs b/src/full/Agda/Interaction/Highlighting/Emacs.hs
index a1fae1f..b8baf8b 100644
--- a/src/full/Agda/Interaction/Highlighting/Emacs.hs
+++ b/src/full/Agda/Interaction/Highlighting/Emacs.hs
@@ -29,7 +29,7 @@ import Data.Monoid
 import qualified System.Directory as D
 import qualified System.IO as IO
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -38,7 +38,7 @@ import Agda.Utils.Impossible
 -- | Converts the 'aspect' and 'otherAspects' fields to atoms readable
 -- by the Emacs interface.
 
-toAtoms :: MetaInfo -> [String]
+toAtoms :: Aspects -> [String]
 toAtoms m = map toAtom (otherAspects m) ++ toAtoms' (aspect m)
   where
   toAtom x = map toLower (show x)
@@ -57,11 +57,11 @@ toAtoms m = map toAtom (otherAspects m) ++ toAtoms' (aspect m)
 -- | Shows meta information in such a way that it can easily be read
 -- by Emacs.
 
-showMetaInfo :: ModuleToSource
-                -- ^ Must contain a mapping for the definition site's
-                -- module, if any.
-             -> (Range, MetaInfo) -> Lisp String
-showMetaInfo modFile (r, m) =
+showAspects
+  :: ModuleToSource
+     -- ^ Must contain a mapping for the definition site's module, if any.
+  -> (Range, Aspects) -> Lisp String
+showAspects modFile (r, m) =
     L $ ((map (A . show) [from r, to r])
            ++
          [L $ map A $ toAtoms m]
@@ -92,7 +92,7 @@ lispifyHighlightingInfo h modFile = do
                     mi == mempty                       -> direct
     _                                                  -> indirect
   where
-  info     = map (showMetaInfo modFile) (ranges h)
+  info     = map (showAspects modFile) (ranges h)
 
   direct   = return $ L (A "agda2-highlight-add-annotations" :
                          map Q info)
diff --git a/src/full/Agda/Interaction/Highlighting/Generate.hs b/src/full/Agda/Interaction/Highlighting/Generate.hs
index 39eabdc..e073421 100644
--- a/src/full/Agda/Interaction/Highlighting/Generate.hs
+++ b/src/full/Agda/Interaction/Highlighting/Generate.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RelaxedPolyRec #-}
+{-# LANGUAGE RelaxedPolyRec   #-}
 
 -- | Generates data used for precise syntax highlighting.
 
@@ -14,9 +14,12 @@ module Agda.Interaction.Highlighting.Generate
   , highlightAsTypeChecked
   , computeUnsolvedMetaWarnings
   , computeUnsolvedConstraints
+  , storeDisambiguatedName
   , Agda.Interaction.Highlighting.Generate.tests
   ) where
 
+import Prelude hiding (null)
+
 import Agda.Interaction.FindFile
 import Agda.Interaction.Response (Response(Resp_HighlightingInfo))
 import Agda.Interaction.Highlighting.Precise hiding (tests)
@@ -38,6 +41,7 @@ import qualified Agda.Syntax.Literal as L
 import qualified Agda.Syntax.Parser as Pa
 import qualified Agda.Syntax.Parser.Tokens as T
 import qualified Agda.Syntax.Position as P
+import Agda.Utils.Lens
 import Agda.Utils.List
 import Agda.Utils.TestHelpers
 import Agda.Utils.HashMap (HashMap)
@@ -47,7 +51,7 @@ import Control.Monad.Trans
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Applicative
-import Control.Arrow ((***))
+import Control.Arrow ((***), first, second)
 import Data.Monoid
 import Data.Generics.Geniplate
 import Agda.Utils.FileName
@@ -57,12 +61,18 @@ import qualified Data.Map as Map
 import Data.Maybe
 import Data.List ((\\), isPrefixOf)
 import qualified Data.Foldable as Fold (toList, fold, foldMap)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+
+import Agda.Utils.Functor
+import Agda.Utils.Maybe
+import Agda.Utils.Null
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | @highlightAsTypeChecked rPre r m@ runs @m@ and returns its
--- result. Some code may additionally be highlighted:
+--   result. Additionally, some code may be highlighted:
 --
 -- * If @r@ is non-empty and not a sub-range of @rPre@ (after
 --   'P.continuousPerLine' has been applied to both): @r@ is
@@ -101,7 +111,7 @@ highlightAsTypeChecked rPre r m
 
 printHighlightingInfo :: MonadTCM tcm => HighlightingInfo -> tcm ()
 printHighlightingInfo x = do
-  modToSrc <- gets stModuleToSource
+  modToSrc <- use stModuleToSource
   liftTCM $ reportSLn "highlighting" 50 $
     "Printing highlighting info:\n" ++ show x ++ "\n" ++
     "  modToSrc = " ++ show modToSrc
@@ -112,27 +122,22 @@ printHighlightingInfo x = do
 -- | Highlighting levels.
 
 data Level
-  = Full [TerminationError]
+  = Full
     -- ^ Full highlighting. Should only be used after typechecking has
-    -- completed successfully.
-    --
-    -- The list of termination problems is also highlighted.
-    --
-    -- Precondition: The termination problems must be located in the
-    -- module that is highlighted.
+    --   completed successfully.
   | Partial
     -- ^ Highlighting without disambiguation of overloaded
-    -- constructors.
+    --   constructors.
 
 -- | Generate syntax highlighting information for the given
 -- declaration, and (if appropriate) print it. If the
--- 'HighlightingLevel' is @'Full' something@, then the state is
+-- 'HighlightingLevel' is @'Full'@, then the state is
 -- additionally updated with the new highlighting info (in case of a
 -- conflict new info takes precedence over old info).
 --
 -- The procedure makes use of some of the token highlighting info in
 -- 'stTokens' (that corresponding to the interval covered by the
--- declaration). If the 'HighlightingLevel' is @'Full' something@,
+-- declaration). If the 'HighlightingLevel' is @'Full'@,
 -- then this token highlighting info is additionally removed from
 -- 'stTokens'.
 
@@ -157,15 +162,15 @@ generateAndPrintSyntaxInfo decl hlLevel = do
     -- Constructors are only highlighted after type checking, since they
     -- can be overloaded.
     constructorInfo <- case hlLevel of
-      Full _ -> generateConstructorInfo modMap file kinds decl
+      Full{} -> generateConstructorInfo modMap file kinds decl
       _      -> return mempty
 
     let (from, to) = case P.rangeToInterval (P.getRange decl) of
           Nothing -> __IMPOSSIBLE__
-          Just i  -> let conv = toInteger . P.posPos in
-                     (conv $ P.iStart i, conv $ P.iEnd i)
+          Just i  -> ( fromIntegral $ P.posPos $ P.iStart i
+                     , fromIntegral $ P.posPos $ P.iEnd i)
     (prevTokens, (curTokens, postTokens)) <-
-      (id *** splitAtC to) . splitAtC from . stTokens <$> get
+      (second (splitAtC to)) . splitAtC from <$> use stTokens
 
     -- theRest needs to be placed before nameInfo here since record
     -- field declarations contain QNames. constructorInfo also needs
@@ -176,32 +181,18 @@ generateAndPrintSyntaxInfo decl hlLevel = do
     let syntaxInfo = compress (mconcat [ constructorInfo
                                        , theRest modMap file
                                        , nameInfo
-                                       , termInfo
                                        ])
                        `mappend`
                      curTokens
 
     case hlLevel of
-      Full _ -> modify (\st ->
-                  st { stSyntaxInfo = syntaxInfo `mappend` stSyntaxInfo st
-                     , stTokens     = prevTokens `mappend` postTokens
-                     })
+      Full{} -> do stSyntaxInfo %= mappend syntaxInfo
+                   stTokens     .= prevTokens `mappend` postTokens
       _      -> return ()
 
     ifTopLevelAndHighlightingLevelIs NonInteractive $
       printHighlightingInfo syntaxInfo
   where
-  -- Highlighting of termination problems.
-  termInfo = case hlLevel of
-    Full termErrs -> functionDefs `mappend` callSites
-      where
-      m            = mempty { otherAspects = [TerminationProblem] }
-      functionDefs = Fold.foldMap (\x -> singleton (rToR $ bindingSite x) m) $
-                     concatMap M.termErrFunctions termErrs
-      callSites    = Fold.foldMap (\r -> singleton (rToR r) m) $
-                     concatMap (map M.callInfoRange . M.termErrCalls) termErrs
-    _ -> mempty
-
   -- All names mentioned in the syntax tree (not bound variables).
   names :: [A.AmbiguousQName]
   names =
@@ -211,7 +202,7 @@ generateAndPrintSyntaxInfo decl hlLevel = do
     universeBi decl
     where
     extendedLambda :: A.QName -> Bool
-    extendedLambda n = extendlambdaname `isPrefixOf` show (A.qnameName n)
+    extendedLambda = (extendedLambdaName `isPrefixOf`) . show . A.nameConcrete . A.qnameName
 
   -- Bound variables, dotted patterns, record fields, module names,
   -- the "as" and "to" symbols.
@@ -373,15 +364,15 @@ type NameKinds = A.QName -> Maybe NameKind
 -- | Builds a 'NameKinds' function.
 
 nameKinds :: Level
-             -- ^ This should only be @'Full' something@ if
+             -- ^ This should only be @'Full'@ if
              -- type-checking completed successfully (without any
              -- errors).
           -> A.Declaration
           -> TCM NameKinds
 nameKinds hlLevel decl = do
-  imported <- fix . stImports <$> get
+  imported <- fix <$> use stImports
   local    <- case hlLevel of
-    Full _ -> fix . stSignature <$> get
+    Full{} -> fix <$> use stSignature
     _      -> return HMap.empty
       -- Traverses the syntax tree and constructs a map from qualified
       -- names to name kinds. TODO: Handle open public.
@@ -454,115 +445,64 @@ generateConstructorInfo
   -> A.Declaration
   -> TCM File
 generateConstructorInfo modMap file kinds decl = do
-  -- Extract all defined names from the declaration.
-  let names = Fold.toList (A.allNames decl)
-
-  -- Look up the corresponding declarations in the internal syntax.
-  defMap <- M.sigDefinitions <$> M.getSignature
-  let defs = catMaybes $ map (flip HMap.lookup defMap) names
-
-  -- Instantiate meta variables.
-  clauses <- R.instantiateFull $ concatMap M.defClauses defs
-  types   <- R.instantiateFull $ map defType defs
 
-  let -- Find all patterns and terms.
-      patterns = universeBi (types, clauses)
-      terms    = universeBi (types, clauses)
+  -- Get boundaries of current declaration.
+  -- @noRange@ should be impossible, but in case of @noRange@
+  -- it makes sense to return the empty File.
+  ifNull (P.getRange decl) (return mempty) $ \ (P.Range is) -> do
+  let start = fromIntegral $ P.posPos $ P.iStart $ head is
+      end   = fromIntegral $ P.posPos $ P.iEnd   $ last is
 
-      -- Find all constructors in the patterns and terms.
-      constrs = filter ((/= P.noRange) . P.getRange) $
-                concatMap getConstructorP patterns ++
-                concatMap getConstructor  terms
-
-  -- Find all constructors in right-hand sides of delayed definitions.
-  delayed <- evalStateT (getDelayed terms) HSet.empty
+  -- Get all disambiguated names that fall within the range of decl.
+  m0 <- use stDisambiguatedNames
+  let (_, m1) = IntMap.split (pred start) m0
+      (m2, _) = IntMap.split end m1
+      constrs = IntMap.elems m2
 
   -- Return suitable syntax highlighting information.
-  return $ Fold.fold $ fmap (generate modMap file kinds . mkAmb)
-                            (delayed ++ constrs)
-  where
-  mkAmb q = A.AmbQ [q]
-
-  -- Finds names corresponding to delayed definitions occurring at the
-  -- top of the given terms, as well as in the found definition's
-  -- right-hand sides. Only definitions from the current file are
-  -- considered.
-  --
-  -- Constructors occurring in the delayed definitions' right-hand
-  -- sides are returned.
-  --
-  -- The set is used to avoid inspecting the same definition multiple
-  -- times.
-
-  getDelayed :: [I.Term] -> StateT (HashSet A.QName) TCM [A.QName]
-  getDelayed ts = concat <$> mapM getT ts
-    where
-    getT t = do
-      lift $ reportSDoc "highlighting.delayed" 50 $
-        text "Inspecting sub-term:" <+> prettyTCM t
-
-      seen <- get
-      case t of
-        I.Def q _ | not (q `HSet.member` seen)
-                      &&
-                    fmap P.srcFile (P.rStart (P.getRange q)) ==
-                      Just (Just file)
-                  -> getQ q
-        _         -> return []
-
-    getQ q = do
-      lift $ reportSDoc "highlighting.delayed" 30 $
-        text "Inspecting name:" <+> prettyTCM q
-
-      def <- lift $ getConstInfo q
-      case defDelayed def of
-        NotDelayed -> return []
-        Delayed    -> do
-          lift $ reportSDoc "highlighting.delayed" 10 $
-            text "Found delayed definition:" <+> prettyTCM q
-
-          -- Mark the definition as seen.
-          modify (HSet.insert q)
-
-          -- All sub-terms in the delayed definition's right-hand
-          -- sides.
-          terms <- universeBi . concat . map (getRHS . I.clauseBody) <$>
-                     lift (R.instantiateFull $ defClauses def)
-
-          -- Find the constructors and continue the search.
-          (concatMap getConstructor terms ++) <$> getDelayed terms
-
-    getRHS (I.Body v)   = [v]
-    getRHS I.NoBody     = []
-    getRHS (I.Bind b)   = getRHS (I.unAbs b)
-
-  getConstructorP :: I.Pattern -> [A.QName]
-  getConstructorP (I.ConP c _ _) = [I.conName c]
-  getConstructorP _              = []
-
-  getConstructor :: I.Term -> [A.QName]
-  getConstructor (I.Con q _) = [I.conName q]
-  getConstructor _           = []
+  let files = for constrs $ \ q -> generate modMap file kinds $ A.AmbQ [q]
+  return $ Fold.fold files
+
 
 -- | Prints syntax highlighting info for an error.
 
 printErrorInfo :: TCErr -> TCM ()
-printErrorInfo e = do
-  -- Erase previous highlighting.
-  printHighlightingInfo $ singletonC (rToR $ P.continuousPerLine $ P.getRange e) mempty
+printErrorInfo e = printHighlightingInfo . compress =<< errorHighlighting e
 
-  -- Print new highlighting.
-  printHighlightingInfo . compress =<< errorHighlighting e
+-- | Generate highlighting for error.
+--   Does something special for termination errors.
 
 errorHighlighting :: TCErr -> TCM File
+
+errorHighlighting (TypeError s cl@(Closure sig env scope (TerminationCheckFailed termErrs))) =
+  -- For termination errors, we keep the previous highlighting,
+  -- just additionally mark the bad calls.
+  return $ terminationErrorHighlighting termErrs
+
 errorHighlighting e = do
+
+  -- Erase previous highlighting.
+  let r     = P.getRange e
+      erase = singleton (rToR $ P.continuousPerLine r) mempty
+
+  -- Print new highlighting.
   s <- E.prettyError e
-  return $ singleton (rToR r)
+  let error = singleton (rToR r)
          $ mempty { otherAspects = [Error]
                   , note         = Just s
                   }
+  return $ mconcat [ erase, error ]
+
+-- | Generate syntax highlighting for termination errors.
+
+terminationErrorHighlighting :: [TerminationError] -> File
+terminationErrorHighlighting termErrs = functionDefs `mappend` callSites
   where
-    r = P.getRange e
+    m            = mempty { otherAspects = [TerminationProblem] }
+    functionDefs = Fold.foldMap (\x -> singleton (rToR $ bindingSite x) m) $
+                   concatMap M.termErrFunctions termErrs
+    callSites    = Fold.foldMap (\r -> singleton (rToR r) m) $
+                   concatMap (map M.callInfoRange . M.termErrCalls) termErrs
 
 -- | Generates and prints syntax highlighting information for unsolved
 -- meta-variables and certain unsolved constraints.
@@ -642,7 +582,7 @@ nameToFile :: SourceToModule
               -- ^ The name qualifier (may be empty).
            -> C.Name
               -- ^ The base name.
-           -> (Bool -> MetaInfo)
+           -> (Bool -> Aspects)
               -- ^ Meta information to be associated with the name.
               -- The argument is 'True' iff the name is an operator.
            -> Maybe P.Range
@@ -664,23 +604,24 @@ nameToFile modMap file xs x m mR =
     r <- mR
     P.Pn { P.srcFile = Just f, P.posPos = p } <- P.rStart r
     mod <- Map.lookup f modMap
-    return (mod, toInteger p)
+    return (mod, fromIntegral p)
 
 -- | A variant of 'nameToFile' for qualified abstract names.
 
-nameToFileA :: SourceToModule
-               -- ^ Maps source file paths to module names.
-            -> AbsolutePath
-               -- ^ The file name of the current module. Used for
-               -- consistency checking.
-            -> A.QName
-               -- ^ The name.
-            -> Bool
-               -- ^ Should the binding site be included in the file?
-            -> (Bool -> MetaInfo)
-               -- ^ Meta information to be associated with the name.
-               -- ^ The argument is 'True' iff the name is an operator.
-            -> File
+nameToFileA
+  :: SourceToModule
+     -- ^ Maps source file paths to module names.
+  -> AbsolutePath
+     -- ^ The file name of the current module. Used for
+     -- consistency checking.
+  -> A.QName
+     -- ^ The name.
+  -> Bool
+     -- ^ Should the binding site be included in the file?
+  -> (Bool -> Aspects)
+     -- ^ Meta information to be associated with the name.
+     -- ^ The argument is 'True' iff the name is an operator.
+  -> File
 nameToFileA modMap file x include m =
   nameToFile modMap
              file
@@ -689,9 +630,24 @@ nameToFileA modMap file x include m =
              m
              (if include then Just $ bindingSite x else Nothing)
 
-concreteBase      = A.nameConcrete . A.qnameName
+concreteBase :: I.QName -> C.Name
+concreteBase = A.nameConcrete . A.qnameName
+
+concreteQualifier :: I.QName -> [C.Name]
 concreteQualifier = map A.nameConcrete . A.mnameToList . A.qnameModule
-bindingSite       = A.nameBindingSite . A.qnameName
+
+bindingSite :: I.QName -> P.Range
+bindingSite = A.nameBindingSite . A.qnameName
+
+-- | Remember a name disambiguation (during type checking).
+--   To be used later during syntax highlighting.
+storeDisambiguatedName :: A.QName -> TCM ()
+storeDisambiguatedName q = whenJust (start $ P.getRange q) $ \ i ->
+  stDisambiguatedNames %= IntMap.insert i q
+  where
+    start (P.Range [])    = Nothing
+    start (P.Range (i:_)) = Just $ fromIntegral $ P.posPos $ P.iStart i
+    -- TODO: Move start to Agda.Syntax.Position
 
 ------------------------------------------------------------------------
 -- All tests
diff --git a/src/full/Agda/Interaction/Highlighting/HTML.hs b/src/full/Agda/Interaction/Highlighting/HTML.hs
index 385bfc0..3c33264 100644
--- a/src/full/Agda/Interaction/Highlighting/HTML.hs
+++ b/src/full/Agda/Interaction/Highlighting/HTML.hs
@@ -15,8 +15,9 @@ import Control.Monad.State.Class
 import Data.Function
 import Data.Monoid
 import Data.Maybe
-import qualified Data.Map  as Map
-import qualified Data.List as List
+import qualified Data.IntMap as IntMap
+import qualified Data.Map    as Map
+import qualified Data.List   as List
 
 import System.FilePath
 import System.Directory
@@ -36,11 +37,12 @@ import Agda.TypeChecking.Monad (TCM)
 import qualified Agda.TypeChecking.Monad as TCM
 
 import Agda.Utils.FileName (filePath)
+import Agda.Utils.Lens
 import qualified Agda.Utils.IO.UTF8 as UTF8
 import Agda.Utils.Pretty
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | The name of the default CSS file.
@@ -94,7 +96,7 @@ generatePage
   -> HighlightingInfo      -- ^ Syntax highlighting info for the module.
   -> TCM ()
 generatePage dir mod highlighting = do
-  mf <- Map.lookup mod . TCM.stModuleToSource <$> get
+  mf <- Map.lookup mod <$> use TCM.stModuleToSource
   case mf of
     Nothing -> __IMPOSSIBLE__
     Just f  -> do
@@ -146,12 +148,12 @@ code contents info =
             (pos, map (snd . snd) cs, maybe mempty id mi)
           [] -> __IMPOSSIBLE__) $
   List.groupBy ((==) `on` fst) $
-  map (\(pos, c) -> (Map.lookup pos infoMap, (pos, c))) $
+  map (\(pos, c) -> (IntMap.lookup pos infoMap, (pos, c))) $
   zip [1..] contents
   where
   infoMap = toMap (decompress info)
 
-  annotate :: Integer -> MetaInfo -> Html -> Html
+  annotate :: Int -> Aspects -> Html -> Html
   annotate pos mi = anchor ! attributes
     where
     attributes =
diff --git a/src/full/Agda/Interaction/Highlighting/LaTeX.hs b/src/full/Agda/Interaction/Highlighting/LaTeX.hs
index 97717cc..0363fdd 100644
--- a/src/full/Agda/Interaction/Highlighting/LaTeX.hs
+++ b/src/full/Agda/Interaction/Highlighting/LaTeX.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP          #-}
 {-# LANGUAGE ViewPatterns #-}
 
 -- | Function for generating highlighted and aligned LaTeX from literate
@@ -13,7 +13,6 @@ import Data.Char
 import Data.Maybe
 import Data.Function
 import Control.Monad.RWS
-import Control.Monad.Error
 import System.Directory
 import System.FilePath
 import Data.Text (Text)
@@ -22,8 +21,9 @@ import qualified Data.Text.IO       as T
 import qualified Data.Text.Encoding as E
 import qualified Data.ByteString    as BS
 
-import qualified Data.List as List
-import qualified Data.Map  as Map
+import qualified Data.IntMap as IntMap
+import qualified Data.List   as List
+import qualified Data.Map    as Map
 
 import Paths_Agda
 
@@ -39,18 +39,20 @@ import qualified Agda.Utils.IO.UTF8 as UTF8
 import Agda.Utils.FileName (filePath)
 import Agda.Utils.Pretty (pretty, render)
 
-#include "../../undefined.h"
+import Agda.Utils.Except ( ExceptT, MonadError(throwError), runExceptT )
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
 -- * Datatypes.
 
--- | The @LaTeX@ monad is a combination of @ErrorT@, @RWST@ and
+-- | The @LaTeX@ monad is a combination of @ExceptT@, @RWST@ and
 -- @IO at . The error part is just used to keep track whether we finished
 -- or not, the reader part isn't used, the writer is where the output
 -- goes and the state is for keeping track of the tokens and some other
 -- useful info, and the I/O part is used for printing debugging info.
-type LaTeX = ErrorT String (RWST () Text State IO)
+type LaTeX = ExceptT String (RWST () Text State IO)
 
 data State = State
   { tokens     :: Tokens
@@ -66,8 +68,8 @@ type Tokens = [Token]
 
 data Token = Token
   { text     :: Text
-  , info     :: MetaInfo
-  , position :: Integer  -- ^ Is not used currently, but could
+  , info     :: Aspects
+  , position :: Int      -- ^ Is not used currently, but could
                          -- potentially be used for hyperlinks as in
                          -- the HTML output?
   }
@@ -78,7 +80,7 @@ data Debug = MoveColumn | NonCode | Code | Spaces | Output
 
 -- | Run function for the @LaTeX@ monad.
 runLaTeX :: LaTeX a -> () -> State -> IO (Either String a, State, Text)
-runLaTeX = runRWST . runErrorT
+runLaTeX = runRWST . runExceptT
 
 emptyState :: State
 emptyState = State
@@ -93,6 +95,7 @@ emptyState = State
 ------------------------------------------------------------------------
 -- * Some helpers.
 
+(<+>) :: Text -> Text -> Text
 (<+>) = T.append
 
 isInfixOf' :: Text -> Text -> Maybe (Text, Text)
@@ -246,24 +249,40 @@ output text = do
 -- Polytable, http://www.ctan.org/pkg/polytable, is used for code
 -- alignment, similar to lhs2TeX's approach.
 
+nl, beginCode, endCode :: Text
 nl        = T.pack "%\n"
 beginCode = T.pack "\\begin{code}"
 endCode   = T.pack "\\end{code}"
 
-ptOpen     = T.pack "\\>"
-ptOpen'  i = ptOpen <+> T.pack ("[" ++ show i ++ "]")
-ptClose    = T.pack "\\<"
+ptOpen :: Text
+ptOpen = T.pack "\\>"
+
+ptOpen' :: Show a => a -> Text
+ptOpen' i = ptOpen <+> T.pack ("[" ++ show i ++ "]")
+
+ptClose :: Text
+ptClose = T.pack "\\<"
+
+ptClose' :: Show a => a -> Text
 ptClose' i = ptClose <+> T.pack ("[" ++ show i ++ "]")
-ptNL       = nl <+> T.pack "\\\\\n"
 
-cmdPrefix   = T.pack "\\Agda"
-cmdArg    x = T.singleton '{' <+> x <+> T.singleton '}'
+ptNL :: Text
+ptNL = nl <+> T.pack "\\\\\n"
+
+cmdPrefix :: Text
+cmdPrefix = T.pack "\\Agda"
+
+cmdArg :: Text -> Text
+cmdArg x = T.singleton '{' <+> x <+> T.singleton '}'
+
+cmdIndent :: Show a => a -> Text
 cmdIndent i = cmdPrefix <+> T.pack "Indent" <+>
                   cmdArg (T.pack (show i)) <+> cmdArg T.empty
 
-infixl'     = T.pack "infixl"
-infix'      = T.pack "infix"
-infixr'     = T.pack "infixr"
+infixl', infix', infixr' :: Text
+infixl' = T.pack "infixl"
+infix'  = T.pack "infix"
+infixr' = T.pack "infixr"
 
 ------------------------------------------------------------------------
 -- * Automaton.
@@ -474,6 +493,7 @@ spaces (_                              : ss) = __IMPOSSIBLE__
 ------------------------------------------------------------------------
 -- * Main.
 
+defaultStyFile :: String
 defaultStyFile = "agda.sty"
 
 -- | The only exported function. It's (only) called in @Main.hs at .
@@ -529,7 +549,7 @@ toLaTeX source hi
   . map (\xs -> case xs of
                     (mi, (pos, _)) : _ ->
                         Token { text     = T.pack $ map (\(_, (_, c)) -> c) xs
-                              , info     = maybe mempty id mi
+                              , info     = fromMaybe mempty mi
                               , position = pos
                               }
                     []                 -> __IMPOSSIBLE__)
@@ -540,7 +560,7 @@ toLaTeX source hi
 
   -- Look up the meta info at each position in the highlighting info.
   . map (\(pos, char) ->
-        (Map.lookup pos infoMap, (pos, char)))
+        (IntMap.lookup pos infoMap, (pos, char)))
 
   -- Add position in file to each character.
   . zip [1..]
diff --git a/src/full/Agda/Interaction/Highlighting/Precise.hs b/src/full/Agda/Interaction/Highlighting/Precise.hs
index 2c90106..932dafa 100644
--- a/src/full/Agda/Interaction/Highlighting/Precise.hs
+++ b/src/full/Agda/Interaction/Highlighting/Precise.hs
@@ -7,7 +7,7 @@ module Agda.Interaction.Highlighting.Precise
     Aspect(..)
   , NameKind(..)
   , OtherAspect(..)
-  , MetaInfo(..)
+  , Aspects(..)
   , File
   , HighlightingInfo
     -- ** Creation
@@ -41,6 +41,8 @@ import Data.Monoid
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad
 import Agda.Utils.QuickCheck
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Typeable (Typeable)
@@ -53,8 +55,9 @@ import Agda.Interaction.Highlighting.Range
 ------------------------------------------------------------------------
 -- Files
 
--- | Various more or less syntactic aspects of the code. (These cannot
--- overlap.)
+-- | Syntactic aspects of the code. (These cannot overlap.)
+--   They can be obtained from the lexed tokens already,
+--   except for the 'NameKind'.
 
 data Aspect
   = Comment
@@ -66,6 +69,8 @@ data Aspect
   | Name (Maybe NameKind) Bool -- ^ Is the name an operator part?
     deriving (Eq, Show, Typeable)
 
+-- | @NameKind at s are figured our during scope checking.
+
 data NameKind
   = Bound                   -- ^ Bound variable.
   | Constructor C.Induction -- ^ Inductive or coinductive constructor.
@@ -79,8 +84,8 @@ data NameKind
   | Argument                -- ^ Named argument, like x in {x = v}
     deriving (Eq, Show, Typeable)
 
--- | Other aspects. (These can overlap with each other and with
--- 'Aspect's.)
+-- | Other aspects, generated by type checking.
+--   (These can overlap with each other and with 'Aspect's.)
 
 data OtherAspect
   = Error
@@ -100,7 +105,7 @@ data OtherAspect
 -- | Meta information which can be associated with a
 -- character\/character range.
 
-data MetaInfo = MetaInfo
+data Aspects = Aspects
   { aspect       :: Maybe Aspect
   , otherAspects :: [OtherAspect]
   , note         :: Maybe String
@@ -108,7 +113,7 @@ data MetaInfo = MetaInfo
     -- something like that. It should contain useful information about
     -- the range (like the module containing a certain identifier, or
     -- the fixity of an operator).
-  , definitionSite :: Maybe (SC.TopLevelModuleName, Integer)
+  , definitionSite :: Maybe (SC.TopLevelModuleName, Int)
     -- ^ The definition site of the annotated thing, if applicable and
     --   known. File positions are counted from 1.
   }
@@ -118,7 +123,7 @@ data MetaInfo = MetaInfo
 --
 -- The first position in the file has number 1.
 
-newtype File = File { mapping :: Map Integer MetaInfo }
+newtype File = File { mapping :: IntMap Aspects }
   deriving (Eq, Show, Typeable)
 
 -- | Syntax highlighting information.
@@ -131,13 +136,13 @@ type HighlightingInfo = CompressedFile
 -- | @'singleton' rs m@ is a file whose positions are those in @rs@,
 -- and in which every position is associated with @m at .
 
-singleton :: Ranges -> MetaInfo -> File
+singleton :: Ranges -> Aspects -> File
 singleton rs m = File {
- mapping = Map.fromAscList [ (p, m) | p <- rangesToPositions rs ] }
+ mapping = IntMap.fromAscList [ (p, m) | p <- rangesToPositions rs ] }
 
 -- | Like 'singleton', but with several 'Ranges' instead of only one.
 
-several :: [Ranges] -> MetaInfo -> File
+several :: [Ranges] -> Aspects -> File
 several rs m = mconcat $ map (\r -> singleton r m) rs
 
 ------------------------------------------------------------------------
@@ -145,36 +150,38 @@ several rs m = mconcat $ map (\r -> singleton r m) rs
 
 -- | Merges meta information.
 
-mergeMetaInfo :: MetaInfo -> MetaInfo -> MetaInfo
-mergeMetaInfo m1 m2 = MetaInfo
+mergeAspects :: Aspects -> Aspects -> Aspects
+mergeAspects m1 m2 = Aspects
   { aspect       = (mplus `on` aspect) m1 m2
   , otherAspects = nub $ ((++) `on` otherAspects) m1 m2
   , note         = case (note m1, note m2) of
       (Just n1, Just n2) -> Just $
-         if n1 == n2 then n1
-                     else addFinalNewLine n1 ++ "----\n" ++ n2
+         if n1 == n2
+           then n1
+           else addFinalNewLine n1 ++ "----\n" ++ n2
       (Just n1, Nothing) -> Just n1
       (Nothing, Just n2) -> Just n2
       (Nothing, Nothing) -> Nothing
   , definitionSite = (mplus `on` definitionSite) m1 m2
   }
 
-instance Monoid MetaInfo where
-  mempty = MetaInfo { aspect         = Nothing
-                    , otherAspects   = []
-                    , note           = Nothing
-                    , definitionSite = Nothing
-                    }
-  mappend = mergeMetaInfo
+instance Monoid Aspects where
+  mempty = Aspects
+    { aspect         = Nothing
+    , otherAspects   = []
+    , note           = Nothing
+    , definitionSite = Nothing
+    }
+  mappend = mergeAspects
 
 -- | Merges files.
 
 merge :: File -> File -> File
 merge f1 f2 =
-  File { mapping = (Map.unionWith mappend `on` mapping) f1 f2 }
+  File { mapping = (IntMap.unionWith mappend `on` mapping) f1 f2 }
 
 instance Monoid File where
-  mempty  = File { mapping = Map.empty }
+  mempty  = File { mapping = IntMap.empty }
   mappend = merge
 
 ------------------------------------------------------------------------
@@ -182,30 +189,30 @@ instance Monoid File where
 
 -- | Returns the smallest position, if any, in the 'File'.
 
-smallestPos :: File -> Maybe Integer
-smallestPos = fmap (fst . fst) . Map.minViewWithKey . mapping
+smallestPos :: File -> Maybe Int
+smallestPos = fmap (fst . fst) . IntMap.minViewWithKey . mapping
 
 -- | Convert the 'File' to a map from file positions (counting from 1)
 -- to meta information.
 
-toMap :: File -> Map Integer MetaInfo
+toMap :: File -> IntMap Aspects
 toMap = mapping
 
 ------------------------------------------------------------------------
 -- Compressed files
 
 -- | A compressed 'File', in which consecutive positions with the same
--- 'MetaInfo' are stored together.
+-- 'Aspects' are stored together.
 
 newtype CompressedFile =
-  CompressedFile { ranges :: [(Range, MetaInfo)] }
+  CompressedFile { ranges :: [(Range, Aspects)] }
   deriving (Eq, Show, Typeable)
 
 -- | Invariant for compressed files.
 --
 -- Note that these files are not required to be /maximally/
 -- compressed, because ranges are allowed to be empty, and the
--- 'MetaInfo's in adjacent ranges are allowed to be equal.
+-- 'Aspects's in adjacent ranges are allowed to be equal.
 
 compressedFileInvariant :: CompressedFile -> Bool
 compressedFileInvariant (CompressedFile []) = True
@@ -220,7 +227,7 @@ compressedFileInvariant (CompressedFile f)  =
 
 compress :: File -> CompressedFile
 compress f =
-  CompressedFile $ map join $ groupBy' p (Map.toAscList $ mapping f)
+  CompressedFile $ map join $ groupBy' p (IntMap.toAscList $ mapping f)
   where
   p (pos1, m1) (pos2, m2) = pos2 == pos1 + 1 && m1 == m2
   join pms = ( Range { from = head ps, to = last ps + 1 }
@@ -233,11 +240,12 @@ compress f =
 decompress :: CompressedFile -> File
 decompress =
   File .
-  Map.fromList .
+  IntMap.fromList .
   concat .
   map (\(r, m) -> [ (p, m) | p <- rangeToPositions r ]) .
   ranges
 
+prop_compress :: File -> Bool
 prop_compress f =
   compressedFileInvariant c
   &&
@@ -261,18 +269,20 @@ noHighlightingInRange rs (CompressedFile hs) =
 -- | @'singletonC' rs m@ is a file whose positions are those in @rs@,
 -- and in which every position is associated with @m at .
 
-singletonC :: Ranges -> MetaInfo -> CompressedFile
+singletonC :: Ranges -> Aspects -> CompressedFile
 singletonC (Ranges rs) m =
   CompressedFile [(r, m) | r <- rs, not (empty r)]
 
+prop_singleton :: Ranges -> Aspects -> Bool
 prop_singleton rs m = singleton rs m == decompress (singletonC rs m)
 
 -- | Like 'singletonR', but with a list of 'Ranges' instead of a
 -- single one.
 
-severalC :: [Ranges] -> MetaInfo -> CompressedFile
+severalC :: [Ranges] -> Aspects -> CompressedFile
 severalC rss m = mconcat $ map (\rs -> singletonC rs m) rss
 
+prop_several :: [Ranges] -> Aspects -> Bool
 prop_several rss m = several rss m == decompress (severalC rss m)
 
 -- | Merges compressed files.
@@ -293,7 +303,7 @@ mergeC (CompressedFile f1) (CompressedFile f2) =
   -- Precondition: The ranges are overlapping.
   fuse (i1, m1) (i2, m2) =
     ( fix [ (Range { from = a, to = b }, ma)
-          , (Range { from = b, to = c }, mergeMetaInfo m1 m2)
+          , (Range { from = b, to = c }, mergeAspects m1 m2)
           ]
     , fix [ (Range { from = c, to = d }, md)
           ]
@@ -304,6 +314,7 @@ mergeC (CompressedFile f1) (CompressedFile f2) =
              [(from i1, m1), (to i1, m1), (from i2, m2), (to i2, m2)]
     fix = filter (not . empty . fst)
 
+prop_merge :: File -> File -> Bool
 prop_merge f1 f2 =
   merge f1 f2 == decompress (mergeC (compress f1) (compress f2))
 
@@ -315,7 +326,7 @@ instance Monoid CompressedFile where
 -- where all the positions in @f1@ are @< p@, and all the positions
 -- in @f2@ are @>= p at .
 
-splitAtC :: Integer -> CompressedFile ->
+splitAtC :: Int -> CompressedFile ->
             (CompressedFile, CompressedFile)
 splitAtC p f = (CompressedFile f1, CompressedFile f2)
   where
@@ -330,6 +341,7 @@ splitAtC p f = (CompressedFile f1, CompressedFile f2)
           toP      = Range { from = from r, to = p    }
           fromP    = Range { from = p,      to = to r }
 
+prop_splitAtC :: Int -> CompressedFile -> Bool
 prop_splitAtC p f =
   all (<  p) (positions f1) &&
   all (>= p) (positions f2) &&
@@ -337,14 +349,15 @@ prop_splitAtC p f =
   where
   (f1, f2) = splitAtC p f
 
-  positions = Map.keys . toMap . decompress
+  positions = IntMap.keys . toMap . decompress
 
 -- | Returns the smallest position, if any, in the 'CompressedFile'.
 
-smallestPosC :: CompressedFile -> Maybe Integer
+smallestPosC :: CompressedFile -> Maybe Int
 smallestPosC (CompressedFile [])           = Nothing
 smallestPosC (CompressedFile ((r, _) : _)) = Just (from r)
 
+prop_smallestPos :: CompressedFile -> Bool
 prop_smallestPos f = smallestPos (decompress f) == smallestPosC f
 
 ------------------------------------------------------------------------
@@ -403,35 +416,35 @@ instance Arbitrary OtherAspect where
 instance CoArbitrary OtherAspect where
   coarbitrary = coarbitrary . fromEnum
 
-instance Arbitrary MetaInfo where
+instance Arbitrary Aspects where
   arbitrary = do
     aspect  <- arbitrary
     other   <- arbitrary
     note    <- maybeGen string
     defSite <- arbitrary
-    return (MetaInfo { aspect = aspect, otherAspects = other
+    return (Aspects { aspect = aspect, otherAspects = other
                      , note = note, definitionSite = defSite })
     where string = listOfElements "abcdefABCDEF/\\.\"'@()åäö\n"
 
-  shrink (MetaInfo a o n d) =
-    [ MetaInfo a o n d | a <- shrink a ] ++
-    [ MetaInfo a o n d | o <- shrink o ] ++
-    [ MetaInfo a o n d | n <- shrink n ] ++
-    [ MetaInfo a o n d | d <- shrink d ]
+  shrink (Aspects a o n d) =
+    [ Aspects a o n d | a <- shrink a ] ++
+    [ Aspects a o n d | o <- shrink o ] ++
+    [ Aspects a o n d | n <- shrink n ] ++
+    [ Aspects a o n d | d <- shrink d ]
 
-instance CoArbitrary MetaInfo where
-  coarbitrary (MetaInfo aspect otherAspects note defSite) =
+instance CoArbitrary Aspects where
+  coarbitrary (Aspects aspect otherAspects note defSite) =
     coarbitrary aspect .
     coarbitrary otherAspects .
     coarbitrary note .
     coarbitrary defSite
 
 instance Arbitrary File where
-  arbitrary = fmap (File . Map.fromList) $ listOf arbitrary
-  shrink    = map (File . Map.fromList) . shrink . Map.toList . toMap
+  arbitrary = fmap (File . IntMap.fromList) $ listOf arbitrary
+  shrink    = map (File . IntMap.fromList) . shrink . IntMap.toList . toMap
 
 instance CoArbitrary File where
-  coarbitrary (File rs) = coarbitrary (Map.toAscList rs)
+  coarbitrary (File rs) = coarbitrary (IntMap.toAscList rs)
 
 instance Arbitrary CompressedFile where
   arbitrary = do
diff --git a/src/full/Agda/Interaction/Highlighting/Range.hs b/src/full/Agda/Interaction/Highlighting/Range.hs
index 991ebed..f859a86 100644
--- a/src/full/Agda/Interaction/Highlighting/Range.hs
+++ b/src/full/Agda/Interaction/Highlighting/Range.hs
@@ -31,7 +31,7 @@ import Agda.Utils.QuickCheck
 --
 -- Invariant: @'from' '<=' 'to'@.
 
-data Range = Range { from, to :: Integer }
+data Range = Range { from, to :: Int }
              deriving (Eq, Ord, Show, Typeable)
 
 -- | The 'Range' invariant.
@@ -72,14 +72,15 @@ empty r = to r <= from r
 
 -- | Converts a range to a list of positions.
 
-rangeToPositions :: Range -> [Integer]
+rangeToPositions :: Range -> [Int]
 rangeToPositions r = [from r .. to r - 1]
 
 -- | Converts several ranges to a list of positions.
 
-rangesToPositions :: Ranges -> [Integer]
+rangesToPositions :: Ranges -> [Int]
 rangesToPositions (Ranges rs) = concatMap rangeToPositions rs
 
+prop_rangesToPositions :: Ranges -> Bool
 prop_rangesToPositions rs = sorted (rangesToPositions rs)
 
 -- | Converts a 'P.Range' to a 'Ranges'.
@@ -90,7 +91,7 @@ rToR (P.Range is) = Ranges (map iToR is)
   iToR (P.Interval { P.iStart = P.Pn { P.posPos = pos1 }
                    , P.iEnd   = P.Pn { P.posPos = pos2 }
                    }) =
-    Range { from = toInteger pos1, to = toInteger pos2 }
+    Range { from = fromIntegral pos1, to = fromIntegral pos2 }
 
 ------------------------------------------------------------------------
 -- Operations
@@ -115,6 +116,7 @@ minus (Ranges rs1) (Ranges rs2) = Ranges (m rs1 rs2)
     | to y < to x     = m (Range { from = to y, to = to x } : xs) ys
     | otherwise       = m xs (y:ys)
 
+prop_minus :: Ranges -> Ranges -> Bool
 prop_minus xs ys =
   rangesToPositions (xs `minus` ys) ==
   rangesToPositions xs \\ rangesToPositions ys
diff --git a/src/full/Agda/Interaction/Highlighting/Vim.hs b/src/full/Agda/Interaction/Highlighting/Vim.hs
index 04185b8..d559e84 100644
--- a/src/full/Agda/Interaction/Highlighting/Vim.hs
+++ b/src/full/Agda/Interaction/Highlighting/Vim.hs
@@ -22,26 +22,26 @@ import Agda.Utils.Tuple
 vimFile :: FilePath -> FilePath
 vimFile file =
     case splitFileName file of
-	(path, name) -> path </> "" <.> name <.> "vim"
+        (path, name) -> path </> "" <.> name <.> "vim"
 
 escape :: String -> String
 escape = concatMap esc
     where
-	escchars = "$\\^.*~[]"
-	esc c	| c `elem` escchars = ['\\',c]
-		| otherwise	    = [c]
+        escchars = "$\\^.*~[]"
+        esc c   | c `elem` escchars = ['\\',c]
+                | otherwise         = [c]
 
 wordBounded :: String -> String
 wordBounded s0 = concat ["\\<", s0, "\\>"]
 
 keyword :: String -> [String] -> String
 keyword _ [] = ""
-keyword cat ws	= "syn keyword " ++ unwords (cat : ws)
+keyword cat ws  = "syn keyword " ++ unwords (cat : ws)
 
 match :: String -> [String] -> String
 match _ [] = ""
-match cat ws	= "syn match " ++ cat ++ " \"" ++
-		    concat (List.intersperse "\\|" $ map (wordBounded . escape) ws) ++ "\""
+match cat ws    = "syn match " ++ cat ++ " \"" ++
+                    concat (List.intersperse "\\|" $ map (wordBounded . escape) ws) ++ "\""
 
 matches :: [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String]
 matches cons icons defs idefs flds iflds =
@@ -49,41 +49,41 @@ matches cons icons defs idefs flds iflds =
     $ List.sortBy (compare `on` fst)
     $ cons' ++ defs' ++ icons' ++ idefs'
     where
-	cons'  = foo "agdaConstructor"	    $ classify length cons
-	icons' = foo "agdaInfixConstructor" $ classify length icons
-	defs'  = foo "agdaFunction"	    $ classify length defs
-	idefs' = foo "agdaInfixFunction"    $ classify length idefs
-	flds'  = foo "agdaProjection"	    $ classify length flds
-	iflds' = foo "agdaInfixProjection"  $ classify length iflds
+        cons'  = foo "agdaConstructor"      $ classify length cons
+        icons' = foo "agdaInfixConstructor" $ classify length icons
+        defs'  = foo "agdaFunction"         $ classify length defs
+        idefs' = foo "agdaInfixFunction"    $ classify length idefs
+        flds'  = foo "agdaProjection"       $ classify length flds
+        iflds' = foo "agdaInfixProjection"  $ classify length iflds
 
-	classify f = List.groupBy ((==) `on` f)
-		     . List.sortBy (compare `on` f)
+        classify f = List.groupBy ((==) `on` f)
+                     . List.sortBy (compare `on` f)
 
-	foo :: String -> [[String]] -> [(Int, String)]
-	foo cat = map (length . head /\ match cat)
+        foo :: String -> [[String]] -> [(Int, String)]
+        foo cat = map (length . head /\ match cat)
 
 toVim :: NamesInScope -> String
 toVim ns = unlines $ matches mcons micons mdefs midefs mflds miflds
     where
-	cons = [ x | (x, def:_) <- Map.toList ns, anameKind def == ConName ]
-	defs = [ x | (x, def:_) <- Map.toList ns, anameKind def == DefName ]
-	flds = [ x | (x, fld:_) <- Map.toList ns, anameKind fld == FldName ]
+        cons = [ x | (x, def:_) <- Map.toList ns, anameKind def == ConName ]
+        defs = [ x | (x, def:_) <- Map.toList ns, anameKind def == DefName ]
+        flds = [ x | (x, fld:_) <- Map.toList ns, anameKind fld == FldName ]
 
-	mcons = map show cons
-	mdefs = map show defs
-	mflds = map show flds
+        mcons = map show cons
+        mdefs = map show defs
+        mflds = map show flds
 
-	micons = concatMap parts cons
-	midefs = concatMap parts defs
-	miflds = concatMap parts flds
+        micons = concatMap parts cons
+        midefs = concatMap parts defs
+        miflds = concatMap parts flds
 
-	parts (NoName _ _) = []
-	parts (Name _ [_]) = []
-	parts (Name _ ps)  = [ rawNameToString x | Id x <- ps ]
+        parts (NoName _ _) = []
+        parts (Name _ [_]) = []
+        parts (Name _ ps)  = [ rawNameToString x | Id x <- ps ]
 
 generateVimFile :: FilePath -> TCM ()
 generateVimFile file = do
     scope <- getScope
     liftIO $ UTF8.writeFile (vimFile file) $ toVim $ names scope
     where
-	names = nsNames . everythingInScope
+        names = nsNames . everythingInScope
diff --git a/src/full/Agda/Interaction/Imports.hs b/src/full/Agda/Interaction/Imports.hs
index d8d2809..e193baa 100644
--- a/src/full/Agda/Interaction/Imports.hs
+++ b/src/full/Agda/Interaction/Imports.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE TupleSections #-}
 
 {-| This module deals with finding imported modules and loading their
@@ -8,7 +8,6 @@ module Agda.Interaction.Imports where
 
 import Prelude
 
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Control.Exception as E
@@ -23,9 +22,12 @@ import Data.Maybe
 import Data.Monoid (mempty, mappend)
 import Data.Map (Map)
 import Data.Set (Set)
+
 import System.Directory (doesFileExist, getModificationTime, removeFile)
 import System.FilePath ((</>))
 
+import qualified Text.PrettyPrint.Boxes as Boxes
+
 import Paths_Agda (getDataFileName)
 
 import qualified Agda.Syntax.Abstract as A
@@ -40,7 +42,7 @@ import Agda.Syntax.Internal
 import Agda.TypeChecking.Errors
 import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Monad
--- import Agda.TypeChecking.Monad.Base.KillRange  -- killRange for Signature
+import Agda.TypeChecking.Monad.Base.KillRange  -- killRange for Signature
 import Agda.TypeChecking.Serialise
 import Agda.TypeChecking.Telescope
 import Agda.TypeChecking.Primitive
@@ -56,25 +58,34 @@ import Agda.Interaction.Highlighting.Precise (HighlightingInfo)
 import Agda.Interaction.Highlighting.Generate
 import Agda.Interaction.Highlighting.Vim
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.FileName
+import Agda.Utils.Lens
 import Agda.Utils.Monad
+import Agda.Utils.Null (unlessNullM)
 import Agda.Utils.IO.Binary
 import Agda.Utils.Pretty
-import Agda.Utils.Fresh
 import Agda.Utils.Time
 import Agda.Utils.Hash
 import qualified Agda.Utils.Trie as Trie
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
+-- | Are we loading the interface for the user-loaded file
+--   or for an import?
+data MainInterface
+  = MainInterface     -- ^ Interface for main file.
+  | NotMainInterface  -- ^ Interface for imported file.
+  deriving (Eq, Show)
+
 -- | Merge an interface into the current proof state.
 mergeInterface :: Interface -> TCM ()
 mergeInterface i = do
-    let sig	= iSignature i
-	builtin = Map.toList $ iBuiltin i
-	prim	= [ x | (_,Prim x) <- builtin ]
-	bi	= Map.fromList [ (x,Builtin t) | (x,Builtin t) <- builtin ]
+    let sig     = iSignature i
+        builtin = Map.toList $ iBuiltin i
+        prim    = [ x | (_,Prim x) <- builtin ]
+        bi      = Map.fromList [ (x,Builtin t) | (x,Builtin t) <- builtin ]
     bs <- gets stBuiltinThings
     reportSLn "import.iface.merge" 10 $ "Merging interface"
     reportSLn "import.iface.merge" 20 $
@@ -93,22 +104,19 @@ mergeInterface i = do
     reportSLn "import.iface.merge" 20 $
       "  Rebinding primitives " ++ show prim
     prim <- Map.fromList <$> mapM rebind prim
-    modify $ \st -> st { stImportedBuiltins = stImportedBuiltins st `Map.union` prim
-		       }
+    stImportedBuiltins %= (`Map.union` prim)
     where
-	rebind (x, q) = do
-	    PrimImpl _ pf <- lookupPrimitiveFunction x
-	    return (x, Prim $ pf { primFunName = q })
+        rebind (x, q) = do
+            PrimImpl _ pf <- lookupPrimitiveFunction x
+            return (x, Prim $ pf { primFunName = q })
 
 addImportedThings ::
   Signature -> BuiltinThings PrimFun -> Set String -> A.PatternSynDefns -> TCM ()
 addImportedThings isig ibuiltin hsImports patsyns = do
-  modify $ \st -> st
-    { stImports          = unionSignatures [stImports st, isig]
-    , stImportedBuiltins = Map.union (stImportedBuiltins st) ibuiltin
-    , stHaskellImports   = Set.union (stHaskellImports st) hsImports
-    , stPatternSynImports = Map.union (stPatternSynImports st) patsyns
-    }
+  stImports %= \imp -> unionSignatures [imp, isig]
+  stImportedBuiltins %= \imp -> Map.union imp ibuiltin
+  stHaskellImports %= \imp -> Set.union imp hsImports
+  stPatternSynImports %= \imp -> Map.union imp patsyns
   addSignatureInstances isig
 
 -- | Scope checks the given module. A proper version of the module
@@ -146,10 +154,10 @@ alreadyVisited x getIface = do
     case mm of
         -- A module with warnings should never be allowed to be
         -- imported from another module.
-	Just mi | not (miWarnings mi) -> do
+        Just mi | not (miWarnings mi) -> do
           reportSLn "import.visit" 10 $ "  Already visited " ++ render (pretty x)
           return (miInterface mi, NoWarnings)
-	_ -> do
+        _ -> do
           reportSLn "import.visit" 5 $ "  Getting interface for " ++ render (pretty x)
           r@(i, wt) <- getIface
           reportSLn "import.visit" 5 $ "  Now we've looked at " ++ render (pretty x)
@@ -164,7 +172,7 @@ alreadyVisited x getIface = do
 --   or the file passed on the command line.
 --
 --   First, the primitive modules are imported.
---   Then, 'typeCheck' is called to do the main work.
+--   Then, @getInterface'@ is called to do the main work.
 
 typeCheckMain :: AbsolutePath -> TCM (Interface, MaybeWarnings)
 typeCheckMain f = do
@@ -188,28 +196,27 @@ typeCheckMain f = do
           moduleName $ mkAbsolute $
             libpath </> "prim" </> "Agda" </> "Primitive.agda"
   reportSLn "import.main" 10 $ "Done importing the primitive modules."
-  typeCheck f
-
--- | Type checks the given module (if necessary).
---
---   Called recursively for imported modules.
 
-typeCheck :: AbsolutePath -> TCM (Interface, MaybeWarnings)
-typeCheck f = do
+  -- Now do the type checking via getInterface.
   m <- moduleName f
-  getInterface' m True
+  getInterface' m MainInterface
 
--- | Tries to return the interface associated to the given module. The
--- time stamp of the relevant interface file is also returned. May
--- type check the module. An error is raised if a warning is
--- encountered.
+-- | Tries to return the interface associated to the given (imported) module.
+--   The time stamp of the relevant interface file is also returned.
+--   Calls itself recursively for the imports of the given module.
+--   May type check the module.
+--   An error is raised if a warning is encountered.
+--
+--   Do not use this for the main file, use 'typeCheckMain' instead.
 
 getInterface :: ModuleName -> TCM Interface
 getInterface = getInterface_ . toTopLevelModuleName
 
+-- | See 'getInterface'.
+
 getInterface_ :: C.TopLevelModuleName -> TCM Interface
 getInterface_ x = do
-  (i, wt) <- getInterface' x False
+  (i, wt) <- getInterface' x NotMainInterface
   case wt of
     SomeWarnings w  -> warningsToError w
     NoWarnings      -> return i
@@ -218,18 +225,19 @@ getInterface_ x = do
 -- encountered then they are returned instead of being turned into
 -- errors.
 
-getInterface' :: C.TopLevelModuleName
-              -> Bool  -- ^ If type checking is necessary, should all
-                       -- state changes inflicted by 'createInterface'
-                       -- be preserved?
-              -> TCM (Interface, MaybeWarnings)
-getInterface' x includeStateChanges =
-  withIncreasedModuleNestingLevel $
+getInterface'
+  :: C.TopLevelModuleName
+  -> MainInterface
+     -- ^ If type checking is necessary,
+     --   should all state changes inflicted by 'createInterface' be preserved?
+  -> TCM (Interface, MaybeWarnings)
+getInterface' x isMain = do
+  withIncreasedModuleNestingLevel $ do
   -- Preserve the pragma options unless includeStateChanges is True.
-  bracket_ (stPragmaOptions <$> get)
+  bracket_ (use stPragmaOptions)
            (unless includeStateChanges . setPragmaOptions) $ do
    -- Forget the pragma options (locally).
-   setCommandLineOptions . stPersistentOptions . stPersistent =<< get
+   setCommandLineOptions . stPersistentOptions . stPersistentState =<< get
 
    alreadyVisited x $ addImportCycleCheck x $ do
     file <- findFile x  -- requires source to exist
@@ -253,8 +261,11 @@ getInterface' x includeStateChanges =
       "  " ++ render (pretty x) ++ " is " ++
       (if uptodate then "" else "not ") ++ "up-to-date."
 
+    -- Andreas, 2014-10-20 AIM XX:
+    -- Always retype-check the main file to get the iInsideScope
+    -- which is no longer serialized.
     (stateChangesIncluded, (i, wt)) <-
-      if uptodate then skip file else typeCheckThe file
+      if uptodate && isMain == NotMainInterface then skip file else typeCheckThe file
 
     -- Ensure that the given module name matches the one in the file.
     let topLevelName = toTopLevelModuleName $ iModuleName i
@@ -272,7 +283,7 @@ getInterface' x includeStateChanges =
         ifTopLevelAndHighlightingLevelIs NonInteractive $
           highlightFromInterface i file
 
-    modify (\s -> s { stCurrentModule = Just $ iModuleName i })
+    stCurrentModule .= Just (iModuleName i)
 
     -- Interfaces are only stored if no warnings were encountered.
     case wt of
@@ -282,6 +293,8 @@ getInterface' x includeStateChanges =
     return (i, wt)
 
     where
+      includeStateChanges = isMain == MainInterface
+
       isCached file = do
         let ifile = filePath $ toIFile file
         exist <- liftIO $ doesFileExistCaseSensitive ifile
@@ -327,10 +340,10 @@ getInterface' x includeStateChanges =
 
         -- Check that it's the right version
         case mi of
-          Nothing	-> do
+          Nothing       -> do
             reportSLn "import.iface" 5 $ "  bad interface, re-type checking"
             typeCheckThe file
-          Just i	-> do
+          Just i        -> do
 
             reportSLn "import.iface" 5 $ "  imports: " ++ show (iImportedModules i)
 
@@ -339,7 +352,7 @@ getInterface' x includeStateChanges =
             -- If any of the imports are newer we need to retype check
             if hs /= map snd (iImportedModules i)
               then do
-                -- liftIO close	-- Close the interface file. See above.
+                -- liftIO close -- Close the interface file. See above.
                 typeCheckThe file
               else do
                 unless cached $ chaseMsg "Skipping" (Just ifile)
@@ -373,12 +386,12 @@ getInterface' x includeStateChanges =
             nesting  <- asks envModuleNestingLevel
             range    <- asks envRange
             call     <- asks envCall
-            mf       <- gets stModuleToSource
+            mf       <- use stModuleToSource
             vs       <- getVisitedModules
             ds       <- getDecodedModules
-            opts     <- stPersistentOptions . stPersistent <$> get
+            opts     <- stPersistentOptions . stPersistentState <$> get
             isig     <- getImportedSignature
-            ibuiltin <- gets stImportedBuiltins
+            ibuiltin <- use stImportedBuiltins
             ipatsyns <- getPatternSynImports
             ho       <- getInteractionOutputCallback
             -- Every interface is treated in isolation. Note: Changes
@@ -400,16 +413,15 @@ getInterface' x includeStateChanges =
                      setDecodedModules ds
                      setCommandLineOptions opts
                      setInteractionOutputCallback ho
-                     modify $ \s -> s { stModuleToSource     = mf
-                                      }
+                     stModuleToSource .= mf
                      setVisitedModules vs
                      addImportedThings isig ibuiltin Set.empty ipatsyns
 
                      r  <- withMsgs $ createInterface file x
-                     mf <- stModuleToSource <$> get
+                     mf <- use stModuleToSource
                      ds <- getDecodedModules
                      return (r, do
-                        modify $ \s -> s { stModuleToSource = mf }
+                        stModuleToSource .= mf
                         setDecodedModules ds
                         case r of
                           (i, NoWarnings) -> storeDecodedModule i
@@ -477,6 +489,11 @@ readInterface file = do
 writeInterface :: FilePath -> Interface -> TCM ()
 writeInterface file i = do
     reportSLn "import.iface.write" 5  $ "Writing interface file " ++ file ++ "."
+    -- Andreas, Makoto, 2014-10-18 AIM XX:
+    -- iInsideScope is bloating the interface files, so we do not serialize it?
+    i <- return $
+      i { iInsideScope  = emptyScopeInfo
+        }
     encodeFile file i
     reportSLn "import.iface.write" 5 $ "Wrote interface file."
     reportSLn "import.iface.write" 50 $ "  hash = " ++ show (iFullHash i) ++ ""
@@ -500,9 +517,9 @@ createInterface
   -> TCM (Interface, MaybeWarnings)
 createInterface file mname =
   local (\e -> e { envCurrentPath = file }) $ do
-    modFile       <- stModuleToSource <$> get
+    modFile       <- use stModuleToSource
     fileTokenInfo <- billTop Bench.Highlighting $ generateTokenInfo file
-    modify $ \st -> st { stTokens = fileTokenInfo }
+    stTokens .= fileTokenInfo
 
     reportSLn "import.iface.create" 5 $
       "Creating interface for " ++ render (pretty mname) ++ "."
@@ -559,12 +576,10 @@ createInterface file mname =
     billTop Bench.Highlighting $ do
 
       -- Move any remaining token highlighting to stSyntaxInfo.
-      ifTopLevelAndHighlightingLevelIs NonInteractive $
-        printHighlightingInfo . stTokens =<< get
-      modify $ \st ->
-        st { stTokens     = mempty
-           , stSyntaxInfo = stSyntaxInfo st `mappend` stTokens st
-           }
+      toks <- use stTokens
+      ifTopLevelAndHighlightingLevelIs NonInteractive $ printHighlightingInfo toks
+      stTokens .= mempty
+      stSyntaxInfo %= \inf -> inf `mappend` toks
 
       whenM (optGenerateVimFile <$> commandLineOptions) $
         -- Generate Vim file.
@@ -575,14 +590,13 @@ createInterface file mname =
     reportSLn "scope.top" 50 $ "SCOPE " ++ show (insideScope topLevel)
 
     -- Serialization.
-    syntaxInfo <- stSyntaxInfo <$> get
+    syntaxInfo <- use stSyntaxInfo
     i <- billTop Bench.Serialization $ do
       buildInterface file topLevel syntaxInfo previousHsImports options
 
     -- TODO: It would be nice if unsolved things were highlighted
     -- after every mutual block.
 
-    termErrs            <- Fold.toList <$> stTermErrs <$> get
     unsolvedMetas       <- List.nub <$> (mapM getMetaRange =<< getOpenMetas)
     unsolvedConstraints <- getAllConstraints
     interactionPoints   <- getInteractionPoints
@@ -590,7 +604,7 @@ createInterface file mname =
     ifTopLevelAndHighlightingLevelIs NonInteractive $
       printUnsolvedInfo
 
-    r <- if and [ null termErrs, null unsolvedMetas, null unsolvedConstraints, null interactionPoints ]
+    r <- if and [ null unsolvedMetas, null unsolvedConstraints, null interactionPoints ]
      then billTop Bench.Serialization $ do
       -- The file was successfully type-checked (and no warnings were
       -- encountered), so the interface should be written out.
@@ -598,19 +612,17 @@ createInterface file mname =
       writeInterface ifile i
       return (i, NoWarnings)
      else do
-      termErr <- if null termErrs then return Nothing else Just <$> do
-        typeError_ $ TerminationCheckFailed termErrs
-      return (i, SomeWarnings $ Warnings termErr unsolvedMetas unsolvedConstraints)
+      return (i, SomeWarnings $ Warnings unsolvedMetas unsolvedConstraints)
 
     -- Profiling: Print statistics.
+    printStatistics 30 (Just mname) =<< getStatistics
+
+    -- Get the statistics of the current module
+    -- and add it to the accumulated statistics.
+    localStatistics <- getStatistics
+    lensAccumStatistics %= Map.unionWith (+) localStatistics
     verboseS "profile" 1 $ do
-      stats <- Map.toList <$> getStatistics
-      case stats of
-        []      -> return ()
-        _       -> reportS "profile" 1 $ unlines $
-          [ "Ticks for " ++ show (pretty mname) ] ++
-          [ "  " ++ s ++ " = " ++ show n
-          | (s, n) <- sortBy (compare `on` snd) stats ]
+      reportSLn "import.iface" 5 $ "Accumulated statistics."
 
     return r
 
@@ -635,15 +647,17 @@ buildInterface file topLevel syntaxInfo previousHsImports pragmas = do
     let scope = scope' { scopeCurrent = m }
     -- Andreas, 2014-05-03: killRange did not result in significant reduction
     -- of .agdai file size, and lost a few seconds performance on library-test.
-    -- sig     <- killRange <$> getSignature
-    sig     <- getSignature
-    builtin <- gets stLocalBuiltins
+    -- Andreas, Makoto, 2014-10-18 AIM XX: repeating the experiment
+    -- with discarding also the nameBindingSite in QName:
+    -- Saves 10% on serialization time (and file size)!
+    sig     <- killRange <$> getSignature
+    builtin <- use stLocalBuiltins
     ms      <- getImports
     mhs     <- mapM (\ m -> (m,) <$> moduleHash m) $ Set.toList ms
     hsImps  <- getHaskellImports
     patsyns <- getPatternSyns
     h       <- liftIO $ hashFile file
-    let	builtin' = Map.mapWithKey (\ x b -> (x,) . primFunName <$> b) builtin
+    let builtin' = Map.mapWithKey (\ x b -> (x,) . primFunName <$> b) builtin
     reportSLn "import.iface" 7 "  instantiating all meta variables"
     i <- instantiateFull $ Interface
       { iSourceHash      = h
@@ -687,8 +701,8 @@ isNewerThan new old = do
     newExist <- doesFileExist new
     oldExist <- doesFileExist old
     if not (newExist && oldExist)
-	then return newExist
-	else do
-	    newT <- getModificationTime new
-	    oldT <- getModificationTime old
-	    return $ newT >= oldT
+        then return newExist
+        else do
+            newT <- getModificationTime new
+            oldT <- getModificationTime old
+            return $ newT >= oldT
diff --git a/src/full/Agda/Interaction/InteractionTop.hs b/src/full/Agda/Interaction/InteractionTop.hs
index b559605..c956729 100644
--- a/src/full/Agda/Interaction/InteractionTop.hs
+++ b/src/full/Agda/Interaction/InteractionTop.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveFoldable        #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE DeriveTraversable     #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE Rank2Types            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
 
 {-# OPTIONS -fno-cse #-}
 
@@ -19,10 +19,10 @@ module Agda.Interaction.InteractionTop
 import Control.Applicative hiding (empty)
 import qualified Control.Exception as E
 import Control.Monad.Identity
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 
+import qualified Data.Char as Char
 import Data.Foldable (Foldable)
 import Data.Function
 import Data.List as List
@@ -73,15 +73,23 @@ import qualified Agda.Compiler.JS.Compiler as JS
 
 import qualified Agda.Auto.Auto as Auto
 
+import Agda.Utils.Except
+  ( ExceptT
+  , mkExceptT
+  , MonadError(catchError, throwError)
+  , runExceptT
+  )
+
 import Agda.Utils.FileName
 import Agda.Utils.Hash
 import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.Lens
 import Agda.Utils.Monad
 import Agda.Utils.Pretty
 import Agda.Utils.String
 import Agda.Utils.Time
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------
@@ -248,12 +256,12 @@ runInteraction (IOTCM current highlighting highlightingMethod cmd)
         meta    <- lift $ computeUnsolvedMetaWarnings
         constr  <- lift $ computeUnsolvedConstraints
         err     <- lift $ errorHighlighting e
-        modFile <- lift $ gets stModuleToSource
+        modFile <- lift $ use stModuleToSource
         let info = compress $ mconcat
                      -- Errors take precedence over unsolved things.
                      [err, meta, constr]
         s <- lift $ prettyError e
-        x <- lift . gets $ optShowImplicit . stPragmaOptions
+        x <- lift $ optShowImplicit <$> use stPragmaOptions
         mapM_ putResponse $
             [ Resp_DisplayInfo $ Info_Error s ] ++
             tellEmacsToJumpToError (getRange e) ++
@@ -406,7 +414,7 @@ data IOTCM' range
 -- | The 'Parse' monad.
 --   'StateT' state holds the remaining input.
 
-type Parse a = ErrorT String (StateT String Identity) a
+type Parse a = ExceptT String (StateT String Identity) a
 
 -- | Converter from the type of 'reads' to 'Parse'
 --   The first paramter is part of the error message
@@ -422,7 +430,7 @@ readsToParse s f = do
             return a
 
 parseToReadsPrec :: Parse a -> Int -> String -> [(a, String)]
-parseToReadsPrec p i s = case runIdentity . flip runStateT s . runErrorT $ parens' p of
+parseToReadsPrec p i s = case runIdentity . flip runStateT s . runExceptT $ parens' p of
     (Right a, s) -> [(a,s)]
     _ -> []
 
@@ -592,7 +600,7 @@ interpret (Cmd_load_highlighting_info source) = do
               sourceH <- liftIO $ hashFile absSource
               if sourceH == iSourceHash (miInterface mi)
                then do
-                modFile <- gets stModuleToSource
+                modFile <- use stModuleToSource
                 return $ Just (iHighlighting $ miInterface mi, modFile)
                else
                 return Nothing
@@ -609,14 +617,14 @@ interpret (Cmd_highlight ii rng s) = withCurrentFile $ do
     lift $ printHighlightingInfo =<< generateTokenInfoFromString rng s
     lift $ highlightExpr e
   where
-    handle :: ErrorT String TCM () -> CommandM ()
+    handle :: ExceptT String TCM () -> CommandM ()
     handle m = do
-      res <- lift $ runErrorT m
+      res <- lift $ runExceptT m
       case res of
         Left s  -> display_info $ Info_Error s
         Right _ -> return ()
-    try :: String -> TCM a -> ErrorT String TCM a
-    try err m = ErrorT $ do
+    try :: String -> TCM a -> ExceptT String TCM a
+    try err m = mkExceptT $ do
       (Right <$> m) `catchError` \ _ -> return (Left err)
 
 interpret (Cmd_give   ii rng s) = give_gen ii rng s Give
@@ -692,9 +700,14 @@ interpret (Cmd_goal_type_context norm ii rng s) =
   cmd_goal_type_context_and empty norm ii rng s
 
 interpret (Cmd_goal_type_context_infer norm ii rng s) = do
-  typ <- lift $ B.withInteractionId ii $
-           prettyATop =<< B.typeInMeta ii norm =<< B.parseExprIn ii rng s
-  cmd_goal_type_context_and (text "Have:" <+> typ) norm ii rng s
+  -- In case of the empty expression to type, don't fail with
+  -- a stupid parse error, but just fall back to
+  -- Cmd_goal_type_context.
+  have <- if all Char.isSpace s then return empty else do
+    typ <- lift $ B.withInteractionId ii $
+      prettyATop =<< B.typeInMeta ii norm =<< B.parseExprIn ii rng s
+    return $ text "Have:" <+> typ
+  cmd_goal_type_context_and have norm ii rng s
 
 interpret (Cmd_show_module_contents norm ii rng s) =
   liftCommandMT (B.withInteractionId ii) $ showModuleContents norm rng s
@@ -756,7 +769,7 @@ type GoalCommand = InteractionId -> Range -> String -> Interaction
 --
 -- If type checking completes without any exceptions having been
 -- encountered then the command @cmd r@ is executed, where @r@ is the
--- result of 'Imp.typeCheck'.
+-- result of 'Imp.typeCheckMain'.
 
 cmd_load' :: FilePath -> [FilePath]
           -> Bool -- ^ Allow unsolved meta-variables?
@@ -904,7 +917,7 @@ highlightExpr e =
   local (\e -> e { envModuleNestingLevel = 0
                  , envHighlightingLevel  = NonInteractive
                  , envHighlightingMethod = Direct }) $
-    generateAndPrintSyntaxInfo decl (Full [])
+    generateAndPrintSyntaxInfo decl Full
   where
     dummy = mkName_ (NameId 0 0) "dummy"
     info  = mkDefInfo (nameConcrete dummy) defaultFixity' PublicAccess ConcreteDef (getRange e)
@@ -950,6 +963,8 @@ cmd_helper_function norm ii r s = B.withInteractionId ii $ inTopContext $
 -- | Displays the current goal, the given document, and the current
 -- context.
 
+cmd_goal_type_context_and :: Doc -> B.Rewrite -> InteractionId -> Range ->
+                             String -> StateT CommandState (TCMT IO) ()
 cmd_goal_type_context_and doc norm ii _ _ = do
   goal <- lift $ B.withInteractionId ii $ prettyTypeOfMeta norm ii
   ctx  <- lift $ prettyContext norm True ii
@@ -1000,13 +1015,16 @@ whyInScope s = do
         variable (Just x) xs
           | null xs   = asVar
           | otherwise = TCP.vcat
-             [ TCP.sep [ asVar, TCP.nest 2 $ TCP.text "shadowing"]
+             [ TCP.sep [ asVar, TCP.nest 2 $ shadowing x]
              , TCP.nest 2 $ names xs
              ]
           where
             asVar :: TCM Doc
             asVar = do
-              TCP.text "* a variable bound at" TCP.<+> prettyTCM (nameBindingSite x)
+              TCP.text "* a variable bound at" TCP.<+> prettyTCM (nameBindingSite $ localVar x)
+            shadowing :: LocalVar -> TCM Doc
+            shadowing LocalVar{}    = TCP.text "shadowing"
+            shadowing ShadowedVar{} = TCP.text "in conflict with"
         names   xs = TCP.vcat $ map pName xs
         modules ms = TCP.vcat $ map pMod ms
 
@@ -1020,13 +1038,13 @@ whyInScope s = do
         pName a = TCP.sep
           [ TCP.text "* a"
             TCP.<+> pKind (anameKind a)
-            TCP.<+> TCP.text (show $ anameName a)
+            TCP.<+> TCP.text (prettyShow $ anameName a)
           , TCP.nest 2 $ TCP.text "brought into scope by"
           ] TCP.$$
           TCP.nest 2 (pWhy (nameBindingSite $ qnameName $ anameName a) (anameLineage a))
         pMod :: AbstractModule -> TCM Doc
         pMod  a = TCP.sep
-          [ TCP.text "* a module" TCP.<+> TCP.text (show $ amodName a)
+          [ TCP.text "* a module" TCP.<+> TCP.text (prettyShow $ amodName a)
           , TCP.nest 2 $ TCP.text "brought into scope by"
           ] TCP.$$
           TCP.nest 2 (pWhy (nameBindingSite $ qnameName $ mnameToQName $ amodName a) (amodLineage a))
@@ -1104,7 +1122,7 @@ display_info info = do
 --   xss <- sequence [ List.map (fst . unDom) <$> getContext
 --                   , Map.keys <$> asks envLetBindings
 --                   , List.map qnameName . HMap.keys . sigDefinitions <$> getSignature
--- 		  ]
+--                ]
 --   return $ concat [ parts $ nameConcrete x | x <- concat xss]
 --   where
 --     parts x = [ s | Id s <- nameParts x ]
@@ -1115,6 +1133,7 @@ refreshStr taken s = go nameModifiers where
                 if s' `elem` taken then go mods else (s':taken, s')
   go _        = __IMPOSSIBLE__
 
+nameModifiers :: [String]
 nameModifiers = "" : "'" : "''" : [show i | i <-[3..]]
 
 
@@ -1154,7 +1173,7 @@ parseAndDoAtToplevel cmd title s = do
   let work = lift (B.atTopLevel $ prettyA =<< cmd =<< concreteToAbstract_ e)
   res <- if not doTime then work else do
       (r, time) <- measureTime work
-      return $ text ("Time: " ++ showThousandSep (div time 1000000000) ++ "ms") $$ r
+      return $ text "Time:" <+> pretty time $$ r
   display_info (title res)
 
 -- | Tell to highlight the code using the given highlighting
diff --git a/src/full/Agda/Interaction/MakeCase.hs b/src/full/Agda/Interaction/MakeCase.hs
index b9e334d..2e6775c 100644
--- a/src/full/Agda/Interaction/MakeCase.hs
+++ b/src/full/Agda/Interaction/MakeCase.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections   #-}
 
 module Agda.Interaction.MakeCase where
 
@@ -12,9 +12,12 @@ import Data.Traversable
 
 import Agda.Syntax.Common
 import Agda.Syntax.Position
+import qualified Agda.Syntax.Concrete as C
 import qualified Agda.Syntax.Abstract as A
 import qualified Agda.Syntax.Info as A
 import Agda.Syntax.Internal
+import Agda.Syntax.Scope.Monad (resolveName, ResolvedName(..))
+import Agda.Syntax.Translation.ConcreteToAbstract
 import Agda.Syntax.Translation.InternalToAbstract
 
 import Agda.TypeChecking.Monad
@@ -27,17 +30,21 @@ import Agda.TheTypeChecker
 
 import Agda.Interaction.BasicOps
 
+import Agda.Utils.Functor
 import Agda.Utils.List
 import Agda.Utils.Monad
 import qualified Agda.Utils.Pretty as P
 import Agda.Utils.Size
 import qualified Agda.Utils.HashMap as HMap
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
-data CaseContext = FunctionDef | ExtendedLambda Int Int
-                 deriving (Eq)
+data CaseContext
+  = FunctionDef
+  | ExtendedLambda Int Int
+  deriving (Eq)
+
 -- | Find the clause whose right hand side is the given meta
 -- BY SEARCHING THE WHOLE SIGNATURE. Returns
 -- the original clause, before record patterns have been translated
@@ -82,21 +89,62 @@ findClause m = do
       MetaV m' _  -> m == m'
       _           -> False
 
+
 -- | Parse variables (visible or hidden), returning their de Bruijn indices.
 --   Used in 'makeCase'.
+
 parseVariables :: InteractionId -> Range -> [String] -> TCM [Int]
 parseVariables ii rng ss = do
+
+  -- Get into the context of the meta.
   mId <- lookupInteractionId ii
   updateMetaVarRange mId rng
   mi  <- getMetaInfo <$> lookupMeta mId
-  enterClosure mi $ \ _r -> do
-    n  <- getContextSize
-    xs <- forM (downFrom n) $ \ i -> do
-      (,i) . P.render <$> prettyTCM (var i)
-    forM ss $ \ s -> do
-      case lookup s xs of
-        Nothing -> typeError $ GenericError $ "Unbound variable " ++ s
-        Just i  -> return i
+  enterClosure mi $ \ r -> do
+
+  -- Get printed representation of variables in context.
+  n  <- getContextSize
+  xs <- forM (downFrom n) $ \ i -> do
+    (,i) . P.render <$> prettyTCM (var i)
+
+  -- Get number of module parameters.  These cannot be split on.
+  fv <- getModuleFreeVars =<< currentModule
+  let numSplittableVars = n - fv
+
+  -- Resolve each string to a variable.
+  forM ss $ \ s -> do
+    let failNotVar = typeError $ GenericError $ "Not a (splittable) variable: " ++ s
+        done i
+          | i < numSplittableVars = return i
+          | otherwise             = failNotVar
+
+    -- Note: the range in the concrete name is only approximate.
+    resName <- resolveName $ C.QName $ C.Name r $ C.stringNameParts s
+    case resName of
+
+      -- Fail if s is a name, but not of a variable.
+      DefinedName{}       -> failNotVar
+      FieldName{}         -> failNotVar
+      ConstructorName{}   -> failNotVar
+      PatternSynResName{} -> failNotVar
+
+      -- If s is a variable name in scope, get its de Bruijn index
+      -- via the type checker.
+      VarName x -> do
+        (v, _) <- getVarInfo x
+        case ignoreSharing v of
+          Var i [] -> done i
+          _        -> failNotVar
+
+      -- If s is not a name, compare it to the printed variable representation.
+      -- This fallback is to enable splitting on hidden variables.
+      UnknownName -> do
+        case filter ((s ==) . fst) xs of
+          []      -> typeError $ GenericError $ "Unbound variable " ++ s
+          [(_,i)] -> done i
+          -- Issue 1325: Variable names in context can be ambiguous.
+          _       -> typeError $ GenericError $ "Ambiguous variable " ++ s
+
 
 -- | Entry point for case splitting tactic.
 makeCase :: InteractionId -> Range -> String -> TCM (CaseContext , [A.Clause])
@@ -116,10 +164,13 @@ makeCase hole rng s = withInteractionId hole $ do
   let vars = words s
   if null vars then do
     -- split result
-    res <- splitResult f =<< fixTarget (clauseToSplitClause clause)
-    case res of
-      Nothing  -> typeError $ GenericError $ "Cannot split on result here"
-      Just cov -> (casectxt,) <$> do mapM (makeAbstractClause f) $ splitClauses cov
+    (newPats, sc) <- fixTarget (clauseToSplitClause clause)
+    res <- splitResult f sc
+    scs <- case res of
+      Nothing  -> if newPats then return [sc] else
+        typeError $ GenericError $ "Cannot split on result here"
+      Just cov -> mapM (snd <.> fixTarget) $ splitClauses cov
+    (casectxt,) <$> mapM (makeAbstractClause f) scs
   else do
     -- split on variables
     vars <- parseVariables hole rng vars
diff --git a/src/full/Agda/Interaction/Monad.hs b/src/full/Agda/Interaction/Monad.hs
index c91e86e..089fc92 100644
--- a/src/full/Agda/Interaction/Monad.hs
+++ b/src/full/Agda/Interaction/Monad.hs
@@ -1,13 +1,16 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances,
-             MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+
 module Agda.Interaction.Monad where
 
 import Agda.TypeChecking.Monad
 
 import Control.Monad.Trans
-import Control.Monad.Error
 import System.Console.Haskeline
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
+
 -- | Interaction monad.
 
 type IM = TCMT (InputT IO)
diff --git a/src/full/Agda/Interaction/Options.hs b/src/full/Agda/Interaction/Options.hs
index 50f453d..3249c26 100644
--- a/src/full/Agda/Interaction/Options.hs
+++ b/src/full/Agda/Interaction/Options.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
 
 #if __GLASGOW_HASKELL__ <= 706
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFunctor      #-}
 {-# LANGUAGE StandaloneDeriving #-}
 #endif
 
@@ -29,24 +29,25 @@ module Agda.Interaction.Options
     ) where
 
 import Control.Monad            ( when )
-import Control.Monad.Error	( MonadError(..) )
 import Data.Maybe               ( isJust )
-import Data.List		( isSuffixOf , intercalate )
-import System.Console.GetOpt	( getOpt, usageInfo, ArgOrder(ReturnInOrder)
-				, OptDescr(..), ArgDescr(..)
-				)
+import Data.List                ( isSuffixOf , intercalate )
+import System.Console.GetOpt    ( getOpt, usageInfo, ArgOrder(ReturnInOrder)
+                                , OptDescr(..), ArgDescr(..)
+                                )
 
 import Agda.Termination.CutOff  ( CutOff(..) )
 
 import Agda.Utils.TestHelpers   ( runTests )
 import Agda.Utils.QuickCheck    ( quickCheck' )
 import Agda.Utils.FileName      ( AbsolutePath )
-import Agda.Utils.Monad		( readM )
+import Agda.Utils.Monad         ( readM )
 import Agda.Utils.List          ( wordsBy )
 import Agda.Utils.String        ( indent )
 import Agda.Utils.Trie          ( Trie )
 import qualified Agda.Utils.Trie as Trie
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
+
 -- | This should probably go somewhere else.
 isLiterate :: FilePath -> Bool
 isLiterate file = ".lagda" `isSuffixOf` file
@@ -67,36 +68,36 @@ type IncludeDirs = Either [FilePath] [AbsolutePath]
      -- interpreted as @["."]@ (see
      -- 'Agda.TypeChecking.Monad.Options.makeIncludeDirsAbsolute').
 
-data CommandLineOptions =
-    Options { optProgramName          :: String
-            , optInputFile            :: Maybe FilePath
-            , optIncludeDirs          :: IncludeDirs
-            , optShowVersion          :: Bool
-            , optShowHelp             :: Bool
-            , optInteractive          :: Bool
-            , optRunTests             :: Bool
-            , optGHCiInteraction      :: Bool
-            , optCompile              :: Bool
-            , optCompileNoMain        :: Bool
-            , optEpicCompile          :: Bool
-            , optJSCompile            :: Bool
-            , optCompileDir           :: Maybe FilePath
-              -- ^ In the absence of a path the project root is used.
-	    , optGenerateVimFile      :: Bool
-            , optGenerateLaTeX        :: Bool
-	    , optGenerateHTML         :: Bool
-	    , optDependencyGraph      :: Maybe FilePath
-	    , optLaTeXDir             :: FilePath
-	    , optHTMLDir              :: FilePath
-	    , optCSSFile              :: Maybe FilePath
-	    , optIgnoreInterfaces     :: Bool
-            , optForcing              :: Bool
-            , optGhcFlags             :: [String]
-            , optPragmaOptions        :: PragmaOptions
-            , optEpicFlags            :: [String]
-            , optSafe                 :: Bool
-            }
-    deriving Show
+data CommandLineOptions = Options
+  { optProgramName      :: String
+  , optInputFile        :: Maybe FilePath
+  , optIncludeDirs      :: IncludeDirs
+  , optShowVersion      :: Bool
+  , optShowHelp         :: Bool
+  , optInteractive      :: Bool
+  , optRunTests         :: Bool
+  , optGHCiInteraction  :: Bool
+  , optCompile          :: Bool
+  , optCompileNoMain    :: Bool
+  , optEpicCompile      :: Bool
+  , optJSCompile        :: Bool
+  , optCompileDir       :: Maybe FilePath
+  -- ^ In the absence of a path the project root is used.
+  , optGenerateVimFile  :: Bool
+  , optGenerateLaTeX    :: Bool
+  , optGenerateHTML     :: Bool
+  , optDependencyGraph  :: Maybe FilePath
+  , optLaTeXDir         :: FilePath
+  , optHTMLDir          :: FilePath
+  , optCSSFile          :: Maybe FilePath
+  , optIgnoreInterfaces :: Bool
+  , optForcing          :: Bool
+  , optGhcFlags         :: [String]
+  , optPragmaOptions    :: PragmaOptions
+  , optEpicFlags        :: [String]
+  , optSafe             :: Bool
+  }
+  deriving Show
 
 -- | Options which can be set in a pragma.
 
@@ -143,34 +144,34 @@ defaultInteractionOptions :: PragmaOptions
 defaultInteractionOptions = defaultPragmaOptions
 
 defaultOptions :: CommandLineOptions
-defaultOptions =
-    Options { optProgramName          = "agda"
-            , optInputFile            = Nothing
-            , optIncludeDirs          = Left []
-            , optShowVersion          = False
-            , optShowHelp             = False
-            , optInteractive          = False
-            , optRunTests             = False
-            , optGHCiInteraction      = False
-            , optCompile              = False
-            , optCompileNoMain        = False
-            , optEpicCompile          = False
-            , optJSCompile            = False
-            , optCompileDir           = Nothing
-	    , optGenerateVimFile      = False
-            , optGenerateLaTeX        = False
-	    , optGenerateHTML         = False
-	    , optDependencyGraph      = Nothing
-	    , optLaTeXDir             = defaultLaTeXDir
-	    , optHTMLDir              = defaultHTMLDir
-	    , optCSSFile              = Nothing
-	    , optIgnoreInterfaces     = False
-            , optForcing              = True
-            , optGhcFlags             = []
-            , optPragmaOptions        = defaultPragmaOptions
-            , optEpicFlags            = []
-            , optSafe                 = False
-            }
+defaultOptions = Options
+  { optProgramName      = "agda"
+  , optInputFile        = Nothing
+  , optIncludeDirs      = Left []
+  , optShowVersion      = False
+  , optShowHelp         = False
+  , optInteractive      = False
+  , optRunTests         = False
+  , optGHCiInteraction  = False
+  , optCompile          = False
+  , optCompileNoMain    = False
+  , optEpicCompile      = False
+  , optJSCompile        = False
+  , optCompileDir       = Nothing
+  , optGenerateVimFile  = False
+  , optGenerateLaTeX    = False
+  , optGenerateHTML     = False
+  , optDependencyGraph  = Nothing
+  , optLaTeXDir         = defaultLaTeXDir
+  , optHTMLDir          = defaultHTMLDir
+  , optCSSFile          = Nothing
+  , optIgnoreInterfaces = False
+  , optForcing          = True
+  , optGhcFlags         = []
+  , optPragmaOptions    = defaultPragmaOptions
+  , optEpicFlags        = []
+  , optSafe             = False
+  }
 
 defaultPragmaOptions :: PragmaOptions
 defaultPragmaOptions = PragmaOptions
@@ -197,16 +198,20 @@ defaultPragmaOptions = PragmaOptions
 
 -- | The default termination depth.
 
+defaultCutOff :: CutOff
 defaultCutOff = CutOff 0 -- minimum value
 
 -- | The default output directory for LaTeX.
 
+defaultLaTeXDir :: String
 defaultLaTeXDir = "latex"
 
 -- | The default output directory for HTML.
 
+defaultHTMLDir :: String
 defaultHTMLDir = "html"
 
+prop_defaultOptions :: Bool
 prop_defaultOptions = case checkOpts defaultOptions of
   Left  _ -> False
   Right _ -> True
@@ -281,58 +286,144 @@ inputFlag f o =
         Nothing  -> return $ o { optInputFile = Just f }
         Just _   -> throwError "only one input file allowed"
 
-versionFlag                  o = return $ o { optShowVersion               = True  }
-helpFlag                     o = return $ o { optShowHelp                  = True  }
-safeFlag                     o = return $ o { optSafe                      = True  }
-proofIrrelevanceFlag         o = return $ o { optProofIrrelevance          = True  }
-experimentalIrrelevanceFlag  o = return $ o { optExperimentalIrrelevance   = True  }
-noIrrelevantProjectionsFlag  o = return $ o { optIrrelevantProjections     = False }
-ignoreInterfacesFlag         o = return $ o { optIgnoreInterfaces          = True  }
-allowUnsolvedFlag            o = return $ o { optAllowUnsolved             = True  }
-showImplicitFlag             o = return $ o { optShowImplicit              = True  }
-showIrrelevantFlag           o = return $ o { optShowIrrelevant            = True  }
-runTestsFlag                 o = return $ o { optRunTests                  = True  }
-ghciInteractionFlag          o = return $ o { optGHCiInteraction           = True  }
-vimFlag                      o = return $ o { optGenerateVimFile           = True  }
-latexFlag                    o = return $ o { optGenerateLaTeX             = True  }
-latexDirFlag               d o = return $ o { optLaTeXDir                  = d     }
-noPositivityFlag             o = return $ o { optDisablePositivity         = True  }
-dontTerminationCheckFlag     o = return $ o { optTerminationCheck          = False }
-dontCompletenessCheckFlag    o = return $ o { optCompletenessCheck         = False }
-dontUniverseCheckFlag        o = return $ o { optUniverseCheck             = False
-                                            , optUniversePolymorphism      = False }
-sizedTypes                   o = return $ o { optSizedTypes                = True  }
-noSizedTypes                 o = return $ o { optSizedTypes                = False  }
-injectiveTypeConstructorFlag o = return $ o { optInjectiveTypeConstructors = True  }
-guardingTypeConstructorFlag  o = return $ o { optGuardingTypeConstructors  = True  }
-universePolymorphismFlag     o = return $ o { optUniversePolymorphism      = True  }
-noUniversePolymorphismFlag   o = return $ o { optUniversePolymorphism      = False }
-noForcingFlag                o = return $ o { optForcing                   = False }
-withKFlag                    o = return $ o { optWithoutK                  = False }
-withoutKFlag                 o = return $ o { optWithoutK                  = True  }
-copatternsFlag               o = return $ o { optCopatterns                = True  }
-noPatternMatchingFlag        o = return $ o { optPatternMatching           = False }
+versionFlag :: Flag CommandLineOptions
+versionFlag o = return $ o { optShowVersion = True }
+
+helpFlag :: Flag CommandLineOptions
+helpFlag o = return $ o { optShowHelp = True }
+
+safeFlag :: Flag CommandLineOptions
+safeFlag o = return $ o { optSafe = True }
+
+proofIrrelevanceFlag :: Flag PragmaOptions
+proofIrrelevanceFlag o = return $ o { optProofIrrelevance = True }
+
+experimentalIrrelevanceFlag :: Flag PragmaOptions
+experimentalIrrelevanceFlag o = return $ o { optExperimentalIrrelevance = True }
+
+noIrrelevantProjectionsFlag :: Flag PragmaOptions
+noIrrelevantProjectionsFlag o = return $ o { optIrrelevantProjections = False }
+
+ignoreInterfacesFlag :: Flag CommandLineOptions
+ignoreInterfacesFlag o = return $ o { optIgnoreInterfaces = True }
+
+allowUnsolvedFlag :: Flag PragmaOptions
+allowUnsolvedFlag o = return $ o { optAllowUnsolved = True }
+
+showImplicitFlag :: Flag PragmaOptions
+showImplicitFlag o = return $ o { optShowImplicit = True }
+
+showIrrelevantFlag :: Flag PragmaOptions
+showIrrelevantFlag o = return $ o { optShowIrrelevant = True }
+
+runTestsFlag :: Flag CommandLineOptions
+runTestsFlag o = return $ o { optRunTests = True }
+
+ghciInteractionFlag :: Flag CommandLineOptions
+ghciInteractionFlag o = return $ o { optGHCiInteraction = True }
+
+vimFlag :: Flag CommandLineOptions
+vimFlag o = return $ o { optGenerateVimFile = True }
+
+latexFlag :: Flag CommandLineOptions
+latexFlag o = return $ o { optGenerateLaTeX = True }
+
+latexDirFlag :: FilePath -> Flag CommandLineOptions
+latexDirFlag d o = return $ o { optLaTeXDir = d }
+
+noPositivityFlag :: Flag PragmaOptions
+noPositivityFlag o = return $ o { optDisablePositivity = True }
+
+dontTerminationCheckFlag :: Flag PragmaOptions
+dontTerminationCheckFlag o = return $ o { optTerminationCheck = False }
+
+dontCompletenessCheckFlag :: Flag PragmaOptions
+dontCompletenessCheckFlag o = return $ o { optCompletenessCheck = False }
+
+dontUniverseCheckFlag :: Flag PragmaOptions
+dontUniverseCheckFlag o = return $ o { optUniverseCheck        = False
+                                     , optUniversePolymorphism = False
+                                     }
 
+sizedTypes :: Flag PragmaOptions
+sizedTypes o = return $ o { optSizedTypes = True }
+
+noSizedTypes :: Flag PragmaOptions
+noSizedTypes o = return $ o { optSizedTypes = False }
+
+injectiveTypeConstructorFlag :: Flag PragmaOptions
+injectiveTypeConstructorFlag o = return $ o { optInjectiveTypeConstructors = True }
+
+guardingTypeConstructorFlag :: Flag PragmaOptions
+guardingTypeConstructorFlag o = return $ o { optGuardingTypeConstructors = True }
+
+universePolymorphismFlag :: Flag PragmaOptions
+universePolymorphismFlag o = return $ o { optUniversePolymorphism = True }
+
+noUniversePolymorphismFlag :: Flag PragmaOptions
+noUniversePolymorphismFlag  o = return $ o { optUniversePolymorphism = False }
+
+noForcingFlag :: Flag CommandLineOptions
+noForcingFlag o = return $ o { optForcing = False }
+
+withKFlag :: Flag PragmaOptions
+withKFlag o = return $ o { optWithoutK = False }
+
+withoutKFlag :: Flag PragmaOptions
+withoutKFlag o = return $ o { optWithoutK = True }
+
+copatternsFlag :: Flag PragmaOptions
+copatternsFlag o = return $ o { optCopatterns = True }
+
+noPatternMatchingFlag :: Flag PragmaOptions
+noPatternMatchingFlag o = return $ o { optPatternMatching = False }
+
+interactiveFlag :: Flag CommandLineOptions
 interactiveFlag  o = return $ o { optInteractive    = True
                                 , optPragmaOptions  = (optPragmaOptions o)
-                                                        { optAllowUnsolved = True }
+                                                      { optAllowUnsolved = True }
                                 }
-compileFlag        o = return $ o { optCompile    = True }
-compileFlagNoMain  o = return $ o { optCompileNoMain = True }
-compileEpicFlag    o = return $ o { optEpicCompile = True}
-compileJSFlag      o = return $ o { optJSCompile = True}
-compileDirFlag f   o = return $ o { optCompileDir = Just f }
-ghcFlag        f   o = return $ o { optGhcFlags   = optGhcFlags o  ++ [f] }  -- NOTE: Quadratic in number of flags.
-epicFlagsFlag  s   o = return $ o { optEpicFlags  = optEpicFlags o ++ [s] }  -- NOTE: Quadratic in number of flags.
-
-htmlFlag      o = return $ o { optGenerateHTML = True }
-dependencyGraphFlag f o = return $ o { optDependencyGraph  = Just f }
-htmlDirFlag d o = return $ o { optHTMLDir      = d }
-cssFlag     f o = return $ o { optCSSFile      = Just f }
 
+compileFlag :: Flag CommandLineOptions
+compileFlag o = return $ o { optCompile = True }
+
+compileFlagNoMain :: Flag CommandLineOptions
+compileFlagNoMain o = return $ o { optCompileNoMain = True }
+
+compileEpicFlag :: Flag CommandLineOptions
+compileEpicFlag o = return $ o { optEpicCompile = True}
+
+compileJSFlag :: Flag CommandLineOptions
+compileJSFlag  o = return $ o { optJSCompile = True }
+
+compileDirFlag :: FilePath -> Flag CommandLineOptions
+compileDirFlag f o = return $ o { optCompileDir = Just f }
+
+-- NOTE: Quadratic in number of flags.
+ghcFlag :: String -> Flag CommandLineOptions
+ghcFlag f o = return $ o { optGhcFlags = optGhcFlags o ++ [f] }
+
+-- NOTE: Quadratic in number of flags.
+epicFlagsFlag :: String -> Flag CommandLineOptions
+epicFlagsFlag s o = return $ o { optEpicFlags = optEpicFlags o ++ [s] }
+
+htmlFlag :: Flag CommandLineOptions
+htmlFlag o = return $ o { optGenerateHTML = True }
+
+dependencyGraphFlag :: FilePath -> Flag CommandLineOptions
+dependencyGraphFlag f o = return $ o { optDependencyGraph = Just f }
+
+htmlDirFlag :: FilePath -> Flag CommandLineOptions
+htmlDirFlag d o = return $ o { optHTMLDir = d }
+
+cssFlag :: FilePath -> Flag CommandLineOptions
+cssFlag f o = return $ o { optCSSFile = Just f }
+
+includeFlag :: FilePath -> Flag CommandLineOptions
 includeFlag d o = return $ o { optIncludeDirs = Left (d : ds) }
   where ds = either id (const []) $ optIncludeDirs o
 
+verboseFlag :: String -> Flag PragmaOptions
 verboseFlag s o =
     do  (k,n) <- parseVerbose s
         return $ o { optVerbose = Trie.insert k n $ optVerbose o }
@@ -344,6 +435,7 @@ verboseFlag s o =
         return (init ss, n)
     usage = throwError "argument to verbose should be on the form x.y.z:N or N"
 
+terminationDepthFlag :: String -> Flag PragmaOptions
 terminationDepthFlag s o =
     do k <- readM s `catchError` \_ -> usage
        when (k < 1) $ usage -- or: turn termination checking off for 0
@@ -370,33 +462,33 @@ standardOptions =
     , Option []     ["epic"] (NoArg compileEpicFlag) "compile program using the Epic backend"
     , Option []     ["js"] (NoArg compileJSFlag) "compile program using the JS backend"
     , Option []     ["compile-dir"] (ReqArg compileDirFlag "DIR")
-		    ("directory for compiler output (default: the project root)")
+                    ("directory for compiler output (default: the project root)")
     , Option []     ["ghc-flag"] (ReqArg ghcFlag "GHC-FLAG")
                     "give the flag GHC-FLAG to GHC when compiling using MAlonzo"
     , Option []     ["epic-flag"] (ReqArg epicFlagsFlag "EPIC-FLAG")
                     "give the flag EPIC-FLAG to Epic when compiling using Epic"
-    , Option []	    ["test"] (NoArg runTestsFlag)
-		    "run internal test suite"
-    , Option []	    ["vim"] (NoArg vimFlag)
-		    "generate Vim highlighting files"
-    , Option []	    ["latex"] (NoArg latexFlag)
+    , Option []     ["test"] (NoArg runTestsFlag)
+                    "run internal test suite"
+    , Option []     ["vim"] (NoArg vimFlag)
+                    "generate Vim highlighting files"
+    , Option []     ["latex"] (NoArg latexFlag)
                     "generate LaTeX with highlighted source code"
-    , Option []	    ["latex-dir"] (ReqArg latexDirFlag "DIR")
+    , Option []     ["latex-dir"] (ReqArg latexDirFlag "DIR")
                     ("directory in which LaTeX files are placed (default: " ++
                      defaultLaTeXDir ++ ")")
-    , Option []	    ["html"] (NoArg htmlFlag)
-		    "generate HTML files with highlighted source code"
-    , Option []	    ["dependency-graph"] (ReqArg dependencyGraphFlag "FILE")
-		    "generate a Dot file with a module dependency graph"
-    , Option []	    ["html-dir"] (ReqArg htmlDirFlag "DIR")
+    , Option []     ["html"] (NoArg htmlFlag)
+                    "generate HTML files with highlighted source code"
+    , Option []     ["dependency-graph"] (ReqArg dependencyGraphFlag "FILE")
+                    "generate a Dot file with a module dependency graph"
+    , Option []     ["html-dir"] (ReqArg htmlDirFlag "DIR")
                     ("directory in which HTML files are placed (default: " ++
                      defaultHTMLDir ++ ")")
-    , Option []	    ["css"] (ReqArg cssFlag "URL")
-		    "the CSS file used by the HTML files (can be relative)"
-    , Option []	    ["ignore-interfaces"] (NoArg ignoreInterfacesFlag)
-		    "ignore interface files (re-type check everything)"
+    , Option []     ["css"] (ReqArg cssFlag "URL")
+                    "the CSS file used by the HTML files (can be relative)"
+    , Option []     ["ignore-interfaces"] (NoArg ignoreInterfacesFlag)
+                    "ignore interface files (re-type check everything)"
     , Option ['i']  ["include-path"] (ReqArg includeFlag "DIR")
-		    "look for imports in DIR"
+                    "look for imports in DIR"
     , Option []     ["no-forcing"] (NoArg noForcingFlag)
                     "disable the forcing optimisation"
     , Option []     ["safe"] (NoArg safeFlag)
@@ -410,26 +502,26 @@ standardOptions =
 
 pragmaOptions :: [OptDescr (Flag PragmaOptions)]
 pragmaOptions =
-    [ Option []	    ["show-implicit"] (NoArg showImplicitFlag)
-		    "show implicit arguments when printing"
-    , Option []	    ["show-irrelevant"] (NoArg showIrrelevantFlag)
-		    "show irrelevant arguments when printing"
-    , Option ['v']  ["verbose"]	(ReqArg verboseFlag "N")
+    [ Option []     ["show-implicit"] (NoArg showImplicitFlag)
+                    "show implicit arguments when printing"
+    , Option []     ["show-irrelevant"] (NoArg showIrrelevantFlag)
+                    "show irrelevant arguments when printing"
+    , Option ['v']  ["verbose"] (ReqArg verboseFlag "N")
                     "set verbosity level to N"
-    -- , Option []	    ["proof-irrelevance"] (NoArg proofIrrelevanceFlag)
-    --     	    "enable proof irrelevance (experimental feature)"
-    , Option []	    ["allow-unsolved-metas"] (NoArg allowUnsolvedFlag)
-		    "allow unsolved meta variables (only needed in batch mode)"
-    , Option []	    ["no-positivity-check"] (NoArg noPositivityFlag)
-		    "do not warn about not strictly positive data types"
-    , Option []	    ["no-termination-check"] (NoArg dontTerminationCheckFlag)
-		    "do not warn about possibly nonterminating code"
-    , Option []	    ["termination-depth"] (ReqArg terminationDepthFlag "N")
-		    "allow termination checker to count decrease/increase upto N (default N=1)"
-    , Option []	    ["no-coverage-check"] (NoArg dontCompletenessCheckFlag)
-		    "do not warn about possibly incomplete pattern matches"
-    , Option []	    ["type-in-type"] (NoArg dontUniverseCheckFlag)
-		    "ignore universe levels (this makes Agda inconsistent)"
+    -- , Option []          ["proof-irrelevance"] (NoArg proofIrrelevanceFlag)
+    --              "enable proof irrelevance (experimental feature)"
+    , Option []     ["allow-unsolved-metas"] (NoArg allowUnsolvedFlag)
+                    "allow unsolved meta variables (only needed in batch mode)"
+    , Option []     ["no-positivity-check"] (NoArg noPositivityFlag)
+                    "do not warn about not strictly positive data types"
+    , Option []     ["no-termination-check"] (NoArg dontTerminationCheckFlag)
+                    "do not warn about possibly nonterminating code"
+    , Option []     ["termination-depth"] (ReqArg terminationDepthFlag "N")
+                    "allow termination checker to count decrease/increase upto N (default N=1)"
+    , Option []     ["no-coverage-check"] (NoArg dontCompletenessCheckFlag)
+                    "do not warn about possibly incomplete pattern matches"
+    , Option []     ["type-in-type"] (NoArg dontUniverseCheckFlag)
+                    "ignore universe levels (this makes Agda inconsistent)"
     , Option []     ["sized-types"] (NoArg sizedTypes)
                     "use sized types (default, inconsistent with `musical' coinduction)"
     , Option []     ["no-sized-types"] (NoArg noSizedTypes)
@@ -465,8 +557,8 @@ parseOptions' ::
   [String] -> [OptDescr (Flag opts)] -> (String -> Flag opts) -> Flag opts
 parseOptions' argv opts fileArg = \defaults ->
     case getOpt (ReturnInOrder fileArg) opts argv of
-	(o,_,[])    -> foldl (>>=) (return defaults) o
-	(_,_,errs)  -> throwError $ concat errs
+        (o,_,[])    -> foldl (>>=) (return defaults) o
+        (_,_,errs)  -> throwError $ concat errs
 
 -- | Parse the standard options.
 parseStandardOptions :: [String] -> Either String CommandLineOptions
@@ -499,27 +591,27 @@ parsePluginOptions argv opts =
 --   agda).
 usage :: [OptDescr ()] -> [(String, String, [String], [OptDescr ()])] -> String -> String
 usage options pluginInfos progName =
-	usageInfo (header progName) options ++
-	"\nPlugins:\n" ++
+        usageInfo (header progName) options ++
+        "\nPlugins:\n" ++
         indent 2 (concatMap pluginMsg pluginInfos)
 
     where
-	header progName = unlines [ "Agda"
-				  , ""
-				  , "Usage: " ++ progName ++ " [OPTIONS...] [FILE]"
-				  ]
+        header progName = unlines [ "Agda"
+                                  , ""
+                                  , "Usage: " ++ progName ++ " [OPTIONS...] [FILE]"
+                                  ]
 
         pluginMsg (name, help, inherited, opts)
             | null opts && null inherited = optHeader
             | otherwise = usageInfo (optHeader ++
                                      "  Plugin-specific options:" ++
-				     inheritedOptions inherited
-				     ) opts
+                                     inheritedOptions inherited
+                                     ) opts
             where
-		optHeader = "\n" ++ name ++ "-plugin:\n" ++ indent 2 help
-		inheritedOptions [] = ""
-		inheritedOptions pls =
-		    "\n    Inherits options from: " ++ unwords pls
+                optHeader = "\n" ++ name ++ "-plugin:\n" ++ indent 2 help
+                inheritedOptions [] = ""
+                inheritedOptions pls =
+                    "\n    Inherits options from: " ++ unwords pls
 
 ------------------------------------------------------------------------
 -- All tests
diff --git a/src/full/Agda/Interaction/Options/Lenses.hs b/src/full/Agda/Interaction/Options/Lenses.hs
index ade731e..8cb95a5 100644
--- a/src/full/Agda/Interaction/Options/Lenses.hs
+++ b/src/full/Agda/Interaction/Options/Lenses.hs
@@ -12,6 +12,8 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Monad.State
 import Agda.Interaction.Options
 
+import Agda.Utils.Lens
+
 ---------------------------------------------------------------------------
 -- * Pragma options
 ---------------------------------------------------------------------------
@@ -30,8 +32,8 @@ instance LensPragmaOptions CommandLineOptions where
   setPragmaOptions opts st = st { optPragmaOptions = opts }
 
 instance LensPragmaOptions TCState where
-  getPragmaOptions = stPragmaOptions
-  setPragmaOptions opts st = st { stPragmaOptions = opts }
+  getPragmaOptions = (^.stPragmaOptions)
+  setPragmaOptions = set stPragmaOptions
 
 modifyPragmaOptions :: (PragmaOptions -> PragmaOptions) -> TCM ()
 modifyPragmaOptions = modify . mapPragmaOptions
@@ -81,7 +83,7 @@ instance LensCommandLineOptions PersistentTCState where
   setCommandLineOptions opts st = st { stPersistentOptions = opts }
 
 instance LensCommandLineOptions TCState where
-  getCommandLineOptions = getCommandLineOptions . stPersistent
+  getCommandLineOptions = getCommandLineOptions . stPersistentState
   mapCommandLineOptions = updatePersistentState . mapCommandLineOptions
 
 modifyCommandLineOptions :: (CommandLineOptions -> CommandLineOptions) -> TCM ()
diff --git a/src/full/Agda/Interaction/Response.hs b/src/full/Agda/Interaction/Response.hs
index 67f69b4..f620452 100644
--- a/src/full/Agda/Interaction/Response.hs
+++ b/src/full/Agda/Interaction/Response.hs
@@ -1,11 +1,11 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 ------------------------------------------------------------------------
 -- | Data type for all interactive responses
 ------------------------------------------------------------------------
 
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-
 module Agda.Interaction.Response
   ( Response (..)
   , MakeCaseVariant (..)
@@ -26,7 +26,7 @@ import Control.Monad.Trans
 import Data.Int
 import System.IO
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Responses for any interactive interface
diff --git a/src/full/Agda/Main.hs b/src/full/Agda/Main.hs
index 902662e..f5f1c79 100644
--- a/src/full/Agda/Main.hs
+++ b/src/full/Agda/Main.hs
@@ -5,7 +5,6 @@
 module Agda.Main where
 
 import Control.Monad.State
-import Control.Monad.Error
 import Control.Applicative
 
 import qualified Data.List as List
@@ -38,16 +37,20 @@ import Agda.Compiler.MAlonzo.Compiler as MAlonzo
 import Agda.Compiler.Epic.Compiler as Epic
 import Agda.Compiler.JS.Compiler as JS
 
+import Agda.Utils.Lens
 import Agda.Utils.Monad
+import Agda.Utils.Pretty (prettyShow)
 import Agda.Utils.String
 import qualified Agda.Utils.Trie as Trie
 
 import Agda.Tests
 import Agda.Version
 
-#include "undefined.h"
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.Impossible
 
+#include "undefined.h"
+
 -- | The main function
 runAgda :: TCM ()
 runAgda = do
@@ -83,12 +86,15 @@ runAgda = do
                        map (Boxes.text . showAccount) $
                        accounts
                 -- Second column is times.
-                -- CPU times are in pico seconds, convert to milliseconds.
                 col2 = Boxes.vcat Boxes.right $
-                       map (Boxes.text . (++ " ms") . showThousandSep . (`div` 1000000000)) $
+                       map (Boxes.text . prettyShow) $
                        times
                 table = Boxes.hsep 1 Boxes.left [col1, col2]
             reportBenchmarkingLn $ Boxes.render table
+
+          -- Print accumulated statistics.
+          printStatistics 20 Nothing =<< use lensAccumStatistics
+
   where
     checkFile :: TCM ()
     checkFile = do
@@ -129,20 +135,20 @@ runAgda = do
 
           unsolvedOK <- optAllowUnsolved <$> pragmaOptions
 
+          -- Reported unsolved problems as error unless unsolvedOK.
+          -- An interface is only generated if NoWarnings.
           result <- case mw of
-                          -- we get here if there are unfilled interaction
-                          -- points that have been solved by unification
-            SomeWarnings (Warnings Nothing [] []) -> return Nothing
             -- Unsolved metas.
-            SomeWarnings (Warnings _ w@(_:_) _)
-              | not unsolvedOK                    -> typeError $ UnsolvedMetas w
+            SomeWarnings (Warnings w@(_:_) _)
+              | not unsolvedOK                 -> typeError $ UnsolvedMetas w
             -- Unsolved constraints.
-            SomeWarnings (Warnings _ _ w@(_:_))
-              | not unsolvedOK                    -> typeError $ UnsolvedConstraints w
-            -- Termination errors.
-            SomeWarnings (Warnings (Just w) _ _)  -> throwError w
-            SomeWarnings _                        -> return Nothing
-            NoWarnings                            -> return $ Just i
+            SomeWarnings (Warnings _ w@(_:_))
+              | not unsolvedOK                 -> typeError $ UnsolvedConstraints w
+            -- Unsolved metas, unsolved constraints, or
+            -- interaction points left whose metas have been solved
+            -- automatically.  (See Issue 1296).
+            SomeWarnings (Warnings _ _)        -> return Nothing
+            NoWarnings                         -> return $ Just i
 
           whenM (optGenerateHTML <$> commandLineOptions) $
             generateHTML
diff --git a/src/full/Agda/Syntax/Abstract.hs b/src/full/Agda/Syntax/Abstract.hs
index 612ddd5..406e8f9 100644
--- a/src/full/Agda/Syntax/Abstract.hs
+++ b/src/full/Agda/Syntax/Abstract.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE DeriveFoldable        #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE DeriveTraversable     #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
 
 {-| The abstract syntax. This is what you get after desugaring and scope
     analysis of the concrete syntax. The type checker works on abstract syntax,
@@ -23,6 +23,7 @@ import Control.Applicative
 
 import Data.Foldable as Fold
 import Data.Map (Map)
+import Data.Maybe
 import Data.Sequence (Seq, (<|), (><))
 import qualified Data.Sequence as Seq
 import Data.Traversable
@@ -43,7 +44,7 @@ import Agda.Syntax.Scope.Base
 import Agda.Utils.Geniplate
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Color      = Expr
@@ -65,41 +66,43 @@ instance Ord Color where
   -- TODO guilhem:
   _ <= _         = __IMPOSSIBLE__
 
+-- | Expressions after scope checking (operators parsed, names resolved).
 data Expr
-        = Var  Name			     -- ^ Bound variables
-        | Def  QName			     -- ^ Constants (i.e. axioms, functions, projections, and datatypes)
-        | Con  AmbiguousQName		     -- ^ Constructors
-	| Lit Literal			     -- ^ Literals
-	| QuestionMark MetaInfo	InteractionId
-          -- ^ Meta variable for interaction.
-          --   The 'InteractionId' is usually identical with the
-          --   'metaNumber' of 'MetaInfo'.
-          --   However, if you want to print an interaction meta as
-          --   just @?@ instead of @?n@, you should set the
-          --   'metaNumber' to 'Nothing' while keeping the 'InteractionId'.
-        | Underscore   MetaInfo
-          -- ^ Meta variable for hidden argument (must be inferred locally).
-        | App  ExprInfo Expr (NamedArg Expr) -- ^
-	| WithApp ExprInfo Expr [Expr]	     -- ^ with application
-        | Lam  ExprInfo LamBinding Expr	     -- ^
-        | AbsurdLam ExprInfo Hiding
-        | ExtendedLam ExprInfo DefInfo QName [Clause]
-        | Pi   ExprInfo Telescope Expr	     -- ^
-	| Fun  ExprInfo (Arg Expr) Expr	     -- ^ independent function space
-        | Set  ExprInfo Integer              -- ^ Set, Set1, Set2, ...
-        | Prop ExprInfo			     -- ^
-        | Let  ExprInfo [LetBinding] Expr    -- ^
-        | ETel Telescope                     -- ^ only used when printing telescopes
-	| Rec  ExprInfo Assigns              -- ^ record construction
-	| RecUpdate ExprInfo Expr Assigns    -- ^ record update
-	| ScopedExpr ScopeInfo Expr	     -- ^ scope annotation
-        | QuoteGoal ExprInfo Name Expr       -- ^ binds @Name@ to current type in @Expr@
-        | QuoteContext ExprInfo Name Expr    -- ^ binds @Name@ to current context in @Expr@
-        | Quote ExprInfo                     -- ^ Quote an identifier 'QName'.
-        | QuoteTerm ExprInfo                 -- ^ Quote a term.
-        | Unquote ExprInfo                   -- ^ The splicing construct: unquote ...
-        | DontCare Expr                      -- ^ for printing DontCare from Syntax.Internal
-        | PatternSyn QName
+  = Var  Name                          -- ^ Bound variable.
+  | Def  QName                         -- ^ Constant: axiom, function, data or record type.
+  | Proj QName                         -- ^ Projection.
+  | Con  AmbiguousQName                -- ^ Constructor.
+  | PatternSyn QName                   -- ^ Pattern synonym.
+  | Lit Literal                        -- ^ Literal.
+  | QuestionMark MetaInfo InteractionId
+    -- ^ Meta variable for interaction.
+    --   The 'InteractionId' is usually identical with the
+    --   'metaNumber' of 'MetaInfo'.
+    --   However, if you want to print an interaction meta as
+    --   just @?@ instead of @?n@, you should set the
+    --   'metaNumber' to 'Nothing' while keeping the 'InteractionId'.
+  | Underscore   MetaInfo
+    -- ^ Meta variable for hidden argument (must be inferred locally).
+  | App  ExprInfo Expr (NamedArg Expr) -- ^ Ordinary (binary) application.
+  | WithApp ExprInfo Expr [Expr]       -- ^ With application.
+  | Lam  ExprInfo LamBinding Expr      -- ^ @λ bs → e at .
+  | AbsurdLam ExprInfo Hiding          -- ^ @λ()@ or @λ{}@.
+  | ExtendedLam ExprInfo DefInfo QName [Clause]
+  | Pi   ExprInfo Telescope Expr       -- ^ Dependent function space @Γ → A at .
+  | Fun  ExprInfo (Arg Expr) Expr      -- ^ Non-dependent function space.
+  | Set  ExprInfo Integer              -- ^ @Set@, @Set1@, @Set2@, ...
+  | Prop ExprInfo                      -- ^ @Prop@ (no longer supported, used as dummy type).
+  | Let  ExprInfo [LetBinding] Expr    -- ^ @let bs in e at .
+  | ETel Telescope                     -- ^ Only used when printing telescopes.
+  | Rec  ExprInfo Assigns              -- ^ Record construction.
+  | RecUpdate ExprInfo Expr Assigns    -- ^ Record update.
+  | ScopedExpr ScopeInfo Expr          -- ^ Scope annotation.
+  | QuoteGoal ExprInfo Name Expr       -- ^ Binds @Name@ to current type in @Expr at .
+  | QuoteContext ExprInfo Name Expr    -- ^ Binds @Name@ to current context in @Expr at .
+  | Quote ExprInfo                     -- ^ Quote an identifier 'QName'.
+  | QuoteTerm ExprInfo                 -- ^ Quote a term.
+  | Unquote ExprInfo                   -- ^ The splicing construct: unquote ...
+  | DontCare Expr                      -- ^ For printing @DontCare@ from @Syntax.Internal at .
   deriving (Typeable, Show)
 
 -- | Record field assignment @f = e at .
@@ -113,33 +116,34 @@ data Axiom
               --   or another (e.g. data/record) type signature (internally).
   deriving (Typeable, Eq, Ord, Show)
 
+-- | Renaming (generic).
 type Ren a = Map a a
 
 data Declaration
-	= Axiom      Axiom DefInfo ArgInfo QName Expr      -- ^ type signature (can be irrelevant and colored, but not hidden)
-	| Field      DefInfo QName (Arg Expr)		   -- ^ record field
-	| Primitive  DefInfo QName Expr			   -- ^ primitive function
-	| Mutual     MutualInfo [Declaration]              -- ^ a bunch of mutually recursive definitions
-	| Section    ModuleInfo ModuleName [TypedBindings] [Declaration]
-	| Apply	     ModuleInfo ModuleName ModuleApplication (Ren QName) (Ren ModuleName)
-	| Import     ModuleInfo ModuleName
-	| Pragma     Range	Pragma
-        | Open       ModuleInfo ModuleName
-          -- ^ only retained for highlighting purposes
-        | FunDef     DefInfo QName Delayed [Clause] -- ^ sequence of function clauses
-        | DataSig    DefInfo QName Telescope Expr -- ^ lone data signature
-            -- ^ the 'LamBinding's are 'DomainFree' and binds the parameters of the datatype.
-        | DataDef    DefInfo QName [LamBinding] [Constructor]
-            -- ^ the 'LamBinding's are 'DomainFree' and binds the parameters of the datatype.
-        | RecSig     DefInfo QName Telescope Expr -- ^ lone record signature
-        | RecDef     DefInfo QName (Maybe (Ranged Induction)) (Maybe QName) [LamBinding] Expr [Declaration]
-            -- ^ The 'Expr' gives the constructor type telescope, @(x1 : A1)..(xn : An) -> Prop@,
-            --   and the optional name is the constructor's name.
-        | PatternSynDef QName [Arg Name] Pattern
-            -- ^ Only for highlighting purposes
-        | UnquoteDecl MutualInfo DefInfo QName Expr
-	| ScopedDecl ScopeInfo [Declaration]  -- ^ scope annotation
-        deriving (Typeable, Show)
+  = Axiom      Axiom DefInfo ArgInfo QName Expr      -- ^ type signature (can be irrelevant and colored, but not hidden)
+  | Field      DefInfo QName (Arg Expr)              -- ^ record field
+  | Primitive  DefInfo QName Expr                    -- ^ primitive function
+  | Mutual     MutualInfo [Declaration]              -- ^ a bunch of mutually recursive definitions
+  | Section    ModuleInfo ModuleName [TypedBindings] [Declaration]
+  | Apply      ModuleInfo ModuleName ModuleApplication (Ren QName) (Ren ModuleName)
+  | Import     ModuleInfo ModuleName
+  | Pragma     Range      Pragma
+  | Open       ModuleInfo ModuleName
+    -- ^ only retained for highlighting purposes
+  | FunDef     DefInfo QName Delayed [Clause] -- ^ sequence of function clauses
+  | DataSig    DefInfo QName Telescope Expr -- ^ lone data signature
+      -- ^ the 'LamBinding's are 'DomainFree' and binds the parameters of the datatype.
+  | DataDef    DefInfo QName [LamBinding] [Constructor]
+      -- ^ the 'LamBinding's are 'DomainFree' and binds the parameters of the datatype.
+  | RecSig     DefInfo QName Telescope Expr -- ^ lone record signature
+  | RecDef     DefInfo QName (Maybe (Ranged Induction)) (Maybe QName) [LamBinding] Expr [Declaration]
+      -- ^ The 'Expr' gives the constructor type telescope, @(x1 : A1)..(xn : An) -> Prop@,
+      --   and the optional name is the constructor's name.
+  | PatternSynDef QName [Arg Name] Pattern
+      -- ^ Only for highlighting purposes
+  | UnquoteDecl MutualInfo DefInfo QName Expr
+  | ScopedDecl ScopeInfo [Declaration]  -- ^ scope annotation
+  deriving (Typeable, Show)
 
 class GetDefInfo a where
   getDefInfo :: a -> Maybe DefInfo
@@ -163,17 +167,18 @@ data ModuleApplication
       -- ^ @M {{...}}@
   deriving (Typeable, Show)
 
-data Pragma = OptionsPragma [String]
-	    | BuiltinPragma String Expr
-	    | RewritePragma QName
-            | CompiledPragma QName String
-            | CompiledExportPragma QName String
-            | CompiledTypePragma QName String
-            | CompiledDataPragma QName String [String]
-            | CompiledEpicPragma QName String
-            | CompiledJSPragma QName String
-            | StaticPragma QName
-            | EtaPragma QName
+data Pragma
+  = OptionsPragma [String]
+  | BuiltinPragma String Expr
+  | RewritePragma QName
+  | CompiledPragma QName String
+  | CompiledExportPragma QName String
+  | CompiledTypePragma QName String
+  | CompiledDataPragma QName String [String]
+  | CompiledEpicPragma QName String
+  | CompiledJSPragma QName String
+  | StaticPragma QName
+  | EtaPragma QName
   deriving (Typeable, Show)
 
 -- | Bindings that are valid in a @let at .
@@ -195,13 +200,13 @@ type Field          = TypeSignature
 
 -- | A lambda binding is either domain free or typed.
 data LamBinding
-	= DomainFree ArgInfo Name   -- ^ . @x@ or @{x}@ or @.x@ or @.{x}@
-	| DomainFull TypedBindings  -- ^ . @(xs:e)@ or @{xs:e}@ or @(let Ds)@
+  = DomainFree ArgInfo Name   -- ^ . @x@ or @{x}@ or @.x@ or @.{x}@
+  | DomainFull TypedBindings  -- ^ . @(xs:e)@ or @{xs:e}@ or @(let Ds)@
   deriving (Typeable, Show)
 
 -- | Typed bindings with hiding information.
 data TypedBindings = TypedBindings Range (Arg TypedBinding)
-	    -- ^ . @(xs : e)@ or @{xs : e}@
+            -- ^ . @(xs : e)@ or @{xs : e}@
   deriving (Typeable, Show)
 
 -- | A typed binding. Appears in dependent function spaces, typed lambdas, and
@@ -214,13 +219,13 @@ data TypedBindings = TypedBindings Range (Arg TypedBinding)
 --   (Andreas, 2013-12-10: The more serious problem would that the translation
 --   from @(x y : ?)@ to @(x : ?) (y : ?)@ duplicates the hole @?@.
 data TypedBinding
-    = TBind Range [Name] Expr
-      -- ^ As in telescope @(x y z : A)@ or type @(x y z : A) -> B at .
-    | TLet Range [LetBinding]
-      -- ^
+  = TBind Range [Name] Expr
+    -- ^ As in telescope @(x y z : A)@ or type @(x y z : A) -> B at .
+  | TLet Range [LetBinding]
+    -- ^
   deriving (Typeable, Show)
 
-type Telescope	= [TypedBindings]
+type Telescope  = [TypedBindings]
 
 -- | We could throw away @where@ clauses at this point and translate them to
 --   @let at . It's not obvious how to remember that the @let@ was really a
@@ -234,13 +239,15 @@ data Clause' lhs = Clause
 type Clause = Clause' LHS
 type SpineClause = Clause' SpineLHS
 
-data RHS	= RHS Expr
-		| AbsurdRHS
-		| WithRHS QName [Expr] [Clause] -- ^ The 'QName' is the name of the with function.
-                | RewriteRHS [QName] [Expr] RHS [Declaration]
-                    -- ^ The 'QName's are the names of the generated with functions.
-                    --   One for each 'Expr'.
-                    --   The RHS shouldn't be another RewriteRHS
+data RHS
+  = RHS Expr
+  | AbsurdRHS
+  | WithRHS QName [Expr] [Clause]
+      -- ^ The 'QName' is the name of the with function.
+  | RewriteRHS [QName] [Expr] RHS [Declaration]
+      -- ^ The 'QName's are the names of the generated with functions.
+      --   One for each 'Expr'.
+      --   The RHS shouldn't be another @RewriteRHS at .
   deriving (Typeable, Show)
 
 -- | The lhs of a clause in spine view (inside-out).
@@ -290,42 +297,6 @@ class LHSToSpine a b where
   lhsToSpine :: a -> b
   spineToLhs :: b -> a
 
-{-
--- | Pattern instance.
--- instance LHSToSpine (LHSCore' e) (A.QNamed [NamedArg (Pattern' e)]) where
-instance LHSToSpine (LHSCore' e) (A.QNamed [Common.NamedArg Expr (Pattern' e)]) where
-  lhsToSpine (LHSHead f ps) = QNamed f ps
-  lhsToSpine (LHSProj d ps1 h ps2) = (++ (p : ps2)) <$> lhsToSpine (namedArg h)
-    where p = updateNamedArg (const $ DefP patNoRange d ps1) h
-
-instance SpineToLHS (LHSCore' e) (A.QNamed [Common.NamedArg Expr (Pattern' e)]) where
-  spineToLhs (QNamed f ps) = lhsCoreAddSpine (LHSHead f []) ps
-    where
-      -- | Add applicative patterns (non-projection patterns) to the right.
-      -- lhsCoreApp :: LHSCore' e -> [NamedArg (Pattern' e)] -> LHSCore' e
-      lhsCoreApp (LHSHead f ps)        ps' = LHSHead f $ ps ++ ps'
-      lhsCoreApp (LHSProj d ps1 h ps2) ps' = LHSProj d ps1 h $ ps2 ++ ps'
-
-      -- | Add projection and applicative patterns to the right.
-      -- lhsCoreAddSpine :: LHSCore' e -> [NamedArg (Pattern' e)] -> LHSCore' e
-      lhsCoreAddSpine core ps = case ps2 of
-          []                                      -> lhsCoreApp core ps
-          (Common.Arg info (Named n (DefP i d ps0)) : ps2') ->
-             LHSProj d ps0 (Common.Arg info $ Named n $ lhsCoreApp core ps1) []
-               `lhsCoreAddSpine` ps2'
-          _ -> __IMPOSSIBLE__
-        where
-          (ps1, ps2) = break (isDefP . namedArg) ps
-          isDefP DefP{} = True
-          isDefP _      = False
--}
-
--- | LHS instance.
-instance LHSToSpine LHS SpineLHS where
-  lhsToSpine (LHS i core wps) = SpineLHS i f ps wps
-    where QNamed f ps = lhsCoreToSpine core
-  spineToLhs (SpineLHS i f ps wps) = LHS i (spineToLhsCore $ QNamed f ps) wps
-
 -- | Clause instance.
 instance LHSToSpine Clause SpineClause where
   lhsToSpine = fmap lhsToSpine
@@ -336,17 +307,11 @@ instance LHSToSpine a b => LHSToSpine [a] [b] where
   lhsToSpine = map lhsToSpine
   spineToLhs = map spineToLhs
 
-
-{-
--- | Convert a focused lhs to spine view.
-lhsToSpine :: LHS -> SpineLHS
-lhsToSpine (LHS i core wps) = SpineLHS i f ps wps
-  where QNamed f ps = lhsCoreToSpine core
-
--- | Convert a lhs from spine view into focused view.
-spineToLhs :: SpineLHS -> LHS
-spineToLhs (SpineLHS i f ps wps) = LHS i (spineToLhsCore $ QNamed f ps) wps
--}
+-- | LHS instance.
+instance LHSToSpine LHS SpineLHS where
+  lhsToSpine (LHS i core wps) = SpineLHS i f ps wps
+    where QNamed f ps = lhsCoreToSpine core
+  spineToLhs (SpineLHS i f ps wps) = LHS i (spineToLhsCore $ QNamed f ps) wps
 
 lhsCoreToSpine :: LHSCore' e -> A.QNamed [NamedArg (Pattern' e)]
 lhsCoreToSpine (LHSHead f ps) = QNamed f ps
@@ -364,27 +329,19 @@ lhsCoreApp (LHSProj d ps1 h ps2) ps' = LHSProj d ps1 h $ ps2 ++ ps'
 -- | Add projection and applicative patterns to the right.
 lhsCoreAddSpine :: LHSCore' e -> [NamedArg (Pattern' e)] -> LHSCore' e
 lhsCoreAddSpine core ps = case ps2 of
-    []                                      -> lhsCoreApp core ps
     (Common.Arg info (Named n (DefP i d ps0)) : ps2') ->
        LHSProj d ps0 (Common.Arg info $ Named n $ lhsCoreApp core ps1) []
          `lhsCoreAddSpine` ps2'
+    [] -> lhsCoreApp core ps
     _ -> __IMPOSSIBLE__
   where
     (ps1, ps2) = break (isDefP . namedArg) ps
     isDefP DefP{} = True
     isDefP _      = False
 
-
 -- | Used for checking pattern linearity.
 lhsCoreAllPatterns :: LHSCore' e -> [Pattern' e]
 lhsCoreAllPatterns = map namedArg . qnamed . lhsCoreToSpine
-{- OLD code, dumps projection patterns, superfluous
-lhsCoreAllPatterns (LHSHead f ps) = map namedArg ps
-lhsCoreAllPatterns (LHSProj d ps1 l ps2) =
-  map namedArg ps1 ++
-  lhsCoreAllPatterns (namedArg l) ++
-  map namedArg ps2
--}
 
 -- | Used in AbstractToConcrete.
 lhsCoreToPattern :: LHSCore -> Pattern
@@ -400,14 +357,6 @@ mapLHSHead f (LHSHead x ps)        = f x ps
 mapLHSHead f (LHSProj d ps1 l ps2) =
   LHSProj d ps1 (fmap (fmap (mapLHSHead f)) l) ps2
 
-{- UNUSED
-mapLHSHeadM :: (Monad m) => (QName -> [NamedArg Pattern] -> m LHSCore) -> LHSCore -> m LHSCore
-mapLHSHeadM f (LHSHead x ps)        = f x ps
-mapLHSHeadM f (LHSProj d ps1 l ps2) = do
-  l <- mapLHSHead f l
-  return $ LHSProj d ps1 l ps2
--}
-
 ---------------------------------------------------------------------------
 -- * Patterns
 ---------------------------------------------------------------------------
@@ -462,31 +411,32 @@ instance HasRange TypedBinding where
     getRange (TLet r _)    = r
 
 instance HasRange Expr where
-    getRange (Var x)		   = getRange x
-    getRange (Def x)		   = getRange x
-    getRange (Con x)		   = getRange x
-    getRange (Lit l)		   = getRange l
-    getRange (QuestionMark i _)	   = getRange i
-    getRange (Underscore  i)	   = getRange i
-    getRange (App i _ _)	   = getRange i
-    getRange (WithApp i _ _)	   = getRange i
-    getRange (Lam i _ _)	   = getRange i
+    getRange (Var x)               = getRange x
+    getRange (Def x)               = getRange x
+    getRange (Proj x)              = getRange x
+    getRange (Con x)               = getRange x
+    getRange (Lit l)               = getRange l
+    getRange (QuestionMark i _)    = getRange i
+    getRange (Underscore  i)       = getRange i
+    getRange (App i _ _)           = getRange i
+    getRange (WithApp i _ _)       = getRange i
+    getRange (Lam i _ _)           = getRange i
     getRange (AbsurdLam i _)       = getRange i
     getRange (ExtendedLam i _ _ _) = getRange i
-    getRange (Pi i _ _)		   = getRange i
-    getRange (Fun i _ _)	   = getRange i
-    getRange (Set i _)		   = getRange i
-    getRange (Prop i)		   = getRange i
-    getRange (Let i _ _)	   = getRange i
-    getRange (Rec i _)		   = getRange i
+    getRange (Pi i _ _)            = getRange i
+    getRange (Fun i _ _)           = getRange i
+    getRange (Set i _)             = getRange i
+    getRange (Prop i)              = getRange i
+    getRange (Let i _ _)           = getRange i
+    getRange (Rec i _)             = getRange i
     getRange (RecUpdate i _ _)     = getRange i
     getRange (ETel tel)            = getRange tel
-    getRange (ScopedExpr _ e)	   = getRange e
-    getRange (QuoteGoal _ _ e)	   = getRange e
+    getRange (ScopedExpr _ e)      = getRange e
+    getRange (QuoteGoal _ _ e)     = getRange e
     getRange (QuoteContext _ _ e)  = getRange e
-    getRange (Quote i)  	   = getRange i
-    getRange (QuoteTerm i)  	   = getRange i
-    getRange (Unquote i)  	   = getRange i
+    getRange (Quote i)             = getRange i
+    getRange (QuoteTerm i)         = getRange i
+    getRange (Unquote i)           = getRange i
     getRange (DontCare{})          = noRange
     getRange (PatternSyn x)        = getRange x
 
@@ -495,12 +445,12 @@ instance HasRange Declaration where
     getRange (Field      i _ _      ) = getRange i
     getRange (Mutual     i _        ) = getRange i
     getRange (Section    i _ _ _    ) = getRange i
-    getRange (Apply	 i _ _ _ _  ) = getRange i
-    getRange (Import     i _	    ) = getRange i
-    getRange (Primitive  i _ _	    ) = getRange i
-    getRange (Pragma	 i _	    ) = getRange i
+    getRange (Apply      i _ _ _ _  ) = getRange i
+    getRange (Import     i _        ) = getRange i
+    getRange (Primitive  i _ _      ) = getRange i
+    getRange (Pragma     i _        ) = getRange i
     getRange (Open       i _        ) = getRange i
-    getRange (ScopedDecl _ d	    ) = getRange d
+    getRange (ScopedDecl _ d        ) = getRange d
     getRange (FunDef     i _ _ _    ) = getRange i
     getRange (DataSig    i _ _ _    ) = getRange i
     getRange (DataDef    i _ _ _    ) = getRange i
@@ -510,15 +460,15 @@ instance HasRange Declaration where
     getRange (UnquoteDecl _ i _ _)    = getRange i
 
 instance HasRange (Pattern' e) where
-    getRange (VarP x)	         = getRange x
+    getRange (VarP x)            = getRange x
     getRange (ConP i _ _)        = getRange i
     getRange (DefP i _ _)        = getRange i
-    getRange (WildP i)	         = getRange i
+    getRange (WildP i)           = getRange i
     getRange (ImplicitP i)       = getRange i
     getRange (AsP i _ _)         = getRange i
     getRange (DotP i _)          = getRange i
     getRange (AbsurdP i)         = getRange i
-    getRange (LitP l)	         = getRange l
+    getRange (LitP l)            = getRange l
     getRange (PatternSynP i _ _) = getRange i
 
 instance HasRange SpineLHS where
@@ -573,6 +523,7 @@ instance KillRange TypedBinding where
 instance KillRange Expr where
   killRange (Var x)                = killRange1 Var x
   killRange (Def x)                = killRange1 Def x
+  killRange (Proj x)               = killRange1 Proj x
   killRange (Con x)                = killRange1 Con x
   killRange (Lit l)                = killRange1 Lit l
   killRange (QuestionMark i ii)    = killRange2 QuestionMark i ii
@@ -687,91 +638,105 @@ instanceUniverseBiT' [] [t| (Declaration, RString)        |]
 -- include local modules, where clauses and the names of extended
 -- lambdas.
 
-allNames :: Declaration -> Seq QName
-allNames (Axiom   _ _ _ q _)      = Seq.singleton q
-allNames (Field     _   q _)      = Seq.singleton q
-allNames (Primitive _   q _)      = Seq.singleton q
-allNames (Mutual     _ defs)      = Fold.foldMap allNames defs
-allNames (DataSig _ q _ _)        = Seq.singleton q
-allNames (DataDef _ q _ decls)    = q <| Fold.foldMap allNames decls
-allNames (RecSig _ q _ _)         = Seq.singleton q
-allNames (RecDef _ q _ c _ _ decls) =
-  q <| foldMap Seq.singleton c >< Fold.foldMap allNames decls
-allNames (PatternSynDef q _ _)    = Seq.singleton q
-allNames (UnquoteDecl _ _ q _)    = Seq.singleton q
-allNames (FunDef _ q _ cls)       = q <| Fold.foldMap allNamesC cls
-  where
-  allNamesC :: Clause -> Seq QName
-  allNamesC (Clause _ rhs decls) = allNamesR rhs ><
-                                   Fold.foldMap allNames decls
-
-  allNamesR :: RHS -> Seq QName
-  allNamesR (RHS e)               = allNamesE e
-  allNamesR AbsurdRHS {}          = Seq.empty
-  allNamesR (WithRHS q _ cls)     = q <| Fold.foldMap allNamesC cls
-  allNamesR (RewriteRHS qs _ rhs cls) =
-    Seq.fromList qs >< allNamesR rhs
-                    >< Fold.foldMap allNames cls
-
-  allNamesE :: Expr -> Seq QName
-  allNamesE Var {}                       = Seq.empty
-  allNamesE Def {}                       = Seq.empty
-  allNamesE Con {}                       = Seq.empty
-  allNamesE Lit {}                       = Seq.empty
-  allNamesE QuestionMark {}              = Seq.empty
-  allNamesE Underscore {}                = Seq.empty
-  allNamesE (App _ e1 e2)                = Fold.foldMap allNamesE [e1, namedThing (unArg e2)]
-  allNamesE (WithApp _ e es)             = Fold.foldMap allNamesE (e : es)
-  allNamesE (Lam _ b e)                  = allNamesLam b >< allNamesE e
-  allNamesE AbsurdLam {}                 = Seq.empty
-  allNamesE (ExtendedLam _ _ q cls)      = q <| Fold.foldMap allNamesC cls
-  allNamesE (Pi _ tel e)                 = Fold.foldMap allNamesBinds tel ><
-                                                        allNamesE e
-  allNamesE (Fun _ (Common.Arg _ e1) e2) = Fold.foldMap allNamesE [e1, e2]
-  allNamesE Set {}                       = Seq.empty
-  allNamesE Prop {}                      = Seq.empty
-  allNamesE (Let _ lbs e)                = Fold.foldMap allNamesLet lbs ><
-                                                        allNamesE e
-  allNamesE ETel {}                      = __IMPOSSIBLE__
-  allNamesE (Rec _ fields)               = Fold.foldMap allNamesE (map snd fields)
-  allNamesE (RecUpdate _ e fs)           = allNamesE e >< Fold.foldMap allNamesE (map snd fs)
-  allNamesE (ScopedExpr _ e)             = allNamesE e
-  allNamesE (QuoteGoal _ _ e)            = allNamesE e
-  allNamesE (QuoteContext _ _ e)         = allNamesE e
-  allNamesE Quote {}                     = Seq.empty
-  allNamesE QuoteTerm {}                 = Seq.empty
-  allNamesE Unquote {}                   = Seq.empty
-  allNamesE DontCare {}                  = Seq.empty
-  allNamesE (PatternSyn x)               = Seq.empty
-
-  allNamesLam :: LamBinding -> Seq QName
-  allNamesLam DomainFree {}      = Seq.empty
-  allNamesLam (DomainFull binds) = allNamesBinds binds
-
-  allNamesBinds :: TypedBindings -> Seq QName
-  allNamesBinds (TypedBindings _ (Common.Arg _ (TBind _ _ e))) = allNamesE e
-  allNamesBinds (TypedBindings _ (Common.Arg _ (TLet _ lbs)))  = allNamesLets lbs
-
-  allNamesLets :: [LetBinding] -> Seq QName
-  allNamesLets = Fold.foldMap allNamesLet
-
-  allNamesLet :: LetBinding -> Seq QName
-  allNamesLet (LetBind _ _ _ e1 e2)  = Fold.foldMap allNamesE [e1, e2]
-  allNamesLet (LetPatBind _ _ e)     = allNamesE e
-  allNamesLet (LetApply _ _ app _ _) = allNamesApp app
-  allNamesLet LetOpen {}             = Seq.empty
-
-  allNamesApp :: ModuleApplication -> Seq QName
-  allNamesApp (SectionApp bindss _ es) = Fold.foldMap allNamesBinds bindss ><
-                                         Fold.foldMap allNamesE (map namedArg es)
-  allNamesApp RecordModuleIFS {}       = Seq.empty
-
-allNames (Section _ _ _ decls) = Fold.foldMap allNames decls
-allNames Apply {}              = Seq.empty
-allNames Import {}             = Seq.empty
-allNames Pragma {}             = Seq.empty
-allNames Open {}               = Seq.empty
-allNames (ScopedDecl _ decls)  = Fold.foldMap allNames decls
+class AllNames a where
+  allNames :: a -> Seq QName
+
+instance AllNames a => AllNames [a] where
+  allNames = Fold.foldMap allNames
+
+instance AllNames a => AllNames (Maybe a) where
+  allNames = Fold.foldMap allNames
+
+instance AllNames a => AllNames (Arg a) where
+  allNames = Fold.foldMap allNames
+
+instance AllNames a => AllNames (Named name a) where
+  allNames = Fold.foldMap allNames
+
+instance (AllNames a, AllNames b) => AllNames (a,b) where
+  allNames (a,b) = allNames a >< allNames b
+
+instance AllNames QName where
+  allNames q = Seq.singleton q
+
+instance AllNames Declaration where
+  allNames (Axiom   _ _ _ q _)        = Seq.singleton q
+  allNames (Field     _   q _)        = Seq.singleton q
+  allNames (Primitive _   q _)        = Seq.singleton q
+  allNames (Mutual     _ defs)        = allNames defs
+  allNames (DataSig _ q _ _)          = Seq.singleton q
+  allNames (DataDef _ q _ decls)      = q <| allNames decls
+  allNames (RecSig _ q _ _)           = Seq.singleton q
+  allNames (RecDef _ q _ c _ _ decls) = q <| allNames c >< allNames decls
+  allNames (PatternSynDef q _ _)      = Seq.singleton q
+  allNames (UnquoteDecl _ _ q _)      = Seq.singleton q
+  allNames (FunDef _ q _ cls)         = q <| allNames cls
+  allNames (Section _ _ _ decls)      = allNames decls
+  allNames Apply{}                    = Seq.empty
+  allNames Import{}                   = Seq.empty
+  allNames Pragma{}                   = Seq.empty
+  allNames Open{}                     = Seq.empty
+  allNames (ScopedDecl _ decls)       = allNames decls
+
+instance AllNames Clause where
+  allNames (Clause _ rhs decls) = allNames rhs >< allNames decls
+
+instance AllNames RHS where
+  allNames (RHS e)                   = allNames e
+  allNames AbsurdRHS{}               = Seq.empty
+  allNames (WithRHS q _ cls)         = q <| allNames cls
+  allNames (RewriteRHS qs _ rhs cls) = Seq.fromList qs >< allNames rhs >< allNames cls
+
+instance AllNames Expr where
+  allNames Var{}                   = Seq.empty
+  allNames Def{}                   = Seq.empty
+  allNames Proj{}                  = Seq.empty
+  allNames Con{}                   = Seq.empty
+  allNames Lit{}                   = Seq.empty
+  allNames QuestionMark{}          = Seq.empty
+  allNames Underscore{}            = Seq.empty
+  allNames (App _ e1 e2)           = allNames e1 >< allNames e2
+  allNames (WithApp _ e es)        = allNames e >< allNames es
+  allNames (Lam _ b e)             = allNames b >< allNames e
+  allNames AbsurdLam{}             = Seq.empty
+  allNames (ExtendedLam _ _ q cls) = q <| allNames cls
+  allNames (Pi _ tel e)            = allNames tel >< allNames e
+  allNames (Fun _ e1 e2)           = allNames e1 >< allNames e2
+  allNames Set{}                   = Seq.empty
+  allNames Prop{}                  = Seq.empty
+  allNames (Let _ lbs e)           = allNames lbs >< allNames e
+  allNames ETel{}                  = __IMPOSSIBLE__
+  allNames (Rec _ fields)          = allNames $ map snd fields
+  allNames (RecUpdate _ e fs)      = allNames e >< allNames (map snd fs)
+  allNames (ScopedExpr _ e)        = allNames e
+  allNames (QuoteGoal _ _ e)       = allNames e
+  allNames (QuoteContext _ _ e)    = allNames e
+  allNames Quote{}                 = Seq.empty
+  allNames QuoteTerm{}             = Seq.empty
+  allNames Unquote{}               = Seq.empty
+  allNames DontCare{}              = Seq.empty
+  allNames (PatternSyn x)          = Seq.empty
+
+instance AllNames LamBinding where
+  allNames DomainFree{}       = Seq.empty
+  allNames (DomainFull binds) = allNames binds
+
+instance AllNames TypedBindings where
+  allNames (TypedBindings _ bs) = allNames bs
+
+instance AllNames TypedBinding where
+  allNames (TBind _ _ e) = allNames e
+  allNames (TLet _ lbs)  = allNames lbs
+
+instance AllNames LetBinding where
+  allNames (LetBind _ _ _ e1 e2)  = allNames e1 >< allNames e2
+  allNames (LetPatBind _ _ e)     = allNames e
+  allNames (LetApply _ _ app _ _) = allNames app
+  allNames LetOpen{}              = Seq.empty
+
+instance AllNames ModuleApplication where
+  allNames (SectionApp bindss _ es) = allNames bindss >< allNames es
+  allNames RecordModuleIFS{}        = Seq.empty
 
 -- | The name defined by the given axiom.
 --
@@ -804,14 +769,15 @@ instance AnyAbstract Declaration where
   anyAbstract (RecSig i _ _ _)       = defAbstract i == AbstractDef
   anyAbstract _                      = __IMPOSSIBLE__
 
-app   = foldl (App (ExprRange noRange))
+app :: Expr -> [NamedArg Expr] -> Expr
+app = foldl (App (ExprRange noRange))
 
 patternToExpr :: Pattern -> Expr
 patternToExpr (VarP x)            = Var x
 patternToExpr (ConP _ c ps)       =
-          Con c `app` map (fmap (fmap patternToExpr)) ps
+  Con c `app` map (fmap (fmap patternToExpr)) ps
 patternToExpr (DefP _ f ps)       =
-          Def f `app` map (fmap (fmap patternToExpr)) ps
+  Def f `app` map (fmap (fmap patternToExpr)) ps
 patternToExpr (WildP _)           = Underscore emptyMetaInfo
 patternToExpr (AsP _ _ p)         = patternToExpr p
 patternToExpr (DotP _ e)          = e
@@ -825,15 +791,12 @@ type PatternSynDefns = Map QName PatternSynDefn
 
 lambdaLiftExpr :: [Name] -> Expr -> Expr
 lambdaLiftExpr []     e = e
-lambdaLiftExpr (n:ns) e = Lam (ExprRange noRange)
-                                     (DomainFree defaultArgInfo n) $
+lambdaLiftExpr (n:ns) e = Lam (ExprRange noRange) (DomainFree defaultArgInfo n) $
                                      lambdaLiftExpr ns e
 
 substPattern :: [(Name, Pattern)] -> Pattern -> Pattern
 substPattern s p = case p of
-  VarP z      -> case lookup z s of
-    Nothing -> p
-    Just x  -> x
+  VarP z      -> fromMaybe p (lookup z s)
   ConP i q ps -> ConP i q (fmap (fmap (fmap (substPattern s))) ps)
   WildP i     -> p
   DotP i e    -> DotP i (substExpr (map (fmap patternToExpr) s) e)
@@ -843,62 +806,69 @@ substPattern s p = case p of
                                 -- pattern synonyms (already gone), and
                                 -- @-patterns (not supported anyways).
 
-substExpr :: [(Name, Expr)] -> Expr -> Expr
-substExpr s e = case e of
-  Var n -> case lookup n s of
-    Nothing -> e
-    Just z  -> z
-  Def _                 -> e
-  Con _	                -> e
-  Lit _                 -> e
-  QuestionMark{}        -> e
-  Underscore   _        -> e
-  App  i e e'           -> App i (substExpr s e)
-                                 (fmap (fmap (substExpr s)) e')
-  WithApp i e es        -> WithApp i (substExpr s e)
-                                     (fmap (substExpr s) es)
-  Lam  i lb e           -> Lam i lb (substExpr s e)
-  AbsurdLam i h         -> e
-  ExtendedLam i di n cs -> __IMPOSSIBLE__   -- Maybe later...
-  Pi   i t e            -> Pi i (fmap (substTypedBindings s) t)
-                                (substExpr s e)
-  Fun  i ae e           -> Fun i (fmap (substExpr s) ae)
-                                 (substExpr s e)
-  Set  i n              -> e
-  Prop i                -> e
-  Let  i ls e           -> Let i (substLetBindings s ls)
-                                 (substExpr s e)
-  ETel t                -> e
-  Rec  i nes            -> Rec i (fmap (fmap (substExpr s)) nes)
-  RecUpdate i e nes     -> RecUpdate i (substExpr s e)
-                                       (fmap (fmap (substExpr s)) nes)
-  -- XXX: Do we need to do more with ScopedExprs?
-  ScopedExpr si e       -> ScopedExpr si (substExpr s e)
-  QuoteGoal i n e       -> QuoteGoal i n (substExpr s e)
-  QuoteContext i n e    -> QuoteContext i n (substExpr s e)
-  Quote i               -> e
-  QuoteTerm i           -> e
-  Unquote i             -> e
-  DontCare e            -> DontCare (substExpr s e)
-  PatternSyn x          -> e
-
-substLetBindings :: [(Name, Expr)] -> [LetBinding] -> [LetBinding]
-substLetBindings s = fmap (substLetBinding s)
-
-substLetBinding :: [(Name, Expr)] -> LetBinding -> LetBinding
-substLetBinding s lb = case lb of
-  LetBind i r n e e' -> LetBind i r n (substExpr s e) (substExpr s e')
-  LetPatBind i p e   -> LetPatBind i p (substExpr s e) -- Andreas, 2012-06-04: what about the pattern p
-  _                  -> lb -- Nicolas, 2013-11-11: what about "LetApply" there is experessions in there
-
-substTypedBindings :: [(Name, Expr)] -> TypedBindings -> TypedBindings
-substTypedBindings s (TypedBindings r atb) = TypedBindings r
-    (fmap (substTypedBinding s) atb)
-
-substTypedBinding :: [(Name, Expr)] -> TypedBinding -> TypedBinding
-substTypedBinding s tb = case tb of
-  TBind r ns e -> TBind r ns $ substExpr s e
-  TLet r lbs   -> TLet r $ substLetBindings s lbs
+class SubstExpr a where
+  substExpr :: [(Name, Expr)] -> a -> a
+
+instance SubstExpr a => SubstExpr [a] where
+  substExpr = fmap . substExpr
+
+instance SubstExpr a => SubstExpr (Arg a) where
+  substExpr = fmap . substExpr
+
+instance SubstExpr a => SubstExpr (Common.Named name a) where
+  substExpr = fmap . substExpr
+
+instance (SubstExpr a, SubstExpr b) => SubstExpr (a, b) where
+  substExpr s (x, y) = (substExpr s x, substExpr s y)
+
+instance SubstExpr C.Name where
+  substExpr _ = id
+
+instance SubstExpr Expr where
+  substExpr s e = case e of
+    Var n                 -> fromMaybe e (lookup n s)
+    Def _                 -> e
+    Proj{}                -> e
+    Con _                 -> e
+    Lit _                 -> e
+    QuestionMark{}        -> e
+    Underscore   _        -> e
+    App  i e e'           -> App i (substExpr s e) (substExpr s e')
+    WithApp i e es        -> WithApp i (substExpr s e) (substExpr s es)
+    Lam  i lb e           -> Lam i lb (substExpr s e)
+    AbsurdLam i h         -> e
+    ExtendedLam i di n cs -> __IMPOSSIBLE__   -- Maybe later...
+    Pi   i t e            -> Pi i (substExpr s t) (substExpr s e)
+    Fun  i ae e           -> Fun i (substExpr s ae) (substExpr s e)
+    Set  i n              -> e
+    Prop i                -> e
+    Let  i ls e           -> Let i (substExpr s ls) (substExpr s e)
+    ETel t                -> e
+    Rec  i nes            -> Rec i (substExpr s nes)
+    RecUpdate i e nes     -> RecUpdate i (substExpr s e) (substExpr s nes)
+    -- XXX: Do we need to do more with ScopedExprs?
+    ScopedExpr si e       -> ScopedExpr si (substExpr s e)
+    QuoteGoal i n e       -> QuoteGoal i n (substExpr s e)
+    QuoteContext i n e    -> QuoteContext i n (substExpr s e)
+    Quote i               -> e
+    QuoteTerm i           -> e
+    Unquote i             -> e
+    DontCare e            -> DontCare (substExpr s e)
+    PatternSyn x          -> e
+
+instance SubstExpr LetBinding where
+  substExpr s lb = case lb of
+    LetBind i r n e e' -> LetBind i r n (substExpr s e) (substExpr s e')
+    LetPatBind i p e   -> LetPatBind i p (substExpr s e) -- Andreas, 2012-06-04: what about the pattern p
+    _                  -> lb -- Nicolas, 2013-11-11: what about "LetApply" there is experessions in there
+
+instance SubstExpr TypedBindings where
+  substExpr s (TypedBindings r atb) = TypedBindings r (substExpr s atb)
+
+instance SubstExpr TypedBinding where
+  substExpr s tb = case tb of
+    TBind r ns e -> TBind r ns $ substExpr s e
+    TLet r lbs   -> TLet r $ substExpr s lbs
 
 -- TODO: more informative failure
 insertImplicitPatSynArgs :: HasRange a => (Range -> a) -> Range -> [Arg Name] -> [NamedArg a] ->
diff --git a/src/full/Agda/Syntax/Abstract/Copatterns.hs b/src/full/Agda/Syntax/Abstract/Copatterns.hs
index 3cfd697..5220c0c 100644
--- a/src/full/Agda/Syntax/Abstract/Copatterns.hs
+++ b/src/full/Agda/Syntax/Abstract/Copatterns.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DeriveFunctor        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE StandaloneDeriving   #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.Syntax.Abstract.Copatterns (translateCopatternClauses) where
@@ -33,7 +33,7 @@ import Agda.Syntax.Scope.Monad
 import Agda.TypeChecking.Monad.Base (TypeError(..), typeError)
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {- Andreas 2012-04-07, 2012-05-08
@@ -268,6 +268,7 @@ instance Rename Expr where
     case e of
       Var x                 -> Var $ maybe x id (rho x)
       Def f                 -> e
+      Proj f                -> e
       Con c                 -> e
       Lit l                 -> e
       QuestionMark{}        -> e
diff --git a/src/full/Agda/Syntax/Abstract/Name.hs b/src/full/Agda/Syntax/Abstract/Name.hs
index 3c0263a..1e29f4e 100644
--- a/src/full/Agda/Syntax/Abstract/Name.hs
+++ b/src/full/Agda/Syntax/Abstract/Name.hs
@@ -1,11 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 {-| Abstract names carry unique identifiers and stuff.
 -}
@@ -29,21 +30,22 @@ import Agda.Syntax.Fixity
 import Agda.Syntax.Concrete.Name (IsNoName(..))
 import qualified Agda.Syntax.Concrete.Name as C
 
-import Agda.Utils.Fresh
+-- import Agda.Utils.Function
+import Agda.Utils.Pretty
 import Agda.Utils.Size
 import Agda.Utils.Suffix
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | A name is a unique identifier and a suggestion for a concrete name. The
 --   concrete name contains the source location (if any) of the name. The
 --   source location of the binding site is also recorded.
-data Name = Name { nameId	   :: NameId
-		 , nameConcrete	   :: C.Name
-		 , nameBindingSite :: Range
-		 , nameFixity	   :: Fixity'
-		 }
+data Name = Name { nameId          :: NameId
+                 , nameConcrete    :: C.Name
+                 , nameBindingSite :: Range
+                 , nameFixity      :: Fixity'
+                 }
     deriving (Typeable)
 
 -- | Qualified names are non-empty lists of names. Equality on qualified names
@@ -53,8 +55,8 @@ data Name = Name { nameId	   :: NameId
 -- The 'SetRange' instance for qualified names sets all individual
 -- ranges (including those of the module prefix) to the given one.
 data QName = QName { qnameModule :: ModuleName
-		   , qnameName	 :: Name
-		   }
+                   , qnameName   :: Name
+                   }
     deriving (Typeable)
 
 -- | Something preceeded by a qualified name.
@@ -74,9 +76,9 @@ newtype ModuleName = MName { mnameToList :: [Name] }
 -- | Ambiguous qualified names. Used for overloaded constructors.
 --
 -- Invariant: All the names in the list must have the same concrete,
--- unqualified name.
+-- unqualified name.  (This implies that they all have the same 'Range').
 newtype AmbiguousQName = AmbQ { unAmbQ :: [QName] }
-  deriving (Typeable, HasRange, Show)
+  deriving (Typeable, Show)
 
 -- | A module is anonymous if the qualification path ends in an underscore.
 isAnonymousModuleName :: ModuleName -> Bool
@@ -171,7 +173,7 @@ mnameToConcrete (MName xs) = foldr C.Qual (C.QName $ last cs) $ init cs
 
 toTopLevelModuleName :: ModuleName -> C.TopLevelModuleName
 toTopLevelModuleName (MName []) = __IMPOSSIBLE__
-toTopLevelModuleName (MName ms) = C.TopLevelModuleName (map show ms)
+toTopLevelModuleName (MName ms) = C.TopLevelModuleName $ map (C.nameToRawName . nameConcrete) ms
 
 qualifyM :: ModuleName -> ModuleName -> ModuleName
 qualifyM m1 m2 = mnameFromList $ mnameToList m1 ++ mnameToList m2
@@ -180,7 +182,11 @@ qualifyQ :: ModuleName -> QName -> QName
 qualifyQ m x = qnameFromList $ mnameToList m ++ qnameToList x
 
 qualify :: ModuleName -> Name -> QName
-qualify m x = qualifyQ m (qnameFromList [x])
+qualify = QName
+
+-- | Convert a 'Name' to a 'QName' (add no module name).
+qualify_ :: Name -> QName
+qualify_ = qualify noModuleName
 
 -- | Is the name an operator?
 
@@ -196,48 +202,19 @@ isSubModuleOf x y = xs /= ys && isPrefixOf ys xs
 isInModule :: QName -> ModuleName -> Bool
 isInModule q m = mnameToList m `isPrefixOf` qnameToList q
 
-freshName :: (MonadState s m, HasFresh NameId s) => Range -> String -> m Name
-freshName r s = do
-  i <- fresh
-  return $ mkName r i s
-
-freshNoName :: (MonadState s m, HasFresh NameId s) => Range -> m Name
-freshNoName r =
-    do	i <- fresh
-	return $ Name i (C.NoName noRange i) r defaultFixity'
-
-freshNoName_ :: (MonadState s m, HasFresh NameId s) => m Name
-freshNoName_ = freshNoName noRange
-
--- | Create a fresh name from @a at .
-class FreshName a where
-  freshName_ :: (MonadState s m, HasFresh NameId s) => a -> m Name
-
-instance FreshName (Range, String) where
-  freshName_ = uncurry freshName
-
-instance FreshName String where
-  freshName_ = freshName noRange
-
-instance FreshName Range where
-  freshName_ = freshNoName
-
-instance FreshName () where
-  freshName_ () = freshNoName_
-
 -- | Get the next version of the concrete name. For instance, @nextName "x" = "x₁"@.
 --   The name must not be a 'NoName'.
 nextName :: Name -> Name
 nextName x = x { nameConcrete = C.Name noRange $ nextSuf ps }
     where
-	C.Name _ ps = nameConcrete x
-	-- NoName cannot appear here
-	nextSuf [C.Id s]         = [C.Id $ nextStr s]
-	nextSuf [C.Id s, C.Hole] = [C.Id $ nextStr s, C.Hole]
-	nextSuf (p : ps)         = p : nextSuf ps
-	nextSuf []               = __IMPOSSIBLE__
-	nextStr s = case suffixView s of
-	    (s0, suf) -> addSuffix s0 (nextSuffix suf)
+        C.Name _ ps = nameConcrete x
+        -- NoName cannot appear here
+        nextSuf [C.Id s]         = [C.Id $ nextStr s]
+        nextSuf [C.Id s, C.Hole] = [C.Id $ nextStr s, C.Hole]
+        nextSuf (p : ps)         = p : nextSuf ps
+        nextSuf []               = __IMPOSSIBLE__
+        nextStr s = case suffixView s of
+            (s0, suf) -> addSuffix s0 (nextSuffix suf)
 
 ------------------------------------------------------------------------
 -- * Important instances: Eq, Ord, Hashable
@@ -277,16 +254,41 @@ instance IsNoName Name where
 -- * Show instances
 ------------------------------------------------------------------------
 
+-- | Only use this @show@ function in debugging!  To convert an
+--   abstract 'Name' into a string use @prettyShow at .
 instance Show Name where
-  show x = show (nameConcrete x) -- ++ "|" ++ show (nameId x)
-
+  -- Andreas, 2014-10-02: Reverted to nice printing.
+  -- Reason: I do not have time just now to properly fix the
+  -- use of Show Name for pretty printing everywhere, e.g. in
+  -- the Epic backend.  But I want to push the fix for Issue 836 now.
+  show n = show (nameConcrete n)
+  -- show n = show (nameConcrete n) ++ "^" ++ show (nameId n)
+  -- show n = applyWhen (isNoName n) (++ show (nameId n)) $ show (nameConcrete n)
+
+-- | Only use this @show@ function in debugging!  To convert an
+--   abstract 'ModuleName' into a string use @prettyShow at .
 instance Show ModuleName where
   show m = concat $ intersperse "." $ map show $ mnameToList m
 
+-- | Only use this @show@ function in debugging!  To convert an
+--   abstract 'QName' into a string use @prettyShow at .
 instance Show QName where
   show q = concat $ intersperse "." $ map show $ qnameToList q
 
 ------------------------------------------------------------------------
+-- * Pretty instances
+------------------------------------------------------------------------
+
+instance Pretty Name where
+  pretty = pretty . nameConcrete
+
+instance Pretty ModuleName where
+  pretty = hcat . punctuate (text ".") . map pretty . mnameToList
+
+instance Pretty QName where
+  pretty = hcat . punctuate (text ".") . map pretty . qnameToList
+
+------------------------------------------------------------------------
 -- * Range instances
 ------------------------------------------------------------------------
 
@@ -302,6 +304,12 @@ instance HasRange ModuleName where
 instance HasRange QName where
   getRange q = getRange (qnameModule q, qnameName q)
 
+-- | The range of an @AmbiguousQName@ is the range of any of its
+--   disambiguations (they are the same concrete name).
+instance HasRange AmbiguousQName where
+  getRange (AmbQ [])    = noRange
+  getRange (AmbQ (c:_)) = getRange c
+
 -- ** SetRange
 
 instance SetRange Name where
@@ -323,7 +331,9 @@ instance KillRange Name where
                   -- An experiment: what happens if we preserve
                   -- the range of the binding site, but kill all
                   -- other ranges before serialization?
-                  -- , nameBindingSite = noRange
+                  -- Andreas, Makoto, 2014-10-18 AIM XX
+                  -- Kill all ranges in signature, including nameBindingSite.
+                  , nameBindingSite = noRange
                   }
 
 instance KillRange ModuleName where
diff --git a/src/full/Agda/Syntax/Abstract/Pretty.hs b/src/full/Agda/Syntax/Abstract/Pretty.hs
index 6f66275..cedacae 100644
--- a/src/full/Agda/Syntax/Abstract/Pretty.hs
+++ b/src/full/Agda/Syntax/Abstract/Pretty.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+
 module Agda.Syntax.Abstract.Pretty where
 
 import Control.Applicative
diff --git a/src/full/Agda/Syntax/Abstract/Views.hs b/src/full/Agda/Syntax/Abstract/Views.hs
index 4739049..f5a8b55 100644
--- a/src/full/Agda/Syntax/Abstract/Views.hs
+++ b/src/full/Agda/Syntax/Abstract/Views.hs
@@ -1,10 +1,15 @@
-{-# LANGUAGE TupleSections, PatternGuards #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE PatternGuards             #-}
+{-# LANGUAGE TupleSections             #-}
 
 module Agda.Syntax.Abstract.Views where
 
 import Control.Applicative
 import Control.Arrow (first)
 import Control.Monad.Identity
+
+import Data.Foldable (foldMap)
+import Data.Monoid
 import Data.Traversable
 
 import Agda.Syntax.Position
@@ -33,7 +38,7 @@ unAppView (Application h es) =
 -- | Gather top-level 'AsP'atterns to expose underlying pattern.
 asView :: A.Pattern -> ([Name], A.Pattern)
 asView (A.AsP _ x p) = first (x :) $ asView p
-asView p	     = ([], p)
+asView p             = ([], p)
 
 -- | Check whether we are dealing with a universe.
 isSet :: Expr -> Bool
@@ -56,16 +61,52 @@ deepUnScope = mapExpr unScope
 -- | Apply an expression rewriting to every subexpression, inside-out.
 --   See 'Agda.Syntax.Internal.Generic'
 class ExprLike a where
+  foldExpr :: Monoid m => (Expr -> m) -> a -> m
   traverseExpr :: (Monad m, Applicative m) => (Expr -> m Expr) -> a -> m a
   mapExpr :: (Expr -> Expr) -> (a -> a)
   mapExpr f e = runIdentity $ traverseExpr (Identity . f) e
 
 instance ExprLike Expr where
+  foldExpr f e =
+    case e of
+      Var{}                -> m
+      Def{}                -> m
+      Proj{}               -> m
+      Con{}                -> m
+      PatternSyn{}         -> m
+      Lit{}                -> m
+      QuestionMark{}       -> m
+      Underscore{}         -> m
+      App _ e e'           -> m `mappend` fold e `mappend` fold e'
+      WithApp _ e es       -> m `mappend` fold e `mappend` fold es
+      Lam _ b e            -> m `mappend` fold b `mappend` fold e
+      AbsurdLam{}          -> m
+      ExtendedLam _ _ _ cs -> m `mappend` fold cs
+      Pi _ tel e           -> m `mappend` fold tel `mappend` fold e
+      Fun _ e e'           -> m `mappend` fold e `mappend` fold e'
+      Set{}                -> m
+      Prop{}               -> m
+      Let _ bs e           -> m `mappend` fold bs `mappend` fold e
+      ETel tel             -> m `mappend` fold tel
+      Rec _ as             -> m `mappend` fold as
+      RecUpdate _ e as     -> m `mappend` fold e `mappend` fold as
+      ScopedExpr _ e       -> m `mappend` fold e
+      QuoteGoal _ _ e      -> m `mappend` fold e
+      QuoteContext _ _ e   -> m `mappend` fold e
+      Quote{}              -> m
+      QuoteTerm{}          -> m
+      Unquote{}            -> m
+      DontCare e           -> m `mappend` fold e
+   where
+     m    = f e
+     fold = foldExpr f
+
   traverseExpr f e = do
     let trav e = traverseExpr f e
     case e of
       Var{}                   -> f e
       Def{}                   -> f e
+      Proj{}                  -> f e
       Con{}                   -> f e
       Lit{}                   -> f e
       QuestionMark{}          -> f e
@@ -94,33 +135,54 @@ instance ExprLike Expr where
 
 -- | TODO: currently does not go into colors.
 instance ExprLike a => ExprLike (Common.Arg c a) where
+  foldExpr     = foldMap . foldExpr
   traverseExpr = traverse . traverseExpr
 
 instance ExprLike a => ExprLike (Named x a) where
+  foldExpr     = foldMap . foldExpr
   traverseExpr = traverse . traverseExpr
 
 instance ExprLike a => ExprLike [a] where
+  foldExpr     = foldMap . foldExpr
   traverseExpr = traverse . traverseExpr
 
 instance ExprLike a => ExprLike (x, a) where
+  foldExpr     f (x, e) = foldExpr f e
   traverseExpr f (x, e) = (x,) <$> traverseExpr f e
 
 instance ExprLike LamBinding where
+  foldExpr f e =
+    case e of
+      DomainFree{}  -> mempty
+      DomainFull bs -> foldExpr f bs
   traverseExpr f e =
     case e of
       DomainFree{}  -> return e
       DomainFull bs -> DomainFull <$> traverseExpr f bs
 
 instance ExprLike TypedBindings where
+  foldExpr     f (TypedBindings r b) = foldExpr f b
   traverseExpr f (TypedBindings r b) = TypedBindings r <$> traverseExpr f b
 
 instance ExprLike TypedBinding where
+  foldExpr f e =
+    case e of
+      TBind _ _ e  -> foldExpr f e
+      TLet _ ds    -> foldExpr f ds
   traverseExpr f e =
     case e of
       TBind r xs e -> TBind r xs <$> traverseExpr f e
       TLet r ds    -> TLet r <$> traverseExpr f ds
 
 instance ExprLike LetBinding where
+  foldExpr f e =
+    case e of
+      LetBind _ _ _ e e' -> fold e `mappend` fold e'
+      LetPatBind _ p e   -> fold p `mappend` fold e
+      LetApply{}         -> mempty
+      LetOpen{}          -> mempty
+    where fold e = foldExpr f e
+
   traverseExpr f e = do
     let trav e = traverseExpr f e
     case e of
@@ -131,8 +193,39 @@ instance ExprLike LetBinding where
 
 -- | TODO: currently does not go into patterns.
 instance ExprLike (Pattern' a) where
+  foldExpr     f _ = mempty
   traverseExpr f e = return e
 
 -- | TODO: currently does not go into clauses.
 instance ExprLike (Clause' a) where
+  foldExpr     f _ = mempty
   traverseExpr f e = return e
+
+{- TODO: finish
+instance ExprLike (Clause' a) where
+  foldExpr f (Clause _ rhs ds) = fold rhs `mappend` fold ds
+    where fold e = foldExpr f e
+  traverseExpr f (Clause lhs rhs ds) = Clause lhs <$> trav rhs <*> trav ds
+    where trav e = traverseExpr f e
+
+instance ExprLike RHS where
+  foldExpr f rhs =
+    case rhs of
+      RHS e                  -> fold e
+      AbsurdRHS{}            -> mempty
+      WithRHS _ es cs        -> fold es `mappend` fold cs
+      RewriteRHS _ es rhs ds -> fold es `mappend` fold rhs `mappend` fold ds
+    where fold e = foldExpr f e
+
+  traverseExpr f rhs =
+    case rhs of
+      RHS e                   -> RHS <$> trav e
+      AbsurdRHS{}             -> pure rhs
+      WithRHS x es cs         -> WithRHS x <$> trav es <*> trav cs
+      RewriteRHS xs es rhs ds -> RewriteRHS xs <$> trav es <*> trav rhs <*> trav ds
+    where trav e = traverseExpr f e
+
+instance ExprLike Declaration where
+  foldExpr f d =
+    case d of
+-}
diff --git a/src/full/Agda/Syntax/Common.hs b/src/full/Agda/Syntax/Common.hs
index 225a836..381b300 100644
--- a/src/full/Agda/Syntax/Common.hs
+++ b/src/full/Agda/Syntax/Common.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 {-| Some common syntactic entities are defined in this module.
 -}
@@ -27,10 +28,9 @@ import Agda.Utils.Functor
 import Agda.Utils.Pretty
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
-
 ---------------------------------------------------------------------------
 -- * Delayed
 ---------------------------------------------------------------------------
@@ -314,7 +314,8 @@ isHiddenArg arg = argHiding arg /= NotHidden
 mapArgInfo :: (ArgInfo c -> ArgInfo c') -> Arg c a -> Arg c' a
 mapArgInfo f arg = arg { argInfo = f $ argInfo arg }
 
-argColors    = argInfoColors    . argInfo
+argColors :: Arg c a -> [c]
+argColors = argInfoColors . argInfo
 
 mapArgColors :: ([c] -> [c']) -> Arg c a -> Arg c' a
 mapArgColors = mapArgInfo . mapArgInfoColors
@@ -329,10 +330,10 @@ defaultColoredArg :: ([c],a) -> Arg c a
 defaultColoredArg (cs,a) = setArgColors cs $ defaultArg a
 
 noColorArg :: Hiding -> Relevance -> a -> Arg c a
-noColorArg h r = Arg $ ArgInfo { argInfoHiding    = h
-                               , argInfoRelevance = r
-                               , argInfoColors    = []
-                               }
+noColorArg h r = Arg ArgInfo { argInfoHiding    = h
+                             , argInfoRelevance = r
+                             , argInfoColors    = []
+                             }
 
 -- | @xs \`withArgsFrom\` args@ translates @xs@ into a list of 'Arg's,
 -- using the elements in @args@ to fill in the non-'unArg' fields.
@@ -408,7 +409,8 @@ instance LensRelevance (Dom c e) where
 mapDomInfo :: (ArgInfo c -> ArgInfo c') -> Dom c a -> Dom c' a
 mapDomInfo f arg = arg { domInfo = f $ domInfo arg }
 
-domColors    = argInfoColors    . domInfo
+domColors :: Dom c a -> [c]
+domColors = argInfoColors . domInfo
 
 argFromDom :: Dom c a -> Arg c a
 argFromDom (Dom i a) = Arg i a
@@ -426,8 +428,8 @@ defaultDom = Dom defaultArgInfo
 -- | Something potentially carrying a name.
 data Named name a =
     Named { nameOf     :: Maybe name
-	  , namedThing :: a
-	  }
+          , namedThing :: a
+          }
     deriving (Eq, Ord, Typeable, Functor, Foldable, Traversable)
 
 -- | Standard naming.
@@ -557,9 +559,9 @@ instance Show NameId where
   show (NameId x i) = show x ++ "@" ++ show i
 
 instance Enum NameId where
-  succ (NameId n m)	= NameId (n + 1) m
-  pred (NameId n m)	= NameId (n - 1) m
-  toEnum n		= __IMPOSSIBLE__  -- should not be used
+  succ (NameId n m)     = NameId (n + 1) m
+  pred (NameId n m)     = NameId (n - 1) m
+  toEnum n              = __IMPOSSIBLE__  -- should not be used
   fromEnum (NameId n _) = fromIntegral n
 
 instance Hashable NameId where
@@ -592,9 +594,11 @@ data TerminationCheck m
     -- ^ Skip termination checking (unsafe).
   | NonTerminating
     -- ^ Treat as non-terminating.
+  | Terminating
+    -- ^ Treat as terminating (unsafe).  Same effect as 'NoTerminationCheck'.
   | TerminationMeasure !Range m
     -- ^ Skip termination checking but use measure instead.
-    deriving (Typeable, Show, Eq)
+    deriving (Typeable, Show, Eq, Functor)
 
 instance KillRange m => KillRange (TerminationCheck m) where
   killRange (TerminationMeasure _ m) = TerminationMeasure noRange (killRange m)
diff --git a/src/full/Agda/Syntax/Concrete.hs b/src/full/Agda/Syntax/Concrete.hs
index 39509d4..1ba4fa2 100644
--- a/src/full/Agda/Syntax/Concrete.hs
+++ b/src/full/Agda/Syntax/Concrete.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DeriveDataTypeable   #-}
+{-# LANGUAGE DeriveFoldable       #-}
+{-# LANGUAGE DeriveFunctor        #-}
+{-# LANGUAGE DeriveTraversable    #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 {-| The concrete syntax is a raw representation of the program text
@@ -12,48 +12,50 @@
     around, it can be printed exactly as the user wrote it.
 -}
 module Agda.Syntax.Concrete
-    ( -- * Expressions
-      Expr(..)
-    , OpApp(..), fromOrdinary
-    , module Agda.Syntax.Concrete.Name
-    , appView, AppView(..)
-      -- * Bindings
-    , LamBinding
-    , LamBinding'(..)
-    , TypedBindings
-    , TypedBindings'(..)
-    , TypedBinding
-    , TypedBinding'(..)
-    , ColoredTypedBinding(..)
-    , BoundName(..), mkBoundName_, mkBoundName
-    , Telescope -- (..)
-    , countTelVars
-      -- * Declarations
-    , Declaration(..)
-    , ModuleApplication(..)
-    , TypeSignature
-    , TypeSignatureOrInstanceBlock
-    , Constructor
-    , ImportDirective(..), UsingOrHiding(..), ImportedName(..)
-    , Renaming(..), AsName(..)
-    , defaultImportDir
-    , OpenShortHand(..), RewriteEqn, WithExpr
-    , LHS(..), Pattern(..), LHSCore(..)
-    , RHS, RHS'(..), WhereClause, WhereClause'(..)
-    , Pragma(..)
-    , Module
-    , ThingWithFixity(..)
-    , topLevelModuleName
+  ( -- * Expressions
+    Expr(..)
+  , OpApp(..), fromOrdinary
+  , module Agda.Syntax.Concrete.Name
+  , appView, AppView(..)
+    -- * Bindings
+  , LamBinding
+  , LamBinding'(..)
+  , TypedBindings
+  , TypedBindings'(..)
+  , TypedBinding
+  , TypedBinding'(..)
+  , ColoredTypedBinding(..)
+  , BoundName(..), mkBoundName_, mkBoundName
+  , Telescope -- (..)
+  , countTelVars
+    -- * Declarations
+  , Declaration(..)
+  , ModuleApplication(..)
+  , TypeSignature
+  , TypeSignatureOrInstanceBlock
+  , Constructor
+  , ImportDirective(..), UsingOrHiding(..), ImportedName(..)
+  , Renaming(..), AsName(..)
+  , defaultImportDir
+  , OpenShortHand(..), RewriteEqn, WithExpr
+  , LHS(..), Pattern(..), LHSCore(..)
+  , RHS, RHS'(..), WhereClause, WhereClause'(..)
+  , Pragma(..)
+  , Module
+  , ThingWithFixity(..)
+  , topLevelModuleName
     -- * Pattern tools
-    , patternHead, patternNames
+  , patternHead, patternNames
+    -- * Lenses
+  , mapLhsOriginalPattern
     -- * Concrete instances
-    , Color
-    , Arg
---    , Dom
-    , NamedArg
-    , ArgInfo
-    )
-    where
+  , Color
+  , Arg
+  -- , Dom
+  , NamedArg
+  , ArgInfo
+  )
+  where
 
 import Control.DeepSeq
 import Data.Typeable (Typeable)
@@ -69,7 +71,9 @@ import Agda.Syntax.Literal
 
 import Agda.Syntax.Concrete.Name
 
-#include "../undefined.h"
+import Agda.Utils.Lens
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Color      = Expr
@@ -79,9 +83,11 @@ type NamedArg a = Common.NamedArg Color a
 type ArgInfo    = Common.ArgInfo Color
 
 data OpApp e
-        = SyntaxBindingLambda !Range [LamBinding] e -- ^ an abstraction inside a special syntax declaration (see Issue 358 why we introduce this).
-        | Ordinary e
-    deriving (Typeable, Functor, Foldable, Traversable)
+  = SyntaxBindingLambda !Range [LamBinding] e
+    -- ^ An abstraction inside a special syntax declaration
+    --   (see Issue 358 why we introduce this).
+  | Ordinary e
+  deriving (Typeable, Functor, Foldable, Traversable)
 
 fromOrdinary :: e -> OpApp e -> e
 fromOrdinary d (Ordinary e) = e
@@ -89,84 +95,86 @@ fromOrdinary d _            = d
 
 -- | Concrete expressions. Should represent exactly what the user wrote.
 data Expr
-	= Ident QName			       -- ^ ex: @x@
-	| Lit Literal			       -- ^ ex: @1@ or @\"foo\"@
-	| QuestionMark !Range (Maybe Nat)      -- ^ ex: @?@ or @{! ... !}@
-	| Underscore !Range (Maybe String)     -- ^ ex: @_@ or @_A_5@
-	| RawApp !Range [Expr]		       -- ^ before parsing operators
-	| App !Range Expr (NamedArg Expr)      -- ^ ex: @e e@, @e {e}@, or @e {x = e}@
-	| OpApp !Range QName [NamedArg (OpApp Expr)] -- ^ ex: @e + e@
-        | WithApp !Range Expr [Expr]           -- ^ ex: @e | e1 | .. | en@
-	| HiddenArg !Range (Named_ Expr)       -- ^ ex: @{e}@ or @{x=e}@
-	| InstanceArg !Range (Named_ Expr)     -- ^ ex: @{{e}}@ or @{{x=e}}@
-	| Lam !Range [LamBinding] Expr	       -- ^ ex: @\\x {y} -> e@ or @\\(x:A){y:B} -> e@
-        | AbsurdLam !Range Hiding              -- ^ ex: @\\ ()@
-        | ExtendedLam !Range [(LHS,RHS,WhereClause)]       -- ^ ex: @\\ { p11 .. p1a -> e1 ; .. ; pn1 .. pnz -> en }@
-	| Fun !Range Expr Expr                 -- ^ ex: @e -> e@ or @.e -> e@ (NYI: @{e} -> e@)
-	| Pi Telescope Expr		       -- ^ ex: @(xs:e) -> e@ or @{xs:e} -> e@
-	| Set !Range			       -- ^ ex: @Set@
-	| Prop !Range			       -- ^ ex: @Prop@
-	| SetN !Range Integer                  -- ^ ex: @Set0, Set1, ..@
-	| Rec !Range [(Name, Expr)]	       -- ^ ex: @record {x = a; y = b}@
-	| RecUpdate !Range Expr [(Name, Expr)] -- ^ ex: @record e {x = a; y = b}@
-	| Let !Range [Declaration] Expr	       -- ^ ex: @let Ds in e@
-	| Paren !Range Expr		       -- ^ ex: @(e)@
-	| Absurd !Range			       -- ^ ex: @()@ or @{}@, only in patterns
-	| As !Range Name Expr		       -- ^ ex: @x\@p@, only in patterns
-	| Dot !Range Expr		       -- ^ ex: @.p@, only in patterns
-        | ETel Telescope                       -- ^ only used for printing telescopes
-        | QuoteGoal !Range Name Expr           -- ^ ex: @quoteGoal x in e@
-        | QuoteContext !Range Name Expr        -- ^ ex: @quoteContext ctx in e@
-        | Quote !Range                         -- ^ ex: @quote@, should be applied to a name
-        | QuoteTerm !Range                     -- ^ ex: @quoteTerm@, should be applied to a term
-        | Tactic !Range Expr [Expr]            -- ^ @tactic solve | subgoal1 | .. | subgoalN@
-        | Unquote !Range                       -- ^ ex: @unquote@, should be applied to a term of type @Term@
-        | DontCare Expr                        -- ^ to print irrelevant things
-        | Equal !Range Expr Expr               -- ^ ex: @a = b@, used internally in the parser
-    deriving (Typeable)
+  = Ident QName                                -- ^ ex: @x@
+  | Lit Literal                                -- ^ ex: @1@ or @\"foo\"@
+  | QuestionMark !Range (Maybe Nat)            -- ^ ex: @?@ or @{! ... !}@
+  | Underscore !Range (Maybe String)           -- ^ ex: @_@ or @_A_5@
+  | RawApp !Range [Expr]                       -- ^ before parsing operators
+  | App !Range Expr (NamedArg Expr)            -- ^ ex: @e e@, @e {e}@, or @e {x = e}@
+  | OpApp !Range QName [NamedArg (OpApp Expr)] -- ^ ex: @e + e@
+  | WithApp !Range Expr [Expr]                 -- ^ ex: @e | e1 | .. | en@
+  | HiddenArg !Range (Named_ Expr)             -- ^ ex: @{e}@ or @{x=e}@
+  | InstanceArg !Range (Named_ Expr)           -- ^ ex: @{{e}}@ or @{{x=e}}@
+  | Lam !Range [LamBinding] Expr               -- ^ ex: @\\x {y} -> e@ or @\\(x:A){y:B} -> e@
+  | AbsurdLam !Range Hiding                    -- ^ ex: @\\ ()@
+  | ExtendedLam !Range [(LHS,RHS,WhereClause)] -- ^ ex: @\\ { p11 .. p1a -> e1 ; .. ; pn1 .. pnz -> en }@
+  | Fun !Range Expr Expr                       -- ^ ex: @e -> e@ or @.e -> e@ (NYI: @{e} -> e@)
+  | Pi Telescope Expr                          -- ^ ex: @(xs:e) -> e@ or @{xs:e} -> e@
+  | Set !Range                                 -- ^ ex: @Set@
+  | Prop !Range                                -- ^ ex: @Prop@
+  | SetN !Range Integer                        -- ^ ex: @Set0, Set1, ..@
+  | Rec !Range [(Name, Expr)]                  -- ^ ex: @record {x = a; y = b}@
+  | RecUpdate !Range Expr [(Name, Expr)]       -- ^ ex: @record e {x = a; y = b}@
+  | Let !Range [Declaration] Expr              -- ^ ex: @let Ds in e@
+  | Paren !Range Expr                          -- ^ ex: @(e)@
+  | Absurd !Range                              -- ^ ex: @()@ or @{}@, only in patterns
+  | As !Range Name Expr                        -- ^ ex: @x\@p@, only in patterns
+  | Dot !Range Expr                            -- ^ ex: @.p@, only in patterns
+  | ETel Telescope                             -- ^ only used for printing telescopes
+  | QuoteGoal !Range Name Expr                 -- ^ ex: @quoteGoal x in e@
+  | QuoteContext !Range Name Expr              -- ^ ex: @quoteContext ctx in e@
+  | Quote !Range                               -- ^ ex: @quote@, should be applied to a name
+  | QuoteTerm !Range                           -- ^ ex: @quoteTerm@, should be applied to a term
+  | Tactic !Range Expr [Expr]                  -- ^ @tactic solve | subgoal1 | .. | subgoalN@
+  | Unquote !Range                             -- ^ ex: @unquote@, should be applied to a term of type @Term@
+  | DontCare Expr                              -- ^ to print irrelevant things
+  | Equal !Range Expr Expr                     -- ^ ex: @a = b@, used internally in the parser
+  deriving (Typeable)
 
 instance NFData Expr
 
 -- | Concrete patterns. No literals in patterns at the moment.
 data Pattern
-	= IdentP QName                            -- ^ @c@ or @x@
-        | QuoteP !Range                           -- ^ @quote@
-	| AppP Pattern (NamedArg Pattern)         -- ^ @p p'@ or @p {x = p'}@
-	| RawAppP !Range [Pattern]                -- ^ @p1..pn@ before parsing operators
-	| OpAppP !Range QName [NamedArg Pattern]  -- ^ eg: @p => p'@ for operator @_=>_@
-	| HiddenP !Range (Named_ Pattern)         -- ^ @{p}@ or @{x = p}@
-	| InstanceP !Range (Named_ Pattern)       -- ^ @{{p}}@ or @{{x = p}}@
-	| ParenP !Range Pattern                   -- ^ @(p)@
-	| WildP !Range                            -- ^ @_@
-	| AbsurdP !Range                          -- ^ @()@
-	| AsP !Range Name Pattern                 -- ^ @x\@p@ unused
-	| DotP !Range Expr                        -- ^ @.e@
-	| LitP Literal                            -- ^ @0@, @1@, etc.
-    deriving (Typeable)
+  = IdentP QName                            -- ^ @c@ or @x@
+  | QuoteP !Range                           -- ^ @quote@
+  | AppP Pattern (NamedArg Pattern)         -- ^ @p p'@ or @p {x = p'}@
+  | RawAppP !Range [Pattern]                -- ^ @p1..pn@ before parsing operators
+  | OpAppP !Range QName [NamedArg Pattern]  -- ^ eg: @p => p'@ for operator @_=>_@
+  | HiddenP !Range (Named_ Pattern)         -- ^ @{p}@ or @{x = p}@
+  | InstanceP !Range (Named_ Pattern)       -- ^ @{{p}}@ or @{{x = p}}@
+  | ParenP !Range Pattern                   -- ^ @(p)@
+  | WildP !Range                            -- ^ @_@
+  | AbsurdP !Range                          -- ^ @()@
+  | AsP !Range Name Pattern                 -- ^ @x\@p@ unused
+  | DotP !Range Expr                        -- ^ @.e@
+  | LitP Literal                            -- ^ @0@, @1@, etc.
+  deriving (Typeable)
 
 instance NFData Pattern
 
 -- | A lambda binding is either domain free or typed.
 type LamBinding = LamBinding' TypedBindings
 data LamBinding' a
-	= DomainFree ArgInfo BoundName -- ^ . @x@ or @{x}@ or @.x@ or @.{x}@ or @{.x}@
-	| DomainFull a                 -- ^ . @(xs : e)@ or @{xs : e}@
-    deriving (Typeable, Functor, Foldable, Traversable)
+  = DomainFree ArgInfo BoundName  -- ^ . @x@ or @{x}@ or @.x@ or @.{x}@ or @{.x}@
+  | DomainFull a                  -- ^ . @(xs : e)@ or @{xs : e}@
+  deriving (Typeable, Functor, Foldable, Traversable)
 
 
 -- | A sequence of typed bindings with hiding information. Appears in dependent
 --   function spaces, typed lambdas, and telescopes.
+
 type TypedBindings = TypedBindings' TypedBinding
-data TypedBindings' a = TypedBindings !Range (Arg a)
-	-- ^ . @(xs : e)@ or @{xs : e}@
-    deriving (Typeable, Functor, Foldable, Traversable)
 
+data TypedBindings' a = TypedBindings !Range (Arg a)
+     -- ^ . @(xs : e)@ or @{xs : e}@
+  deriving (Typeable, Functor, Foldable, Traversable)
 
-data BoundName = BName { boundName   :: Name
-                       , boundLabel  :: Name    -- ^ for implicit function types the label matters and can't be alpha-renamed
-                       , bnameFixity :: Fixity'
-                       }
-    deriving (Typeable)
+data BoundName = BName
+  { boundName   :: Name
+  , boundLabel  :: Name    -- ^ for implicit function types the label matters and can't be alpha-renamed
+  , bnameFixity :: Fixity'
+  }
+  deriving (Typeable)
 
 mkBoundName_ :: Name -> BoundName
 mkBoundName_ x = mkBoundName x defaultFixity'
@@ -175,10 +183,12 @@ mkBoundName :: Name -> Fixity' -> BoundName
 mkBoundName x f = BName x x f
 
 -- | A typed binding.
+
 type TypedBinding = TypedBinding' Expr
+
 data TypedBinding' e
-    = TBind !Range [BoundName] e -- ^ Binding @(x1 ... xn : A)@.
-    | TLet  !Range [Declaration] -- ^ Let binding @(let Ds)@ or @(open M args)@.
+  = TBind !Range [BoundName] e  -- ^ Binding @(x1 ... xn : A)@.
+  | TLet  !Range [Declaration]  -- ^ Let binding @(let Ds)@ or @(open M args)@.
   deriving (Typeable, Functor, Foldable, Traversable)
 
 -- | Color a TypeBinding. Used by Pretty.
@@ -202,14 +212,15 @@ countTelVars tel =
 
    We use fixity information to see which name is actually defined.
 -}
-data LHS = LHS { lhsOriginalPattern :: Pattern       -- ^ @f ps@
-               , lhsWithPattern     :: [Pattern]     -- ^ @| p@ (many)
-               , lhsRewriteEqn      :: [RewriteEqn]  -- ^ @rewrite e@ (many)
-               , lhsWithExpr        :: [WithExpr]    -- ^ @with e@ (many)
-               }
-         -- ^ original pattern, with-patterns, rewrite equations and with-expressions
-         | Ellipsis Range [Pattern] [RewriteEqn] [WithExpr]
-         -- ^ new with-patterns, rewrite equations and with-expressions
+data LHS
+  = LHS { lhsOriginalPattern :: Pattern       -- ^ @f ps@
+        , lhsWithPattern     :: [Pattern]     -- ^ @| p@ (many)
+        , lhsRewriteEqn      :: [RewriteEqn]  -- ^ @rewrite e@ (many)
+        , lhsWithExpr        :: [WithExpr]    -- ^ @with e@ (many)
+        }
+    -- ^ original pattern, with-patterns, rewrite equations and with-expressions
+  | Ellipsis Range [Pattern] [RewriteEqn] [WithExpr]
+    -- ^ new with-patterns, rewrite equations and with-expressions
   deriving (Typeable)
 
 type RewriteEqn = Expr
@@ -240,75 +251,75 @@ lhsCoreToPattern (LHSProj d ps1 lhscore ps2) = OpAppP (fuseRange d ps) (unqualif
 
 type RHS = RHS' Expr
 data RHS' e
-    = AbsurdRHS -- ^ No right hand side because of absurd match.
-    | RHS e
+  = AbsurdRHS -- ^ No right hand side because of absurd match.
+  | RHS e
   deriving (Typeable, Functor, Foldable, Traversable)
 
 
 type WhereClause = WhereClause' [Declaration]
 data WhereClause' decls
-    = NoWhere               -- ^ No @where@ clauses.
-    | AnyWhere decls        -- ^ Ordinary @where at .
-    | SomeWhere Name decls  -- ^ Named where: @module M where at .
+  = NoWhere               -- ^ No @where@ clauses.
+  | AnyWhere decls        -- ^ Ordinary @where at .
+  | SomeWhere Name decls  -- ^ Named where: @module M where at .
   deriving (Typeable, Functor, Foldable, Traversable)
 
 
 -- | The things you are allowed to say when you shuffle names between name
 --   spaces (i.e. in @import@, @namespace@, or @open@ declarations).
-data ImportDirective
-	= ImportDirective
-	    { importDirRange	:: !Range
-	    , usingOrHiding	:: UsingOrHiding
-	    , renaming		:: [Renaming]
-	    , publicOpen	:: Bool	-- ^ Only for @open at . Exports the opened names from the current module.
-	    }
-    deriving (Typeable)
+data ImportDirective = ImportDirective
+  { importDirRange :: !Range
+  , usingOrHiding  :: UsingOrHiding
+  , renaming       :: [Renaming]
+  , publicOpen     :: Bool -- ^ Only for @open at . Exports the opened names from the current module.
+  }
+  deriving (Typeable)
 
 -- | Default is directive is @private@ (use everything, but do not export).
 defaultImportDir :: ImportDirective
 defaultImportDir = ImportDirective noRange (Hiding []) [] False
 
 data UsingOrHiding
-	= Hiding [ImportedName]
-	| Using  [ImportedName]
-    deriving (Typeable)
+  = Hiding [ImportedName]
+  | Using  [ImportedName]
+  deriving (Typeable)
 
 -- | An imported name can be a module or a defined name
-data ImportedName = ImportedModule  { importedName :: Name }
-		  | ImportedName    { importedName :: Name }
-    deriving (Typeable, Eq, Ord)
+data ImportedName
+  = ImportedModule  { importedName :: Name }
+  | ImportedName    { importedName :: Name }
+  deriving (Typeable, Eq, Ord)
 
 instance Show ImportedName where
-    show (ImportedModule x) = "module " ++ show x
-    show (ImportedName   x) = show x
-
-data Renaming = Renaming { renFrom    :: ImportedName
-                           -- ^ Rename from this name.
-                         , renTo      :: Name
-                           -- ^ To this one.
-                         , renToRange :: Range
-                           -- ^ The range of the \"to\" keyword. Retained
-                           --   for highlighting purposes.
-                         }
-    deriving (Typeable)
-
-data AsName = AsName { asName  :: Name
-                       -- ^ The \"as\" name.
-                     , asRange :: Range
-                       -- ^ The range of the \"as\" keyword. Retained
-                       --   for highlighting purposes.
-                     }
-    deriving (Typeable, Show)
+  show (ImportedModule x) = "module " ++ show x
+  show (ImportedName   x) = show x
+
+data Renaming = Renaming
+  { renFrom    :: ImportedName
+    -- ^ Rename from this name.
+  , renTo      :: Name
+    -- ^ To this one.
+  , renToRange :: Range
+    -- ^ The range of the \"to\" keyword.  Retained for highlighting purposes.
+  }
+  deriving (Typeable)
+
+data AsName = AsName
+  { asName  :: Name
+    -- ^ The \"as\" name.
+  , asRange :: Range
+    -- ^ The range of the \"as\" keyword.  Retained for highlighting purposes.
+  }
+  deriving (Typeable, Show)
 
 {--------------------------------------------------------------------------
     Declarations
  --------------------------------------------------------------------------}
 
 -- | Just type signatures.
-type TypeSignature   = Declaration
+type TypeSignature = Declaration
 
 -- | Just type signatures or instance blocks.
-type TypeSignatureOrInstanceBlock   = Declaration
+type TypeSignatureOrInstanceBlock = Declaration
 
 -- | A data constructor declaration is just a type signature.
 type Constructor = TypeSignature
@@ -318,61 +329,61 @@ type Constructor = TypeSignature
 -}
 
 data Declaration
-	= TypeSig ArgInfo Name Expr
-        -- ^ Axioms and functions can be irrelevant. (Hiding should be NotHidden)
-        | Field Name (Arg Expr) -- ^ Record field, can be hidden and/or irrelevant.
-	| FunClause LHS RHS WhereClause
-	| DataSig     !Range Induction Name [LamBinding] Expr -- ^ lone data signature in mutual block
-	| Data        !Range Induction Name [LamBinding] (Maybe Expr) [Constructor]
-	| RecordSig   !Range Name [LamBinding] Expr -- ^ lone record signature in mutual block
-	| Record      !Range Name (Maybe (Ranged Induction)) (Maybe Name) [LamBinding] (Maybe Expr) [Declaration]
-          -- ^ The optional name is a name for the record constructor.
-	| Infix Fixity [Name]
-        | Syntax      Name Notation -- ^ notation declaration for a name
-        | PatternSyn  !Range Name [Arg Name] Pattern
-	| Mutual      !Range [Declaration]
-	| Abstract    !Range [Declaration]
-	| Private     !Range [Declaration]
-	| InstanceB   !Range [Declaration]
-	| Postulate   !Range [TypeSignatureOrInstanceBlock]
-	| Primitive   !Range [TypeSignature]
-	| Open        !Range QName ImportDirective
-	| Import      !Range QName (Maybe AsName) OpenShortHand ImportDirective
-	| ModuleMacro !Range  Name ModuleApplication OpenShortHand ImportDirective
-	| Module      !Range QName [TypedBindings] [Declaration]
-        | UnquoteDecl !Range Name Expr
-	| Pragma      Pragma
-    deriving (Typeable)
+  = TypeSig ArgInfo Name Expr
+  -- ^ Axioms and functions can be irrelevant. (Hiding should be NotHidden)
+  | Field Name (Arg Expr) -- ^ Record field, can be hidden and/or irrelevant.
+  | FunClause LHS RHS WhereClause
+  | DataSig     !Range Induction Name [LamBinding] Expr -- ^ lone data signature in mutual block
+  | Data        !Range Induction Name [LamBinding] (Maybe Expr) [Constructor]
+  | RecordSig   !Range Name [LamBinding] Expr -- ^ lone record signature in mutual block
+  | Record      !Range Name (Maybe (Ranged Induction)) (Maybe Name) [LamBinding] (Maybe Expr) [Declaration]
+    -- ^ The optional name is a name for the record constructor.
+  | Infix Fixity [Name]
+  | Syntax      Name Notation -- ^ notation declaration for a name
+  | PatternSyn  !Range Name [Arg Name] Pattern
+  | Mutual      !Range [Declaration]
+  | Abstract    !Range [Declaration]
+  | Private     !Range [Declaration]
+  | InstanceB   !Range [Declaration]
+  | Postulate   !Range [TypeSignatureOrInstanceBlock]
+  | Primitive   !Range [TypeSignature]
+  | Open        !Range QName ImportDirective
+  | Import      !Range QName (Maybe AsName) OpenShortHand ImportDirective
+  | ModuleMacro !Range  Name ModuleApplication OpenShortHand ImportDirective
+  | Module      !Range QName [TypedBindings] [Declaration]
+  | UnquoteDecl !Range Name Expr
+  | Pragma      Pragma
+  deriving (Typeable)
 
 data ModuleApplication
   = SectionApp Range [TypedBindings] Expr
     -- ^ @tel. M args@
   | RecordModuleIFS Range QName
     -- ^ @M {{...}}@
-    deriving (Typeable)
+  deriving (Typeable)
 
 data OpenShortHand = DoOpen | DontOpen
-    deriving (Typeable, Eq, Show)
+  deriving (Typeable, Eq, Show)
 
 -- Pragmas ----------------------------------------------------------------
 
-data Pragma = OptionsPragma     !Range [String]
-	    | BuiltinPragma     !Range String Expr
-	    | RewritePragma     !Range QName
-            | CompiledDataPragma !Range QName String [String]
-            | CompiledTypePragma !Range QName String
-            | CompiledPragma    !Range QName String
-            | CompiledExportPragma    !Range QName String
-            | CompiledEpicPragma !Range QName String
-            | CompiledJSPragma  !Range QName String
-            | StaticPragma      !Range QName
-            | ImportPragma      !Range String
-              -- ^ Invariant: The string must be a valid Haskell
-              -- module name.
-            | ImpossiblePragma !Range
-            | EtaPragma !Range QName
-            | TerminationCheckPragma !Range (TerminationCheck Name)
-    deriving (Typeable)
+data Pragma
+  = OptionsPragma          !Range [String]
+  | BuiltinPragma          !Range String Expr
+  | RewritePragma          !Range QName
+  | CompiledDataPragma     !Range QName String [String]
+  | CompiledTypePragma     !Range QName String
+  | CompiledPragma         !Range QName String
+  | CompiledExportPragma   !Range QName String
+  | CompiledEpicPragma     !Range QName String
+  | CompiledJSPragma       !Range QName String
+  | StaticPragma           !Range QName
+  | ImportPragma           !Range String
+    -- ^ Invariant: The string must be a valid Haskell module name.
+  | ImpossiblePragma       !Range
+  | EtaPragma              !Range QName
+  | TerminationCheckPragma !Range (TerminationCheck Name)
+  deriving (Typeable)
 
 ---------------------------------------------------------------------------
 
@@ -391,6 +402,15 @@ topLevelModuleName (_, ds) = case last ds of
   _              -> __IMPOSSIBLE__
 
 {--------------------------------------------------------------------------
+    Lenses
+ --------------------------------------------------------------------------}
+
+mapLhsOriginalPattern :: (Pattern -> Pattern) -> LHS -> LHS
+mapLhsOriginalPattern f lhs at Ellipsis{}                    = lhs
+mapLhsOriginalPattern f lhs at LHS{ lhsOriginalPattern = p } =
+  lhs { lhsOriginalPattern = f p }
+
+{--------------------------------------------------------------------------
     Views
  --------------------------------------------------------------------------}
 
@@ -399,13 +419,13 @@ data AppView = AppView Expr [NamedArg Expr]
 
 appView :: Expr -> AppView
 appView (App r e1 e2) = vApp (appView e1) e2
-    where
-	vApp (AppView e es) arg = AppView e (es ++ [arg])
+  where
+    vApp (AppView e es) arg = AppView e (es ++ [arg])
 appView (RawApp _ (e:es)) = AppView e $ map arg es
-    where
-	arg (HiddenArg   _ e) = noColorArg Hidden    Relevant e
-	arg (InstanceArg _ e) = noColorArg Instance  Relevant e
-	arg e		      = noColorArg NotHidden Relevant (unnamed e)
+  where
+    arg (HiddenArg   _ e) = noColorArg Hidden    Relevant e
+    arg (InstanceArg _ e) = noColorArg Instance  Relevant e
+    arg e                 = noColorArg NotHidden Relevant (unnamed e)
 appView e = AppView e []
 
 {--------------------------------------------------------------------------
@@ -416,20 +436,20 @@ appView e = AppView e []
 patternHead :: Pattern -> Maybe Name
 patternHead p =
   case p of
-    IdentP x             -> return $ unqualify x
-    AppP p p'            -> patternHead p
-    RawAppP _ []         -> __IMPOSSIBLE__
-    RawAppP _ (p:_)      -> patternHead p
-    OpAppP _ name ps     -> return $ unqualify name
-    HiddenP _ (namedPat) -> patternHead (namedThing namedPat)
-    ParenP _ p           -> patternHead p
-    WildP _              -> Nothing
-    AbsurdP _            -> Nothing
-    AsP _ x p            -> patternHead p
-    DotP{}               -> Nothing
-    LitP (LitQName _ x)  -> Nothing -- return $ unqualify x -- does not compile
-    LitP _               -> Nothing
-    QuoteP _             -> Nothing
+    IdentP x               -> return $ unqualify x
+    AppP p p'              -> patternHead p
+    RawAppP _ []           -> __IMPOSSIBLE__
+    RawAppP _ (p:_)        -> patternHead p
+    OpAppP _ name ps       -> return $ unqualify name
+    HiddenP _ (namedPat)   -> patternHead (namedThing namedPat)
+    ParenP _ p             -> patternHead p
+    WildP _                -> Nothing
+    AbsurdP _              -> Nothing
+    AsP _ x p              -> patternHead p
+    DotP{}                 -> Nothing
+    LitP (LitQName _ x)    -> Nothing -- return $ unqualify x -- does not compile
+    LitP _                 -> Nothing
+    QuoteP _               -> Nothing
     InstanceP _ (namedPat) -> patternHead (namedThing namedPat)
 
 
@@ -437,18 +457,18 @@ patternHead p =
 patternNames :: Pattern -> [Name]
 patternNames p =
   case p of
-    IdentP x             -> [unqualify x]
-    AppP p p'            -> concatMap patternNames [p, namedArg p']
-    RawAppP _ ps         -> concatMap patternNames  ps
-    OpAppP _ name ps     -> unqualify name : concatMap (patternNames . namedArg) ps
-    HiddenP _ (namedPat) -> patternNames (namedThing namedPat)
-    ParenP _ p           -> patternNames p
-    WildP _              -> []
-    AbsurdP _            -> []
-    AsP _ x p            -> patternNames p
-    DotP{}               -> []
-    LitP _               -> []
-    QuoteP _             -> []
+    IdentP x               -> [unqualify x]
+    AppP p p'              -> concatMap patternNames [p, namedArg p']
+    RawAppP _ ps           -> concatMap patternNames  ps
+    OpAppP _ name ps       -> unqualify name : concatMap (patternNames . namedArg) ps
+    HiddenP _ (namedPat)   -> patternNames (namedThing namedPat)
+    ParenP _ p             -> patternNames p
+    WildP _                -> []
+    AbsurdP _              -> []
+    AsP _ x p              -> patternNames p
+    DotP{}                 -> []
+    LitP _                 -> []
+    QuoteP _               -> []
     InstanceP _ (namedPat) -> patternNames (namedThing namedPat)
 
 {--------------------------------------------------------------------------
@@ -456,68 +476,68 @@ patternNames p =
  --------------------------------------------------------------------------}
 
 instance HasRange e => HasRange (OpApp e) where
-    getRange e = case e of
-        Ordinary e -> getRange e
-        SyntaxBindingLambda r _ _ -> r
+  getRange e = case e of
+    Ordinary e -> getRange e
+    SyntaxBindingLambda r _ _ -> r
 
 instance HasRange Expr where
-    getRange e =
-	case e of
-	    Ident x		-> getRange x
-	    Lit x		-> getRange x
-	    QuestionMark r _	-> r
-	    Underscore r _	-> r
-	    App r _ _		-> r
-	    RawApp r _		-> r
-	    OpApp r _ _		-> r
-            WithApp r _ _       -> r
-	    Lam r _ _		-> r
-            AbsurdLam r _       -> r
-            ExtendedLam r _       -> r
-	    Fun r _ _		-> r
-	    Pi b e		-> fuseRange b e
-	    Set r		-> r
-	    Prop r		-> r
-	    SetN r _		-> r
-	    Let r _ _		-> r
-	    Paren r _		-> r
-	    As r _ _		-> r
-	    Dot r _		-> r
-	    Absurd r		-> r
-	    HiddenArg r _	-> r
-	    InstanceArg r _	-> r
-	    Rec r _		-> r
-	    RecUpdate r _ _	-> r
-            ETel tel            -> getRange tel
-            QuoteGoal r _ _     -> r
-            QuoteContext r _ _  -> r
-            Quote r             -> r
-            QuoteTerm r         -> r
-            Unquote r           -> r
-            Tactic r _ _        -> r
-            DontCare{}          -> noRange
-            Equal r _ _         -> r
+  getRange e =
+    case e of
+      Ident x            -> getRange x
+      Lit x              -> getRange x
+      QuestionMark r _   -> r
+      Underscore r _     -> r
+      App r _ _          -> r
+      RawApp r _         -> r
+      OpApp r _ _        -> r
+      WithApp r _ _      -> r
+      Lam r _ _          -> r
+      AbsurdLam r _      -> r
+      ExtendedLam r _    -> r
+      Fun r _ _          -> r
+      Pi b e             -> fuseRange b e
+      Set r              -> r
+      Prop r             -> r
+      SetN r _           -> r
+      Let r _ _          -> r
+      Paren r _          -> r
+      As r _ _           -> r
+      Dot r _            -> r
+      Absurd r           -> r
+      HiddenArg r _      -> r
+      InstanceArg r _    -> r
+      Rec r _            -> r
+      RecUpdate r _ _    -> r
+      ETel tel           -> getRange tel
+      QuoteGoal r _ _    -> r
+      QuoteContext r _ _ -> r
+      Quote r            -> r
+      QuoteTerm r        -> r
+      Unquote r          -> r
+      Tactic r _ _       -> r
+      DontCare{}         -> noRange
+      Equal r _ _        -> r
 
 -- instance HasRange Telescope where
 --     getRange (TeleBind bs) = getRange bs
 --     getRange (TeleFun x y) = fuseRange x y
 
 instance HasRange TypedBindings where
-    getRange (TypedBindings r _) = r
+  getRange (TypedBindings r _) = r
 
 instance HasRange TypedBinding where
-    getRange (TBind r _ _) = r
-    getRange (TLet r _)    = r
+  getRange (TBind r _ _) = r
+  getRange (TLet r _)    = r
 
 instance HasRange LamBinding where
-    getRange (DomainFree _ x) = getRange x
-    getRange (DomainFull b)   = getRange b
+  getRange (DomainFree _ x) = getRange x
+  getRange (DomainFull b)   = getRange b
 
 instance HasRange BoundName where
   getRange = getRange . boundName
 
 instance HasRange WhereClause where
-  getRange  NoWhere	    = noRange
+  getRange  NoWhere         = noRange
   getRange (AnyWhere ds)    = getRange ds
   getRange (SomeWhere _ ds) = getRange ds
 
@@ -526,67 +546,67 @@ instance HasRange ModuleApplication where
   getRange (RecordModuleIFS r _) = r
 
 instance HasRange Declaration where
-    getRange (TypeSig _ x t)	       = fuseRange x t
-    getRange (Field x t)               = fuseRange x t
-    getRange (FunClause lhs rhs wh)    = fuseRange lhs rhs `fuseRange` wh
-    getRange (DataSig r _ _ _ _)       = r
-    getRange (Data r _ _ _ _ _)	       = r
-    getRange (RecordSig r _ _ _)       = r
-    getRange (Record r _ _ _ _ _ _)    = r
-    getRange (Mutual r _)	       = r
-    getRange (Abstract r _)	       = r
-    getRange (Open r _ _)	       = r
-    getRange (ModuleMacro r _ _ _ _)   = r
-    getRange (Import r _ _ _ _)	       = r
-    getRange (InstanceB r _)	       = r
-    getRange (Private r _)	       = r
-    getRange (Postulate r _)	       = r
-    getRange (Primitive r _)	       = r
-    getRange (Module r _ _ _)	       = r
-    getRange (Infix f _)	       = getRange f
-    getRange (Syntax n _)              = getRange n
-    getRange (PatternSyn r _ _ _)      = r
-    getRange (UnquoteDecl r _ _)       = r
-    getRange (Pragma p)		       = getRange p
+  getRange (TypeSig _ x t)         = fuseRange x t
+  getRange (Field x t)             = fuseRange x t
+  getRange (FunClause lhs rhs wh)  = fuseRange lhs rhs `fuseRange` wh
+  getRange (DataSig r _ _ _ _)     = r
+  getRange (Data r _ _ _ _ _)      = r
+  getRange (RecordSig r _ _ _)     = r
+  getRange (Record r _ _ _ _ _ _)  = r
+  getRange (Mutual r _)            = r
+  getRange (Abstract r _)          = r
+  getRange (Open r _ _)            = r
+  getRange (ModuleMacro r _ _ _ _) = r
+  getRange (Import r _ _ _ _)      = r
+  getRange (InstanceB r _)         = r
+  getRange (Private r _)           = r
+  getRange (Postulate r _)         = r
+  getRange (Primitive r _)         = r
+  getRange (Module r _ _ _)        = r
+  getRange (Infix f _)             = getRange f
+  getRange (Syntax n _)            = getRange n
+  getRange (PatternSyn r _ _ _)    = r
+  getRange (UnquoteDecl r _ _)     = r
+  getRange (Pragma p)              = getRange p
 
 instance HasRange LHS where
   getRange (LHS p ps eqns ws) = fuseRange p (fuseRange ps (eqns ++ ws))
   getRange (Ellipsis r _ _ _) = r
 
 instance HasRange LHSCore where
-  getRange (LHSHead f ps) = fuseRange f ps
+  getRange (LHSHead f ps)              = fuseRange f ps
   getRange (LHSProj d ps1 lhscore ps2) = d `fuseRange` ps1 `fuseRange` lhscore `fuseRange` ps2
 
 instance HasRange RHS where
-    getRange AbsurdRHS = noRange
-    getRange (RHS e)   = getRange e
+  getRange AbsurdRHS = noRange
+  getRange (RHS e)   = getRange e
 
 instance HasRange Pragma where
-    getRange (OptionsPragma r _)          = r
-    getRange (BuiltinPragma r _ _)        = r
-    getRange (RewritePragma r _)          = r
-    getRange (CompiledDataPragma r _ _ _) = r
-    getRange (CompiledTypePragma r _ _)   = r
-    getRange (CompiledPragma r _ _)       = r
-    getRange (CompiledExportPragma r _ _) = r
-    getRange (CompiledEpicPragma r _ _)   = r
-    getRange (CompiledJSPragma r _ _)     = r
-    getRange (StaticPragma r _)           = r
-    getRange (ImportPragma r _)           = r
-    getRange (ImpossiblePragma r)         = r
-    getRange (EtaPragma r _)              = r
-    getRange (TerminationCheckPragma r _) = r
+  getRange (OptionsPragma r _)          = r
+  getRange (BuiltinPragma r _ _)        = r
+  getRange (RewritePragma r _)          = r
+  getRange (CompiledDataPragma r _ _ _) = r
+  getRange (CompiledTypePragma r _ _)   = r
+  getRange (CompiledPragma r _ _)       = r
+  getRange (CompiledExportPragma r _ _) = r
+  getRange (CompiledEpicPragma r _ _)   = r
+  getRange (CompiledJSPragma r _ _)     = r
+  getRange (StaticPragma r _)           = r
+  getRange (ImportPragma r _)           = r
+  getRange (ImpossiblePragma r)         = r
+  getRange (EtaPragma r _)              = r
+  getRange (TerminationCheckPragma r _) = r
 
 instance HasRange UsingOrHiding where
-    getRange (Using xs)	    = getRange xs
-    getRange (Hiding xs)    = getRange xs
+  getRange (Using xs)  = getRange xs
+  getRange (Hiding xs) = getRange xs
 
 instance HasRange ImportDirective where
-    getRange = importDirRange
+  getRange = importDirRange
 
 instance HasRange ImportedName where
-    getRange (ImportedName x)	= getRange x
-    getRange (ImportedModule x)	= getRange x
+  getRange (ImportedName x)   = getRange x
+  getRange (ImportedModule x) = getRange x
 
 instance HasRange Renaming where
   getRange r = getRange (renFrom r, renTo r)
@@ -595,19 +615,19 @@ instance HasRange AsName where
   getRange a = getRange (asRange a, asName a)
 
 instance HasRange Pattern where
-    getRange (IdentP x)		= getRange x
-    getRange (AppP p q)		= fuseRange p q
-    getRange (OpAppP r _ _)	= r
-    getRange (RawAppP r _)	= r
-    getRange (ParenP r _)	= r
-    getRange (WildP r)		= r
-    getRange (AsP r _ _)	= r
-    getRange (AbsurdP r)	= r
-    getRange (LitP l)		= getRange l
-    getRange (QuoteP r)         = r
-    getRange (HiddenP r _)	= r
-    getRange (InstanceP r _)	= r
-    getRange (DotP r _)		= r
+  getRange (IdentP x)         = getRange x
+  getRange (AppP p q)         = fuseRange p q
+  getRange (OpAppP r _ _)     = r
+  getRange (RawAppP r _)      = r
+  getRange (ParenP r _)       = r
+  getRange (WildP r)          = r
+  getRange (AsP r _ _)        = r
+  getRange (AbsurdP r)        = r
+  getRange (LitP l)           = getRange l
+  getRange (QuoteP r)         = r
+  getRange (HiddenP r _)      = r
+  getRange (InstanceP r _)    = r
+  getRange (DotP r _)         = r
 
 instance KillRange AsName where
   killRange (AsName n _) = killRange1 (flip AsName noRange) n
diff --git a/src/full/Agda/Syntax/Concrete/Definitions.hs b/src/full/Agda/Syntax/Concrete/Definitions.hs
index b3432b8..acc46d1 100644
--- a/src/full/Agda/Syntax/Concrete/Definitions.hs
+++ b/src/full/Agda/Syntax/Concrete/Definitions.hs
@@ -1,6 +1,32 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DeriveDataTypeable   #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- | Preprocess 'Agda.Syntax.Concrete.Declaration's, producing 'NiceDeclaration's.
+--
+--   * Attach fixity and syntax declarations to the definition they refer to.
+--
+--   * Distribute the following attributes to the individual definitions:
+--       @abstract@,
+--       @instance@,
+--       @postulate@,
+--       @primitive@,
+--       @private@,
+--       termination pragmas.
+--
+--   * Gather the function clauses belonging to one function definition.
+--
+--   * Expand ellipsis @...@ in function clauses following @with at .
+--
+--   * Infer mutual blocks.
+--     A block starts when a lone signature is encountered, and ends when
+--     all lone signatures have seen their definition.
+--
+--   * Report basic well-formedness error,
+--     when one of the above transformation fails.
 
 module Agda.Syntax.Concrete.Definitions
     ( NiceDeclaration(..)
@@ -15,15 +41,15 @@ module Agda.Syntax.Concrete.Definitions
 
 import Control.Arrow ((***))
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.State
 
-import Data.Typeable (Typeable)
 import Data.Foldable hiding (concatMap, mapM_, notElem, elem, all)
 import qualified Data.Map as Map
 import Data.Map (Map)
+import Data.Monoid ( Monoid(mappend, mempty) )
 import Data.List as List
 import Data.Traversable (traverse)
+import Data.Typeable (Typeable)
 
 import Agda.Syntax.Concrete
 import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo, TerminationCheck())
@@ -32,12 +58,15 @@ import Agda.Syntax.Position
 import Agda.Syntax.Fixity
 import Agda.Syntax.Notation
 import Agda.Syntax.Concrete.Pretty ()
-import Agda.Utils.Pretty
-import Agda.Utils.List (mhead, isSublistOf)
+
+import Agda.Utils.Except ( Error(noMsg, strMsg), MonadError(throwError) )
+import Agda.Utils.Lens
+import Agda.Utils.List (headMaybe, isSublistOf)
 import Agda.Utils.Monad
+import Agda.Utils.Pretty
 import Agda.Utils.Update
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {--------------------------------------------------------------------------
@@ -111,6 +140,9 @@ data DeclarationException
         | InvalidMeasureMutual Range
           -- ^ In a mutual block, all or none need a MEASURE pragma.
           --   Range is of mutual block.
+        | PragmaNoTerminationCheck Range
+          -- ^ Pragma @{-# NO_TERMINATION_CHECK #-}@ has been replaced
+          --   by {-# TERMINATING #-} and {-# NON_TERMINATING #-}.
     deriving (Typeable)
 
 instance HasRange DeclarationException where
@@ -132,6 +164,7 @@ instance HasRange DeclarationException where
     getRange (WrongContentPostulateBlock r) = r
     getRange (InvalidTerminationCheckPragma r) = r
     getRange (InvalidMeasureMutual r)      = r
+    getRange (PragmaNoTerminationCheck r)  = r
 
 instance HasRange NiceDeclaration where
   getRange (Axiom r _ _ _ _ _ _)           = r
@@ -157,13 +190,15 @@ instance Error DeclarationException where
   noMsg  = strMsg ""
   strMsg = DeclarationPanic
 
+-- These error messages can (should) be terminated by a dot ".",
+-- there is no error context printed after them.
 instance Show DeclarationException where
   show (MultipleFixityDecls xs) = show $
-    sep [ fsep $ pwords "Multiple fixity declarations for"
+    sep [ fsep $ pwords "Multiple fixity or syntax declarations for"
         , vcat $ map f xs
         ]
       where
-        f (x, fs) = pretty x <> text ":" <+> fsep (map (text . show) fs)
+        f (x, fs) = pretty x <> text ": " <+> fsep (map pretty fs)
   show (MissingDefinition x) = show $ fsep $
     pwords "Missing definition for" ++ [pretty x]
   show (MissingWithClauses x) = show $ fsep $
@@ -181,7 +216,7 @@ instance Show DeclarationException where
     pwords "More than one matching type signature for left hand side" ++ [pretty lhs] ++
     pwords "it could belong to any of:" ++ map pretty xs
   show (UnknownNamesInFixityDecl xs) = show $ fsep $
-    pwords "Names out of scope in fixity declarations:" ++ map pretty xs
+    pwords "The following names are not declared in the same scope as their syntax or fixity declaration (i.e., either not in scope at all, imported from another module, or declared in a super module):" ++ map pretty xs
   show (UselessPrivate _)      = show $ fsep $
     pwords "Using private here has no effect. Private applies only to declarations that introduce new identifiers into the module, like type signatures and data, record, and module declarations."
   show (UselessAbstract _)      = show $ fsep $
@@ -190,24 +225,33 @@ instance Show DeclarationException where
     pwords "Using instance here has no effect. Instance applies only to declarations that introduce new identifiers into the module, like type signatures and axioms."
   show (WrongContentPostulateBlock _)      = show $ fsep $
     pwords "A postulate block can only contain type signatures or instance blocks"
+  show (PragmaNoTerminationCheck _) = show $ fsep $
+    pwords "Pragma {-# NO_TERMINATION_CHECK #-} has been removed.  To skip the termination check, label your definitions either as {-# TERMINATING #-} or {-# NON_TERMINATING #-}."
   show (InvalidTerminationCheckPragma _) = show $ fsep $
-    pwords "Termination checking pragmas can only preceed a mutual block or a function definition."
+    pwords "Termination checking pragmas can only precede a mutual block or a function definition."
   show (InvalidMeasureMutual _) = show $ fsep $
     pwords "In a mutual block, either all functions must have the same (or no) termination checking pragma."
   show (NotAllowedInMutual nd) = show $ fsep $
     [text $ decl nd] ++ pwords "are not allowed in mutual blocks"
     where
-      decl (Axiom{})             = "Postulates"
-      decl (NiceField{})         = "Fields"
-      decl (NiceMutual{})        = "Mutual blocks"
-      decl (NiceModule{})        = "Modules"
-      decl (NiceModuleMacro{})   = "Modules"
-      decl (NiceOpen{})          = "Open declarations"
-      decl (NiceImport{})        = "Import statements"
-      decl (NicePragma{})        = "Pragmas"
-      decl (PrimitiveFunction{}) = "Primitive declarations"
-      decl (NicePatternSyn{})    = "Pattern synonyms"
-      decl _ = __IMPOSSIBLE__
+      decl Axiom{}             = "Postulates"
+      decl NiceField{}         = "Fields"
+      decl NiceMutual{}        = "Mutual blocks"
+      decl NiceModule{}        = "Modules"
+      decl NiceModuleMacro{}   = "Modules"
+      decl NiceOpen{}          = "Open declarations"
+      decl NiceImport{}        = "Import statements"
+      decl NicePragma{}        = "Pragmas"
+      decl PrimitiveFunction{} = "Primitive declarations"
+      decl NicePatternSyn{}    = "Pattern synonyms"
+      decl NiceUnquoteDecl{}   = "Unquoted declarations"
+      decl NiceRecSig{}        = __IMPOSSIBLE__
+      decl NiceDataSig{}       = __IMPOSSIBLE__
+      decl NiceFunClause{}     = __IMPOSSIBLE__
+      decl FunSig{}            = __IMPOSSIBLE__
+      decl FunDef{}            = __IMPOSSIBLE__
+      decl RecDef{}            = __IMPOSSIBLE__
+      decl DataDef{}           = __IMPOSSIBLE__
   show (Codata _) =
     "The codata construction has been removed. " ++
     "Use the INFINITY builtin instead."
@@ -260,53 +304,85 @@ combineTermChecks r tcs = loop tcs where
     let failure r = throwError $ InvalidMeasureMutual r
     tc' <- loop tcs
     case (tc, tc') of
-      (TerminationCheck      , _                     ) -> return tc'
-      (_                     , TerminationCheck      ) -> return tc
-      (NonTerminating        , NonTerminating        ) -> return tc
-      (NoTerminationCheck    , NoTerminationCheck    ) -> return tc
+      (TerminationCheck      , tc'                   ) -> return tc'
+      (tc                    , TerminationCheck      ) -> return tc
+      (NonTerminating        , NonTerminating        ) -> return NonTerminating
+      (NoTerminationCheck    , NoTerminationCheck    ) -> return NoTerminationCheck
+      (NoTerminationCheck    , Terminating           ) -> return Terminating
+      (Terminating           , NoTerminationCheck    ) -> return Terminating
+      (Terminating           , Terminating           ) -> return Terminating
       (TerminationMeasure{}  , TerminationMeasure{}  ) -> return tc
       (TerminationMeasure r _, NoTerminationCheck    ) -> failure r
+      (TerminationMeasure r _, Terminating           ) -> failure r
       (NoTerminationCheck    , TerminationMeasure r _) -> failure r
+      (Terminating           , TerminationMeasure r _) -> failure r
       (TerminationMeasure r _, NonTerminating        ) -> failure r
       (NonTerminating        , TerminationMeasure r _) -> failure r
       (NoTerminationCheck    , NonTerminating        ) -> failure r
+      (Terminating           , NonTerminating        ) -> failure r
       (NonTerminating        , NoTerminationCheck    ) -> failure r
+      (NonTerminating        , Terminating           ) -> failure r
+
+
+-- | Nicifier monad.
+
+type Nice = StateT NiceEnv (Either DeclarationException)
+
+-- | Nicifier state.
 
-type LoneSigs = [(DataRecOrFun, Name)]
 data NiceEnv = NiceEnv
-  { loneSigs :: LoneSigs -- ^ lone type signatures that wait for their definition
-  , fixs     :: Map Name Fixity'
+  { _loneSigs :: LoneSigs
+    -- ^ Lone type signatures that wait for their definition.
+  , fixs     :: Fixities
   }
 
+type LoneSigs = [(DataRecOrFun, Name)]
+type Fixities = Map Name Fixity'
+
+-- | Initial nicifier state.
+
 initNiceEnv :: NiceEnv
 initNiceEnv = NiceEnv
-  { loneSigs = []
+  { _loneSigs = []
   , fixs     = Map.empty
   }
 
-type Nice = StateT NiceEnv (Either DeclarationException)
+-- * Handling the lone signatures, stored to infer mutual blocks.
+
+-- | Lens for field '_loneSigs'.
+
+loneSigs :: Lens' LoneSigs NiceEnv
+loneSigs f e = f (_loneSigs e) <&> \ s -> e { _loneSigs = s }
+
+-- | Adding a lone signature to the state.
 
 addLoneSig :: DataRecOrFun -> Name -> Nice ()
-addLoneSig k x = modify $ \ niceEnv -> niceEnv { loneSigs = (k, x) : loneSigs niceEnv }
+addLoneSig k x = loneSigs %= ((k, x) :)
+
+-- | Remove a lone signature from the state.
 
 removeLoneSig :: Name -> Nice ()
-removeLoneSig x = modify $ \ niceEnv ->
-  niceEnv { loneSigs = filter (\ (k', x') -> x /= x') $ loneSigs niceEnv }
+removeLoneSig x = loneSigs %= filter (\ (k', x') -> x /= x')
+
+-- | Search for forward type signature.
 
--- | Search for forward type signature that
 getSig :: Name -> Nice (Maybe DataRecOrFun)
-getSig n = gets $ fmap fst . List.find (\ (k, x) -> x == n) . loneSigs
+getSig n = fmap fst . List.find (\ (k, x) -> x == n) <$> use loneSigs
+
+-- | Check that no lone signatures are left in the state.
 
 noLoneSigs :: Nice Bool
-noLoneSigs = gets $ null . loneSigs
+noLoneSigs = null <$> use loneSigs
 
 -- | Ensure that all forward declarations have been given a definition.
+
 checkLoneSigs :: LoneSigs -> Nice ()
 checkLoneSigs xs =
   case xs of
     []       -> return ()
     (_, x):_ -> throwError $ MissingDefinition x
 
+
 getFixity :: Name -> Nice Fixity'
 getFixity x = gets $ Map.findWithDefault defaultFixity' x . fixs
 
@@ -319,6 +395,7 @@ data DeclKind
     | OtherDecl
   deriving (Eq, Show)
 
+declKind :: NiceDeclaration -> DeclKind
 declKind (FunSig _ _ _ _ _ tc x _)    = LoneSig (FunName tc) x
 declKind (NiceRecSig _ _ _ x pars _)  = LoneSig (RecName $ parameters pars) x
 declKind (NiceDataSig _ _ _ x pars _) = LoneSig (DataName $ parameters pars) x
@@ -334,61 +411,54 @@ parameters = List.concat . List.map numP where
   numP (DomainFull (TypedBindings _ (Common.Arg i (TBind _ xs _)))) = List.replicate (length xs) $ argInfoHiding i
   numP (DomainFull (TypedBindings _ (Common.Arg _ TLet{})))         = []
 
-{- OLD:
-
--- | Compute number of visible parameters of a data or record signature or definition.
-numberOfPars :: [LamBinding] -> Params
-numberOfPars = List.sum . List.map numP where
-  numP (DomainFree NotHidden _ _) = 1
-  numP (DomainFull (TypedBindings _ (Arg NotHidden _ (TBind _ xs _)))) = length xs
-  numP _ = 0  -- hidden / instance argument
--- | Compute number of parameters of a data or record signature or definition.
-numberOfPars :: [LamBinding] -> Int
-numberOfPars = List.sum . List.map numP where
-  numP (DomainFree{}) = 1
-  numP (DomainFull (TypedBindings _ arg)) = nP $ unArg arg where
-    nP (TBind _ xs _) = length xs
--}
-
+-- | Main.
 niceDeclarations :: [Declaration] -> Nice [NiceDeclaration]
 niceDeclarations ds = do
+  -- Get fixity and syntax declarations.
   fixs <- fixities ds
   case Map.keys fixs \\ concatMap declaredNames ds of
-    []  -> localState $ do
+    -- If we have fixity/syntax decls for names not declared
+    -- in the current scope, fail.
+    xs@(_:_) -> throwError $ UnknownNamesInFixityDecl xs
+    []       -> localState $ do
+      -- Run the nicifier in an initial environment of fixity decls.
       put $ initNiceEnv { fixs = fixs }
       ds <- nice ds
-      checkLoneSigs =<< gets loneSigs
-      modify $ \s -> s { loneSigs = [] }
+      -- Check that every signature got its definition.
+      checkLoneSigs =<< use loneSigs
+      -- Note that loneSigs is ensured to be empty.
+      -- (Important, since inferMutualBlocks also uses loneSigs state).
       inferMutualBlocks ds
-    xs  -> throwError $ UnknownNamesInFixityDecl xs
   where
-    -- Compute the names defined in a declaration
+    -- Compute the names defined in a declaration.
+    -- We stay in the current scope, i.e., do not go into modules.
     declaredNames :: Declaration -> [Name]
     declaredNames d = case d of
-      TypeSig _ x _                                -> [x]
-      Field x _                                    -> [x]
+      TypeSig _ x _        -> [x]
+      Field x _            -> [x]
       FunClause (LHS p [] [] []) _ _
-        | IdentP (QName x) <- removeSingletonRawAppP p -> [x]
-      FunClause{}                                  -> []
-      DataSig _ _ x _ _                            -> [x]
-      Data _ _ x _ _ cs                            -> x : concatMap declaredNames cs
-      RecordSig _ x _ _                            -> [x]
-      Record _ x _ c _ _ _                         -> x : foldMap (:[]) c
-      Infix _ _                                    -> []
-      Syntax _ _                                   -> []
-      PatternSyn _ x _ _                           -> [x]
-      Mutual _ ds                                  -> concatMap declaredNames ds
-      Abstract _ ds                                -> concatMap declaredNames ds
-      Private _ ds                                 -> concatMap declaredNames ds
-      InstanceB _ ds                               -> concatMap declaredNames ds
-      Postulate _ ds                               -> concatMap declaredNames ds
-      Primitive _ ds                               -> concatMap declaredNames ds
-      Open{}                                       -> []
-      Import{}                                     -> []
-      ModuleMacro{}                                -> []
-      Module{}                                     -> []
-      UnquoteDecl _ x _                            -> [x]
-      Pragma{}                                     -> []
+        | IdentP (QName x) <- removeSingletonRawAppP p
+                           -> [x]
+      FunClause{}          -> []
+      DataSig _ _ x _ _    -> [x]
+      Data _ _ x _ _ cs    -> x : concatMap declaredNames cs
+      RecordSig _ x _ _    -> [x]
+      Record _ x _ c _ _ _ -> x : foldMap (:[]) c
+      Infix _ _            -> []
+      Syntax _ _           -> []
+      PatternSyn _ x _ _   -> [x]
+      Mutual    _ ds       -> concatMap declaredNames ds
+      Abstract  _ ds       -> concatMap declaredNames ds
+      Private   _ ds       -> concatMap declaredNames ds
+      InstanceB _ ds       -> concatMap declaredNames ds
+      Postulate _ ds       -> concatMap declaredNames ds
+      Primitive _ ds       -> concatMap declaredNames ds
+      Open{}               -> []
+      Import{}             -> []
+      ModuleMacro{}        -> []
+      Module{}             -> []
+      UnquoteDecl _ x _    -> [x]
+      Pragma{}             -> []
 
     inferMutualBlocks :: [NiceDeclaration] -> Nice [NiceDeclaration]
     inferMutualBlocks [] = return []
@@ -416,7 +486,7 @@ niceDeclarations ds = do
           done <- noLoneSigs
           if done then return (tc, ([], ds)) else
             case ds of
-              []     -> __IMPOSSIBLE__ <$ (checkLoneSigs =<< gets loneSigs)
+              []     -> __IMPOSSIBLE__ <$ (checkLoneSigs =<< use loneSigs)
               d : ds -> case declKind d of
                 LoneSig k x -> addLoneSig  k x >> cons d (untilAllDefined (terminationCheck k : tc) ds)
                 LoneDef k x -> removeLoneSig x >> cons d (untilAllDefined (terminationCheck k : tc) ds)
@@ -429,6 +499,9 @@ niceDeclarations ds = do
 
     nice :: [Declaration] -> Nice [NiceDeclaration]
     nice [] = return []
+    -- Andreas, AIM XX: do not forbid NO_TERMINATION_CHECK in maintenance version.
+    -- nice (Pragma (TerminationCheckPragma r NoTerminationCheck) : _) =
+    --   throwError $ PragmaNoTerminationCheck r
     nice (Pragma (TerminationCheckPragma r tc) : ds@(Mutual{} : _)) | notMeasure tc = do
       ds <- nice ds
       case ds of
@@ -495,8 +568,10 @@ niceDeclarations ds = do
           (NiceModuleMacro r PublicAccess x modapp op is :)
             <$> nice ds
 
+        -- Fixity and syntax declarations have been looked at already.
         Infix _ _           -> nice ds
         Syntax _ _          -> nice ds
+
         PatternSyn r n as p -> do
           fx <- getFixity n
           (NicePatternSyn r fx n as p :) <$> nice ds
@@ -506,21 +581,19 @@ niceDeclarations ds = do
         UnquoteDecl r x e -> do
           fx <- getFixity x
           (NiceUnquoteDecl r fx PublicAccess ConcreteDef TerminationCheck x e :) <$> nice ds
-
+        -- Andreas, AIM XX: do not forbid NO_TERMINATION_CHECK in maintenance version.
+        -- Pragma (TerminationCheckPragma r NoTerminationCheck) ->
+        --   throwError $ PragmaNoTerminationCheck r
         Pragma (TerminationCheckPragma r _) ->
           throwError $ InvalidTerminationCheckPragma r
         Pragma p            -> (NicePragma (getRange p) p :) <$> nice ds
 
     niceFunClause :: TerminationCheck -> Declaration -> [Declaration] -> Nice [NiceDeclaration]
     niceFunClause termCheck d@(FunClause lhs _ _) ds = do
-          xs <- gets $ map snd . filter (isFunName . fst) . loneSigs
+          xs <- map snd . filter (isFunName . fst) <$> use loneSigs
           -- for each type signature 'x' waiting for clauses, we try
           -- if we have some clauses for 'x'
           fixs <- gets fixs
-{- OLD CODE, a bit dense
-          case filter (\ (x,(fits,rest)) -> not $ null fits) $
-                  map (\ x -> (x, span (couldBeFunClauseOf (Map.lookup x fixs) x) $ d : ds)) xs of
--}
           case [ (x, (fits, rest))
                | x <- xs
                , let (fits, rest) =
@@ -678,7 +751,7 @@ niceDeclarations ds = do
 --          trace ("xStrings = " ++ show xStrings) $
 --          trace ("patStrings = " ++ show patStrings) $
 --          trace ("mFixity = " ++ show mFixity) $
-      case (mhead pns, mFixity) of
+      case (headMaybe pns, mFixity) of
         -- first identifier in the patterns is the fun.symbol?
         (Just y, _) | x == y -> True -- trace ("couldBe since y = " ++ show y) $ True
         -- are the parts of x contained in p
@@ -798,48 +871,6 @@ niceDeclarations ds = do
     mkAbstractWhere (AnyWhere ds)    = dirty $ AnyWhere [Abstract noRange ds]
     mkAbstractWhere (SomeWhere m ds) = dirty $SomeWhere m [Abstract noRange ds]
 
-{- OLD CODE
-    abstractBlock _ [] = return []
-    abstractBlock r ds
-        -- hack to avoid failing on inherited abstract blocks in where clauses
-      | r == noRange           = return $ map mkAbstract ds
-      | all uselessAbstract ds = throwError $ UselessAbstract r
-      | otherwise              = return $ map mkAbstract ds
-
-    uselessAbstract d = case d of
-      FunDef{}  -> False
-      DataDef{} -> False
-      RecDef{}  -> False
-      _         -> True
-
-    -- Make a declaration abstract
-    mkAbstract d =
-        case d of
-            NiceField r f a _ x e            -> NiceField r f a AbstractDef x e
-            PrimitiveFunction r f a _ x e    -> PrimitiveFunction r f a AbstractDef x e
-            NiceMutual r termCheck ds        -> NiceMutual r termCheck (map mkAbstract ds)
-            FunDef r ds f _ tc x cs          -> FunDef r ds f AbstractDef tc x (map mkAbstractClause cs)
-            DataDef r f _ x ps cs            -> DataDef r f AbstractDef x ps $ map mkAbstract cs
-            RecDef r f _ x i c ps cs         -> RecDef r f AbstractDef x i c ps $ map mkAbstract cs
-            NiceFunClause r a _ termCheck d  -> NiceFunClause r a AbstractDef termCheck d
-            NiceModule{}                     -> d
-            NiceModuleMacro{}                -> d
-            Axiom{}                          -> d
-            NicePragma{}                     -> d
-            NiceOpen{}                       -> d
-            NiceImport{}                     -> d
-            FunSig{}                         -> d
-            NiceRecSig{}                     -> d
-            NiceDataSig{}                    -> d
-            NicePatternSyn{}                 -> d
-
-    mkAbstractClause (Clause x lhs rhs wh with) =
-        Clause x lhs rhs (mkAbstractWhere wh) (map mkAbstractClause with)
-
-    mkAbstractWhere  NoWhere         = NoWhere
-    mkAbstractWhere (AnyWhere ds)    = AnyWhere [Abstract noRange ds]
-    mkAbstractWhere (SomeWhere m ds) = SomeWhere m [Abstract noRange ds]
--}
     privateBlock _ [] = return []
     privateBlock r ds = do
       let (ds', anyChange) = runChange $ mapM mkPrivate ds
@@ -865,18 +896,6 @@ niceDeclarations ds = do
         NiceDataSig r f p x ls t         -> (\ p -> NiceDataSig r f p x ls t) <$> setPrivate p
         NiceFunClause r p a termCheck d  -> (\ p -> NiceFunClause r p a termCheck d) <$> setPrivate p
         NiceUnquoteDecl r f p a t x e    -> (\ p -> NiceUnquoteDecl r f p a t x e) <$> setPrivate p
-{-
-        Axiom r f _ rel x e              -> dirty $ Axiom r f PrivateAccess rel x e
-        NiceField r f _ a x e            -> dirty $ NiceField r f PrivateAccess a x e
-        PrimitiveFunction r f _ a x e    -> dirty $ PrimitiveFunction r f PrivateAccess a x e
-        NiceMutual r termCheck ds        -> NiceMutual r termCheck <$> mapM mkPrivate ds
-        NiceModule r _ a x tel ds        -> dirty $ NiceModule r PrivateAccess a x tel ds
-        NiceModuleMacro r _ x ma op is   -> dirty $ NiceModuleMacro r PrivateAccess x ma op is
-        FunSig r f _ rel tc x e          -> dirty $ FunSig r f PrivateAccess rel tc x e
-        NiceRecSig r f _ x ls t          -> dirty $ NiceRecSig r f PrivateAccess x ls t
-        NiceDataSig r f _ x ls t         -> dirty $ NiceDataSig r f PrivateAccess x ls t
-        NiceFunClause r _ a termCheck d  -> dirty $ NiceFunClause r PrivateAccess a termCheck d
--}
         NicePragma _ _                   -> return $ d
         NiceOpen _ _ _                   -> return $ d
         NiceImport _ _ _ _ _             -> return $ d
@@ -902,49 +921,6 @@ niceDeclarations ds = do
     mkPrivateWhere (AnyWhere ds)    = dirty  $ AnyWhere [Private (getRange ds) ds]
     mkPrivateWhere (SomeWhere m ds) = dirty  $ SomeWhere m [Private (getRange ds) ds]
 
-{- OLD CODE, with two functions (uselessPrivate, mkPrivate) to be maintained in sync.
-
-    privateBlock _ [] = return []
-    privateBlock r ds
-      | all uselessPrivate ds = throwError $ UselessPrivate r
-      | otherwise             = return $ map mkPrivate ds
-
-    uselessPrivate d = case d of
-      FunDef{}  -> True
-      DataDef{} -> True
-      RecDef{}  -> True
-      _         -> False
-
-    -- Make a declaration private
-    mkPrivate d =
-        case d of
-            Axiom r f _ rel x e              -> Axiom r f PrivateAccess rel x e
-            NiceField r f _ a x e            -> NiceField r f PrivateAccess a x e
-            PrimitiveFunction r f _ a x e    -> PrimitiveFunction r f PrivateAccess a x e
-            NiceMutual r termCheck ds        -> NiceMutual r termCheck (map mkPrivate ds)
-            NiceModule r _ a x tel ds        -> NiceModule r PrivateAccess a x tel ds
-            NiceModuleMacro r _ x ma op is   -> NiceModuleMacro r PrivateAccess x ma op is
-            FunSig r f _ rel tc x e          -> FunSig r f PrivateAccess rel tc x e
-            NiceRecSig r f _ x ls t          -> NiceRecSig r f PrivateAccess x ls t
-            NiceDataSig r f _ x ls t         -> NiceDataSig r f PrivateAccess x ls t
-            NiceFunClause r _ a termCheck d  -> NiceFunClause r PrivateAccess a termCheck d
-            NiceUnquoteDecl r fx _ a term x d -> NiceUnquoteDecl r fx PrivateAccess a term x d
-            NicePragma _ _                   -> d
-            NiceOpen _ _ _                   -> d
-            NiceImport _ _ _ _ _             -> d
-            FunDef{}                         -> d
-            DataDef{}                        -> d
-            RecDef{}                         -> d
-            NicePatternSyn _ _ _ _ _         -> d
-
-    mkPrivateClause (Clause x lhs rhs wh with) =
-        Clause x lhs rhs (mkPrivateWhere wh) (map mkPrivateClause with)
-
-    mkPrivateWhere  NoWhere         = NoWhere
-    mkPrivateWhere (AnyWhere ds)    = AnyWhere [Private (getRange ds) ds]
-    mkPrivateWhere (SomeWhere m ds) = SomeWhere m [Private (getRange ds) ds]
--}
-
     instanceBlock _ [] = return []
     instanceBlock r ds = do
       let (ds', anyChange) = runChange $ mapM mkInstance ds
@@ -980,42 +956,83 @@ niceDeclarations ds = do
       _             -> dirty $ InstanceDef
 
 -- | Add more fixities. Throw an exception for multiple fixity declarations.
-plusFixities :: Map.Map Name Fixity' -> Map.Map Name Fixity' -> Nice (Map.Map Name Fixity')
+--   OR:  Disjoint union of fixity maps.  Throws exception if not disjoint.
+
+plusFixities :: Fixities -> Fixities -> Nice Fixities
 plusFixities m1 m2
+    -- If maps are not disjoint, report conflicts as exception.
     | not (null isect) = throwError $ MultipleFixityDecls isect
-    | otherwise = return $ Map.unionWithKey mergeFixites m1 m2
-    where mergeFixites name (Fixity' f1 s1) (Fixity' f2 s2) = Fixity' f s
+    -- Otherwise, do the union.
+    | otherwise        = return $ Map.unionWithKey mergeFixites m1 m2
+  where
+    --  Merge two fixities, assuming there is no conflict
+    mergeFixites name (Fixity' f1 s1) (Fixity' f2 s2) = Fixity' f s
               where f | f1 == noFixity = f2
                       | f2 == noFixity = f1
                       | otherwise = __IMPOSSIBLE__
                     s | s1 == noNotation = s2
                       | s2 == noNotation = s1
                       | otherwise = __IMPOSSIBLE__
-          isect = [decls x | (x,compat) <- Map.assocs (Map.intersectionWith compatible m1 m2), not compat]
-
-          decls x = (x, map (Map.findWithDefault __IMPOSSIBLE__ x) [m1,m2])
-                                -- cpp doesn't know about primes
-          compatible (Fixity' f1 s1) (Fixity' f2 s2) = (f1 == noFixity || f2 == noFixity) &&
-                                                       (s1 == noNotation || s2 == noNotation)
 
--- | Get the fixities from the current block. Doesn't go inside /any/ blocks.
+    -- Compute a list of conflicts in a format suitable for error reporting.
+    isect = [ (x, map (Map.findWithDefault __IMPOSSIBLE__ x) [m1,m2])
+            | (x, False) <- Map.assocs $ Map.intersectionWith compatible m1 m2 ]
+
+    -- Check for no conflict.
+    compatible (Fixity' f1 s1) (Fixity' f2 s2) = (f1 == noFixity || f2 == noFixity) &&
+                                                 (s1 == noNotation || s2 == noNotation)
+
+-- | While 'Fixities' is not a monoid under disjoint union (which might fail),
+--   we get the monoid instance for the monadic @Nice Fixities@ which propagates
+--   the first error.
+instance Monoid (Nice Fixities) where
+  mempty        = return $ Map.empty
+  mappend c1 c2 = do
+    m1 <- c1
+    m2 <- c2
+    plusFixities m1 m2
+
+-- | Get the fixities from the current block.
+--   Doesn't go inside modules and where blocks.
 --   The reason for this is that fixity declarations have to appear at the same
 --   level (or possibly outside an abstract or mutual block) as its target
 --   declaration.
-fixities :: [Declaration] -> Nice (Map.Map Name Fixity')
-fixities (d:ds) = case d of
-  Syntax x syn   -> plusFixities (Map.singleton x (Fixity' noFixity syn)) =<< fixities ds
-  Infix f xs     -> plusFixities (Map.fromList [ (x,Fixity' f noNotation) | x <- xs ]) =<< fixities ds
-  Mutual _ ds'   -> fixities (ds' ++ ds)
-  Abstract _ ds' -> fixities (ds' ++ ds)
-  Private _ ds'  -> fixities (ds' ++ ds)
-  _              -> fixities ds
-fixities [] = return $ Map.empty
+fixities :: [Declaration] -> Nice Fixities
+fixities = foldMap $ \ d -> case d of
+  -- These declarations define fixities:
+  Syntax x syn    -> return $ Map.singleton x $ Fixity' noFixity syn
+  Infix  f xs     -> return $ Map.fromList $ map (,Fixity' f noNotation) xs
+  -- We look into these blocks:
+  Mutual    _ ds' -> fixities ds'
+  Abstract  _ ds' -> fixities ds'
+  Private   _ ds' -> fixities ds'
+  InstanceB _ ds' -> fixities ds'
+  -- All other declarations are ignored.
+  -- We expand these boring cases to trigger a revisit
+  -- in case the @Declaration@ type is extended in the future.
+  TypeSig     {}  -> mempty
+  Field       {}  -> mempty
+  FunClause   {}  -> mempty
+  DataSig     {}  -> mempty
+  Data        {}  -> mempty
+  RecordSig   {}  -> mempty
+  Record      {}  -> mempty
+  PatternSyn  {}  -> mempty
+  Postulate   {}  -> mempty
+  Primitive   {}  -> mempty
+  Open        {}  -> mempty
+  Import      {}  -> mempty
+  ModuleMacro {}  -> mempty
+  Module      {}  -> mempty
+  UnquoteDecl {}  -> mempty
+  Pragma      {}  -> mempty
 
 
 -- Andreas, 2012-04-07
 -- The following function is only used twice, for building a Let, and for
 -- printing an error message.
+
+-- | (Approximately) convert a 'NiceDeclaration' back to a 'Declaration'.
 notSoNiceDeclaration :: NiceDeclaration -> Declaration
 notSoNiceDeclaration d =
     case d of
@@ -1040,28 +1057,3 @@ notSoNiceDeclaration d =
       NicePatternSyn r _ n as p        -> PatternSyn r n as p
       NiceUnquoteDecl r _ _ _ _ x e    -> UnquoteDecl r x e
 
-{-
--- Andreas, 2012-03-08 the following function is only used twice,
--- both just on a single declaration.
-notSoNiceDeclarations :: [NiceDeclaration] -> [Declaration]
-notSoNiceDeclarations = concatMap notNice
-  where
-    notNice d = case d of
-      Axiom _ _ _ rel x e              -> [TypeSig rel x e]
-      NiceField _ _ _ _ x argt         -> [Field x argt]
-      PrimitiveFunction r _ _ _ x e    -> [Primitive r [TypeSig Relevant x e]]
-      NiceMutual _ _ ds                -> concatMap notNice ds
-      NiceModule r _ _ x tel ds        -> [Module r x tel ds]
-      NiceModuleMacro r _ x ma o dir   -> [ModuleMacro r x ma o dir]
-      NiceOpen r x dir                 -> [Open r x dir]
-      NiceImport r x as o dir          -> [Import r x as o dir]
-      NicePragma _ p                   -> [Pragma p]
-      NiceRecSig r _ _ x bs e          -> [RecordSig r x bs e]
-      NiceDataSig r _ _ x bs e         -> [DataSig r Inductive x bs e]
-      FunSig _ _ _ rel tc x e          -> [TypeSig rel x e]
-      FunDef _ ds _ _ _ _ _            -> ds
-      DataDef r _ _ x bs cs            -> [Data r Inductive x bs Nothing $ concatMap notNice cs]
-      RecDef r _ _ x c bs ds           -> [Record r x (unThing <$> c) bs Nothing $ concatMap notNice ds]
-        where unThing (ThingWithFixity c _) = c
-      NicePatternSyn r _ n as p        -> [PatternSyn r n as p]
--}
diff --git a/src/full/Agda/Syntax/Concrete/Generic.hs b/src/full/Agda/Syntax/Concrete/Generic.hs
index 3717d42..f499b2b 100644
--- a/src/full/Agda/Syntax/Concrete/Generic.hs
+++ b/src/full/Agda/Syntax/Concrete/Generic.hs
@@ -1,12 +1,12 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 -- | Generic traversal and reduce for concrete syntax,
 --   in the style of 'Agda.Syntax.Internal.Generic'.
 --
 --   However, here we use the terminology of 'Data.Traversable'.
 
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-
 module Agda.Syntax.Concrete.Generic where
 
 import Control.Applicative
@@ -18,7 +18,7 @@ import Data.Foldable
 import Agda.Syntax.Common hiding (Arg)
 import Agda.Syntax.Concrete
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Generic traversals for concrete expressions.
diff --git a/src/full/Agda/Syntax/Concrete/Name.hs b/src/full/Agda/Syntax/Concrete/Name.hs
index 06ba292..437b592 100644
--- a/src/full/Agda/Syntax/Concrete/Name.hs
+++ b/src/full/Agda/Syntax/Concrete/Name.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DeriveDataTypeable   #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 {-| Names in the concrete syntax are just strings (or lists of strings for
@@ -26,7 +26,7 @@ import Agda.Syntax.Position
 import Agda.Utils.FileName
 import Agda.Utils.Pretty
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {-| A name is a non-empty list of alternating 'Id's and 'Hole's. A normal name
@@ -69,7 +69,7 @@ data NamePart
 instance Eq Name where
     Name _ xs  == Name _ ys  = xs == ys
     NoName _ i == NoName _ j = i == j
-    _	       == _	     = False
+    _          == _          = False
 
 instance Ord Name where
     compare (Name _ xs)  (Name _ ys)  = compare xs ys
@@ -156,8 +156,8 @@ isNonfix  x = not (isHole (head xs)) && not (isHole (last xs)) where xs = namePa
 
 -- | @qualify A.B x == A.B.x@
 qualify :: QName -> Name -> QName
-qualify (QName m) x	= Qual m (QName x)
-qualify (Qual m m') x	= Qual m $ qualify m' x
+qualify (QName m) x     = Qual m (QName x)
+qualify (Qual m m') x   = Qual m $ qualify m' x
 
 -- | @unqualify A.B.x == x@
 --
@@ -241,9 +241,13 @@ instance IsNoName QName where
 -- no instance for TopLevelModuleName
 
 ------------------------------------------------------------------------
--- * Printing names
+-- * Showing names
 ------------------------------------------------------------------------
 
+-- TODO: 'Show' should output Haskell-parseable representations.
+-- The following instances are deprecated, and Pretty should be used
+-- instead.  Later, simply derive Show for these types:
+
 instance Show Name where
     show (Name _ xs)  = concatMap show xs
     show (NoName _ _) = "_"
@@ -256,6 +260,22 @@ instance Show QName where
     show (Qual m x) = show m ++ "." ++ show x
     show (QName x)  = show x
 
+------------------------------------------------------------------------
+-- * Printing names
+------------------------------------------------------------------------
+
+instance Pretty Name where
+    pretty (Name _ xs)  = hcat $ map pretty xs
+    pretty (NoName _ _) = text $ "_"
+
+instance Pretty NamePart where
+    pretty Hole   = text $ "_"
+    pretty (Id s) = text $ rawNameToString s
+
+instance Pretty QName where
+    pretty (Qual m x) = pretty m <> pretty "." <> pretty x
+    pretty (QName x)  = pretty x
+
 instance Pretty TopLevelModuleName where
   pretty (TopLevelModuleName ms) = text $ intercalate "." ms
 
@@ -279,7 +299,7 @@ instance HasRange Name where
 
 instance HasRange QName where
     getRange (QName  x) = getRange x
-    getRange (Qual n x)	= fuseRange n x
+    getRange (Qual n x) = fuseRange n x
 
 instance SetRange Name where
   setRange r (Name _ ps)  = Name r ps
diff --git a/src/full/Agda/Syntax/Concrete/Operators.hs b/src/full/Agda/Syntax/Concrete/Operators.hs
index 586b425..2fa1546 100644
--- a/src/full/Agda/Syntax/Concrete/Operators.hs
+++ b/src/full/Agda/Syntax/Concrete/Operators.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-| The parser doesn't know about operators and parses everything as normal
@@ -15,18 +15,6 @@ module Agda.Syntax.Concrete.Operators
     , parseLHS
     , parsePattern
     , parsePatternSyn
-    , paren
-    , mparen
-    -- exports for Copatterns
-    , validConPattern
-    , patternAppView
-    , fullParen
-    , buildParsers, buildParser
-    , parsePat
-    , getDefinedNames
-    , UseBoundNames(..)
-    , qualifierModules
-    , patternQNames
     ) where
 
 import Control.DeepSeq
@@ -36,12 +24,13 @@ import Control.Monad
 import Data.Either (partitionEithers)
 import Data.Function
 import Data.List
-import Data.Traversable (traverse)
-import qualified Data.Traversable as Trav
+import Data.Maybe
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Traversable (traverse)
+import qualified Data.Traversable as Trav
 
 import Agda.Syntax.Concrete.Pretty ()
 import Agda.Syntax.Common hiding (Arg, Dom, NamedArg)
@@ -65,7 +54,7 @@ import Agda.Utils.Either
 import Agda.Utils.ReadP
 import Agda.Utils.List
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -87,15 +76,18 @@ partsInScope flat = do
           where
             first:iparts = [ i | i@(Id {}) <- xs ]
 
-type FlatScope = Map.Map QName [AbstractName]
+type FlatScope = Map QName [AbstractName]
 
 -- | Compute all unqualified defined names in scope and their fixities.
+--   Note that overloaded names (constructors) can have several fixities.
+--   Then we 'chooseFixity'. (See issue 1194.)
 getDefinedNames :: [KindOfName] -> FlatScope -> [(QName, Fixity')]
 getDefinedNames kinds names =
-  [ (x, A.nameFixity $ A.qnameName $ anameName d)
+  [ (x, chooseFixity fixs)
   | (x, ds) <- Map.toList names
-  , d       <- take 1 ds
-  , any (\ d -> anameKind d `elem` kinds) ds
+  , any ((`elem` kinds) . anameKind) ds
+  , let fixs = map (A.nameFixity . A.qnameName . anameName) ds
+  , not (null fixs)
   -- Andreas, 2013-03-21 see Issue 822
   -- Names can have different kinds, i.e., 'defined' and 'constructor'.
   -- We need to consider all names that have *any* matching kind,
@@ -107,25 +99,38 @@ getDefinedNames kinds names =
 localNames :: FlatScope -> ScopeM ([QName], [NewNotation])
 localNames flat = do
   let defs = getDefinedNames allKindsOfNames flat
-  locals <- scopeLocals <$> getScope
-  return $ split $ uniqBy fst $ map localOp locals ++ defs
+  locals <- notShadowedLocals <$> getLocalVars
+  -- Note: Debug printout aligned with the one in buildParsers.
+  reportSLn "scope.operators" 50 $ unlines
+    [ "flat  = " ++ show flat
+    , "defs  = " ++ show defs
+    , "locals= " ++ show locals
+    ]
+  return $ split $ uniqOn fst $ map localOp locals ++ defs
   where
     localOp (x, y) = (QName x, A.nameFixity y)
     split ops = partitionEithers $ concatMap opOrNot ops
 
-    opOrNot (q, Fixity' fx syn) = Left q
-                                :  case unqualify q of
-                                      Name _ [_] -> []
-                                      x -> [Right (q, fx, syntaxOf x)]
-                                ++ case syn of
-                                    [] -> []
-                                    _ -> [Right (q, fx, syn)]
-
-data UseBoundNames = UseBoundNames | DontUseBoundNames
-
-
+    opOrNot (q, Fixity' fx syn) = Left q : map Right (notaFromName ++ nota)
+      where
+        notaFromName = case unqualify q of
+          Name _ [_] -> []
+          x          -> [NewNotation q fx $ syntaxOf x]
+        nota = if null syn then [] else [NewNotation q fx syn]
 
+-- | Data structure filled in by @buildParsers at .
+--   The top-level parser @pTop@ is of primary interest,
+--   but @pArgs@ is used to convert module application
+--   from concrete to abstract syntax.
+data Parsers e = Parsers
+  { pTop    :: ReadP e e
+  , pApp    :: ReadP e e
+  , pArgs   :: ReadP e [NamedArg e]
+  , pNonfix :: ReadP e e
+  , pAtom   :: ReadP e e
+  }
 
+data UseBoundNames = UseBoundNames | DontUseBoundNames
 
 {-| Builds parser for operator applications from all the operators and function
     symbols in scope. When parsing a pattern we use 'DontUseBoundNames'.
@@ -153,46 +158,7 @@ data UseBoundNames = UseBoundNames | DontUseBoundNames
     different associativity the parser won't complain. One could argue that
     this is a Bad Thing, but since it's not trivial to implement the check it
     will stay this way until people start complaining about it.
-
 -}
-
-data NotationStyle = InfixS | Prefix | Postfix | Nonfix | None
-   deriving (Eq)
-
-fixStyle :: Notation -> NotationStyle
-fixStyle [] = None
-fixStyle syn = case (isAHole (head syn), isAHole (last syn)) of
-  (True,True) -> InfixS
-  (True,False) -> Postfix
-  (False,True) -> Prefix
-  (False,False) -> Nonfix
-
-
-notationNames :: NewNotation -> [QName]
-notationNames (q, _, ps) = zipWith ($) (requal : repeat QName) [Name noRange [Id x] | IdPart x <- ps ]
-  where
-    ms       = init (qnameParts q)
-    requal x = foldr Qual (QName x) ms
-
--- | Data structure filled in by @buildParsers at .
---   The top-level parser @pTop@ is of primary interest,
---   but @pArgs@ is used to convert module application
---   from concrete to abstract syntax.
-data Parsers e = Parsers
-  { pTop    :: ReadP e e  -- this was returned by @buildParser@
-  , pApp    :: ReadP e e
-  , pArgs   :: ReadP e [NamedArg e]
-  , pNonfix :: ReadP e e
-  , pAtom   :: ReadP e e
-  }
-
--- | For backwards compatibility.
---   Returns the @pTop@ from @buildParsers at .
-buildParser :: forall e. IsExpr e => Range -> FlatScope -> UseBoundNames -> ScopeM (ReadP e e)
-buildParser r flat use = do
-    p <- buildParsers r flat use
-    return $ pTop p
-
 buildParsers :: forall e. IsExpr e => Range -> FlatScope -> UseBoundNames -> ScopeM (Parsers e)
 buildParsers r flat use = do
     (names, ops) <- localNames flat
@@ -224,24 +190,25 @@ buildParsers r flat use = do
         }
     where
         level :: NewNotation -> Integer
-        level (_name, fixity, _syn) = fixityLevel fixity
+        level = fixityLevel . notaFixity
 
         isinfixl, isinfixr, isinfix, nonfix, isprefix, ispostfix :: NewNotation -> Bool
 
-        isinfixl (_, LeftAssoc _ _, syn)  = isInfix syn
-        isinfixl _                    = False
+        isinfixl (NewNotation _ (LeftAssoc _ _) syn)  = isInfix syn
+        isinfixl _ = False
 
-        isinfixr (_, RightAssoc _ _, syn) = isInfix syn
-        isinfixr _                    = False
+        isinfixr (NewNotation _ (RightAssoc _ _) syn) = isInfix syn
+        isinfixr _ = False
 
-        isinfix (_, NonAssoc _ _,syn)    = isInfix syn
-        isinfix _                     = False
+        isinfix (NewNotation _ (NonAssoc _ _) syn)    = isInfix syn
+        isinfix _ = False
+
+        nonfix    (NewNotation _ _ syn) = notationKind syn == NonfixNotation
+        isprefix  (NewNotation _ _ syn) = notationKind syn == PrefixNotation
+        ispostfix (NewNotation _ _ syn) = notationKind syn == PostfixNotation
 
-        nonfix (_,_,syn) = fixStyle syn == Nonfix
-        isprefix (_,_,syn) = fixStyle syn == Prefix
-        ispostfix (_,_,syn) = fixStyle syn == Postfix
         isInfix :: Notation -> Bool
-        isInfix syn = fixStyle syn == InfixS
+        isInfix syn = notationKind syn == InfixNotation
 
         -- | Group operators by precedence level
         order :: [NewNotation] -> [[NewNotation]]
@@ -656,43 +623,3 @@ fullParen' e = case exprView e of
     LamV bs e -> par $ unExprView $ LamV bs (fullParen e)
     where
         par = unExprView . ParenV
-
-paren :: Monad m => (QName -> m Fixity) -> Expr -> m (Precedence -> Expr)
-paren _   e@(App _ _ _)           = return $ \p -> mparen (appBrackets p) e
-paren f   e@(OpApp _ op _)        = do fx <- f op; return $ \p -> mparen (opBrackets fx p) e
-paren _   e@(Lam _ _ _)           = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(AbsurdLam _ _)       = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(ExtendedLam _ _)     = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(Fun _ _ _)           = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(Pi _ _)              = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(Let _ _ _)           = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(Rec _ _)             = return $ \p -> mparen (appBrackets p) e
-paren _   e@(RecUpdate _ _ _)     = return $ \p -> mparen (appBrackets p) e
-paren _   e@(WithApp _ _ _)       = return $ \p -> mparen (withAppBrackets p) e
-paren _   e at Tactic{}              = return $ \p -> mparen (withAppBrackets p) e
-paren _   e@(Ident _)             = return $ \p -> e
-paren _   e@(Lit _)               = return $ \p -> e
-paren _   e@(QuestionMark _ _)    = return $ \p -> e
-paren _   e@(Underscore _ _)      = return $ \p -> e
-paren _   e@(Set _)               = return $ \p -> e
-paren _   e@(SetN _ _)            = return $ \p -> e
-paren _   e@(Prop _)              = return $ \p -> e
-paren _   e@(Paren _ _)           = return $ \p -> e
-paren _   e@(As _ _ _)            = return $ \p -> e
-paren _   e@(Dot _ _)             = return $ \p -> e
-paren _   e@(Absurd _)            = return $ \p -> e
-paren _   e@(ETel _)              = return $ \p -> e
-paren _   e@(RawApp _ _)          = __IMPOSSIBLE__
-paren _   e@(HiddenArg _ _)       = __IMPOSSIBLE__
-paren _   e@(InstanceArg _ _)     = __IMPOSSIBLE__
-paren _   e@(QuoteGoal _ _ _)     = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(QuoteContext _ _ _)  = return $ \p -> mparen (lamBrackets p) e
-paren _   e@(Quote _)             = return $ \p -> e
-paren _   e@(QuoteTerm _)         = return $ \p -> e
-paren _   e@(Unquote _)           = return $ \p -> e
-paren _   e@(DontCare _)          = return $ \p -> e
-paren _   e@(Equal _ _ _)         = __IMPOSSIBLE__
-
-mparen :: Bool -> Expr -> Expr
-mparen True  e = Paren (getRange e) e
-mparen False e = e
diff --git a/src/full/Agda/Syntax/Concrete/Operators/Parser.hs b/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
index a924ff5..b8e5a55 100644
--- a/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
+++ b/src/full/Agda/Syntax/Concrete/Operators/Parser.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.Syntax.Concrete.Operators.Parser where
@@ -16,7 +16,7 @@ import Agda.TypeChecking.Monad.Base (TCErr(Exception))
 import Agda.Utils.ReadP
 import Agda.Utils.Monad
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data ExprView e
@@ -54,9 +54,9 @@ partP ms s = do
       Nothing -> pfail
     where
         str = show (foldr Qual (QName (Name noRange [Id s])) ms)
-	isLocal e = case exprView e of
-	    LocalV y | str == show y -> Just (getRange y)
-	    _			     -> Nothing
+        isLocal e = case exprView e of
+            LocalV y | str == show y -> Just (getRange y)
+            _                        -> Nothing
 
 binop :: IsExpr e => ReadP e (NewNotation,Range,[e]) -> ReadP e (e -> e -> e)
 binop middleP = do
@@ -80,14 +80,14 @@ postop middleP = do
 -- place as where the holes are discarded, however that would require a dependently
 -- typed function (or duplicated code)
 opP :: IsExpr e => ReadP e e -> NewNotation -> ReadP e (NewNotation,Range,[e])
-opP p nsyn@(q,_,syn) = do
+opP p nsyn@(NewNotation q _ syn) = do
   (range,es) <- worker (init $ qnameParts q) $ removeExternalHoles syn
   return (nsyn,range,es)
  where worker ms [IdPart x] = do r <- partP ms x; return (r,[])
        worker ms (IdPart x : _ : xs) = do
             r1        <- partP ms x
-	    e         <- p
-	    (r2 , es) <- worker [] xs -- only the first part is qualified
+            e         <- p
+            (r2 , es) <- worker [] xs -- only the first part is qualified
             return (fuseRanges r1 r2, e : es)
        worker _ x = __IMPOSSIBLE__ -- holes and non-holes must be alternated.
 
@@ -97,7 +97,7 @@ opP p nsyn@(q,_,syn) = do
 -- | Given a name with a syntax spec, and a list of parsed expressions
 -- fitting it, rebuild the expression.
 rebuild :: forall e. IsExpr e => NewNotation -> Range -> [e] -> e
-rebuild (name,_,syn) r es = unExprView $ OpAppV (setRange r name) exprs
+rebuild (NewNotation name _ syn) r es = unExprView $ OpAppV (setRange r name) exprs
   where
     exprs = map findExprFor [0..lastHole]
     filledHoles = zip es (filter isAHole syn)
@@ -140,9 +140,9 @@ infixP  op p = do
     e <- p
     restP e
     where
-	restP x = return x +++ do
-	    f <- binop op
-	    f x <$> p
+        restP x = return x +++ do
+            f <- binop op
+            f x <$> p
 
 nonfixP op p = do
   (nsyn,r,es) <- op
@@ -152,26 +152,26 @@ nonfixP op p = do
 argsP :: IsExpr e => ReadP e e -> ReadP e [NamedArg e]
 argsP p = many (nothidden +++ hidden +++ instanceH)
     where
-	isHidden (HiddenArgV _) = True
-	isHidden _	        = False
+        isHidden (HiddenArgV _) = True
+        isHidden _              = False
 
-	isInstance (InstanceArgV _) = True
-	isInstance _	            = False
+        isInstance (InstanceArgV _) = True
+        isInstance _                = False
 
-	nothidden = defaultArg . unnamed <$> do
-	    e <- p
-	    case exprView e of
-		HiddenArgV   _ -> pfail
-		InstanceArgV _ -> pfail
-		_	       -> return e
+        nothidden = defaultArg . unnamed <$> do
+            e <- p
+            case exprView e of
+                HiddenArgV   _ -> pfail
+                InstanceArgV _ -> pfail
+                _              -> return e
 
-	instanceH = do
-	    InstanceArgV e <- exprView <$> satisfy (isInstance . exprView)
-	    return $ makeInstance $ defaultArg e
+        instanceH = do
+            InstanceArgV e <- exprView <$> satisfy (isInstance . exprView)
+            return $ makeInstance $ defaultArg e
 
-	hidden = do
-	    HiddenArgV e <- exprView <$> satisfy (isHidden . exprView)
-	    return $ hide $ defaultArg e
+        hidden = do
+            HiddenArgV e <- exprView <$> satisfy (isHidden . exprView)
+            return $ hide $ defaultArg e
 
 appP :: IsExpr e => ReadP e e -> ReadP e [NamedArg e] -> ReadP e e
 appP p pa = do
@@ -179,11 +179,11 @@ appP p pa = do
     es <- pa
     return $ foldl app h es
     where
-	app e = unExprView . AppV e
+        app e = unExprView . AppV e
 
 atomP :: IsExpr e => (QName -> Bool) -> ReadP e e
 atomP p = do
     e <- get
     case exprView e of
-	LocalV x | not (p x) -> pfail
-	_		     -> return e
+        LocalV x | not (p x) -> pfail
+        _                    -> return e
diff --git a/src/full/Agda/Syntax/Concrete/Pretty.hs b/src/full/Agda/Syntax/Concrete/Pretty.hs
index 1a306f0..c2fe806 100644
--- a/src/full/Agda/Syntax/Concrete/Pretty.hs
+++ b/src/full/Agda/Syntax/Concrete/Pretty.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-{-# OPTIONS -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-| Pretty printer for the concrete syntax.
 -}
@@ -14,27 +14,29 @@ import Data.Maybe
 
 import qualified Agda.Syntax.Common as Common
 import Agda.Syntax.Common hiding (Arg, Dom, NamedArg, ArgInfo)
-import Agda.Syntax.Position
 import Agda.Syntax.Concrete
 import Agda.Syntax.Fixity
 import Agda.Syntax.Literal
+import Agda.Syntax.Notation
+import Agda.Syntax.Position
 
 import Agda.Utils.Pretty
 import Agda.Utils.String
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
-instance Show Expr	      where show = show . pretty
+instance Show Expr            where show = show . pretty
 instance Show Declaration     where show = show . pretty
-instance Show Pattern	      where show = show . pretty
+instance Show Pattern         where show = show . pretty
 instance Show TypedBinding    where show = show . pretty
 instance Show TypedBindings   where show = show . pretty
 instance Show LamBinding      where show = show . pretty
 instance Show ImportDirective where show = show . pretty
-instance Show Pragma	      where show = show . pretty
-instance Show RHS	      where show = show . pretty
+instance Show Pragma          where show = show . pretty
+instance Show RHS             where show = show . pretty
 
+braces' :: Doc -> Doc
 braces' d = case render d of
   -- Add space to avoid starting a comment
   '-':_ -> braces (text " " <> d)
@@ -58,6 +60,7 @@ bracesAndSemicolons []       = text "{}"
 bracesAndSemicolons (d : ds) =
   sep ([text "{" <+> d] ++ map (text ";" <+>) ds ++ [text "}"])
 
+arrow, lambda :: Doc
 arrow  = text "\x2192"
 lambda = text "\x03bb"
 
@@ -90,12 +93,6 @@ instance (Pretty a, Pretty b) => Pretty (a, b) where
 instance Pretty (ThingWithFixity Name) where
     pretty (ThingWithFixity n _) = pretty n
 
-instance Pretty Name where
-    pretty = text . show
-
-instance Pretty QName where
-    pretty = text . show
-
 instance Pretty Relevance where
   pretty Forced     = empty
   pretty UnusedArg  = empty
@@ -113,62 +110,62 @@ instance Pretty (OpApp Expr) where
 
 instance Pretty Expr where
     pretty e =
-	case e of
-	    Ident x	     -> pretty x
-	    Lit l	     -> pretty l
-	    QuestionMark _ n -> text "?" <> maybe empty (text . show) n
-	    Underscore _ n   -> maybe underscore text n
---	    Underscore _ n   -> underscore <> maybe empty (text . show) n
-	    App _ _ _	     ->
-		case appView e of
-		    AppView e1 args	->
-			fsep $ pretty e1 : map pretty args
--- 			sep [ pretty e1
--- 			    , nest 2 $ fsep $ map pretty args
--- 			    ]
-	    RawApp _ es   -> fsep $ map pretty es
-	    OpApp _ q es -> fsep $ prettyOpApp q es
-
-	    WithApp _ e es -> fsep $
-	      pretty e : map ((text "|" <+>) . pretty) es
-
-	    HiddenArg _ e -> braces' $ pretty e
-	    InstanceArg _ e -> dbraces $ pretty e
-	    Lam _ bs e ->
-		sep [ lambda <+> fsep (map pretty bs) <+> arrow
-		    , nest 2 $ pretty e
-		    ]
+        case e of
+            Ident x          -> pretty x
+            Lit l            -> pretty l
+            QuestionMark _ n -> text "?" <> maybe empty (text . show) n
+            Underscore _ n   -> maybe underscore text n
+--          Underscore _ n   -> underscore <> maybe empty (text . show) n
+            App _ _ _        ->
+                case appView e of
+                    AppView e1 args     ->
+                        fsep $ pretty e1 : map pretty args
+--                      sep [ pretty e1
+--                          , nest 2 $ fsep $ map pretty args
+--                          ]
+            RawApp _ es   -> fsep $ map pretty es
+            OpApp _ q es -> fsep $ prettyOpApp q es
+
+            WithApp _ e es -> fsep $
+              pretty e : map ((text "|" <+>) . pretty) es
+
+            HiddenArg _ e -> braces' $ pretty e
+            InstanceArg _ e -> dbraces $ pretty e
+            Lam _ bs e ->
+                sep [ lambda <+> fsep (map pretty bs) <+> arrow
+                    , nest 2 $ pretty e
+                    ]
             AbsurdLam _ NotHidden -> lambda <+> text "()"
             AbsurdLam _ Instance -> lambda <+> text "{{}}"
             AbsurdLam _ Hidden -> lambda <+> text "{}"
-	    ExtendedLam _ pes ->
+            ExtendedLam _ pes ->
               lambda <+> bracesAndSemicolons (map (\(x,y,z) -> prettyClause x y z) pes)
                    where prettyClause lhs rhs wh = sep [ pretty lhs
                                                        , nest 2 $ pretty' rhs
                                                        ] $$ nest 2 (pretty wh)
                          pretty' (RHS e)   = arrow <+> pretty e
                          pretty' AbsurdRHS = empty
-	    Fun _ e1 e2 ->
-		sep [ pretty e1 <+> arrow
-		    , pretty e2
-		    ]
-	    Pi tel e ->
-		sep [ pretty (Tel $ smashTel tel) <+> arrow
-		    , pretty e
-		    ]
-	    Set _   -> text "Set"
-	    Prop _  -> text "Prop"
-	    SetN _ n	-> text "Set" <> text (showIndex n)
-	    Let _ ds e	->
-		sep [ text "let" <+> vcat (map pretty ds)
-		    , text "in" <+> pretty e
-		    ]
-	    Paren _ e -> parens $ pretty e
-	    As _ x e  -> pretty x <> text "@" <> pretty e
-	    Dot _ e   -> text "." <> pretty e
-	    Absurd _  -> text "()"
-	    Rec _ xs  -> sep [text "record", bracesAndSemicolons (map recPr xs)]
-	    RecUpdate _ e xs ->
+            Fun _ e1 e2 ->
+                sep [ pretty e1 <+> arrow
+                    , pretty e2
+                    ]
+            Pi tel e ->
+                sep [ pretty (Tel $ smashTel tel) <+> arrow
+                    , pretty e
+                    ]
+            Set _   -> text "Set"
+            Prop _  -> text "Prop"
+            SetN _ n    -> text "Set" <> text (showIndex n)
+            Let _ ds e  ->
+                sep [ text "let" <+> vcat (map pretty ds)
+                    , text "in" <+> pretty e
+                    ]
+            Paren _ e -> parens $ pretty e
+            As _ x e  -> pretty x <> text "@" <> pretty e
+            Dot _ e   -> text "." <> pretty e
+            Absurd _  -> text "()"
+            Rec _ xs  -> sep [text "record", bracesAndSemicolons (map recPr xs)]
+            RecUpdate _ e xs ->
               sep [text "record" <+> pretty e, bracesAndSemicolons (map recPr xs)]
             ETel []  -> text "()"
             ETel tel -> fsep $ map pretty tel
@@ -178,7 +175,7 @@ instance Pretty Expr where
                                     nest 2 $ pretty e]
             Quote _ -> text "quote"
             QuoteTerm _ -> text "quoteTerm"
-	    Unquote _ -> text "unquote"
+            Unquote _ -> text "unquote"
             Tactic _ t es ->
               sep [ text "tactic" <+> pretty t
                   , fsep [ text "|" <+> pretty e | e <- es ]
@@ -186,8 +183,8 @@ instance Pretty Expr where
             -- Andreas, 2011-10-03 print irrelevant things as .(e)
             DontCare e -> text "." <> parens (pretty e)
             Equal _ a b -> pretty a <+> text "=" <+> pretty b
-	where
-	  recPr (x, e) = sep [ pretty x <+> text "=" , nest 2 $ pretty e ]
+        where
+          recPr (x, e) = sep [ pretty x <+> text "=" , nest 2 $ pretty e ]
 
 instance Pretty BoundName where
   pretty BName{ boundName = x, boundLabel = l }
@@ -200,16 +197,17 @@ instance Pretty LamBinding where
     pretty (DomainFull b)   = pretty b
 
 instance Pretty TypedBindings where
-    pretty (TypedBindings _ a) =
-	pRelevance (argInfo a) $ bracks $ pretty $ WithColors (argColors a) $ unArg a
-	where
-	    bracks = case getHiding a of
-			Hidden                       -> braces'
-			Instance                     -> dbraces
-			NotHidden | isMeta (unArg a) -> id
-                                  | otherwise        -> parens
-            isMeta (TBind _ _ (Underscore _ Nothing)) = True
-            isMeta _ = False
+  pretty (TypedBindings _ a) =
+    pRelevance (argInfo a) $ bracks $ pretty $ WithColors (argColors a) $ unArg a
+      where
+        bracks = case getHiding a of
+                   Hidden                       -> braces'
+                   Instance                     -> dbraces
+                   NotHidden | isMeta (unArg a) -> id
+                             | otherwise        -> parens
+
+        isMeta (TBind _ _ (Underscore _ Nothing)) = True
+        isMeta _ = False
 
 newtype Tel = Tel Telescope
 
@@ -230,9 +228,9 @@ instance Pretty ColoredTypedBinding where
         text "let" <+> vcat (map pretty ds)
     pretty (WithColors _ (TLet _ _)) = __IMPOSSIBLE__
     pretty (WithColors cs (TBind _ xs e)) =
-	sep [ fsep (map pretty xs)
-	    , pColors ":" cs <+> pretty e
-	    ]
+        sep [ fsep (map pretty xs)
+            , pColors ":" cs <+> pretty e
+            ]
 
 pColors :: String -> [Color] -> Doc
 pColors s [] = text s
@@ -240,9 +238,9 @@ pColors s cs = text (s ++ "{") <+> fsep (map pretty cs) <+> text "}"
 
 instance Pretty TypedBinding where
     pretty (TBind _ xs e) =
-	sep [ fsep (map pretty xs)
-	    , text ":" <+> pretty e
-	    ]
+        sep [ fsep (map pretty xs)
+            , text ":" <+> pretty e
+            ]
     pretty (TLet _ ds) =
         text "let" <+> vcat (map pretty ds)
 
@@ -269,8 +267,8 @@ instance Pretty WhereClause where
   pretty (AnyWhere ds) = vcat [ text "where", nest 2 (vcat $ map pretty ds) ]
   pretty (SomeWhere m ds) =
     vcat [ hsep [ text "module", pretty m, text "where" ]
-	 , nest 2 (vcat $ map pretty ds)
-	 ]
+         , nest 2 (vcat $ map pretty ds)
+         ]
 
 instance Show LHS where show = show . pretty
 instance Pretty LHS where
@@ -286,7 +284,7 @@ instance Pretty LHS where
             ]
       pThing thing []       = empty
       pThing thing (e : es) = fsep $ (text thing <+> pretty e)
-			           : map ((text "|" <+>) . pretty) es
+                                   : map ((text "|" <+>) . pretty) es
 
 instance Show LHSCore where show = show . pretty
 instance Pretty LHSCore where
@@ -305,120 +303,120 @@ instance Pretty ModuleApplication where
 
 instance Pretty Declaration where
     pretty d =
-	case d of
-	    TypeSig i x e ->
+        case d of
+            TypeSig i x e ->
                 sep [ pRelevance i $ pretty x <+> pColors ":" (argInfoColors i)
-		    , nest 2 $ pretty e
-		    ]
+                    , nest 2 $ pretty e
+                    ]
             Field x (Common.Arg i e) ->
                 sep [ text "field"
                     , nest 2 $ pRelevance i $ pHidden i $
                                TypeSig (i {argInfoRelevance = Relevant}) x e
                     ]
-	    FunClause lhs rhs wh ->
-		sep [ pretty lhs
-		    , nest 2 $ pretty rhs
-		    ] $$ nest 2 (pretty wh)
-	    DataSig _ ind x tel e ->
-		sep [ hsep  [ pretty ind
-			    , pretty x
-			    , fcat (map pretty tel)
-			    ]
-		    , nest 2 $ hsep
-			    [ text ":"
-			    , pretty e
-			    ]
-		    ]
-	    Data _ ind x tel (Just e) cs ->
-		sep [ hsep  [ pretty ind
-			    , pretty x
-			    , fcat (map pretty tel)
-			    ]
-		    , nest 2 $ hsep
-			    [ text ":"
-			    , pretty e
-			    , text "where"
-			    ]
-		    ] $$ nest 2 (vcat $ map pretty cs)
-	    Data _ ind x tel Nothing cs ->
-		sep [ hsep  [ pretty ind
-			    , pretty x
-			    , fcat (map pretty tel)
-			    ]
-		    , nest 2 $ text "where"
-		    ] $$ nest 2 (vcat $ map pretty cs)
-	    RecordSig _ x tel e ->
-		sep [ hsep  [ text "record"
-			    , pretty x
-			    , fcat (map pretty tel)
-			    ]
-		    , nest 2 $ hsep
-			    [ text ":"
-			    , pretty e
-			    ]
-		    ]
-	    Record _ x ind con tel me cs ->
-		sep [ hsep  [ text "record"
-			    , pretty x
-			    , fcat (map pretty tel)
-			    ]
-		    , nest 2 $ pType me
-		    ] $$ nest 2 (vcat $ pInd ++
+            FunClause lhs rhs wh ->
+                sep [ pretty lhs
+                    , nest 2 $ pretty rhs
+                    ] $$ nest 2 (pretty wh)
+            DataSig _ ind x tel e ->
+                sep [ hsep  [ pretty ind
+                            , pretty x
+                            , fcat (map pretty tel)
+                            ]
+                    , nest 2 $ hsep
+                            [ text ":"
+                            , pretty e
+                            ]
+                    ]
+            Data _ ind x tel (Just e) cs ->
+                sep [ hsep  [ pretty ind
+                            , pretty x
+                            , fcat (map pretty tel)
+                            ]
+                    , nest 2 $ hsep
+                            [ text ":"
+                            , pretty e
+                            , text "where"
+                            ]
+                    ] $$ nest 2 (vcat $ map pretty cs)
+            Data _ ind x tel Nothing cs ->
+                sep [ hsep  [ pretty ind
+                            , pretty x
+                            , fcat (map pretty tel)
+                            ]
+                    , nest 2 $ text "where"
+                    ] $$ nest 2 (vcat $ map pretty cs)
+            RecordSig _ x tel e ->
+                sep [ hsep  [ text "record"
+                            , pretty x
+                            , fcat (map pretty tel)
+                            ]
+                    , nest 2 $ hsep
+                            [ text ":"
+                            , pretty e
+                            ]
+                    ]
+            Record _ x ind con tel me cs ->
+                sep [ hsep  [ text "record"
+                            , pretty x
+                            , fcat (map pretty tel)
+                            ]
+                    , nest 2 $ pType me
+                    ] $$ nest 2 (vcat $ pInd ++
                                         pCon ++
                                         map pretty cs)
               where pType (Just e) = hsep
-			    [ text ":"
-			    , pretty e
-			    , text "where"
-			    ]
+                            [ text ":"
+                            , pretty e
+                            , text "where"
+                            ]
                     pType Nothing  =
                               text "where"
                     pInd = maybeToList $ text . show . rangedThing <$> ind
                     pCon = maybeToList $ (text "constructor" <+>) . pretty <$> con
-            Infix f xs	->
-		pretty f <+> (fsep $ punctuate comma $ map pretty xs)
+            Infix f xs  ->
+                pretty f <+> (fsep $ punctuate comma $ map pretty xs)
             Syntax n xs -> text "syntax" <+> pretty n <+> text "..."
             PatternSyn _ n as p -> text "pattern" <+> pretty n <+> fsep (map pretty as)
                                      <+> text "=" <+> pretty p
-	    Mutual _ ds	    -> namedBlock "mutual" ds
-	    Abstract _ ds   -> namedBlock "abstract" ds
-	    Private _ ds    -> namedBlock "private" ds
-	    InstanceB _ ds  -> namedBlock "instance" ds
-	    Postulate _ ds  -> namedBlock "postulate" ds
-	    Primitive _ ds  -> namedBlock "primitive" ds
-	    Module _ x tel ds ->
-		hsep [ text "module"
-		     , pretty x
-		     , fcat (map pretty tel)
-		     , text "where"
-		     ] $$ nest 2 (vcat $ map pretty ds)
-	    ModuleMacro _ x (SectionApp _ [] e) DoOpen i | isNoName x ->
-		sep [ pretty DoOpen
+            Mutual _ ds     -> namedBlock "mutual" ds
+            Abstract _ ds   -> namedBlock "abstract" ds
+            Private _ ds    -> namedBlock "private" ds
+            InstanceB _ ds  -> namedBlock "instance" ds
+            Postulate _ ds  -> namedBlock "postulate" ds
+            Primitive _ ds  -> namedBlock "primitive" ds
+            Module _ x tel ds ->
+                hsep [ text "module"
+                     , pretty x
+                     , fcat (map pretty tel)
+                     , text "where"
+                     ] $$ nest 2 (vcat $ map pretty ds)
+            ModuleMacro _ x (SectionApp _ [] e) DoOpen i | isNoName x ->
+                sep [ pretty DoOpen
                     , nest 2 $ pretty e
                     , nest 4 $ pretty i
                     ]
-	    ModuleMacro _ x (SectionApp _ tel e) open i ->
-		sep [ pretty open <+> text "module" <+> pretty x <+> fcat (map pretty tel)
-		    , nest 2 $ text "=" <+> pretty e <+> pretty i
-		    ]
-	    ModuleMacro _ x (RecordModuleIFS _ rec) open i ->
-		sep [ pretty open <+> text "module" <+> pretty x
-		    , nest 2 $ text "=" <+> pretty rec <+> text "{{...}}"
-		    ]
-	    Open _ x i	-> hsep [ text "open", pretty x, pretty i ]
-	    Import _ x rn open i   ->
-		hsep [ pretty open, text "import", pretty x, as rn, pretty i ]
-		where
-		    as Nothing	= empty
-		    as (Just x) = text "as" <+> pretty (asName x)
+            ModuleMacro _ x (SectionApp _ tel e) open i ->
+                sep [ pretty open <+> text "module" <+> pretty x <+> fcat (map pretty tel)
+                    , nest 2 $ text "=" <+> pretty e <+> pretty i
+                    ]
+            ModuleMacro _ x (RecordModuleIFS _ rec) open i ->
+                sep [ pretty open <+> text "module" <+> pretty x
+                    , nest 2 $ text "=" <+> pretty rec <+> text "{{...}}"
+                    ]
+            Open _ x i  -> hsep [ text "open", pretty x, pretty i ]
+            Import _ x rn open i   ->
+                hsep [ pretty open, text "import", pretty x, as rn, pretty i ]
+                where
+                    as Nothing  = empty
+                    as (Just x) = text "as" <+> pretty (asName x)
             UnquoteDecl _ x t ->
               sep [ text "unquoteDecl" <+> pretty x <+> text "=", nest 2 $ pretty t ]
-	    Pragma pr	-> sep [ text "{-#" <+> pretty pr, text "#-}" ]
-	where
-	    namedBlock s ds =
-		sep [ text s
-		    , nest 2 $ vcat $ map pretty ds
-		    ]
+            Pragma pr   -> sep [ text "{-#" <+> pretty pr, text "#-}" ]
+        where
+            namedBlock s ds =
+                sep [ text s
+                    , nest 2 $ vcat $ map pretty ds
+                    ]
 
 instance Pretty OpenShortHand where
     pretty DoOpen = text "open"
@@ -454,12 +452,26 @@ instance Pretty Pragma where
         TerminationCheck       -> __IMPOSSIBLE__
         NoTerminationCheck     -> text "NO_TERMINATION_CHECK"
         NonTerminating         -> text "NON_TERMINATING"
+        Terminating            -> text "TERMINATING"
         TerminationMeasure _ x -> hsep $ [text "MEASURE", pretty x]
 
 instance Pretty Fixity where
-    pretty (LeftAssoc _ n)  = text "infixl" <+> text (show n)
+    pretty (LeftAssoc  _ n) = text "infixl" <+> text (show n)
     pretty (RightAssoc _ n) = text "infixr" <+> text (show n)
-    pretty (NonAssoc _ n)   = text "infix" <+> text (show n)
+    pretty (NonAssoc   _ n) = text "infix"  <+> text (show n)
+
+instance Pretty GenPart where
+    pretty (IdPart x)   = text x
+    pretty BindHole{}   = underscore
+    pretty NormalHole{} = underscore
+
+instance Pretty Notation where
+    pretty = hcat . map pretty
+
+instance Pretty Fixity' where
+    pretty (Fixity' fix nota)
+      | nota == defaultNotation = pretty fix
+      | otherwise               = text "syntax" <+> pretty nota
 
 instance Pretty e => Pretty (Arg e) where
  -- Andreas 2010-09-21: do not print relevance in general, only in function types!
@@ -477,19 +489,19 @@ instance Pretty [Pattern] where
 
 instance Pretty Pattern where
     pretty p =
-	case p of
-	    IdentP x      -> pretty x
-	    AppP p1 p2    -> sep [ pretty p1, nest 2 $ pretty p2 ]
-	    RawAppP _ ps  -> fsep $ map pretty ps
-	    OpAppP _ q ps -> fsep $ prettyOpApp q ps
-	    HiddenP _ p   -> braces' $ pretty p
-	    InstanceP _ p -> dbraces $ pretty p
-	    ParenP _ p    -> parens $ pretty p
-	    WildP _       -> underscore
-	    AsP _ x p     -> pretty x <> text "@" <> pretty p
-	    DotP _ p      -> text "." <> pretty p
-	    AbsurdP _     -> text "()"
-	    LitP l        -> pretty l
+        case p of
+            IdentP x      -> pretty x
+            AppP p1 p2    -> sep [ pretty p1, nest 2 $ pretty p2 ]
+            RawAppP _ ps  -> fsep $ map pretty ps
+            OpAppP _ q ps -> fsep $ prettyOpApp q ps
+            HiddenP _ p   -> braces' $ pretty p
+            InstanceP _ p -> dbraces $ pretty p
+            ParenP _ p    -> parens $ pretty p
+            WildP _       -> underscore
+            AsP _ x p     -> pretty x <> text "@" <> pretty p
+            DotP _ p      -> text "." <> pretty p
+            AbsurdP _     -> text "()"
+            LitP l        -> pretty l
             QuoteP _      -> text "quote"
 
 prettyOpApp :: Pretty a => QName -> [a] -> [Doc]
@@ -502,33 +514,33 @@ prettyOpApp q es = prOp ms xs es
     prOp ms (Hole : xs) (e : es) = pretty e : prOp ms xs es
     prOp _  (Hole : _)  []       = __IMPOSSIBLE__
     prOp ms (Id x : xs) es       = pretty (foldr Qual (QName (Name noRange $ [Id x])) ms) : prOp [] xs es
-    prOp _  []	     []          = []
-    prOp _  []	     es          = map pretty es
+    prOp _  []       []          = []
+    prOp _  []       es          = map pretty es
 
 instance Pretty ImportDirective where
     pretty i =
-	sep [ public (publicOpen i)
-	    , pretty $ usingOrHiding i
-	    , rename $ renaming i
-	    ]
-	where
-	    public True  = text "public"
-	    public False = empty
+        sep [ public (publicOpen i)
+            , pretty $ usingOrHiding i
+            , rename $ renaming i
+            ]
+        where
+            public True  = text "public"
+            public False = empty
 
-	    rename [] = empty
-	    rename xs =	hsep [ text "renaming"
-			     , parens $ fsep $ punctuate (text ";") $ map pr xs
-			     ]
+            rename [] = empty
+            rename xs = hsep [ text "renaming"
+                             , parens $ fsep $ punctuate (text ";") $ map pr xs
+                             ]
 
-	    pr r = hsep [ pretty (renFrom r), text "to", pretty (renTo r) ]
+            pr r = hsep [ pretty (renFrom r), text "to", pretty (renTo r) ]
 
 instance Pretty UsingOrHiding where
-    pretty (Hiding [])	= empty
-    pretty (Hiding xs)	=
-	text "hiding" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)
-    pretty (Using xs)	 =
-	text "using" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)
+    pretty (Hiding [])  = empty
+    pretty (Hiding xs)  =
+        text "hiding" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)
+    pretty (Using xs)    =
+        text "using" <+> parens (fsep $ punctuate (text ";") $ map pretty xs)
 
 instance Pretty ImportedName where
-    pretty (ImportedName x)	= pretty x
-    pretty (ImportedModule x)	= text "module" <+> pretty x
+    pretty (ImportedName x)     = pretty x
+    pretty (ImportedModule x)   = text "module" <+> pretty x
diff --git a/src/full/Agda/Syntax/Fixity.hs b/src/full/Agda/Syntax/Fixity.hs
index 665496d..ddf7947 100644
--- a/src/full/Agda/Syntax/Fixity.hs
+++ b/src/full/Agda/Syntax/Fixity.hs
@@ -1,79 +1,142 @@
--- {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveTraversable  #-}
 
-{-| Definitions for fixity and precedence levels.
+{-| Definitions for fixity, precedence levels, and declared syntax.
 -}
 module Agda.Syntax.Fixity where
 
-import Data.Typeable (Typeable)
 import Data.Foldable
+import Data.List as List
 import Data.Traversable
+import Data.Typeable (Typeable)
 
 import Agda.Syntax.Position
 import Agda.Syntax.Common
 import Agda.Syntax.Concrete.Name
 import Agda.Syntax.Notation
 
--- | The notation is handled as the fixity in the renamer. Hence they
--- are grouped together in this type.
+import Agda.Utils.List
+
+-- * Notation coupled with 'Fixity'
+
+-- | The notation is handled as the fixity in the renamer.
+--   Hence, they are grouped together in this type.
 data Fixity' = Fixity'
-    {theFixity :: Fixity,
-     theNotation :: Notation}
+    { theFixity   :: Fixity
+    , theNotation :: Notation
+    }
   deriving (Typeable, Show, Eq)
 
-data ThingWithFixity x = ThingWithFixity x Fixity' deriving (Functor,Foldable,Traversable,Typeable,Show)
+-- | Decorating something with @Fixity'@.
+data ThingWithFixity x = ThingWithFixity x Fixity'
+  deriving (Functor, Foldable, Traversable, Typeable, Show)
+
 -- | All the notation information related to a name.
-type NewNotation = (QName, Fixity, Notation)
+data NewNotation = NewNotation
+  { notaName   :: QName
+    -- ^ The concrete name the syntax or fixity belongs to.
+  , notaFixity :: Fixity
+    -- ^ Associativity and precedence (fixity) of the name.
+  , notation   :: Notation
+    -- ^ Syntax associated with the name.
+  } deriving (Typeable, Show)
 
 -- | If an operator has no specific notation, recover it from its name.
 oldToNewNotation :: (QName, Fixity') -> NewNotation
-oldToNewNotation (name, Fixity' f []) = (name, f, syntaxOf $ unqualify name)
-oldToNewNotation (name, Fixity' f syn) = (name, f, syn)
-
+oldToNewNotation (name, Fixity' f syn) = NewNotation
+  { notaName   = name
+  , notaFixity = f
+  , notation   = if null syn then syntaxOf $ unqualify name else syn
+  }
+
+-- | Return the 'IdPart's of a notation, the first part qualified,
+--   the other parts unqualified.
+--   This allows for qualified use of operators, e.g.,
+--   @M.for x ∈ xs return e@, or @x ℕ.+ y at .
+notationNames :: NewNotation -> [QName]
+notationNames (NewNotation q _ parts) =
+  zipWith ($) (reQualify : repeat QName) [Name noRange [Id x] | IdPart x <- parts ]
+  where
+    -- The qualification of @q at .
+    modules     = init (qnameParts q)
+    -- Putting the qualification onto @x at .
+    reQualify x = List.foldr Qual (QName x) modules
+
+-- | Create a 'Notation' (without binders) from a concrete 'Name'.
+--   Does the obvious thing:
+--   'Hole's become 'NormalHole's, 'Id's become 'IdParts'.
+--   If 'Name' has no 'Hole's, it returns 'noNotation'.
 syntaxOf :: Name -> Notation
-syntaxOf (NoName _ _) = []
-syntaxOf (Name _ [_]) = []
+syntaxOf (NoName _ _) = noNotation
+syntaxOf (Name _ [_]) = noNotation
 syntaxOf (Name _ xs)  = mkSyn 0 xs
- where mkSyn :: Int -> [NamePart] -> Notation
-       mkSyn n [] = []
-       mkSyn n (Hole:xs) = NormalHole (defaultNamedArg n) : mkSyn (1+n) xs
-       mkSyn n (Id x:xs) = IdPart x : mkSyn n xs
+  where
+    -- Turn a concrete name into a Notation,
+    -- numbering the holes from left to right.
+    -- Result will have no 'BindingHole's.
+    mkSyn :: Int -> [NamePart] -> Notation
+    mkSyn n []          = []
+    mkSyn n (Hole : xs) = NormalHole (defaultNamedArg n) : mkSyn (1 + n) xs
+    mkSyn n (Id x : xs) = IdPart x : mkSyn n xs
+
+defaultFixity' :: Fixity'
+defaultFixity' = Fixity' defaultFixity defaultNotation
 
+-- | Removes copies of @defaultFixity'@ from a list of fixities.
+--   Never returns an empty list, though, rather a singleton list
+--   consisting of @defaultFixity'@.
+interestingFixities :: [Fixity'] -> [Fixity']
+interestingFixities fixs = if null fixs' then [defaultFixity'] else fixs'
+  where fixs' = filter (not . (== defaultFixity')) fixs
 
-defaultFixity' = Fixity' defaultFixity defaultNotation
+-- | If different interesting fixities are available for the same symbol,
+--   we take none of them.
+chooseFixity :: [Fixity'] -> Fixity'
+chooseFixity fixs = if allEqual fixs' then head fixs' else defaultFixity'
+  where fixs' = interestingFixities fixs
 
-noFixity = NonAssoc noRange (negate 666) -- ts,ts,ts, why the number of the beast?  Revelation 13, 18
-                                         -- It's not the number of the beast, it's the negation of the
-                                         -- number of the beast, which must be a divine number, right?
+-- * Fixity
 
 -- | Fixity of operators.
-data Fixity = LeftAssoc  Range Integer
-	    | RightAssoc Range Integer
-	    | NonAssoc   Range Integer
-    deriving (Typeable, Show)
+
+data Fixity
+  = LeftAssoc  { fixityRange :: Range, fixityLevel :: Integer }
+  | RightAssoc { fixityRange :: Range, fixityLevel :: Integer }
+  | NonAssoc   { fixityRange :: Range, fixityLevel :: Integer }
+  deriving (Typeable, Show)
 
 instance Eq Fixity where
-    LeftAssoc _ n   == LeftAssoc _ m	= n == m
-    RightAssoc _ n  == RightAssoc _ m	= n == m
-    NonAssoc _ n    == NonAssoc _ m	= n == m
-    _		    == _		= False
+    LeftAssoc  _ n == LeftAssoc  _ m = n == m
+    RightAssoc _ n == RightAssoc _ m = n == m
+    NonAssoc   _ n == NonAssoc   _ m = n == m
+    _              == _              = False
 
-fixityLevel :: Fixity -> Integer
-fixityLevel (LeftAssoc	_ n) = n
-fixityLevel (RightAssoc _ n) = n
-fixityLevel (NonAssoc	_ n) = n
+-- For @instance Pretty Fixity@, see Agda.Syntax.Concrete.Pretty
 
 -- | The default fixity. Currently defined to be @'NonAssoc' 20 at .
 defaultFixity :: Fixity
 defaultFixity = NonAssoc noRange 20
 
+-- | Hack used for @syntax@ facility.
+noFixity :: Fixity
+noFixity = NonAssoc noRange (negate 666)
+  -- Ts,ts,ts, why the number of the beast?  Revelation 13, 18
+  --
+  -- It's not the number of the beast, it's the negation of the
+  -- number of the beast, which must be a divine number, right?
+  --
+  -- The divine is not the negation of evil.
+  -- Evil is only the absense of the good and divine.
+
+
+-- * Precendence
+
 -- | Precedence is associated with a context.
 data Precedence = TopCtx | FunctionSpaceDomainCtx
-		| LeftOperandCtx Fixity | RightOperandCtx Fixity
-		| FunctionCtx | ArgumentCtx | InsideOperandCtx
+                | LeftOperandCtx Fixity | RightOperandCtx Fixity
+                | FunctionCtx | ArgumentCtx | InsideOperandCtx
                 | WithFunCtx | WithArgCtx | DotPatternCtx
     deriving (Show,Typeable)
 
@@ -97,10 +160,10 @@ opBrackets f1
            (RightOperandCtx f2) | fixityLevel f1 > fixityLevel f2 = False
 opBrackets _ TopCtx = False
 opBrackets _ FunctionSpaceDomainCtx = False
-opBrackets _ InsideOperandCtx	    = False
+opBrackets _ InsideOperandCtx       = False
 opBrackets _ WithArgCtx             = False
 opBrackets _ WithFunCtx             = False
-opBrackets _ _			    = True
+opBrackets _ _                      = True
 
 -- | Does a lambda-like thing (lambda, let or pi) need brackets in the
 -- given context? A peculiar thing with lambdas is that they don't
@@ -113,7 +176,7 @@ opBrackets _ _			    = True
 --   (here @_>>=_@ is left associative).
 lamBrackets :: Precedence -> Bool
 lamBrackets TopCtx = False
-lamBrackets _	   = True
+lamBrackets _      = True
 
 -- | Does a function application need brackets?
 appBrackets :: Precedence -> Bool
@@ -131,16 +194,14 @@ withAppBrackets _                      = True
 -- | Does a function space need brackets?
 piBrackets :: Precedence -> Bool
 piBrackets TopCtx   = False
-piBrackets _	    = True
+piBrackets _        = True
 
 roundFixBrackets :: Precedence -> Bool
 roundFixBrackets DotPatternCtx = True
 roundFixBrackets _ = False
 
 instance HasRange Fixity where
-    getRange (LeftAssoc  r _)	= r
-    getRange (RightAssoc r _)	= r
-    getRange (NonAssoc   r _)	= r
+  getRange = fixityRange
 
 instance KillRange Fixity where
   killRange (LeftAssoc  _ n) = LeftAssoc  noRange n
diff --git a/src/full/Agda/Syntax/Info.hs b/src/full/Agda/Syntax/Info.hs
index ed6f299..5c91955 100644
--- a/src/full/Agda/Syntax/Info.hs
+++ b/src/full/Agda/Syntax/Info.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable   #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE StandaloneDeriving   #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-| An info object contains additional information about a piece of abstract
@@ -44,45 +44,39 @@ instance HasRange MetaInfo where
   getRange = metaRange
 
 instance KillRange MetaInfo where
-  killRange m = m { metaRange = killRange $ metaRange m }
+  killRange m = m { metaRange = noRange }
 
 {--------------------------------------------------------------------------
     General expression information
  --------------------------------------------------------------------------}
 
--- | For a general expression we can either remember just the source code
---   position or the entire concrete expression it came from.
-data ExprInfo
-	= ExprRange  Range
-	| ExprSource Range (Precedence -> Expr)
-	    -- ^ Even if we store the original expression we have to know
-	    --	 whether to put parenthesis around it.
+newtype ExprInfo = ExprRange Range
   deriving (Typeable, Show)
 
+exprNoRange :: ExprInfo
+exprNoRange = ExprRange noRange
+
 instance HasRange ExprInfo where
-  getRange (ExprRange  r  ) = r
-  getRange (ExprSource r _) = r
+  getRange (ExprRange r) = r
 
 instance KillRange ExprInfo where
-  killRange (ExprRange r)    = ExprRange (killRange r)
-  killRange (ExprSource r f) = ExprSource (killRange r) f
+  killRange (ExprRange r) = exprNoRange
 
 {--------------------------------------------------------------------------
     Module information
  --------------------------------------------------------------------------}
 
-data ModuleInfo =
-	ModuleInfo { minfoRange    :: Range
-                   , minfoAsTo     :: Range
-                     -- The range of the \"as\" and \"to\" keywords,
-                     -- if any. Retained for highlighting purposes.
-                   , minfoAsName   :: Maybe C.Name
-                     -- The \"as\" module name, if any. Retained for
-                     -- highlighting purposes.
-                   , minfoOpenShort :: Maybe OpenShortHand
-                   , minfoDirective :: Maybe ImportDirective
-                     -- Retained for abstractToConcrete of ModuleMacro
-		   }
+data ModuleInfo = ModuleInfo
+  { minfoRange    :: Range
+  , minfoAsTo     :: Range
+    -- ^ The range of the \"as\" and \"to\" keywords,
+    -- if any. Retained for highlighting purposes.
+  , minfoAsName   :: Maybe C.Name
+    -- ^ The \"as\" module name, if any. Retained for highlighting purposes.
+  , minfoOpenShort :: Maybe OpenShortHand
+  , minfoDirective :: Maybe ImportDirective
+    -- ^ Retained for @abstractToConcrete@ of 'ModuleMacro'.
+  }
   deriving (Typeable)
 
 deriving instance (Show OpenShortHand, Show ImportDirective) => Show ModuleInfo
@@ -94,7 +88,7 @@ instance SetRange ModuleInfo where
   setRange r i = i { minfoRange = r }
 
 instance KillRange ModuleInfo where
-  killRange m = m { minfoRange = killRange $ minfoRange m }
+  killRange m = m { minfoRange = noRange }
 
 ---------------------------------------------------------------------------
 -- Let info
@@ -107,19 +101,19 @@ instance HasRange LetInfo where
   getRange (LetRange r)   = r
 
 instance KillRange LetInfo where
-  killRange (LetRange r) = LetRange (killRange r)
+  killRange (LetRange r) = LetRange noRange
 
 {--------------------------------------------------------------------------
     Definition information (declarations that actually define something)
  --------------------------------------------------------------------------}
 
-data DefInfo =
-	DefInfo	{ defFixity   :: Fixity'
-		, defAccess   :: Access
-		, defAbstract :: IsAbstract
-		, defInstance :: IsInstance
-		, defInfo     :: DeclInfo
-		}
+data DefInfo = DefInfo
+  { defFixity   :: Fixity'
+  , defAccess   :: Access
+  , defAbstract :: IsAbstract
+  , defInstance :: IsInstance
+  , defInfo     :: DeclInfo
+  }
   deriving (Typeable, Show)
 
 mkDefInfo :: Name -> Fixity' -> Access -> IsAbstract -> Range -> DefInfo
@@ -142,10 +136,10 @@ instance KillRange DefInfo where
     General declaration information
  --------------------------------------------------------------------------}
 
-data DeclInfo =
-	DeclInfo { declName  :: Name
-		 , declRange :: Range
-		 }
+data DeclInfo = DeclInfo
+  { declName  :: Name
+  , declRange :: Range
+  }
   deriving (Typeable, Show)
 
 instance HasRange DeclInfo where
@@ -155,23 +149,23 @@ instance SetRange DeclInfo where
   setRange r i = i { declRange = r }
 
 instance KillRange DeclInfo where
-  killRange i = i { declRange = killRange $ declRange i }
+  killRange i = i { declRange = noRange }
 
 {--------------------------------------------------------------------------
     Mutual block information
  --------------------------------------------------------------------------}
 
-data MutualInfo =
-     MutualInfo { mutualTermCheck :: TerminationCheck Name
-		, mutualRange     :: Range
-		}
+data MutualInfo = MutualInfo
+  { mutualTermCheck :: TerminationCheck Name
+  , mutualRange     :: Range
+  }
   deriving (Typeable, Show)
 
 instance HasRange MutualInfo where
   getRange = mutualRange
 
 instance KillRange MutualInfo where
-  killRange i = i { mutualRange = killRange $ mutualRange i }
+  killRange i = i { mutualRange = noRange }
 
 {--------------------------------------------------------------------------
     Left hand side information
@@ -184,17 +178,19 @@ instance HasRange LHSInfo where
   getRange (LHSRange r) = r
 
 instance KillRange LHSInfo where
-  killRange (LHSRange r) = LHSRange (killRange r)
+  killRange (LHSRange r) = LHSRange noRange
 
 {--------------------------------------------------------------------------
     Pattern information
  --------------------------------------------------------------------------}
 
--- TODO: Is it safe to add Typeable/Data here? PatInfo contains a
--- function space.
-
-data PatInfo = PatRange Range
-	     | PatSource Range (Precedence -> Pattern)
+-- | For a general pattern we can either remember just the source code
+--   position or the entire concrete pattern it came from.
+data PatInfo
+  = PatRange Range
+  | PatSource Range (Precedence -> Pattern)
+      -- ^ Even if we store the original pattern we have to know
+      --   whether to put parenthesis around it.
   deriving (Typeable)
 
 instance Show PatInfo where
@@ -206,8 +202,8 @@ instance HasRange PatInfo where
   getRange (PatSource r _) = r
 
 instance KillRange PatInfo where
-  killRange (PatRange r)    = PatRange $ killRange r
-  killRange (PatSource r f) = PatSource (killRange r) f
+  killRange (PatRange r)    = PatRange noRange
+  killRange (PatSource r f) = PatSource noRange f
 
 -- | Empty range for patterns.
 patNoRange :: PatInfo
@@ -216,7 +212,7 @@ patNoRange = PatRange noRange
 -- | Constructor pattern info.
 data ConPatInfo = ConPatInfo
   { patImplicit :: Bool
-    -- ^ Does this pattern come form the eta-expansion of an implicit pattern.
+    -- ^ Does this pattern come form the eta-expansion of an implicit pattern?
   , patInfo     :: PatInfo
   }
 
diff --git a/src/full/Agda/Syntax/Internal.hs b/src/full/Agda/Syntax/Internal.hs
index 8959d10..5fda241 100644
--- a/src/full/Agda/Syntax/Internal.hs
+++ b/src/full/Agda/Syntax/Internal.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 module Agda.Syntax.Internal
     ( module Agda.Syntax.Internal
@@ -36,6 +36,7 @@ import qualified Agda.Syntax.Common as Common
 import Agda.Syntax.Literal
 import Agda.Syntax.Abstract.Name
 
+import Agda.Utils.Empty
 import Agda.Utils.Functor
 import Agda.Utils.Geniplate
 import Agda.Utils.List
@@ -45,7 +46,7 @@ import Agda.Utils.Pointer
 import Agda.Utils.Size
 import Agda.Utils.Pretty
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Color      = Term
@@ -63,17 +64,12 @@ type NamedArgs  = [NamedArg Term]
 --   This allows reduction of projection redexes outside of TCM.
 --   For instance, during substitution and application.
 data ConHead = ConHead
-  { conName   :: QName       -- ^ The name of the constructor.
-  , conFields :: [QName]     -- ^ The name of the record fields.
-                             --   Empty list for data constructors.
-                             --   'Arg' is not needed here since it
-                             --   is stored in the constructor args.
-{-
-  , conFields :: [Arg QName] -- ^ The name of the record fields.
-                             --   Empty list for data constructors.
-                             --   'Arg' is needed for irrelevance, to
-                             --   insert 'DontCare's in short-cut reduction.
--}
+  { conName      :: QName     -- ^ The name of the constructor.
+  , conInductive :: Induction -- ^ Record constructors can be coinductive.
+  , conFields    :: [QName]   -- ^ The name of the record fields.
+                              --   Empty list for data constructors.
+                              --   'Arg' is not needed here since it
+                              --   is stored in the constructor args.
   } deriving (Typeable)
 
 instance Eq ConHead where
@@ -83,7 +79,7 @@ instance Ord ConHead where
   (<=) = (<=) `on` conName
 
 instance Show ConHead where
-  show (ConHead c fs) = show c ++ show fs
+  show (ConHead c i fs) = show c ++ "(" ++ show i ++ ")" ++ show fs
 
 instance HasRange ConHead where
   getRange = getRange . conName
@@ -111,15 +107,15 @@ instance LensConName ConHead where
 --     list of clauses.
 --
 data Term = Var {-# UNPACK #-} !Int Elims -- ^ @x es@ neutral
-	  | Lam ArgInfo (Abs Term)        -- ^ Terms are beta normal. Relevance is ignored
+          | Lam ArgInfo (Abs Term)        -- ^ Terms are beta normal. Relevance is ignored
           | ExtLam [Clause] Args          -- ^ Only used by unquote --> reify. Should never appear elsewhere.
-	  | Lit Literal
-	  | Def QName Elims               -- ^ @f es@, possibly a delta/iota-redex
-	  | Con ConHead Args              -- ^ @c vs@
-	  | Pi (Dom Type) (Abs Type)      -- ^ dependent or non-dependent function space
-	  | Sort Sort
+          | Lit Literal
+          | Def QName Elims               -- ^ @f es@, possibly a delta/iota-redex
+          | Con ConHead Args              -- ^ @c vs@
+          | Pi (Dom Type) (Abs Type)      -- ^ dependent or non-dependent function space
+          | Sort Sort
           | Level Level
-	  | MetaV {-# UNPACK #-} !MetaId Elims
+          | MetaV {-# UNPACK #-} !MetaId Elims
           | DontCare Term
             -- ^ Irrelevant stuff in relevant position, but created
             --   in an irrelevant context.  Basically, an internal
@@ -149,7 +145,7 @@ appendArgNames :: ArgName -> ArgName -> ArgName
 appendArgNames = (++)
 
 nameToArgName :: Name -> ArgName
-nameToArgName = stringToArgName . show
+nameToArgName = stringToArgName . prettyShow
 
 -- | Binder.
 --   'Abs': The bound variable might appear in the body.
@@ -174,11 +170,16 @@ instance Decoration Type' where
 -- | Sequence of types. An argument of the first type is bound in later types
 --   and so on.
 data Tele a = EmptyTel
-	    | ExtendTel a (Abs (Tele a))  -- ^ 'Abs' is never 'NoAbs'.
+            | ExtendTel a (Abs (Tele a))  -- ^ 'Abs' is never 'NoAbs'.
   deriving (Typeable, Show, Functor, Foldable, Traversable)
 
 type Telescope = Tele (Dom Type)
 
+instance Null (Tele a) where
+  null EmptyTel    = True
+  null ExtendTel{} = False
+  empty = EmptyTel
+
 mapAbsNamesM :: Applicative m => (ArgName -> m ArgName) -> Tele a -> m (Tele a)
 mapAbsNamesM f EmptyTel                  = pure EmptyTel
 mapAbsNamesM f (ExtendTel a (Abs x b))   = ExtendTel a <$> (Abs <$> f x <*> mapAbsNamesM f b)
@@ -203,7 +204,7 @@ replaceEmptyName x = mapAbsNames $ \ y -> if null y then x else y
 -- | Sorts.
 --
 data Sort = Type Level
-	  | Prop  -- ignore me
+          | Prop  -- ignore me
           | Inf
           | DLub Sort (Abs Sort)
             -- ^ if the free variable occurs in the second sort
@@ -287,7 +288,7 @@ clausePats = map (fmap namedThing) . namedClausePats
 -- clauseArgs cl = evalState (argsToTerms $ namedClausePats cl) xs
 --   where
 --     perm = clausePerm cl
---     xs   = permute (invertP perm) $ downFrom (size perm)
+--     xs   = permute (invertP __IMPOSSIBLE__ perm) $ downFrom (size perm)
 --
 --     next = do x : xs <- get; put xs; return x
 --
@@ -300,8 +301,8 @@ clausePats = map (fmap namedThing) . namedClausePats
 --       ProjP{}     -> __IMPOSSIBLE__   -- TODO
 
 data ClauseBodyF a = Body a
-		   | Bind (Abs (ClauseBodyF a))
-		   | NoBody    -- ^ for absurd clauses.
+                   | Bind (Abs (ClauseBodyF a))
+                   | NoBody    -- ^ for absurd clauses.
   deriving (Typeable, Show, Functor, Foldable, Traversable)
 
 type ClauseBody = ClauseBodyF Term
@@ -324,16 +325,23 @@ nameToPatVarName = nameToArgName
 --     This also meshes well with the fact that values (i.e.
 --     the arguments we are matching with) use @QName at .
 --
-data Pattern
-  = VarP PatVarName
-    -- ^ The @PatVarName@ is a name suggestion.
+data Pattern' x
+  = VarP x
+    -- ^ @x@
   | DotP Term
-  | ConP ConHead ConPatternInfo [NamedArg Pattern]
-    -- ^ The @Pattern at s do not contain any projection copatterns.
+    -- ^ @.t@
+  | ConP ConHead ConPatternInfo [NamedArg (Pattern' x)]
+    -- ^ @c ps@
+    --   The subpatterns do not contain any projection copatterns.
   | LitP Literal
+    -- ^ E.g. @5@, @"hello"@.
   | ProjP QName
     -- ^ Projection copattern.  Can only appear by itself.
-  deriving (Typeable, Show)
+  deriving (Typeable, Show, Functor, Foldable, Traversable)
+
+type Pattern = Pattern' PatVarName
+    -- ^ The @PatVarName@ is a name suggestion.
+
 
 namedVarP :: PatVarName -> Named (Ranged PatVarName) Pattern
 namedVarP x = Named named $ VarP x
@@ -366,6 +374,36 @@ properlyMatching (ConP _ mt ps) = isNothing mt || -- not a record cons
   List.any (properlyMatching . namedArg) ps  -- or one of subpatterns is a proper m
 properlyMatching ProjP{} = True
 
+-----------------------------------------------------------------------------
+-- * Explicit substitutions
+-----------------------------------------------------------------------------
+
+-- | Substitutions.
+
+infixr 4 :#
+data Substitution
+
+  = IdS                     -- Γ ⊢ IdS : Γ
+
+  | EmptyS                  -- Γ ⊢ EmptyS : ()
+
+                            --      Γ ⊢ ρ : Δ
+  | Wk !Int Substitution    -- -------------------
+                            -- Γ, Ψ ⊢ Wk |Ψ| ρ : Δ
+
+                            -- Γ ⊢ u : Aρ  Γ ⊢ ρ : Δ
+  | Term :# Substitution    -- ---------------------
+                            --   Γ ⊢ u :# ρ : Δ, A
+
+    -- First argument is __IMPOSSIBLE__  --         Γ ⊢ ρ : Δ
+  | Strengthen Empty Substitution        -- ---------------------------
+                                         --   Γ ⊢ Strengthen ρ : Δ, A
+
+                            --        Γ ⊢ ρ : Δ
+  | Lift !Int Substitution  -- -------------------------
+                            -- Γ, Ψρ ⊢ Lift |Ψ| ρ : Δ, Ψ
+  deriving (Show)
+
 ---------------------------------------------------------------------------
 -- * Absurd Lambda
 ---------------------------------------------------------------------------
@@ -473,10 +511,13 @@ typeDontCare = El Prop (Sort Prop)
 topSort :: Type
 topSort = El Inf (Sort Inf)
 
-set0      = set 0
-set n     = sort $ mkType n
-prop      = sort Prop
-sort s    = El (sSuc s) $ Sort s
+prop :: Type
+prop = sort Prop
+
+sort :: Sort -> Type
+sort s = El (sSuc s) $ Sort s
+
+varSort :: Int -> Sort
 varSort n = Type $ Max [Plus 0 $ NeutralLevel $ Var n []]
 
 -- | Get the next higher sort.
@@ -486,11 +527,13 @@ sSuc Inf             = Inf
 sSuc (DLub a b)      = DLub (sSuc a) (fmap sSuc b)
 sSuc (Type l)        = Type $ levelSuc l
 
+levelSuc :: Level -> Level
 levelSuc (Max []) = Max [ClosedLevel 1]
 levelSuc (Max as) = Max $ map inc as
   where inc (ClosedLevel n) = ClosedLevel (n + 1)
         inc (Plus n l)      = Plus (n + 1) l
 
+mkType :: Integer -> Sort
 mkType n = Type $ Max [ClosedLevel n | n > 0]
 
 impossibleTerm :: String -> Int -> Term
@@ -499,8 +542,14 @@ impossibleTerm file line = Lit $ LitString noRange $ unlines
   , "Location of the error: " ++ file ++ ":" ++ show line
   ]
 
-sgTel :: Dom (ArgName, Type) -> Telescope
-sgTel (Common.Dom ai (x, t)) = ExtendTel (Common.Dom ai t) $ Abs x EmptyTel
+class SgTel a where
+  sgTel :: a -> Telescope
+
+instance SgTel (ArgName, Dom Type) where
+  sgTel (x, dom) = ExtendTel dom $ Abs x EmptyTel
+
+instance SgTel (Dom (ArgName, Type)) where
+  sgTel (Common.Dom ai (x, t)) = ExtendTel (Common.Dom ai t) $ Abs x EmptyTel
 
 hackReifyToMeta :: Term
 hackReifyToMeta = DontCare $ Lit $ LitInt noRange (-42)
@@ -547,8 +596,8 @@ arity t = case ignoreSharing $ unEl t of
 argName :: Type -> String
 argName = argN . ignoreSharing . unEl
     where
-	argN (Pi _ b)  = "." ++ argNameToString (absName b)
-	argN _	  = __IMPOSSIBLE__
+        argN (Pi _ b)  = "." ++ argNameToString (absName b)
+        argN _    = __IMPOSSIBLE__
 
 -- | Pick the better name suggestion, i.e., the one that is not just underscore.
 class Suggest a b where
@@ -707,7 +756,7 @@ instance Sized LevelAtom where
   size (UnreducedLevel v) = size v
 
 instance Sized (Tele a) where
-  size  EmptyTel	 = 0
+  size  EmptyTel         = 0
   size (ExtendTel _ tel) = 1 + size tel
 
 instance Sized a => Sized (Abs a) where
@@ -722,7 +771,7 @@ instance Sized a => Sized (Elim' a) where
 ---------------------------------------------------------------------------
 
 instance KillRange ConHead where
-  killRange (ConHead c fs) = killRange2 ConHead c fs
+  killRange (ConHead c i fs) = killRange3 ConHead c i fs
 
 instance KillRange Term where
   killRange v = case v of
@@ -821,7 +870,7 @@ instance Pretty Term where
             , nest 2 $ pretty (unAbs b) ]
       Lit l                -> pretty l
       Def q els            -> text (show q) `pApp` els
-      Con (ConHead c _) vs -> text (show c) `pApp` map Apply vs
+      Con c vs             -> text (show $ conName c) `pApp` map Apply vs
       Pi a (NoAbs _ b)     -> mparens (p > 0) $
         sep [ prettyPrec 1 (unDom a) <+> text "->"
             , nest 2 $ pretty b ]
@@ -895,4 +944,3 @@ instance Pretty a => Pretty (Arg a) where
       NotHidden -> prettyPrec p
       Hidden    -> braces . pretty
       Instance  -> braces . braces . pretty
-
diff --git a/src/full/Agda/Syntax/Internal/Defs.hs b/src/full/Agda/Syntax/Internal/Defs.hs
index 2ea05eb..dd4fc38 100644
--- a/src/full/Agda/Syntax/Internal/Defs.hs
+++ b/src/full/Agda/Syntax/Internal/Defs.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Extract used definitions from terms.
 module Agda.Syntax.Internal.Defs where
@@ -12,7 +14,7 @@ import Agda.Syntax.Common
 import Agda.Syntax.Internal hiding (ArgInfo, Arg, Dom)
 
 import Agda.Utils.Impossible
-#include "../../undefined.h"
+#include "undefined.h"
 
 -- | @getDefs' lookup emb a@ extracts all used definitions
 --   (functions, data/record types) from @a@, embedded into a monoid via @emb at .
diff --git a/src/full/Agda/Syntax/Internal/Generic.hs b/src/full/Agda/Syntax/Internal/Generic.hs
index fb143b0..9da57c2 100644
--- a/src/full/Agda/Syntax/Internal/Generic.hs
+++ b/src/full/Agda/Syntax/Internal/Generic.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.Syntax.Internal.Generic where
@@ -11,7 +11,7 @@ import Data.Foldable
 import Agda.Syntax.Internal
 
 import Agda.Utils.Impossible
-#include "../../undefined.h"
+#include "undefined.h"
 
 class TermLike a where
   traverseTerm  :: (Term -> Term) -> a -> a
diff --git a/src/full/Agda/Syntax/Internal/Pattern.hs b/src/full/Agda/Syntax/Internal/Pattern.hs
index e101bf9..7f9ca74 100644
--- a/src/full/Agda/Syntax/Internal/Pattern.hs
+++ b/src/full/Agda/Syntax/Internal/Pattern.hs
@@ -1,6 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverlappingInstances   #-}
+{-# LANGUAGE TupleSections          #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE UndecidableInstances   #-}  -- because of func. deps.
 
 module Agda.Syntax.Internal.Pattern where
 
@@ -21,7 +27,7 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size (size)
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- * Tools for clauses
@@ -57,55 +63,75 @@ instance FunArity [Clause] where
 
 -- * Tools for patterns
 
+-- | Label the pattern variables from left to right
+--   using one label for each variable pattern and one for each dot pattern.
+class LabelPatVars a b i | b -> i where
+  labelPatVars :: a -> State [i] b
+  -- ^ Intended, but unpractical due to the absence of type-level lambda, is:
+  --   @labelPatVars :: f (Pattern' x) -> State [i] (f (Pattern' (i,x)))@
+
+instance LabelPatVars a b i => LabelPatVars (Arg c a) (Arg c b) i where
+  labelPatVars = traverse labelPatVars
+
+instance LabelPatVars a b i => LabelPatVars (Named x a) (Named x b) i where
+  labelPatVars = traverse labelPatVars
+
+instance LabelPatVars a b i => LabelPatVars [a] [b] i where
+  labelPatVars = traverse labelPatVars
+
+instance LabelPatVars (Pattern' x) (Pattern' (i,x)) i where
+  labelPatVars p =
+    case p of
+      VarP x       -> VarP . (,x) <$> next
+      DotP t       -> DotP t <$ next
+      ConP c mt ps -> ConP c mt <$> labelPatVars ps
+      LitP l       -> return $ LitP l
+      ProjP q      -> return $ ProjP q
+    where next = do (x:xs) <- get; put xs; return x
+
+-- | Augment pattern variables with their de Bruijn index.
+{-# SPECIALIZE numberPatVars :: Permutation -> [NamedArg (Pattern' x)] -> [(NamedArg (Pattern' (Int, x)))] #-}
+numberPatVars :: LabelPatVars a b Int => Permutation -> a -> b
+numberPatVars perm ps = evalState (labelPatVars ps) $
+  permute (invertP __IMPOSSIBLE__ perm) $ downFrom $ size perm
+
 instance IsProjP Pattern where
   isProjP (ProjP d) = Just d
   isProjP _         = Nothing
 
--- Special case of Agda.Syntax.Abstract.IsProjP (Arg...)
--- instance IsProjP (Common.Arg c Pattern) where
---   isProjP = isProjP . unArg
-
-{- NOTE: The following definition does not work, since Elim' already
-   contains Arg.  Otherwise, we could have fixed it using traverseF.
-
-patternsToElims :: Permutation -> [I.NamedArg Pattern] -> Elims
-patternsToElims perm aps = evalState (argPatsToElims aps) xs
-  where
-    xs   = permute (invertP perm) $ downFrom (size perm)
-
-    tick :: State [Int] Int
-    tick = do x : xs <- get; put xs; return x
-
-    argPatsToElims :: [I.NamedArg Pattern] -> State [Int] Elims
-    argPatsToElims = traverse $ traverse $ patToElim . namedThing
-
-    patToElim :: Pattern -> State [Int] (Elim' Term)
-    patToElim p = case p of
-      VarP _      -> Apply . flip var <$> tick
-      DotP v      -> Apply v <$ tick   -- dot patterns count as variables
-      ConP c _ ps -> Apply . Con c . map argFromElim <$> argPatsToElims ps
-      LitP l      -> pure $ Apply $ Lit l
-      ProjP d     -> pure $ Proj d
--}
-
 patternsToElims :: Permutation -> [I.NamedArg Pattern] -> [Elim]
-patternsToElims perm ps = evalState (mapM build' ps) xs
+patternsToElims perm ps = map build' $ numberPatVars perm ps
   where
-    xs   = permute (invertP perm) $ downFrom (size perm)
-
-    tick :: State [Int] Int
-    tick = do x : xs <- get; put xs; return x
 
-    build' :: NamedArg Pattern -> State [Int] Elim
+    build' :: NamedArg (Pattern' (Int, PatVarName)) -> Elim
     build' = build . fmap namedThing
 
-    build :: I.Arg Pattern -> State [Int] Elim
-    build (Arg ai (VarP _)     ) = Apply . Arg ai . var <$> tick
-    build (Arg ai (ConP c _ ps)) =
-      Apply . Arg ai . Con c <$> mapM (argFromElim <.> build') ps
-    build (Arg ai (DotP t)     ) = Apply (Arg ai t) <$ tick
-    build (Arg ai (LitP l)     ) = return $ Apply $ Arg ai $ Lit l
-    build (Arg ai (ProjP dest) ) = return $ Proj  $ dest
+    build :: I.Arg (Pattern' (Int, PatVarName)) -> Elim
+    build (Arg ai (VarP (i, _))) = Apply $ Arg ai $ var i
+    build (Arg ai (ConP c _ ps)) = Apply $ Arg ai $ Con c $
+      map (argFromElim . build') ps
+    build (Arg ai (DotP t)     ) = Apply $ Arg ai t
+    build (Arg ai (LitP l)     ) = Apply $ Arg ai $ Lit l
+    build (Arg ai (ProjP dest) ) = Proj  $ dest
+
+-- patternsToElims :: Permutation -> [I.NamedArg Pattern] -> [Elim]
+-- patternsToElims perm ps = evalState (mapM build' ps) xs
+--   where
+--     xs   = permute (invertP __IMPOSSIBLE__ perm) $ downFrom (size perm)
+
+--     tick :: State [Int] Int
+--     tick = do x : xs <- get; put xs; return x
+
+--     build' :: NamedArg Pattern -> State [Int] Elim
+--     build' = build . fmap namedThing
+
+--     build :: I.Arg Pattern -> State [Int] Elim
+--     build (Arg ai (VarP _)     ) = Apply . Arg ai . var <$> tick
+--     build (Arg ai (ConP c _ ps)) =
+--       Apply . Arg ai . Con c <$> mapM (argFromElim <.> build') ps
+--     build (Arg ai (DotP t)     ) = Apply (Arg ai t) <$ tick
+--     build (Arg ai (LitP l)     ) = return $ Apply $ Arg ai $ Lit l
+--     build (Arg ai (ProjP dest) ) = return $ Proj  $ dest
 
 -- * One hole patterns
 
@@ -117,7 +143,7 @@ data OneHolePatterns = OHPats [NamedArg Pattern]
                               [NamedArg Pattern]
   deriving (Show)
 data OneHolePattern  = Hole
-		     | OHCon ConHead ConPatternInfo OneHolePatterns
+                     | OHCon ConHead ConPatternInfo OneHolePatterns
                        -- ^ The type in 'ConPatternInfo' serves the same role as in 'ConP'.
                        --
                        -- TODO: If a hole is plugged this type may
diff --git a/src/full/Agda/Syntax/Literal.hs b/src/full/Agda/Syntax/Literal.hs
index ca1c2a9..a9f06c9 100644
--- a/src/full/Agda/Syntax/Literal.hs
+++ b/src/full/Agda/Syntax/Literal.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+
 module Agda.Syntax.Literal where
 
 import Data.Char
@@ -8,9 +9,9 @@ import Agda.Syntax.Abstract.Name
 import Agda.Utils.Pretty
 
 data Literal = LitInt    Range Integer
-	     | LitFloat  Range Double
-	     | LitString Range String
-	     | LitChar   Range Char
+             | LitFloat  Range Double
+             | LitString Range String
+             | LitChar   Range Char
              | LitQName  Range QName
   deriving (Typeable)
 
@@ -26,7 +27,7 @@ instance Show Literal where
       sh c x = showString (c ++ " ") . shows x
 
 instance Pretty Literal where
-    pretty (LitInt _ n)	    = text $ show n
+    pretty (LitInt _ n)     = text $ show n
     pretty (LitFloat _ x)   = text $ show x
     pretty (LitString _ s)  = text $ showString' s ""
     pretty (LitChar _ c)    = text $ "'" ++ showChar' c "" ++ "'"
@@ -37,12 +38,12 @@ showString' s =
     foldr (.) id $ [ showString "\"" ] ++ map showChar' s ++ [ showString "\"" ]
 
 showChar' :: Char -> ShowS
-showChar' '"'	= showString "\\\""
+showChar' '"'   = showString "\\\""
 showChar' c
     | escapeMe c = showLitChar c
-    | otherwise	 = showString [c]
+    | otherwise  = showString [c]
     where
-	escapeMe c = not (isPrint c) || c == '\\'
+        escapeMe c = not (isPrint c) || c == '\\'
 
 instance Eq Literal where
   LitInt _ n    == LitInt _ m    = n == m
diff --git a/src/full/Agda/Syntax/Notation.hs b/src/full/Agda/Syntax/Notation.hs
index e28f261..71bc525 100644
--- a/src/full/Agda/Syntax/Notation.hs
+++ b/src/full/Agda/Syntax/Notation.hs
@@ -1,11 +1,22 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-| As a concrete name, a notation is a non-empty list of alternating 'IdPart's and holes.
+    In contrast to concrete names, holes can be binders.
+
+    Example:
+    @
+       syntax fmap (λ x → e) xs = for x ∈ xs return e
+    @
+
+    The declared notation for @fmap@ is @for_∈_return_@ where the first hole is a binder.
+-}
 
 module Agda.Syntax.Notation where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error (throwError)
 
 import Data.List
 import Data.Maybe
@@ -13,89 +24,130 @@ import Data.Typeable (Typeable)
 
 import Agda.Syntax.Common
 
-#include "../undefined.h"
-import Agda.Utils.Impossible
-
-{-| A name is a non-empty list of alternating 'Id's and 'Hole's. A normal name
-    is represented by a singleton list, and operators are represented by a list
-    with 'Hole's where the arguments should go. For instance: @[Hole,Id "+",Hole]@
-    is infix addition.
+import Agda.Utils.Except ( MonadError(throwError) )
+import Agda.Utils.List
 
-    Equality and ordering on @Name at s are defined to ignore range so same names
-    in different locations are equal.
--}
+import Agda.Utils.Impossible
+#include "undefined.h"
 
 -- | Data type constructed in the Happy parser; converted to 'GenPart'
--- before it leaves the Happy code.
-data HoleName = LambdaHole RawName RawName -- ^ (\x -> y) ; 1st argument is the bound name (unused for now)
-              | ExprHole RawName           -- ^ simple named hole with hiding
-
--- | Target of a hole
-holeName (LambdaHole _ n) = n
-holeName (ExprHole n) = n
+--   before it leaves the Happy code.
+data HoleName
+  = LambdaHole { _bindHoleName :: RawName
+               , holeName      :: RawName }
+    -- ^ @\ x -> y@; 1st argument is the bound name (unused for now).
+  | ExprHole   { holeName      :: RawName }
+    -- ^ Simple named hole with hiding.
+
+-- | Is the hole a binder?
+isLambdaHole :: HoleName -> Bool
+isLambdaHole (LambdaHole _ _) = True
+isLambdaHole _ = False
 
+-- | Notation as provided by the @syntax@ declaration.
 type Notation = [GenPart]
 
 -- | Part of a Notation
-data GenPart = BindHole Int                 -- ^ Argument is the position of the hole (with binding) where the binding should occur.
-             | NormalHole (NamedArg () Int) -- ^ Argument is where the expression should go
-             | IdPart RawName
+data GenPart
+  = BindHole Int
+    -- ^ Argument is the position of the hole (with binding) where the binding should occur.
+  | NormalHole (NamedArg () Int)
+    -- ^ Argument is where the expression should go.
+  | IdPart RawName
   deriving (Typeable, Show, Eq)
 
 -- | Get a flat list of identifier parts of a notation.
 stringParts :: Notation -> [RawName]
 stringParts gs = [ x | IdPart x <- gs ]
 
--- | Target argument position of a part (Nothing if it is not a hole)
+-- | Target argument position of a part (Nothing if it is not a hole).
 holeTarget :: GenPart -> Maybe Int
-holeTarget (BindHole n) = Just n
-holeTarget (NormalHole n) = Just (namedArg n)
-holeTarget (IdPart _) = Nothing
+holeTarget (BindHole   n) = Just n
+holeTarget (NormalHole n) = Just $ namedArg n
+holeTarget IdPart{}       = Nothing
 
 -- | Is the part a hole?
 isAHole :: GenPart -> Bool
 isAHole = isJust . holeTarget
 
+-- | Is the part a binder?
+isBindingHole :: GenPart -> Bool
 isBindingHole (BindHole _) = True
 isBindingHole _ = False
 
-isLambdaHole (LambdaHole _ _) = True
-isLambdaHole _ = False
-
+-- | Classification of notations.
+
+data NotationKind
+  = InfixNotation   -- ^ Ex: @_bla_blub_ at .
+  | PrefixNotation  -- ^ Ex: @_bla_blub at .
+  | PostfixNotation -- ^ Ex: @bla_blub_ at .
+  | NonfixNotation  -- ^ Ex: @bla_blub at .
+  | NoNotation
+   deriving (Eq)
+
+-- | Classify a notation by presence of leading and/or trailing hole.
+notationKind :: Notation -> NotationKind
+notationKind []  = NoNotation
+notationKind syn =
+  case (isAHole $ head syn, isAHole $ last syn) of
+    (True , True ) -> InfixNotation
+    (True , False) -> PostfixNotation
+    (False, True ) -> PrefixNotation
+    (False, False) -> NonfixNotation
 
 -- | From notation with names to notation with indices.
+--
+--   Example:
+--   @
+--      ids   = ["for", "x", "∈", "xs", "return", "e"]
+--      holes = [ LambdaHole "x" "e",  ExprHole "xs" ]
+--   @
+--   creates the notation
+--   @
+--      [ IdPart "for"    , BindHole 0
+--      , IdPart "∈"      , NormalHole 1
+--      , IdPart "return" , NormalHole 0
+--      ]
+--   @
 mkNotation :: [NamedArg c HoleName] -> [RawName] -> Either String Notation
 mkNotation _ [] = throwError "empty notation is disallowed"
 mkNotation holes ids = do
-  unless (uniqueNames holes) $ throwError "syntax must use unique argument names"
-  let xs = map mkPart ids
+  unless uniqueHoleNames     $ throwError "syntax must use unique argument names"
+  let xs :: Notation = map mkPart ids
   unless (isAlternating xs)  $ throwError "syntax must alternate holes and non-holes"
   unless (isExprLinear xs)   $ throwError "syntax must use holes exactly once"
   unless (isLambdaLinear xs) $ throwError "syntax must use binding holes exactly once"
   return xs
-    where mkPart ident = fromMaybe (IdPart ident) $ lookup ident holeMap
-
-          holeMap = concat $ zipWith mkHole [0..] holes
-            where mkHole i h =
-                    case namedArg h of
-                      ExprHole x     -> [(x, normalHole)]
-                      LambdaHole x y -> [(x, BindHole i), (y, normalHole)]
-                    where normalHole = NormalHole $ setArgColors [] $ fmap (i <$) h
-
-          uniqueNames hs = nub xs == xs
-            where xs = concatMap (names . namedArg) hs
-                  names (ExprHole x)     = [x]
-                  names (LambdaHole x y) = [x, y]
-
-          isExprLinear   xs = sort [ namedArg x | NormalHole x <- xs] == [ i | (i, h) <- zip [0..] holes ]
-          isLambdaLinear xs = sort [ x          | BindHole   x <- xs] == [ i | (i, h) <- zip [0..] holes, isLambdaHole (namedArg h) ]
-
-          isAlternating :: [GenPart] -> Bool
-          isAlternating [] = __IMPOSSIBLE__
-          isAlternating [x] = True
-          isAlternating (x:y:xs) = isAHole x /= isAHole y && isAlternating (y:xs)
-
-
--- | No notation by default
+    where
+      mkPart ident = fromMaybe (IdPart ident) $ lookup ident holeMap
+
+      holeNumbers   = [0 .. length holes - 1]
+      numberedHoles = zip holeNumbers holes
+
+      -- Create a map (association list) from hole names to holes.
+      -- A @LambdaHole@ contributes two entries:
+      -- both names are mapped to the same number,
+      -- but distinguished by BindHole vs. NormalHole.
+      holeMap = do
+        (i, h) <- numberedHoles
+        let normalHole = NormalHole $ setArgColors [] $ fmap (i <$) h
+        case namedArg h of
+          ExprHole y     -> [(y, normalHole)]
+          LambdaHole x y -> [(x, BindHole i), (y, normalHole)]
+
+      -- Check whether all hole names are distinct.
+      -- The hole names are the keys of the @holeMap at .
+      uniqueHoleNames = distinct $ map fst holeMap
+
+      isExprLinear   xs = sort [ namedArg x | NormalHole x <- xs] == holeNumbers
+      isLambdaLinear xs = sort [ x          | BindHole   x <- xs] == [ i | (i, h) <- numberedHoles, isLambdaHole (namedArg h) ]
+
+      isAlternating :: [GenPart] -> Bool
+      isAlternating []       = __IMPOSSIBLE__
+      isAlternating [x]      = True
+      isAlternating (x:y:xs) = isAHole x /= isAHole y && isAlternating (y:xs)
+
+-- | No notation by default.
+defaultNotation, noNotation :: Notation
 defaultNotation = []
 noNotation = []
diff --git a/src/full/Agda/Syntax/Parser.hs b/src/full/Agda/Syntax/Parser.hs
index 6f54b79..4c764a1 100644
--- a/src/full/Agda/Syntax/Parser.hs
+++ b/src/full/Agda/Syntax/Parser.hs
@@ -32,15 +32,15 @@ import Agda.Utils.FileName
 -- Wrapping parse results
 
 wrap :: ParseResult a -> a
-wrap (ParseOk _ x)	= x
-wrap (ParseFailed err)	= throw err
+wrap (ParseOk _ x)      = x
+wrap (ParseFailed err)  = throw err
 
 wrapM:: Monad m => m (ParseResult a) -> m a
 wrapM m =
-    do	r <- m
-	case r of
-	    ParseOk _ x	    -> return x
-	    ParseFailed err -> throw err
+    do  r <- m
+        case r of
+            ParseOk _ x     -> return x
+            ParseFailed err -> throw err
 
 ------------------------------------------------------------------------
 -- Parse functions
diff --git a/src/full/Agda/Syntax/Parser/Alex.hs b/src/full/Agda/Syntax/Parser/Alex.hs
index 0710b68..9149194 100644
--- a/src/full/Agda/Syntax/Parser/Alex.hs
+++ b/src/full/Agda/Syntax/Parser/Alex.hs
@@ -1,10 +1,10 @@
-
 {-| This module defines the things required by Alex and some other
     Alex related things.
 -}
 module Agda.Syntax.Parser.Alex
     ( -- * Alex requirements
       AlexInput(..)
+    , lensLexInput
     , alexInputPrevChar
     , alexGetChar, alexGetByte
       -- * Lex actions
@@ -23,14 +23,19 @@ import Data.Word
 import Agda.Syntax.Position
 import Agda.Syntax.Parser.Monad
 
+import Agda.Utils.Lens
 import Agda.Utils.Monad
 
 -- | This is what the lexer manipulates.
 data AlexInput = AlexInput
-		    { lexPos	    :: !Position    -- ^ current position
-		    , lexInput	    :: String	    -- ^ current input
-		    , lexPrevChar   :: !Char	    -- ^ previously read character
-		    }
+  { lexPos      :: !Position    -- ^ current position
+  , lexInput    :: String       -- ^ current input
+  , lexPrevChar :: !Char        -- ^ previously read character
+  }
+
+-- | A lens for 'lexInput'.
+lensLexInput :: Lens' String AlexInput
+lensLexInput f r = f (lexInput r) <&> \ s -> r { lexInput = s }
 
 -- | Get the previously lexed character. Same as 'lexPrevChar'. Alex needs this
 --   to be defined to handle \"patterns with a left-context\".
@@ -44,11 +49,11 @@ alexGetChar :: AlexInput -> Maybe (Char, AlexInput)
 alexGetChar (AlexInput { lexInput = []  }) = Nothing
 alexGetChar (AlexInput { lexInput = c:s, lexPos = p }) =
     Just (c, AlexInput
-		 { lexInput	= s
-		 , lexPos	= movePos p c
-		 , lexPrevChar	= c
-		 }
-	 )
+                 { lexInput     = s
+                 , lexPos       = movePos p c
+                 , lexPrevChar  = c
+                 }
+         )
 
 -- | A variant of 'alexGetChar'.
 --
@@ -66,19 +71,19 @@ alexGetByte ai =
 getLexInput :: Parser AlexInput
 getLexInput = getInp <$> get
     where
-	getInp s = AlexInput
-		    { lexPos	    = parsePos s
-		    , lexInput	    = parseInp s
-		    , lexPrevChar   = parsePrevChar s
-		    }
+        getInp s = AlexInput
+                    { lexPos        = parsePos s
+                    , lexInput      = parseInp s
+                    , lexPrevChar   = parsePrevChar s
+                    }
 
 setLexInput :: AlexInput -> Parser ()
 setLexInput inp = modify upd
     where
-	upd s = s { parsePos	    = lexPos inp
-		  , parseInp	    = lexInput inp
-		  , parsePrevChar   = lexPrevChar inp
-		  }
+        upd s = s { parsePos        = lexPos inp
+                  , parseInp        = lexInput inp
+                  , parsePrevChar   = lexPrevChar inp
+                  }
 
 {--------------------------------------------------------------------------
     Lex actions
diff --git a/src/full/Agda/Syntax/Parser/Comments.hs b/src/full/Agda/Syntax/Parser/Comments.hs
index 7c3ce9f..93426d4 100644
--- a/src/full/Agda/Syntax/Parser/Comments.hs
+++ b/src/full/Agda/Syntax/Parser/Comments.hs
@@ -36,8 +36,8 @@ keepCommentsM = fmap parseKeepComments getParseFlags
 --   token.
 nestedComment :: LexAction Token
 nestedComment inp inp' _ =
-    do	setLexInput inp'
-	runLookAhead err $ skipBlock "{-" "-}"
+    do  setLexInput inp'
+        runLookAhead err $ skipBlock "{-" "-}"
         keep <- keepCommentsM
         if keep then do
           inp'' <- getLexInput
@@ -48,7 +48,7 @@ nestedComment inp inp' _ =
                       genericTake (p2 - p1) $ lexInput inp
           return $ TokComment (i, s)
          else
-	  lexToken
+          lexToken
     where
         err _ = liftP $ parseErrorAt (lexPos inp) "Unterminated '{-'"
 
@@ -56,10 +56,10 @@ nestedComment inp inp' _ =
 --   Returns @'TokSymbol' 'SymQuestionMark'@.
 hole :: LexAction Token
 hole inp inp' _ =
-    do	setLexInput inp'
-	runLookAhead err $ skipBlock "{!" "!}"
-	p <- lexPos <$> getLexInput
-	return $ TokSymbol SymQuestionMark (Interval (lexPos inp) p)
+    do  setLexInput inp'
+        runLookAhead err $ skipBlock "{!" "!}"
+        p <- lexPos <$> getLexInput
+        return $ TokSymbol SymQuestionMark (Interval (lexPos inp) p)
     where
         err _ = liftP $ parseErrorAt (lexPos inp) "Unterminated '{!'"
 
@@ -68,10 +68,10 @@ hole inp inp' _ =
 skipBlock :: String -> String -> LookAhead ()
 skipBlock open close = scan 1
     where
-	scan 0 = sync
-	scan n = match [ open	==>  scan (n + 1)
-		       , close	==>  scan (n - 1)
-		       ] `other` scan n
-	    where
-		(==>) = (,)
-		other = ($)
+        scan 0 = sync
+        scan n = match [ open   ==>  scan (n + 1)
+                       , close  ==>  scan (n - 1)
+                       ] `other` scan n
+            where
+                (==>) = (,)
+                other = ($)
diff --git a/src/full/Agda/Syntax/Parser/Layout.hs b/src/full/Agda/Syntax/Parser/Layout.hs
index 006eb8e..ceda777 100644
--- a/src/full/Agda/Syntax/Parser/Layout.hs
+++ b/src/full/Agda/Syntax/Parser/Layout.hs
@@ -39,9 +39,9 @@ import Agda.Syntax.Position
 --   context.
 openBrace :: LexAction Token
 openBrace = token $ \_ ->
-    do	pushContext NoLayout
-	i <- getParseInterval
-	return (TokSymbol SymOpenBrace i)
+    do  pushContext NoLayout
+        i <- getParseInterval
+        return (TokSymbol SymOpenBrace i)
 
 
 {-| Executed upon lexing a close brace (@\'}\'@). Exits the current layout
@@ -51,9 +51,9 @@ openBrace = token $ \_ ->
 -}
 closeBrace :: LexAction Token
 closeBrace = token $ \_ ->
-    do	popContext
-	i <- getParseInterval
-	return (TokSymbol SymCloseBrace i)
+    do  popContext
+        i <- getParseInterval
+        return (TokSymbol SymCloseBrace i)
 
 
 {-| Executed for the first token in each line (see 'Agda.Syntax.Parser.Lexer.bol').
@@ -61,31 +61,31 @@ closeBrace = token $ \_ ->
     If the token is
 
     - /to the left/ :
-	Exit the current context and a return virtual close brace (stay in the
-	'Agda.Syntax.Parser.Lexer.bol' state).
+        Exit the current context and a return virtual close brace (stay in the
+        'Agda.Syntax.Parser.Lexer.bol' state).
 
     - /same column/ :
-	Exit the 'Agda.Syntax.Parser.Lexer.bol' state and return a virtual semi
-	colon.
+        Exit the 'Agda.Syntax.Parser.Lexer.bol' state and return a virtual semi
+        colon.
 
     - /to the right/ :
-	Exit the 'Agda.Syntax.Parser.Lexer.bol' state and continue lexing.
+        Exit the 'Agda.Syntax.Parser.Lexer.bol' state and continue lexing.
 
     If the current block doesn't use layout (i.e. it was started by
     'openBrace') all positions are considered to be /to the right/.
 -}
 offsideRule :: LexAction Token
 offsideRule inp _ _ =
-    do	offs <- getOffside p
-	case offs of
-	    LT	-> do	popContext
-			return (TokSymbol SymCloseVirtualBrace (Interval p p))
-	    EQ	-> do	popLexState
-			return (TokSymbol SymVirtualSemi (Interval p p))
-	    GT	-> do	popLexState
-			lexToken
+    do  offs <- getOffside p
+        case offs of
+            LT  -> do   popContext
+                        return (TokSymbol SymCloseVirtualBrace (Interval p p))
+            EQ  -> do   popLexState
+                        return (TokSymbol SymVirtualSemi (Interval p p))
+            GT  -> do   popLexState
+                        lexToken
     where
-	p = lexPos inp
+        p = lexPos inp
 
 
 {-| This action is only executed from the 'Agda.Syntax.Parser.Lexer.empty_layout'
@@ -95,11 +95,11 @@ offsideRule inp _ _ =
 -}
 emptyLayout :: LexAction Token
 emptyLayout inp _ _ =
-    do	popLexState
-	pushLexState bol
-	return (TokSymbol SymCloseVirtualBrace (Interval p p))
+    do  popLexState
+        pushLexState bol
+        return (TokSymbol SymCloseVirtualBrace (Interval p p))
     where
-	p = lexPos inp
+        p = lexPos inp
 
 
 {-| Start a new layout context. This is one of two ways to get out of the
@@ -125,24 +125,24 @@ emptyLayout inp _ _ =
 -}
 newLayoutContext :: LexAction Token
 newLayoutContext inp _ _ =
-    do	let offset = posCol p
-	ctx <- topContext
-	case ctx of
-	    Layout prevOffs | prevOffs >= offset ->
-		do  pushLexState empty_layout
-		    return (TokSymbol SymOpenVirtualBrace (Interval p p))
-	    _ ->
-		do  pushContext (Layout offset)
-		    return (TokSymbol SymOpenVirtualBrace (Interval p p))
+    do  let offset = posCol p
+        ctx <- topContext
+        case ctx of
+            Layout prevOffs | prevOffs >= offset ->
+                do  pushLexState empty_layout
+                    return (TokSymbol SymOpenVirtualBrace (Interval p p))
+            _ ->
+                do  pushContext (Layout offset)
+                    return (TokSymbol SymOpenVirtualBrace (Interval p p))
     where
-	p = lexPos inp
+        p = lexPos inp
 
 
 -- | Compute the relative position of a location to the
 --   current layout context.
 getOffside :: Position -> Parser Ordering
 getOffside loc =
-    do	ctx <- topContext
-	return $ case ctx of
-	    Layout n	-> compare (posCol loc) n
-	    _		-> GT
+    do  ctx <- topContext
+        return $ case ctx of
+            Layout n    -> compare (posCol loc) n
+            _           -> GT
diff --git a/src/full/Agda/Syntax/Parser/LexActions.hs b/src/full/Agda/Syntax/Parser/LexActions.hs
index 0ec1e35..dfd93a0 100644
--- a/src/full/Agda/Syntax/Parser/LexActions.hs
+++ b/src/full/Agda/Syntax/Parser/LexActions.hs
@@ -29,9 +29,9 @@ import Agda.Syntax.Parser.Tokens
 import Agda.Syntax.Position
 import Agda.Syntax.Literal
 
+import Agda.Utils.Lens
 import Agda.Utils.List
 import Agda.Utils.Tuple
-import Agda.Utils.Unicode
 
 {--------------------------------------------------------------------------
     Scan functions
@@ -41,8 +41,8 @@ import Agda.Utils.Unicode
 returnEOF :: AlexInput -> Parser Token
 returnEOF inp =
     do  setLastPos $ lexPos inp
-	setPrevToken "<EOF>"
-	return TokEOF
+        setPrevToken "<EOF>"
+        return TokEOF
 
 -- | Set the current input and lex a new token (calls 'lexToken').
 skipTo :: AlexInput -> Parser Token
@@ -55,14 +55,14 @@ used by the parser is the continuation version of this function.
 -}
 lexToken :: Parser Token
 lexToken =
-    do	inp <- getLexInput
-	lss@(ls:_) <- getLexState
+    do  inp <- getLexInput
+        lss@(ls:_) <- getLexState
         flags <- getParseFlags
-	case alexScanUser (lss, flags) (foolAlex inp) ls of
-	    AlexEOF			-> returnEOF inp
-	    AlexSkip inp' len		-> skipTo (newInput inp inp' len)
-	    AlexToken inp' len action	-> fmap postToken $ action inp (newInput inp inp' len) len
-	    AlexError i			-> parseError $ "Lexical error" ++
+        case alexScanUser (lss, flags) (foolAlex inp) ls of
+            AlexEOF                     -> returnEOF inp
+            AlexSkip inp' len           -> skipTo (newInput inp inp' len)
+            AlexToken inp' len action   -> fmap postToken $ action inp (newInput inp inp' len) len
+            AlexError i                 -> parseError $ "Lexical error" ++
               (case lexInput i of
                  '\t' : _ -> " (you may want to replace tabs with spaces)"
                  _        -> "") ++
@@ -88,23 +88,27 @@ postToken t = t
 newInput :: PreviousInput -> CurrentInput -> TokenLength -> CurrentInput
 newInput inp inp' len =
     case drop (len - 1) (lexInput inp) of
-	c:s'	-> inp' { lexInput    = s'
-			, lexPrevChar = c
-			}
-	[]	-> inp' { lexInput = [] }   -- we do get empty tokens moving between states
+        c:s'    -> inp' { lexInput    = s'
+                        , lexPrevChar = c
+                        }
+        []      -> inp' { lexInput = [] }   -- we do get empty tokens moving between states
 
 -- | Alex 2 can't handle unicode characters. To solve this we
 --   translate all Unicode (non-ASCII) identifiers to @z@, all Unicode
 --   operator characters to @+@, and all whitespace characters (except
---   for @\t@ and @\n@) to ' '. It is important that there aren't any
---   keywords containing @z@, @+@ or @ @.
+--   for @\t@ and @\n@) to ' '.
+--   Further, non-printable Unicode characters are translated to an
+--   arbitrary, harmless ASCII non-printable character, @'\1'@.
+--
+--   It is important that there aren't any keywords containing @z@, @+@ or @ @.
+
 foolAlex :: AlexInput -> AlexInput
-foolAlex inp = inp { lexInput = map fool $ lexInput inp }
-    where
-	fool c
-            | isSpace c && not (c `elem` "\t\n") = ' '
-	    | isUnicodeId c = if isAlpha c then 'z' else '+'
-	    | otherwise     = c
+foolAlex = over lensLexInput $ map $ \ c ->
+  case c of
+    _ | isSpace c && not (c `elem` "\t\n") -> ' '
+    _ | isAscii c                          -> c
+    _ | isPrint c                          -> if isAlpha c then 'z' else '+'
+    _ | otherwise                          -> '\1'
 
 {--------------------------------------------------------------------------
     Lex actions
@@ -114,17 +118,17 @@ foolAlex inp = inp { lexInput = map fool $ lexInput inp }
 token :: (String -> Parser tok) -> LexAction tok
 token action inp inp' len =
     do  setLexInput inp'
-	setPrevToken t
-	setLastPos $ lexPos inp
-	action t
+        setPrevToken t
+        setLastPos $ lexPos inp
+        action t
     where
-	t = take len $ lexInput inp
+        t = take len $ lexInput inp
 
 -- | Parse a token from an 'Interval' and the lexed string.
 withInterval :: ((Interval, String) -> tok) -> LexAction tok
 withInterval f = token $ \s -> do
                    r <- getParseInterval
-		   return $ f (r,s)
+                   return $ f (r,s)
 
 -- | Like 'withInterval', but applies a function to the string.
 withInterval' :: (String -> a) -> ((Interval, a) -> tok) -> LexAction tok
@@ -139,50 +143,50 @@ withInterval_ f = withInterval (f . fst)
 --   state and performs the given action.
 withLayout :: LexAction r -> LexAction r
 withLayout a i1 i2 n =
-    do	pushLexState layout
-	a i1 i2 n
+    do  pushLexState layout
+        a i1 i2 n
 
 
 -- | Enter a new state without consuming any input.
 begin :: LexState -> LexAction Token
 begin code _ _ _ =
-    do	pushLexState code
-	lexToken
+    do  pushLexState code
+        lexToken
 
 
 -- | Enter a new state throwing away the current lexeme.
 begin_ :: LexState -> LexAction Token
 begin_ code _ inp' _ =
-    do	pushLexState code
-	skipTo inp'
+    do  pushLexState code
+        skipTo inp'
 
 
 -- | Exit the current state throwing away the current lexeme.
 end_ :: LexAction Token
 end_ _ inp' _ =
-    do	popLexState
-	skipTo inp'
+    do  popLexState
+        skipTo inp'
 
 
 -- | Exit the current state and perform the given action.
 endWith :: LexAction a -> LexAction a
 endWith a inp inp' n =
-    do	popLexState
-	a inp inp' n
+    do  popLexState
+        a inp inp' n
 
 
 -- | Exit the current state without consuming any input
 end :: LexAction Token
 end _ _ _ =
-    do	popLexState
-	lexToken
+    do  popLexState
+        lexToken
 
 -- | Parse a 'Keyword' token, triggers layout for 'layoutKeywords'.
 keyword :: Keyword -> LexAction Token
 keyword k = layout $ withInterval_ (TokKeyword k)
     where
-	layout | elem k layoutKeywords	= withLayout
-	       | otherwise		= id
+        layout | elem k layoutKeywords  = withLayout
+               | otherwise              = id
 
 
 -- | Parse a 'Symbol' token.
@@ -206,24 +210,24 @@ qualified :: (Either (Interval, String) [(Interval, String)] -> a) -> LexAction
 qualified tok =
     token $ \s ->
     do  i <- getParseInterval
-	case mkName i $ wordsBy (=='.') s of
-	    []	-> lexError "lex error on .."
-	    [x]	-> return $ tok $ Left  x
-	    xs	-> return $ tok $ Right xs
+        case mkName i $ wordsBy (=='.') s of
+            []  -> lexError "lex error on .."
+            [x] -> return $ tok $ Left  x
+            xs  -> return $ tok $ Right xs
     where
-	-- Compute the ranges for the substrings (separated by '.') of
-	-- a name. Dots are included: the intervals generated for
-	-- "A.B.x" correspond to "A.", "B." and "x".
-	mkName :: Interval -> [String] -> [(Interval, String)]
-	mkName _ []	= []
-	mkName i [x]	= [(i, x)]
-	mkName i (x:xs) = (i0, x) : mkName i1 xs
-	    where
-		p0 = iStart i
-		p1 = iEnd i
-		p' = movePos (movePosByString p0 x) '.'
-		i0 = Interval p0 p'
-		i1 = Interval p' p1
+        -- Compute the ranges for the substrings (separated by '.') of
+        -- a name. Dots are included: the intervals generated for
+        -- "A.B.x" correspond to "A.", "B." and "x".
+        mkName :: Interval -> [String] -> [(Interval, String)]
+        mkName _ []     = []
+        mkName i [x]    = [(i, x)]
+        mkName i (x:xs) = (i0, x) : mkName i1 xs
+            where
+                p0 = iStart i
+                p1 = iEnd i
+                p' = movePos (movePosByString p0 x) '.'
+                i0 = Interval p0 p'
+                i1 = Interval p' p1
 
 
 {--------------------------------------------------------------------------
@@ -234,8 +238,8 @@ qualified tok =
 followedBy :: Char -> LexPredicate
 followedBy c' _ _ _ inp =
     case lexInput inp of
-	[]  -> False
-	c:_ -> c == c'
+        []  -> False
+        c:_ -> c == c'
 
 -- | True if we are at the end of the file.
 eof :: LexPredicate
diff --git a/src/full/Agda/Syntax/Parser/Lexer.x b/src/full/Agda/Syntax/Parser/Lexer.x
index 5618879..d861d35 100644
--- a/src/full/Agda/Syntax/Parser/Lexer.x
+++ b/src/full/Agda/Syntax/Parser/Lexer.x
@@ -1,7 +1,11 @@
 {
-{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -fno-warn-deprecated-flags   #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_GHC -fno-warn-tabs               #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports     #-}
+
 {-# LANGUAGE BangPatterns #-}
+
 {-| The lexer is generated by Alex (<http://www.haskell.org/alex>) and is an
     adaptation of GHC's lexer. The main lexing function 'lexer' is called by
     the "Agda.Syntax.Parser.Parser" to get the next token from the input.
@@ -31,21 +35,24 @@ import Agda.Syntax.Literal
 
 }
 
-$digit	     = 0-9
+-- Unicode is not handled by the following regular expressions.
+-- Instead, unicode characters are translated to 7-bit ASCII
+-- by Agda.Syntax.Parser.LexActions.foolAlex in a preprocessing pass.
+
+$digit       = 0-9
 $hexdigit    = [ $digit a-f A-F ]
-$alpha	     = [ A-Z a-z _ ]
-$op	     = [ \- \! \# \$ \% \& \* \+ \/ \< \= \> \^ \| \~ \? \` \[ \] \, \: ]
+$alpha       = [ A-Z a-z _ ]
+$op          = [ \- \! \# \$ \% \& \* \+ \/ \< \= \> \^ \| \~ \? \` \[ \] \, \: ]
 $idstart     = [ $digit $alpha $op ]
-$idchar	     = [ $idstart ' \\ ]
-$endcomment  = ~ [ $idchar ]
+$idchar      = [ $idstart ' \\ ]
 $nonalpha    = $idchar # $alpha
 $nonalphanum = $nonalpha # $digit
 $white_notab = $white # \t
 $white_nonl  = $white_notab # \n
 
- at number	     = $digit+ | "0x" $hexdigit+
+ at number      = $digit+ | "0x" $hexdigit+
 @exponent    = [eE] [\-\+]? @number
- at float	     = @number \. @number @exponent? | @number @exponent
+ at float       = @number \. @number @exponent? | @number @exponent
 
 -- A name can't start with \x (to allow \x -> x).
 -- Bug in alex: [ _ op ]+ doesn't seem to work!
@@ -60,7 +67,7 @@ tokens :-
 -- Lexing literate files
 <tex> $white_nonl* \\ "begin{code}" $white_nonl* $ { end_ }
 <tex> .+ / { keepComments } { withInterval TokTeX }
-<tex>	 .+		            ;
+<tex>    .+                         ;
 <tex>    \n                         ;
 <tex> () / { eof } { end_ }
 <bol_,layout_>
@@ -74,9 +81,9 @@ tokens :-
 <pragma_> $white_notab ;
 
 -- Pragmas
-<0,code>    "{-#"		   { begin pragma }
-<pragma_>   "{-#"		   { symbol SymOpenPragma }
-<pragma_>   "#-}"		   { endWith $ symbol SymClosePragma }
+<0,code>    "{-#"                  { begin pragma }
+<pragma_>   "{-#"                  { symbol SymOpenPragma }
+<pragma_>   "#-}"                  { endWith $ symbol SymClosePragma }
 <pragma_>   "OPTIONS"              { keyword KwOPTIONS }
 <pragma_>   "BUILTIN"              { keyword KwBUILTIN }
 <pragma_>   "REWRITE"              { keyword KwREWRITE }
@@ -92,6 +99,7 @@ tokens :-
 <pragma_>   "ETA"                  { keyword KwETA }
 <pragma_>   "NO_TERMINATION_CHECK" { keyword KwNO_TERMINATION_CHECK }
 <pragma_>   "NON_TERMINATING"      { keyword KwNON_TERMINATING }
+<pragma_>   "TERMINATING"          { keyword KwTERMINATING }
 <pragma_>   "MEASURE"              { keyword KwMEASURE }
 <pragma_>   "LINE"                 { keyword KwLINE }
 <pragma_>   . # [ $white ] +       { withInterval $ TokString }
@@ -115,110 +123,110 @@ tokens :-
 -- We need to check the offside rule for the first token on each line.  We
 -- should not check the offside rule for the end of file token or an
 -- '\end{code}'
-<0,code,imp_dir_> \n	{ begin bol_ }
+<0,code,imp_dir_> \n    { begin bol_ }
 <bol_>
     {
-	\n		    ;
---	^ \\ "end{code}"    { end }
-	() / { not' eof }	{ offsideRule }
+        \n                  ;
+--      ^ \\ "end{code}"    { end }
+        () / { not' eof }       { offsideRule }
     }
 
 -- After a layout keyword there is either an open brace (no layout) or the
 -- indentation of the first token decides the column of the layout block.
 <layout_>
-    {	\n	;
---	\{	{ endWith openBrace }
-	()	{ endWith newLayoutContext }
+    {   \n      ;
+--      \{      { endWith openBrace }
+        ()      { endWith newLayoutContext }
     }
 
 -- The only rule for the empty_layout state. Generates a close brace.
-<empty_layout_> ()		{ emptyLayout }
+<empty_layout_> ()              { emptyLayout }
 
 -- Keywords
-<0,code> let		{ keyword KwLet }
-<0,code> in		{ keyword KwIn }
-<0,code> where		{ keyword KwWhere }
-<0,code> field		{ keyword KwField }
+<0,code> let            { keyword KwLet }
+<0,code> in             { keyword KwIn }
+<0,code> where          { keyword KwWhere }
+<0,code> field          { keyword KwField }
 <0,code> with           { keyword KwWith }
 <0,code> rewrite        { keyword KwRewrite }
-<0,code> postulate	{ keyword KwPostulate }
-<0,code> primitive	{ keyword KwPrimitive }
-<0,code> open		{ keyword KwOpen }
-<0,code> import		{ keyword KwImport }
-<0,code> module		{ keyword KwModule }
-<0,code> data		{ keyword KwData }
-<0,code> codata		{ keyword KwCoData }
-<0,code> record		{ keyword KwRecord }
+<0,code> postulate      { keyword KwPostulate }
+<0,code> primitive      { keyword KwPrimitive }
+<0,code> open           { keyword KwOpen }
+<0,code> import         { keyword KwImport }
+<0,code> module         { keyword KwModule }
+<0,code> data           { keyword KwData }
+<0,code> codata         { keyword KwCoData }
+<0,code> record         { keyword KwRecord }
 <0,code> constructor    { keyword KwConstructor }
 <0,code> inductive      { keyword KwInductive }
 <0,code> coinductive    { keyword KwCoInductive }
-<0,code> infix		{ keyword KwInfix }
-<0,code> infixl		{ keyword KwInfixL }
-<0,code> infixr		{ keyword KwInfixR }
-<0,code> mutual		{ keyword KwMutual }
-<0,code> abstract	{ keyword KwAbstract }
-<0,code> private	{ keyword KwPrivate }
-<0,code> instance	{ keyword KwInstance }
-<0,code> Set		{ keyword KwSet }
-<0,code> Prop		{ keyword KwProp }
-<0,code> forall		{ keyword KwForall }
-<0,code> Set @number	{ withInterval' (read . drop 3) TokSetN }
-<0,code> quoteGoal	{ keyword KwQuoteGoal }
-<0,code> quoteContext	{ keyword KwQuoteContext }
-<0,code> quote		{ keyword KwQuote }
-<0,code> quoteTerm	{ keyword KwQuoteTerm }
-<0,code> unquote	{ keyword KwUnquote }
-<0,code> unquoteDecl	{ keyword KwUnquoteDecl }
-<0,code> tactic 	{ keyword KwTactic }
-<0,code> syntax		{ keyword KwSyntax }
-<0,code> pattern	{ keyword KwPatternSyn }
+<0,code> infix          { keyword KwInfix }
+<0,code> infixl         { keyword KwInfixL }
+<0,code> infixr         { keyword KwInfixR }
+<0,code> mutual         { keyword KwMutual }
+<0,code> abstract       { keyword KwAbstract }
+<0,code> private        { keyword KwPrivate }
+<0,code> instance       { keyword KwInstance }
+<0,code> Set            { keyword KwSet }
+<0,code> Prop           { keyword KwProp }
+<0,code> forall         { keyword KwForall }
+<0,code> Set @number    { withInterval' (read . drop 3) TokSetN }
+<0,code> quoteGoal      { keyword KwQuoteGoal }
+<0,code> quoteContext   { keyword KwQuoteContext }
+<0,code> quote          { keyword KwQuote }
+<0,code> quoteTerm      { keyword KwQuoteTerm }
+<0,code> unquote        { keyword KwUnquote }
+<0,code> unquoteDecl    { keyword KwUnquoteDecl }
+<0,code> tactic         { keyword KwTactic }
+<0,code> syntax         { keyword KwSyntax }
+<0,code> pattern        { keyword KwPatternSyn }
 
 -- The parser is responsible to put the lexer in the imp_dir_ state when it
 -- expects an import directive keyword. This means that if you run the
 -- tokensParser you will never see these keywords.
-<0,code> using	    { keyword KwUsing }
-<0,code> hiding	    { keyword KwHiding }
+<0,code> using      { keyword KwUsing }
+<0,code> hiding     { keyword KwHiding }
 <0,code> renaming   { keyword KwRenaming }
-<imp_dir_> to	    { endWith $ keyword KwTo }
-<0,code> public	    { keyword KwPublic }
+<imp_dir_> to       { endWith $ keyword KwTo }
+<0,code> public     { keyword KwPublic }
 
 -- Holes
-<0,code> "{!"		{ hole }
+<0,code> "{!"           { hole }
 
 -- Special symbols
-<0,code> "..."		{ symbol SymEllipsis }
-<0,code> ".."		{ symbol SymDotDot }
-<0,code> "."		{ symbol SymDot }
-<0,code> ";"		{ symbol SymSemi }
-<0,code> ":"		{ symbol SymColon }
-<0,code> "="		{ symbol SymEqual }
-<0,code> "_"		{ symbol SymUnderscore }
-<0,code> "?"		{ symbol SymQuestionMark }
-<0,code> "|"		{ symbol SymBar }
-<0,code> "("		{ symbol SymOpenParen }
-<0,code> ")"		{ symbol SymCloseParen }
-<0,code> "->"		{ symbol SymArrow }
-<0,code> "\"		{ symbol SymLambda } -- "
-<0,code> "@"		{ symbol SymAs }
-<0,code> "{{" /[^!]		{ symbol SymDoubleOpenBrace }
+<0,code> "..."          { symbol SymEllipsis }
+<0,code> ".."           { symbol SymDotDot }
+<0,code> "."            { symbol SymDot }
+<0,code> ";"            { symbol SymSemi }
+<0,code> ":"            { symbol SymColon }
+<0,code> "="            { symbol SymEqual }
+<0,code> "_"            { symbol SymUnderscore }
+<0,code> "?"            { symbol SymQuestionMark }
+<0,code> "|"            { symbol SymBar }
+<0,code> "("            { symbol SymOpenParen }
+<0,code> ")"            { symbol SymCloseParen }
+<0,code> "->"           { symbol SymArrow }
+<0,code> "\"            { symbol SymLambda } -- "
+<0,code> "@"            { symbol SymAs }
+<0,code> "{{" /[^!]             { symbol SymDoubleOpenBrace }
 -- We don't lex '}}' into a SymDoubleCloseBrace. Instead, we lex it as
 -- two SymCloseBrace's. When the parser is looking for a double
 -- closing brace, it will also accept two SymCloseBrace's, after
 -- verifying that they are immediately next to each other.
 -- This trick allows us to keep "record { a = record {}}" working
 -- properly.
--- <0,code> "}}"		{ symbol SymDoubleCloseBrace }
-<0,code> "{"		{ symbol SymOpenBrace }	    -- you can't use braces for layout
-<0,code> "}"		{ symbol SymCloseBrace }
+-- <0,code> "}}"                { symbol SymDoubleCloseBrace }
+<0,code> "{"            { symbol SymOpenBrace }     -- you can't use braces for layout
+<0,code> "}"            { symbol SymCloseBrace }
 
 -- Literals
-<0,code> \'		{ litChar }
-<0,code> \"		{ litString }
-<0,code> @number	{ literal LitInt }
-<0,code> @float		{ literal LitFloat }
+<0,code> \'             { litChar }
+<0,code> \"             { litString }
+<0,code> @number        { literal LitInt }
+<0,code> @float         { literal LitFloat }
 
 -- Identifiers
-<0,code,imp_dir_> @q_ident	{ identifier }
+<0,code,imp_dir_> @q_ident      { identifier }
 -- Andreas, 2013-02-21, added identifiers to the 'imp_dir_' state.
 -- This is to fix issue 782: 'toz' should not be lexed as 'to'
 -- (followed by 'z' after leaving imp_dir_).
diff --git a/src/full/Agda/Syntax/Parser/LookAhead.hs b/src/full/Agda/Syntax/Parser/LookAhead.hs
index 3cb543d..c683627 100644
--- a/src/full/Agda/Syntax/Parser/LookAhead.hs
+++ b/src/full/Agda/Syntax/Parser/LookAhead.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Rank2Types                 #-}
 
 {-| When lexing by hands (for instance string literals) we need to do some
     looking ahead. The 'LookAhead' monad keeps track of the position we are
@@ -34,8 +35,8 @@ import Agda.Syntax.Parser.Monad
 -}
 newtype LookAhead a =
     LookAhead { unLookAhead :: ReaderT ErrorFunction
-				       (StateT AlexInput Parser) a
-	      }
+                                       (StateT AlexInput Parser) a
+              }
     deriving (Functor, Applicative)
 
 newtype ErrorFunction =
@@ -49,8 +50,8 @@ instance Monad LookAhead where
     return  = LookAhead . return
     m >>= k = LookAhead $ unLookAhead m >>= unLookAhead . k
     fail s  =
-	do  err <- LookAhead ask
-	    throwError err s
+        do  err <- LookAhead ask
+            throwError err s
 
 {--------------------------------------------------------------------------
     Operations
@@ -74,34 +75,34 @@ liftP = LookAhead . lift . lift
 -- | Look at the next character. Fails if there are no more characters.
 nextChar :: LookAhead Char
 nextChar =
-    do	inp <- getInput
-	case alexGetChar inp of
-	    Nothing	    -> fail "unexpected end of file"
-	    Just (c,inp')   ->
-		do  setInput inp'
-		    return c
+    do  inp <- getInput
+        case alexGetChar inp of
+            Nothing         -> fail "unexpected end of file"
+            Just (c,inp')   ->
+                do  setInput inp'
+                    return c
 
 
 -- | Consume all the characters up to the current look-ahead position.
 sync :: LookAhead ()
 sync =
-    do	inp <- getInput
-	liftP $ setLexInput inp
+    do  inp <- getInput
+        liftP $ setLexInput inp
 
 
 -- | Undo look-ahead. Restores the input from the 'ParseState'.
 rollback :: LookAhead ()
 rollback =
-    do	inp <- liftP getLexInput
-	setInput inp
+    do  inp <- liftP getLexInput
+        setInput inp
 
 
 -- | Consume the next character. Does 'nextChar' followed by 'sync'.
 eatNextChar :: LookAhead Char
 eatNextChar =
-    do	c <- nextChar
-	sync
-	return c
+    do  c <- nextChar
+        sync
+        return c
 
 
 {-| Do a case on the current input string. If any of the given strings match we
@@ -111,8 +112,8 @@ eatNextChar =
 -}
 match :: [(String, LookAhead a)] -> LookAhead a -> LookAhead a
 match xs def =
-    do	c <- nextChar
-	match' c xs def
+    do  c <- nextChar
+        match' c xs def
 
 {-| Same as 'match' but takes the initial character from the first argument
     instead of reading it from the input.  Consequently, in the default case
@@ -120,19 +121,19 @@ match xs def =
 -}
 match' :: Char -> [(String, LookAhead a)] -> LookAhead a -> LookAhead a
 match' c xs def =
-    do	inp <- getInput
-	match'' inp xs c
+    do  inp <- getInput
+        match'' inp xs c
     where
-	match'' inp bs c =
-	    case bs' of
-		[]	    -> setInput inp >> def
-		[("",p)]    -> p
-		_	    -> match'' inp bs' =<< nextChar
-	    where
-		bs' = [ (s, p) | (c':s, p) <- bs, c == c' ]
+        match'' inp bs c =
+            case bs' of
+                []          -> setInput inp >> def
+                [("",p)]    -> p
+                _           -> match'' inp bs' =<< nextChar
+            where
+                bs' = [ (s, p) | (c':s, p) <- bs, c == c' ]
 
 -- | Run a 'LookAhead' computation. The first argument is the error function.
 runLookAhead :: (forall b. String -> LookAhead b) -> LookAhead a -> Parser a
 runLookAhead err (LookAhead m) =
-    do	inp <- getLexInput
-	evalStateT (runReaderT m (ErrorFun err)) inp
+    do  inp <- getLexInput
+        evalStateT (runReaderT m (ErrorFun err)) inp
diff --git a/src/full/Agda/Syntax/Parser/Monad.hs b/src/full/Agda/Syntax/Parser/Monad.hs
index ab0a34a..c5cb2d6 100644
--- a/src/full/Agda/Syntax/Parser/Monad.hs
+++ b/src/full/Agda/Syntax/Parser/Monad.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 module Agda.Syntax.Parser.Monad
     ( -- * The parser monad
       Parser
@@ -33,11 +35,12 @@ import Data.Int
 import Data.Typeable
 
 import Control.Monad.State
-import Control.Monad.Error
 import Control.Applicative
 
 import Agda.Syntax.Position
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
+
 import Agda.Utils.FileName
 import qualified Agda.Utils.IO.UTF8 as UTF8
 
@@ -53,15 +56,15 @@ newtype Parser a = P { unP :: ParseState -> ParseResult a }
 -- | The parser state. Contains everything the parser and the lexer could ever
 --   need.
 data ParseState = PState
-    { parsePos	    :: !Position	-- ^ position at current input location
-    , parseLastPos  :: !Position	-- ^ position of last token
-    , parseInp	    :: String		-- ^ the current input
-    , parsePrevChar :: !Char		-- ^ the character before the input
-    , parsePrevToken:: String		-- ^ the previous token
-    , parseLayout   :: [LayoutContext]	-- ^ the stack of layout contexts
-    , parseLexState :: [LexState]	-- ^ the state of the lexer
-					--   (states can be nested so we need a stack)
-    , parseFlags    :: ParseFlags	-- ^ currently there are no flags
+    { parsePos      :: !Position        -- ^ position at current input location
+    , parseLastPos  :: !Position        -- ^ position of last token
+    , parseInp      :: String           -- ^ the current input
+    , parsePrevChar :: !Char            -- ^ the character before the input
+    , parsePrevToken:: String           -- ^ the previous token
+    , parseLayout   :: [LayoutContext]  -- ^ the stack of layout contexts
+    , parseLexState :: [LexState]       -- ^ the state of the lexer
+                                        --   (states can be nested so we need a stack)
+    , parseFlags    :: ParseFlags       -- ^ currently there are no flags
     }
     deriving Show
 
@@ -74,48 +77,48 @@ type LexState = Int
 -- | We need to keep track of the context to do layout. The context
 --   specifies the indentation (if any) of a layout block. See
 --   "Agda.Syntax.Parser.Layout" for more informaton.
-data LayoutContext  = NoLayout	      -- ^ no layout
-		    | Layout Int32    -- ^ layout at specified column
+data LayoutContext  = NoLayout        -- ^ no layout
+                    | Layout Int32    -- ^ layout at specified column
     deriving Show
 
 -- | There aren't any parser flags at the moment.
-data ParseFlags	= ParseFlags
+data ParseFlags = ParseFlags
   { parseKeepComments :: Bool
     -- ^ Should comment tokens be returned by the lexer?
   }
   deriving Show
 
 -- | What you get if parsing fails.
-data ParseError	= ParseError
-		    { errPos	    :: Position	-- ^ where the error occured
-		    , errInput	    :: String	-- ^ the remaining input
-		    , errPrevToken  :: String	-- ^ the previous token
-		    , errMsg	    :: String	-- ^ hopefully an explanation
-						--   of what happened
-		    }
+data ParseError = ParseError
+                    { errPos        :: Position -- ^ where the error occured
+                    , errInput      :: String   -- ^ the remaining input
+                    , errPrevToken  :: String   -- ^ the previous token
+                    , errMsg        :: String   -- ^ hopefully an explanation
+                                                --   of what happened
+                    }
     deriving (Typeable)
 
 instance Exception ParseError
 
 -- | The result of parsing something.
 data ParseResult a  = ParseOk ParseState a
-		    | ParseFailed ParseError
+                    | ParseFailed ParseError
 
 {--------------------------------------------------------------------------
     Instances
  --------------------------------------------------------------------------}
 
 instance Monad Parser where
-    return x	= P $ \s -> ParseOk s x
-    P m >>= f	= P $ \s -> case m s of
-				ParseFailed e	-> ParseFailed e
-				ParseOk s' x	-> unP (f x) s'
-    fail msg	= P $ \s -> ParseFailed $
-				ParseError  { errPos	    = parseLastPos s
-					    , errInput	    = parseInp s
-					    , errPrevToken  = parsePrevToken s
-					    , errMsg	    = msg
-					    }
+    return x    = P $ \s -> ParseOk s x
+    P m >>= f   = P $ \s -> case m s of
+                                ParseFailed e   -> ParseFailed e
+                                ParseOk s' x    -> unP (f x) s'
+    fail msg    = P $ \s -> ParseFailed $
+                                ParseError  { errPos        = parseLastPos s
+                                            , errInput      = parseInp s
+                                            , errPrevToken  = parsePrevToken s
+                                            , errMsg        = msg
+                                            }
 
 instance Functor Parser where
     fmap = liftM
@@ -125,33 +128,33 @@ instance Applicative Parser where
     (<*>) = ap
 
 instance MonadError ParseError Parser where
-    throwError e	= P $ \_ -> ParseFailed e
-    P m `catchError` h	= P $ \s -> case m s of
-					ParseFailed err	-> unP (h err) s
-					m'		-> m'
+    throwError e        = P $ \_ -> ParseFailed e
+    P m `catchError` h  = P $ \s -> case m s of
+                                        ParseFailed err -> unP (h err) s
+                                        m'              -> m'
 
 instance MonadState ParseState Parser where
-    get	    = P $ \s -> ParseOk s s
+    get     = P $ \s -> ParseOk s s
     put s   = P $ \_ -> ParseOk s ()
 
 instance Show ParseError where
     show err =
-	unlines
-	    [ pos ++ ": " ++ errMsg err
-	    --, replicate (length pos + 2) ' ' ++ "on '" ++ errPrevToken err ++ "'"
+        unlines
+            [ pos ++ ": " ++ errMsg err
+            --, replicate (length pos + 2) ' ' ++ "on '" ++ errPrevToken err ++ "'"
             , errPrevToken err ++ "<ERROR>\n" ++ take 30 (errInput err) ++ "..."
-	    ]
-	where
-	    pos = show (errPos err)
+            ]
+        where
+            pos = show (errPos err)
 
--- 	    showInp ""  = "at end of file"
--- 	    showInp t   = "on input " ++ elide 5 t
+--          showInp ""  = "at end of file"
+--          showInp t   = "on input " ++ elide 5 t
 --
--- 	    elide 3 s
--- 		| length (take 4 s) < 4 = s
--- 		| otherwise		    = "..."
--- 	    elide n (c:s)		    = c : elide (n - 1) s
--- 	    elide _ ""		    = ""
+--          elide 3 s
+--              | length (take 4 s) < 4 = s
+--              | otherwise                 = "..."
+--          elide n (c:s)                   = c : elide (n - 1) s
+--          elide _ ""              = ""
 
 instance HasRange ParseError where
     getRange err = posToRange (errPos err) (errPos err)
@@ -162,15 +165,15 @@ instance HasRange ParseError where
 
 initStatePos :: Position -> ParseFlags -> String -> [LexState] -> ParseState
 initStatePos pos flags inp st =
-	PState  { parsePos	    = pos
-		, parseLastPos	    = pos
-		, parseInp	    = inp
-		, parsePrevChar	    = '\n'
-		, parsePrevToken    = ""
-		, parseLexState	    = st
-		, parseLayout	    = [NoLayout]
-		, parseFlags	    = flags
-		}
+        PState  { parsePos          = pos
+                , parseLastPos      = pos
+                , parseInp          = inp
+                , parsePrevChar     = '\n'
+                , parsePrevToken    = ""
+                , parseLexState     = st
+                , parseLayout       = [NoLayout]
+                , parseFlags        = flags
+                }
 
 -- | Constructs the initial state of the parser. The string argument
 --   is the input string, the file path is only there because it's part
@@ -203,8 +206,8 @@ parsePosString pos flags st p input = unP p (initStatePos pos flags input st)
 parseFile :: ParseFlags -> [LexState] -> Parser a -> AbsolutePath
           -> IO (ParseResult a)
 parseFile flags st p file =
-    do	input <- liftIO $ UTF8.readTextFile $ filePath file
-	return $ unP p (initState (Just file) flags input st)
+    do  input <- liftIO $ UTF8.readTextFile $ filePath file
+        return $ unP p (initState (Just file) flags input st)
 
 {--------------------------------------------------------------------------
     Manipulating the state
@@ -225,24 +228,24 @@ getLastPos = get >>= return . parseLastPos
 -- | The parse interval is between the last position and the current position.
 getParseInterval :: Parser Interval
 getParseInterval =
-    do	s <- get
-	return $ Interval (parseLastPos s) (parsePos s)
+    do  s <- get
+        return $ Interval (parseLastPos s) (parsePos s)
 
 getLexState :: Parser [LexState]
 getLexState = parseLexState <$> get
 
 setLexState :: [LexState] -> Parser ()
 setLexState ls =
-    do	s <- get
-	put $ s { parseLexState = ls }
+    do  s <- get
+        put $ s { parseLexState = ls }
 
 pushLexState :: LexState -> Parser ()
 pushLexState l = do s <- getLexState
-		    setLexState (l:s)
+                    setLexState (l:s)
 
 popLexState :: Parser ()
 popLexState = do _:ls <- getLexState
-		 setLexState ls
+                 setLexState ls
 
 getParseFlags :: Parser ParseFlags
 getParseFlags = parseFlags <$> get
@@ -259,8 +262,8 @@ parseError = fail
 --   comment.
 parseErrorAt :: Position -> String -> Parser a
 parseErrorAt p msg =
-    do	setLastPos p
-	parseError msg
+    do  setLastPos p
+        parseError msg
 
 -- | Use 'parseErrorAt' or 'parseError' as appropriate.
 parseError' :: Maybe Position -> String -> Parser a
@@ -273,8 +276,8 @@ parseError' = maybe parseError parseErrorAt
 --   lexed). This function does 'parseErrorAt' the current position.
 lexError :: String -> Parser a
 lexError msg =
-    do	p <- parsePos <$> get
-	parseErrorAt p msg
+    do  p <- parsePos <$> get
+        parseErrorAt p msg
 
 {--------------------------------------------------------------------------
     Layout
@@ -285,33 +288,33 @@ getContext = parseLayout <$> get
 
 setContext :: [LayoutContext] -> Parser ()
 setContext ctx =
-    do	s <- get
-	put $ s { parseLayout = ctx }
+    do  s <- get
+        put $ s { parseLayout = ctx }
 
 -- | Return the current layout context.
 topContext :: Parser LayoutContext
 topContext =
-    do	ctx <- getContext
-	case ctx of
-	    []  -> parseError "No layout context in scope"
-	    l:_ -> return l
+    do  ctx <- getContext
+        case ctx of
+            []  -> parseError "No layout context in scope"
+            l:_ -> return l
 
 popContext :: Parser ()
 popContext =
-    do	ctx <- getContext
-	case ctx of
-	    []	    -> parseError "There is no layout block to close at this point."
-	    _:ctx   -> setContext ctx
+    do  ctx <- getContext
+        case ctx of
+            []      -> parseError "There is no layout block to close at this point."
+            _:ctx   -> setContext ctx
 
 pushContext :: LayoutContext -> Parser ()
 pushContext l =
-    do	ctx <- getContext
-	setContext (l : ctx)
+    do  ctx <- getContext
+        setContext (l : ctx)
 
 -- | Should only be used at the beginning of a file. When we start parsing
 --   we should be in layout mode. Instead of forcing zero indentation we use
 --   the indentation of the first token.
 pushCurrentContext :: Parser ()
 pushCurrentContext =
-    do	p <- getLastPos
-	pushContext (Layout (posCol p))
+    do  p <- getLastPos
+        pushContext (Layout (posCol p))
diff --git a/src/full/Agda/Syntax/Parser/Parser.y b/src/full/Agda/Syntax/Parser/Parser.y
index 9abe09b..0181719 100644
--- a/src/full/Agda/Syntax/Parser/Parser.y
+++ b/src/full/Agda/Syntax/Parser/Parser.y
@@ -108,6 +108,7 @@ import Agda.Utils.Tuple
     'ETA'           { TokKeyword KwETA $$ }
     'NO_TERMINATION_CHECK' { TokKeyword KwNO_TERMINATION_CHECK $$ }
     'NON_TERMINATING' { TokKeyword KwNON_TERMINATING $$ }
+    'TERMINATING'   { TokKeyword KwTERMINATING $$ }
     'MEASURE'       { TokKeyword KwMEASURE $$ }
     'COMPILED'      { TokKeyword KwCOMPILED $$ }
     'COMPILED_EXPORT'      { TokKeyword KwCOMPILED_EXPORT $$ }
@@ -124,40 +125,40 @@ import Agda.Utils.Tuple
     'unquote'       { TokKeyword KwUnquote $$ }
     'unquoteDecl'   { TokKeyword KwUnquoteDecl $$ }
 
-    setN	{ TokSetN $$ }
-    tex		{ TokTeX $$ }
-    comment	{ TokComment $$ }
-
-    '...'	{ TokSymbol SymEllipsis $$ }
-    '..'	{ TokSymbol SymDotDot $$ }
-    '.'		{ TokSymbol SymDot $$ }
-    ';'		{ TokSymbol SymSemi $$ }
-    ':'		{ TokSymbol SymColon $$ }
-    '='		{ TokSymbol SymEqual $$ }
-    '_'		{ TokSymbol SymUnderscore $$ }
-    '?'		{ TokSymbol SymQuestionMark $$ }
-    '->'	{ TokSymbol SymArrow $$ }
-    '\\'	{ TokSymbol SymLambda $$ }
-    '@'		{ TokSymbol SymAs $$ }
-    '|'		{ TokSymbol SymBar $$ }
-    '('		{ TokSymbol SymOpenParen $$ }
-    ')'		{ TokSymbol SymCloseParen $$ }
-    '{{'	{ TokSymbol SymDoubleOpenBrace $$ }
-    '}}'	{ TokSymbol SymDoubleCloseBrace $$ }
-    '{'		{ TokSymbol SymOpenBrace $$ }
-    '}'		{ TokSymbol SymCloseBrace $$ }
---    ':{'	{ TokSymbol SymColonBrace $$ }
-    vopen	{ TokSymbol SymOpenVirtualBrace $$ }
-    vclose	{ TokSymbol SymCloseVirtualBrace $$ }
-    vsemi	{ TokSymbol SymVirtualSemi $$ }
-    '{-#'	{ TokSymbol SymOpenPragma $$ }
-    '#-}'	{ TokSymbol SymClosePragma $$ }
-
-    id		{ TokId $$ }
-    q_id	{ TokQId $$ }
-
-    string	{ TokString $$ }
-    literal	{ TokLiteral $$ }
+    setN        { TokSetN $$ }
+    tex         { TokTeX $$ }
+    comment     { TokComment $$ }
+
+    '...'       { TokSymbol SymEllipsis $$ }
+    '..'        { TokSymbol SymDotDot $$ }
+    '.'         { TokSymbol SymDot $$ }
+    ';'         { TokSymbol SymSemi $$ }
+    ':'         { TokSymbol SymColon $$ }
+    '='         { TokSymbol SymEqual $$ }
+    '_'         { TokSymbol SymUnderscore $$ }
+    '?'         { TokSymbol SymQuestionMark $$ }
+    '->'        { TokSymbol SymArrow $$ }
+    '\\'        { TokSymbol SymLambda $$ }
+    '@'         { TokSymbol SymAs $$ }
+    '|'         { TokSymbol SymBar $$ }
+    '('         { TokSymbol SymOpenParen $$ }
+    ')'         { TokSymbol SymCloseParen $$ }
+    '{{'        { TokSymbol SymDoubleOpenBrace $$ }
+    '}}'        { TokSymbol SymDoubleCloseBrace $$ }
+    '{'         { TokSymbol SymOpenBrace $$ }
+    '}'         { TokSymbol SymCloseBrace $$ }
+--    ':{'      { TokSymbol SymColonBrace $$ }
+    vopen       { TokSymbol SymOpenVirtualBrace $$ }
+    vclose      { TokSymbol SymCloseVirtualBrace $$ }
+    vsemi       { TokSymbol SymVirtualSemi $$ }
+    '{-#'       { TokSymbol SymOpenPragma $$ }
+    '#-}'       { TokSymbol SymClosePragma $$ }
+
+    id          { TokId $$ }
+    q_id        { TokQId $$ }
+
+    string      { TokString $$ }
+    literal     { TokLiteral $$ }
 
 %%
 
@@ -167,52 +168,52 @@ import Agda.Utils.Tuple
 
 -- Parse a list of tokens.
 Tokens :: { [Token] }
-Tokens : TokensR	{ reverse $1 }
+Tokens : TokensR        { reverse $1 }
 
 -- Happy is much better at parsing left recursive grammars (constant
 -- stack size vs. linear stack size for right recursive).
 TokensR :: { [Token] }
-TokensR	: TokensR Token	{ $2 : $1 }
-	|		{ [] }
+TokensR : TokensR Token { $2 : $1 }
+        |               { [] }
 
 -- Parse single token.
 Token :: { Token }
 Token
-    : 'let'	    { TokKeyword KwLet $1 }
-    | 'in'	    { TokKeyword KwIn $1 }
-    | 'where'	    { TokKeyword KwWhere $1 }
-    | 'with'	    { TokKeyword KwWith $1 }
-    | 'rewrite'	    { TokKeyword KwRewrite $1 }
+    : 'let'         { TokKeyword KwLet $1 }
+    | 'in'          { TokKeyword KwIn $1 }
+    | 'where'       { TokKeyword KwWhere $1 }
+    | 'with'        { TokKeyword KwWith $1 }
+    | 'rewrite'     { TokKeyword KwRewrite $1 }
     | 'postulate'   { TokKeyword KwPostulate $1 }
     | 'primitive'   { TokKeyword KwPrimitive $1 }
-    | 'open'	    { TokKeyword KwOpen $1 }
-    | 'import'	    { TokKeyword KwImport $1 }
-    | 'using'	    { TokKeyword KwUsing $1 }
-    | 'hiding'	    { TokKeyword KwHiding $1 }
+    | 'open'        { TokKeyword KwOpen $1 }
+    | 'import'      { TokKeyword KwImport $1 }
+    | 'using'       { TokKeyword KwUsing $1 }
+    | 'hiding'      { TokKeyword KwHiding $1 }
     | 'renaming'    { TokKeyword KwRenaming $1 }
-    | 'to'	    { TokKeyword KwTo $1 }
-    | 'public'	    { TokKeyword KwPublic $1 }
-    | 'module'	    { TokKeyword KwModule $1 }
-    | 'data'	    { TokKeyword KwData $1 }
-    | 'codata'	    { TokKeyword KwCoData $1 }
-    | 'record'	    { TokKeyword KwRecord $1 }
+    | 'to'          { TokKeyword KwTo $1 }
+    | 'public'      { TokKeyword KwPublic $1 }
+    | 'module'      { TokKeyword KwModule $1 }
+    | 'data'        { TokKeyword KwData $1 }
+    | 'codata'      { TokKeyword KwCoData $1 }
+    | 'record'      { TokKeyword KwRecord $1 }
     | 'constructor' { TokKeyword KwConstructor $1 }
     | 'inductive'   { TokKeyword KwInductive $1 }
     | 'coinductive' { TokKeyword KwCoInductive $1 }
     | 'field'       { TokKeyword KwField $1 }
-    | 'infix'	    { TokKeyword KwInfix $1 }
-    | 'infixl'	    { TokKeyword KwInfixL $1 }
-    | 'infixr'	    { TokKeyword KwInfixR $1 }
-    | 'mutual'	    { TokKeyword KwMutual $1 }
+    | 'infix'       { TokKeyword KwInfix $1 }
+    | 'infixl'      { TokKeyword KwInfixL $1 }
+    | 'infixr'      { TokKeyword KwInfixR $1 }
+    | 'mutual'      { TokKeyword KwMutual $1 }
     | 'abstract'    { TokKeyword KwAbstract $1 }
-    | 'private'	    { TokKeyword KwPrivate $1 }
-    | 'instance'	{ TokKeyword KwInstance $1 }
-    | 'Prop'	    { TokKeyword KwProp $1 }
-    | 'Set'	    { TokKeyword KwSet $1 }
-    | 'forall'	    { TokKeyword KwForall $1 }
+    | 'private'     { TokKeyword KwPrivate $1 }
+    | 'instance'        { TokKeyword KwInstance $1 }
+    | 'Prop'        { TokKeyword KwProp $1 }
+    | 'Set'         { TokKeyword KwSet $1 }
+    | 'forall'      { TokKeyword KwForall $1 }
     | 'syntax'      { TokKeyword KwSyntax $1 }
     | 'pattern'     { TokKeyword KwPatternSyn $1 }
-    | 'OPTIONS'	    { TokKeyword KwOPTIONS $1 }
+    | 'OPTIONS'     { TokKeyword KwOPTIONS $1 }
     | 'BUILTIN'     { TokKeyword KwBUILTIN $1 }
     | 'REWRITE'     { TokKeyword KwREWRITE $1 }
     | 'IMPORT'      { TokKeyword KwIMPORT $1 }
@@ -227,6 +228,7 @@ Token
     | 'ETA'           { TokKeyword KwETA $1 }
     | 'NO_TERMINATION_CHECK' { TokKeyword KwNO_TERMINATION_CHECK $1 }
     | 'NON_TERMINATING' { TokKeyword KwNON_TERMINATING $1 }
+    | 'TERMINATING'   { TokKeyword KwTERMINATING $1 }
     | 'MEASURE'       { TokKeyword KwMEASURE $1 }
     | 'quoteGoal'     { TokKeyword KwQuoteGoal $1 }
     | 'quoteContext'     { TokKeyword KwQuoteContext $1 }
@@ -236,39 +238,39 @@ Token
     | 'unquote'       { TokKeyword KwUnquote $1 }
     | 'unquoteDecl'   { TokKeyword KwUnquoteDecl $1 }
 
-    | setN	    { TokSetN $1 }
-    | tex	    { TokTeX $1 }
-    | comment	    { TokComment $1 }
-
-    | '...'	    { TokSymbol SymEllipsis $1 }
-    | '..'	    { TokSymbol SymDotDot $1 }
-    | '.'	    { TokSymbol SymDot $1 }
-    | ';'	    { TokSymbol SymSemi $1 }
-    | ':'	    { TokSymbol SymColon $1 }
-    | '='	    { TokSymbol SymEqual $1 }
-    | '_'	    { TokSymbol SymUnderscore $1 }
-    | '?'	    { TokSymbol SymQuestionMark $1 }
-    | '->'	    { TokSymbol SymArrow $1 }
-    | '\\'	    { TokSymbol SymLambda $1 }
-    | '@'	    { TokSymbol SymAs $1 }
-    | '|'	    { TokSymbol SymBar $1 }
-    | '('	    { TokSymbol SymOpenParen $1 }
-    | ')'	    { TokSymbol SymCloseParen $1 }
-    | '{{'	    { TokSymbol SymDoubleOpenBrace $1 }
-    | '}}'	    { TokSymbol SymDoubleCloseBrace $1 }
-    | '{'	    { TokSymbol SymOpenBrace $1 }
-    | '}'	    { TokSymbol SymCloseBrace $1 }
-    | vopen	    { TokSymbol SymOpenVirtualBrace $1 }
-    | vclose	    { TokSymbol SymCloseVirtualBrace $1 }
-    | vsemi	    { TokSymbol SymVirtualSemi $1 }
-    | '{-#'	    { TokSymbol SymOpenPragma $1 }
-    | '#-}'	    { TokSymbol SymClosePragma $1 }
-
-    | id	    { TokId $1 }
-    | q_id	    { TokQId $1 }
-    | string	    { TokString $1 }
-
-    | literal	    { TokLiteral $1 }
+    | setN          { TokSetN $1 }
+    | tex           { TokTeX $1 }
+    | comment       { TokComment $1 }
+
+    | '...'         { TokSymbol SymEllipsis $1 }
+    | '..'          { TokSymbol SymDotDot $1 }
+    | '.'           { TokSymbol SymDot $1 }
+    | ';'           { TokSymbol SymSemi $1 }
+    | ':'           { TokSymbol SymColon $1 }
+    | '='           { TokSymbol SymEqual $1 }
+    | '_'           { TokSymbol SymUnderscore $1 }
+    | '?'           { TokSymbol SymQuestionMark $1 }
+    | '->'          { TokSymbol SymArrow $1 }
+    | '\\'          { TokSymbol SymLambda $1 }
+    | '@'           { TokSymbol SymAs $1 }
+    | '|'           { TokSymbol SymBar $1 }
+    | '('           { TokSymbol SymOpenParen $1 }
+    | ')'           { TokSymbol SymCloseParen $1 }
+    | '{{'          { TokSymbol SymDoubleOpenBrace $1 }
+    | '}}'          { TokSymbol SymDoubleCloseBrace $1 }
+    | '{'           { TokSymbol SymOpenBrace $1 }
+    | '}'           { TokSymbol SymCloseBrace $1 }
+    | vopen         { TokSymbol SymOpenVirtualBrace $1 }
+    | vclose        { TokSymbol SymCloseVirtualBrace $1 }
+    | vsemi         { TokSymbol SymVirtualSemi $1 }
+    | '{-#'         { TokSymbol SymOpenPragma $1 }
+    | '#-}'         { TokSymbol SymClosePragma $1 }
+
+    | id            { TokId $1 }
+    | q_id          { TokQId $1 }
+    | string        { TokString $1 }
+
+    | literal       { TokLiteral $1 }
 
 {--------------------------------------------------------------------------
     Top level
@@ -286,18 +288,18 @@ maybe_vclose : {- empty -} { () }
 
 -- The first token in a file decides the indentation of the top-level layout
 -- block. Or not. It will if we allow the top-level module to be omitted.
--- topen :	{- empty -}	{% pushCurrentContext }
+-- topen :      {- empty -}     {% pushCurrentContext }
 
 
 {-  A layout block might have to be closed by a parse error. Example:
-	let x = e in e'
+        let x = e in e'
     Here the 'let' starts a layout block which should end before the 'in'.  The
     problem is that the lexer doesn't know this, so there is no virtual close
     brace. However when the parser sees the 'in' there will be a parse error.
     This is our cue to close the layout block.
 -}
 close : vclose  { () }
-      | error	{% popContext }
+      | error   {% popContext }
 
 
 -- You can use concrete semi colons in a layout block started with a virtual
@@ -318,16 +320,16 @@ beginImpDir : {- empty -}   {% pushLexState imp_dir }
 
 -- An integer. Used in fixity declarations.
 Int :: { Integer }
-Int : literal	{% case $1 of {
-		     LitInt _ i	-> return i;
-		     _		-> fail $ "Expected integer"
-		   }
-		}
-   | id	{% case $1 of {
+Int : literal   {% case $1 of {
+                     LitInt _ i -> return i;
+                     _          -> fail $ "Expected integer"
+                   }
+                }
+   | id {% case $1 of {
              (_, s) -> case readM s of {
                          Right i  -> return i;
-		         Left (err :: String) -> fail $ "Expected integer"
-		       }
+                         Left (err :: String) -> fail $ "Expected integer"
+                       }
            }
         }
 
@@ -339,13 +341,13 @@ Int : literal	{% case $1 of {
 -- A name is really a sequence of parts, but the lexer just sees it as a
 -- string, so we have to do the translation here.
 Id :: { Name }
-Id : id	    {% mkName $1 }
+Id : id     {% mkName $1 }
 
 -- Space separated list of one or more identifiers.
 SpaceIds :: { [Name] }
 SpaceIds
     : Id SpaceIds { $1 : $2 }
-    | Id	  { [$1] }
+    | Id          { [$1] }
 
 -- When looking for a double closed brace, we accept either a single token '}}'
 -- (which is what the unicode character "RIGHT WHITE CURLY BRACKET" is
@@ -358,9 +360,9 @@ DoubleCloseBrace
   : '}}' { getRange $1 }
   | '}' '}' {%
       if posPos (fromJust (rEnd (getRange $2))) -
-	 posPos (fromJust (rStart (getRange $1))) > 2
+         posPos (fromJust (rStart (getRange $1))) > 2
       then parseErrorAt (fromJust (rStart (getRange $2)))
-	 "Expecting '}}', found separated '}'s."
+         "Expecting '}}', found separated '}'s."
       else return $ getRange ($1, $2)
     }
 
@@ -425,7 +427,7 @@ MaybeDottedBId
 SpaceBIds :: { [Name] }
 SpaceBIds
     : BId SpaceBIds { $1 : $2 }
-    | BId	    { [$1] }
+    | BId           { [$1] }
 
 {- DOES PRODUCE REDUCE/REDUCE CONFLICTS!
 -- Space-separated list of binding identifiers. Used in dependent
@@ -436,7 +438,7 @@ SpaceBIds
 CommaBIds :: { [Name] }
 CommaBIds
     : CommaBIds BId { $1 ++ [$2] }  -- SWITCHING DOES NOT HELP
-    | BId	    { [$1] }
+    | BId           { [$1] }
 -}
 
 -- Space-separated list of binding identifiers. Used in dependent
@@ -456,19 +458,19 @@ CommaBIds : CommaBIdAndAbsurds {
     }
 {-
     let getName (Ident (QName x)) = Just x
-	getName (Underscore r _)  = Just (Name r [Hole])
-	getName _		  = Nothing
+        getName (Underscore r _)  = Just (Name r [Hole])
+        getName _                 = Nothing
     in
     case partition isJust $ map getName $1 of
-	(good, []) -> return $ map fromJust good
-	_	   -> fail $ "expected sequence of bound identifiers"
+        (good, []) -> return $ map fromJust good
+        _          -> fail $ "expected sequence of bound identifiers"
 -}
 
 CommaBIdAndAbsurds :: { Either [Name] [Expr] }
 CommaBIdAndAbsurds : Application {%
     let getName (Ident (QName x)) = Just x
-	getName (Underscore r _)  = Just (Name r [Hole])
-	getName _		  = Nothing
+        getName (Underscore r _)  = Just (Name r [Hole])
+        getName _                 = Nothing
 
         containsAbsurd (Absurd _) = True
         containsAbsurd (HiddenArg _ (Named _ e)) = containsAbsurd e
@@ -479,15 +481,15 @@ CommaBIdAndAbsurds : Application {%
     in
     if isJust $ find containsAbsurd $1 then return $ Right $1 else
     case partition isJust $ map getName $1 of
-	(good, []) -> return $ Left $ map fromJust good
-	_	   -> fail $ "expected sequence of bound identifiers"
+        (good, []) -> return $ Left $ map fromJust good
+        _          -> fail $ "expected sequence of bound identifiers"
     }
 
 
 -- Space separated list of strings in a pragma.
 PragmaStrings :: { [String] }
 PragmaStrings
-    : {- empty -}	    { [] }
+    : {- empty -}           { [] }
     | string PragmaStrings  { snd $1 : $2 }
 
 PragmaString :: { String }
@@ -508,11 +510,11 @@ PragmaQName : string {% fmap QName (mkName $1) }
     expression category (lowest precedence). The reason they don't is that we
     want to parse things like
 
-	m >>= \x -> k x
+        m >>= \x -> k x
 
     This will leads to a conflict in the following case
 
-	m >>= \x -> k x >>= \y -> k' y
+        m >>= \x -> k x >>= \y -> k' y
 
     At the second '>>=' we can either shift or reduce. We solve this problem
     using Happy's precedence directives. The rule 'Expr -> Expr1' (which is the
@@ -534,28 +536,28 @@ Expr
 
 -- Level 1: Application
 Expr1  : WithExprs {% case $1 of
-		      { [e]    -> return e
-		      ; e : es -> return $ WithApp (fuseRange e es) e es
-		      ; []     -> fail "impossible: empty with expressions"
-		      }
-		   }
+                      { [e]    -> return e
+                      ; e : es -> return $ WithApp (fuseRange e es) e es
+                      ; []     -> fail "impossible: empty with expressions"
+                      }
+                   }
 
 WithExprs :: { [Expr] }
 WithExprs
   : Application3 '|' WithExprs { RawApp (getRange $1) $1 :  $3 }
-  | Application		       { [RawApp (getRange $1) $1] }
+  | Application                { [RawApp (getRange $1) $1] }
 
 Application :: { [Expr] }
 Application
-    : Expr2		{ [$1] }
+    : Expr2             { [$1] }
     | Expr3 Application { $1 : $2 }
 
 -- Level 2: Lambdas and lets
 Expr2
-    : '\\' LamBindings Expr	   { Lam (getRange ($1,$2,$3)) $2 $3 }
+    : '\\' LamBindings Expr        { Lam (getRange ($1,$2,$3)) $2 $3 }
     | ExtendedOrAbsurdLam          { $1 }
     | 'let' Declarations 'in' Expr { Let (getRange ($1,$2,$3,$4)) $2 $4 }
-    | Expr3			   { $1 }
+    | Expr3                        { $1 }
     | 'quoteGoal' Id 'in' Expr     { QuoteGoal (getRange ($1,$2,$3,$4)) $2 $4 }
     | 'quoteContext' Id 'in' Expr  { QuoteContext (getRange ($1,$2,$3,$4)) $2 $4 }
     | 'tactic' Application3               { Tactic (getRange ($1, $2)) (RawApp (getRange $2) $2) [] }
@@ -568,7 +570,7 @@ ExtendedOrAbsurdLam
                                        Left (bs, h) -> if null bs then return $ AbsurdLam r h else
                                                        return $ Lam r bs (AbsurdLam r h)
                                                          where r = fuseRange $1 bs
-    				       Right es -> do -- it is of the form @\ { p1 ... () }@
+                                       Right es -> do -- it is of the form @\ { p1 ... () }@
                                                      p <- exprToLHS (RawApp (getRange es) es);
                                                      return $ ExtendedLam (fuseRange $1 es)
                                                                      [(p [] [], AbsurdRHS, NoWhere)]
@@ -576,52 +578,52 @@ ExtendedOrAbsurdLam
 
 Application3 :: { [Expr] }
 Application3
-    : Expr3		 { [$1] }
+    : Expr3              { [$1] }
     | Expr3 Application3 { $1 : $2 }
 
 -- Level 3: Atoms
 Expr3Curly
-    : '{' Expr '}'			{ HiddenArg (getRange ($1,$2,$3)) (maybeNamed $2) }
-    | '{' '}'				{ let r = fuseRange $1 $2 in HiddenArg r $ unnamed $ Absurd r }
+    : '{' Expr '}'                      { HiddenArg (getRange ($1,$2,$3)) (maybeNamed $2) }
+    | '{' '}'                           { let r = fuseRange $1 $2 in HiddenArg r $ unnamed $ Absurd r }
 
 Expr3NoCurly
-    : QId				{ Ident $1 }
-    | literal				{ Lit $1 }
-    | '?'				{ QuestionMark (getRange $1) Nothing }
-    | '_'				{ Underscore (getRange $1) Nothing }
-    | 'Prop'				{ Prop (getRange $1) }
-    | 'Set'				{ Set (getRange $1) }
+    : QId                               { Ident $1 }
+    | literal                           { Lit $1 }
+    | '?'                               { QuestionMark (getRange $1) Nothing }
+    | '_'                               { Underscore (getRange $1) Nothing }
+    | 'Prop'                            { Prop (getRange $1) }
+    | 'Set'                             { Set (getRange $1) }
     | 'quote'                           { Quote (getRange $1) }
     | 'quoteTerm'                       { QuoteTerm (getRange $1) }
     | 'unquote'                         { Unquote (getRange $1) }
-    | setN				{ SetN (getRange (fst $1)) (snd $1) }
-    | '{{' Expr DoubleCloseBrace			{ InstanceArg (getRange ($1,$2,$3))
+    | setN                              { SetN (getRange (fst $1)) (snd $1) }
+    | '{{' Expr DoubleCloseBrace                        { InstanceArg (getRange ($1,$2,$3))
                                                           (maybeNamed $2) }
-    | '(' Expr ')'			{ Paren (getRange ($1,$2,$3)) $2 }
-    | '(' ')'				{ Absurd (fuseRange $1 $2) }
+    | '(' Expr ')'                      { Paren (getRange ($1,$2,$3)) $2 }
+    | '(' ')'                           { Absurd (fuseRange $1 $2) }
     | '{{' DoubleCloseBrace             { let r = fuseRange $1 $2 in InstanceArg r $ unnamed $ Absurd r }
-    | Id '@' Expr3			{ As (getRange ($1,$2,$3)) $1 $3 }
-    | '.' Expr3				{ Dot (fuseRange $1 $2) $2 }
+    | Id '@' Expr3                      { As (getRange ($1,$2,$3)) $1 $3 }
+    | '.' Expr3                         { Dot (fuseRange $1 $2) $2 }
     | 'record' '{' FieldAssignments '}' { Rec (getRange ($1,$2,$3,$4)) $3 }
     | 'record' Expr3NoCurly '{' FieldAssignments '}' { RecUpdate (getRange ($1,$2,$3,$4,$5)) $2 $4 }
 
 Expr3
-    : Expr3Curly			{ $1 }
-    | Expr3NoCurly			{ $1 }
+    : Expr3Curly                        { $1 }
+    | Expr3NoCurly                      { $1 }
 
 FieldAssignments :: { [(Name, Expr)] }
 FieldAssignments
-  : {- empty -}	      { [] }
+  : {- empty -}       { [] }
   | FieldAssignments1 { $1 }
 
 FieldAssignments1 :: { [(Name, Expr)] }
 FieldAssignments1
-  : FieldAssignment			  { [$1] }
+  : FieldAssignment                       { [$1] }
   | FieldAssignment ';' FieldAssignments1 { $1 : $3 }
 
 FieldAssignment :: { (Name, Expr) }
 FieldAssignment
-  : Id '=' Expr	  { ($1, $3) }
+  : Id '=' Expr   { ($1, $3) }
 
 {--------------------------------------------------------------------------
     Bindings
@@ -631,12 +633,12 @@ FieldAssignment
 TeleArrow : Telescope1 '->' { $1 }
 
 Telescope1
-    : TypedBindingss	{ {-TeleBind-} $1 }
+    : TypedBindingss    { {-TeleBind-} $1 }
 
 TypedBindingss :: { [TypedBindings] }
 TypedBindingss
     : TypedBindings TypedBindingss { $1 : $2 }
-    | TypedBindings		   { [$1] }
+    | TypedBindings                { [$1] }
 
 
 -- A typed binding is either (x1 .. xn : A) or   {y1 .. ym : B}
@@ -683,7 +685,7 @@ LamBindings
   : LamBinds '->' {%
       case reverse $1 of
         Left _ : _ -> parseError "Absurd lambda cannot have a body."
-	_ : _      -> return [ b | Right b <- $1 ]
+        _ : _      -> return [ b | Right b <- $1 ]
         []         -> parsePanic "Empty LamBinds"
       }
 
@@ -704,7 +706,7 @@ LamBinds
   : DomainFreeBinding LamBinds  { map Right $1 ++ $2 }
   | TypedBindings LamBinds      { Right (DomainFull $1) : $2 }
   | DomainFreeBinding           { map Right $1 }
-  | TypedBindings		{ [Right $ DomainFull $1] }
+  | TypedBindings               { [Right $ DomainFull $1] }
   | '(' ')'                     { [Left NotHidden] }
   | '{' '}'                     { [Left Hidden] }
   | '{{' DoubleCloseBrace       { [Left Instance] }
@@ -712,12 +714,12 @@ LamBinds
 -- Like LamBinds, but could also parse an absurd LHS of an extended lambda @{ p1 ... () }@
 LamBindsAbsurd :: { Either [Either Hiding LamBinding] [Expr] }
 LamBindsAbsurd
-  : DomainFreeBinding LamBinds	{ Left $ map Right $1 ++ $2 }
-  | TypedBindings LamBinds	{ Left $ Right (DomainFull $1) : $2 }
-  | DomainFreeBindingAbsurd   	{ case $1 of
+  : DomainFreeBinding LamBinds  { Left $ map Right $1 ++ $2 }
+  | TypedBindings LamBinds      { Left $ Right (DomainFull $1) : $2 }
+  | DomainFreeBindingAbsurd     { case $1 of
                                     Left lb -> Left $ map Right lb
                                     Right es -> Right es }
-  | TypedBindings		{ Left [Right $ DomainFull $1] }
+  | TypedBindings               { Left [Right $ DomainFull $1] }
   | '(' ')'                     { Left [Left NotHidden] }
   | '{' '}'                     { Left [Left Hidden] }
   | '{{' DoubleCloseBrace       { Left [Left Instance] }
@@ -728,7 +730,7 @@ NonAbsurdLamClause
   : Application3 '->' Expr {% do
       p <- exprToLHS (RawApp (getRange $1) $1) ;
       return (p [] [], RHS $3, NoWhere)
-	}
+        }
 
 AbsurdLamClause :: { (LHS,RHS,WhereClause) }
 AbsurdLamClause
@@ -737,7 +739,7 @@ AbsurdLamClause
   : Application {% do
       p <- exprToLHS (RawApp (getRange $1) $1);
       return (p [] [], AbsurdRHS, NoWhere)
-	}
+        }
 
 LamClause :: { (LHS,RHS,WhereClause) }
 LamClause
@@ -762,7 +764,7 @@ ForallBindings
 TypedUntypedBindings1 :: { [LamBinding] }
 TypedUntypedBindings1
   : DomainFreeBinding TypedUntypedBindings1 { $1 ++ $2 }
-  | TypedBindings TypedUntypedBindings1	    { DomainFull $1 : $2 }
+  | TypedBindings TypedUntypedBindings1     { DomainFull $1 : $2 }
   | DomainFreeBinding                       { $1 }
   | TypedBindings                           { [DomainFull $1] }
 
@@ -771,7 +773,7 @@ TypedUntypedBindings1
 TypedUntypedBindings :: { [LamBinding] }
 TypedUntypedBindings
   : DomainFreeBinding TypedUntypedBindings { $1 ++ $2 }
-  | TypedBindings TypedUntypedBindings	   { DomainFull $1 : $2 }
+  | TypedBindings TypedUntypedBindings     { DomainFull $1 : $2 }
   |                                        { [] }
 
 -- A domain free binding is either x or {x1 .. xn}
@@ -781,9 +783,9 @@ DomainFreeBinding
                              Left lbs -> lbs
                              Right _ -> fail "expected sequence of bound identifiers, not absurd pattern"
                           }
-{-    : BId		{ [DomainFree NotHidden Relevant $ mkBoundName_ $1]  }
-    | '.' BId		{ [DomainFree NotHidden Irrelevant $ mkBoundName_ $2]  }
-    | '..' BId		{ [DomainFree NotHidden NonStrict $ mkBoundName_ $2]  }
+{-    : BId             { [DomainFree NotHidden Relevant $ mkBoundName_ $1]  }
+    | '.' BId           { [DomainFree NotHidden Irrelevant $ mkBoundName_ $2]  }
+    | '..' BId          { [DomainFree NotHidden NonStrict $ mkBoundName_ $2]  }
     | '{' CommaBIds '}' { map (DomainFree Hidden Relevant . mkBoundName_) $2 }
     | '{{' CommaBIds DoubleCloseBrace { map (DomainFree (setHiding Instance defaultArgInfo) . mkBoundName_) $2 }
     | '.' '{' CommaBIds '}' { map (DomainFree Hidden Irrelevant . mkBoundName_) $3 }
@@ -796,9 +798,9 @@ DomainFreeBinding
 -- A domain free binding is either x or {x1 .. xn}
 DomainFreeBindingAbsurd :: { Either [LamBinding] [Expr]}
 DomainFreeBindingAbsurd
-    : BId		{ Left [DomainFree defaultArgInfo $ mkBoundName_ $1]  }
-    | '.' BId		{ Left [DomainFree (setRelevance Irrelevant $ defaultArgInfo) $ mkBoundName_ $2]  }
-    | '..' BId		{ Left [DomainFree (setRelevance NonStrict $ defaultArgInfo) $ mkBoundName_ $2]  }
+    : BId               { Left [DomainFree defaultArgInfo $ mkBoundName_ $1]  }
+    | '.' BId           { Left [DomainFree (setRelevance Irrelevant $ defaultArgInfo) $ mkBoundName_ $2]  }
+    | '..' BId          { Left [DomainFree (setRelevance NonStrict $ defaultArgInfo) $ mkBoundName_ $2]  }
     | '{' CommaBIdAndAbsurds '}'
          { either (Left . map (DomainFree (setHiding Hidden $ defaultArgInfo) . mkBoundName_)) Right $2 }
     | '{{' CommaBIds DoubleCloseBrace { Left $ map (DomainFree (setHiding Instance $ defaultArgInfo) . mkBoundName_) $2 }
@@ -815,7 +817,7 @@ DomainFreeBindingAbsurd
 -- You can rename imports
 -- ImportImportDirective :: { (Maybe AsName, ImportDirective) }
 -- ImportImportDirective
---     : ImportDirective	    { (Nothing, $1) }
+--     : ImportDirective            { (Nothing, $1) }
 --     | id Id ImportDirective {% isName "as" $1 >>
 --                                return (Just (AsName $2 (getRange (fst $1))), $3) }
 
@@ -836,7 +838,7 @@ ImportDirective1 :: { ImportDirective }
 UsingOrHiding :: { (UsingOrHiding , Range) }
 UsingOrHiding
     : 'using' '(' CommaImportNames ')'   { (Using $3 , getRange ($1,$2,$3,$4)) }
-	-- using can have an empty list
+        -- using can have an empty list
     | 'hiding' '(' CommaImportNames ')'  { (Hiding $3 , getRange ($1,$2,$3,$4)) }
         -- if you want to hide nothing that's fine, isn't it?
 --    | 'hiding' '(' CommaImportNames1 ')' { (Hiding $3 , getRange ($1,$2,$3,$4)) }
@@ -860,22 +862,22 @@ Renaming
 -- the imp_dir state exactly one token before the 'to'
 ImportName_ :: { ImportedName }
 ImportName_
-    : beginImpDir Id	      { ImportedName $2 }
+    : beginImpDir Id          { ImportedName $2 }
     | 'module' beginImpDir Id { ImportedModule $3 }
 
 ImportName :: { ImportedName }
-ImportName : Id  	 { ImportedName $1 }
-	   | 'module' Id { ImportedModule $2 }
+ImportName : Id          { ImportedName $1 }
+           | 'module' Id { ImportedModule $2 }
 
 -- Actually semi-colon separated
 CommaImportNames :: { [ImportedName] }
 CommaImportNames
-    : {- empty -}	{ [] }
-    | CommaImportNames1	{ $1 }
+    : {- empty -}       { [] }
+    | CommaImportNames1 { $1 }
 
 CommaImportNames1
-    : ImportName			{ [$1] }
-    | ImportName ';' CommaImportNames1	{ $1 : $3 }
+    : ImportName                        { [$1] }
+    | ImportName ';' CommaImportNames1  { $1 : $3 }
 
 {--------------------------------------------------------------------------
     Function clauses
@@ -890,29 +892,29 @@ LHS : Expr1 RewriteEquations WithExpressions
         { Ellipsis (getRange ($1,$2,$3,$4)) $2 $3 $4 }
 
 WithPats :: { [Pattern] }
-WithPats : {- empty -}	{ [] }
-	 | '|' Application3 WithPats
-		{% exprToPattern (RawApp (getRange $2) $2) >>= \p ->
-		   return (p : $3)
-		}
+WithPats : {- empty -}  { [] }
+         | '|' Application3 WithPats
+                {% exprToPattern (RawApp (getRange $2) $2) >>= \p ->
+                   return (p : $3)
+                }
 
 WithExpressions :: { [Expr] }
 WithExpressions
-  : {- empty -}	{ [] }
+  : {- empty -} { [] }
   | 'with' Expr
       { case $2 of { WithApp _ e es -> e : es; e -> [e] } }
 
 RewriteEquations :: { [Expr] }
 RewriteEquations
-  : {- empty -}	{ [] }
+  : {- empty -} { [] }
   | 'rewrite' Expr1
       { case $2 of { WithApp _ e es -> e : es; e -> [e] } }
 
 -- Where clauses are optional.
 WhereClause :: { WhereClause }
 WhereClause
-    : {- empty -}		       { NoWhere	 }
-    | 'where' Declarations0	       { AnyWhere $2	 }
+    : {- empty -}                      { NoWhere         }
+    | 'where' Declarations0            { AnyWhere $2     }
     | 'module' Id 'where' Declarations0 { SomeWhere $2 $4 }
     | 'module' Underscore 'where' Declarations0 { SomeWhere $2 $4 }
 
@@ -924,24 +926,24 @@ WhereClause
 -- Top-level definitions.
 Declaration :: { [Declaration] }
 Declaration
-    : Fields	    {  $1  }
+    : Fields        {  $1  }
     | FunClause     {  $1  }
-    | Data	    { [$1] }
-    | DataSig	    { [$1] }  -- lone data type signature in mutual block
-    | Record	    { [$1] }
-    | RecordSig	    { [$1] }  -- lone record signature in mutual block
-    | Infix	    { [$1] }
-    | Mutual	    { [$1] }
-    | Abstract	    { [$1] }
-    | Private	    { [$1] }
-    | Instance	    { [$1] }
-    | Postulate	    { [$1] }
-    | Primitive	    { [$1] }
-    | Open	    {  $1  }
---    | Import	    { [$1] }
+    | Data          { [$1] }
+    | DataSig       { [$1] }  -- lone data type signature in mutual block
+    | Record        { [$1] }
+    | RecordSig     { [$1] }  -- lone record signature in mutual block
+    | Infix         { [$1] }
+    | Mutual        { [$1] }
+    | Abstract      { [$1] }
+    | Private       { [$1] }
+    | Instance      { [$1] }
+    | Postulate     { [$1] }
+    | Primitive     { [$1] }
+    | Open          {  $1  }
+--    | Import      { [$1] }
     | ModuleMacro   { [$1] }
-    | Module	    { [$1] }
-    | Pragma	    { [$1] }
+    | Module        { [$1] }
+    | Pragma        { [$1] }
     | Syntax        { [$1] }
     | PatternSyn    { [$1] }
     | UnquoteDecl   { [$1] }
@@ -966,25 +968,25 @@ ArgTypeSigs : ArgIds ':' Expr { map (fmap (flip (TypeSig defaultArgInfo) $3)) $1
 -- declarations like 'x::xs ++ ys = e', when '::' has higher precedence than '++'.
 -- FunClause also handle possibly dotted type signatures.
 FunClause :: { [Declaration] }
-FunClause : LHS RHS WhereClause	{% funClauseOrTypeSigs $1 $2 $3 }
+FunClause : LHS RHS WhereClause {% funClauseOrTypeSigs $1 $2 $3 }
 
 RHS :: { RHSOrTypeSigs }
-RHS : '=' Expr	    { JustRHS (RHS $2) }
+RHS : '=' Expr      { JustRHS (RHS $2) }
     | ':' Expr      { TypeSigsRHS $2 }
     | {- empty -}   { JustRHS AbsurdRHS }
 
 -- Data declaration. Can be local.
 Data :: { Declaration }
 Data : 'data' Id TypedUntypedBindings ':' Expr 'where'
-            Constructors	{ Data (getRange ($1,$2,$3,$4,$5,$6,$7)) Inductive $2 $3 (Just $5) $7 }
+            Constructors        { Data (getRange ($1,$2,$3,$4,$5,$6,$7)) Inductive $2 $3 (Just $5) $7 }
      | 'codata' Id TypedUntypedBindings ':' Expr 'where'
-            Constructors	{ Data (getRange ($1,$2,$3,$4,$5,$6,$7)) CoInductive $2 $3 (Just $5) $7 }
+            Constructors        { Data (getRange ($1,$2,$3,$4,$5,$6,$7)) CoInductive $2 $3 (Just $5) $7 }
 
   -- New cases when we already had a DataSig.  Then one can omit the sort.
      | 'data' Id TypedUntypedBindings 'where'
-	    Constructors	{ Data (getRange ($1,$2,$3,$4,$5)) Inductive $2 $3 Nothing $5 }
+            Constructors        { Data (getRange ($1,$2,$3,$4,$5)) Inductive $2 $3 Nothing $5 }
      | 'codata' Id TypedUntypedBindings 'where'
-	    Constructors	{ Data (getRange ($1,$2,$3,$4,$5)) CoInductive $2 $3 Nothing $5 }
+            Constructors        { Data (getRange ($1,$2,$3,$4,$5)) CoInductive $2 $3 Nothing $5 }
 
 -- Data type signature. Found in mutual blocks.
 DataSig :: { Declaration }
@@ -998,10 +1000,10 @@ DataSig : 'data' Id TypedUntypedBindings ':' Expr
 -- Record declarations.
 Record :: { Declaration }
 Record : 'record' Expr3NoCurly TypedUntypedBindings ':' Expr 'where'
-	    RecordDeclarations
+            RecordDeclarations
          {% exprToName $2 >>= \ n -> return $ Record (getRange ($1,$2,$3,$4,$5,$6,$7)) n (fst3 $7) (snd3 $7) $3 (Just $5) (thd3 $7) }
        | 'record' Expr3NoCurly TypedUntypedBindings 'where'
-	    RecordDeclarations
+            RecordDeclarations
          {% exprToName $2 >>= \ n -> return $ Record (getRange ($1,$2,$3,$4,$5)) n (fst3 $5) (snd3 $5) $3 Nothing (thd3 $5) }
 
 -- Record type signature. In mutual blocks.
@@ -1037,7 +1039,7 @@ Abstract : 'abstract' Declarations  { Abstract (fuseRange $1 $2) $2 }
 
 -- Private can only appear on the top-level (or rather the module level).
 Private :: { Declaration }
-Private : 'private' Declarations	{ Private (fuseRange $1 $2) $2 }
+Private : 'private' Declarations        { Private (fuseRange $1 $2) $2 }
 
 
 -- Instance declarations.
@@ -1051,7 +1053,7 @@ Postulate : 'postulate' Declarations { Postulate (fuseRange $1 $2) $2 }
 
 -- Primitives. Can only contain type signatures.
 Primitive :: { Declaration }
-Primitive : 'primitive' TypeSignatures	{ Primitive (fuseRange $1 $2) $2 }
+Primitive : 'primitive' TypeSignatures  { Primitive (fuseRange $1 $2) $2 }
 
 -- Unquoting declarations.
 UnquoteDecl :: { Declaration }
@@ -1062,9 +1064,9 @@ Syntax :: { Declaration }
 Syntax : 'syntax' Id HoleNames '=' SimpleIds  {%
   case $2 of
     Name _ [_] -> case mkNotation $3 (map rangedThing $5) of
-      Left err -> parseError $ "malformed syntax declaration: " ++ err
+      Left err -> parseError $ "Malformed syntax declaration: " ++ err
       Right n -> return $ Syntax $2 n
-    _ -> parseError "syntax declarations are allowed only for simple names (without holes)"
+    _ -> parseError "Syntax declarations are allowed only for simple names (without holes)"
 }
 
 -- Pattern synonyms.
@@ -1172,8 +1174,8 @@ Open : MaybeOpen 'import' ModuleName OpenArgs ImportDirective {%
     [ case es of
       { []  -> Open r m dir
       ; _   -> Private r [ ModuleMacro r (noName $ beginningOf $ getRange m)
-			     (SectionApp (getRange (m , es)) [] (RawApp (fuseRange m es) (Ident m : es)))
-			     DoOpen dir
+                             (SectionApp (getRange (m , es)) [] (RawApp (fuseRange m es) (Ident m : es)))
+                             DoOpen dir
                          ]
       }
     ]
@@ -1181,7 +1183,7 @@ Open : MaybeOpen 'import' ModuleName OpenArgs ImportDirective {%
   | 'open' ModuleName '{{' '...' DoubleCloseBrace ImportDirective {
     let r = getRange $2 in
     [ Private r [ ModuleMacro r (noName $ beginningOf $ getRange $2)
-    	      	(RecordModuleIFS r $2) DoOpen $6
+                (RecordModuleIFS r $2) DoOpen $6
                 ]
     ]
   }
@@ -1192,28 +1194,28 @@ OpenArgs : {- empty -}    { [] }
 
 ModuleApplication :: { [TypedBindings] -> Parser ModuleApplication }
 ModuleApplication : ModuleName '{{' '...' DoubleCloseBrace { (\ts ->
-		    if null ts then return $ RecordModuleIFS (getRange ($1,$2,$3,$4)) $1
-		    else parseError "No bindings allowed for record module with non-canonical implicits" )
-		    }
-		  | ModuleName OpenArgs {
-		    (\ts -> return $ SectionApp (getRange ($1, $2)) ts (RawApp (fuseRange $1 $2) (Ident $1 : $2)) ) }
+                    if null ts then return $ RecordModuleIFS (getRange ($1,$2,$3,$4)) $1
+                    else parseError "No bindings allowed for record module with non-canonical implicits" )
+                    }
+                  | ModuleName OpenArgs {
+                    (\ts -> return $ SectionApp (getRange ($1, $2)) ts (RawApp (fuseRange $1 $2) (Ident $1 : $2)) ) }
 
 
 -- Module instantiation
 ModuleMacro :: { Declaration }
 ModuleMacro : 'module' ModuleName TypedUntypedBindings '=' ModuleApplication ImportDirective
-		    {% do { ma <- $5 (map addType $3)
+                    {% do { ma <- $5 (map addType $3)
                           ; name <- ensureUnqual $2
                           ; return $ ModuleMacro (getRange ($1, $2, ma, $6)) name ma DontOpen $6 } }
-	    | 'open' 'module' Id TypedUntypedBindings '=' ModuleApplication ImportDirective
-		    {% do {ma <- $6 (map addType $4); return $ ModuleMacro (getRange ($1, $2, $3, ma, $7)) $3 ma DoOpen $7 } }
+            | 'open' 'module' Id TypedUntypedBindings '=' ModuleApplication ImportDirective
+                    {% do {ma <- $6 (map addType $4); return $ ModuleMacro (getRange ($1, $2, $3, ma, $7)) $3 ma DoOpen $7 } }
 
 -- Module
 Module :: { Declaration }
 Module : 'module' ModuleName TypedUntypedBindings 'where' Declarations0
-		    { Module (getRange ($1,$2,$3,$4,$5)) $2 (map addType $3) $5 }
+                    { Module (getRange ($1,$2,$3,$4,$5)) $2 (map addType $3) $5 }
        | 'module' Underscore TypedUntypedBindings 'where' Declarations0
-		    { Module (getRange ($1,$2,$3,$4,$5)) (QName $2) (map addType $3) $5 }
+                    { Module (getRange ($1,$2,$3,$4,$5)) (QName $2) (map addType $3) $5 }
 
 Underscore :: { Name }
 Underscore : '_' { noName (getRange $1) }
@@ -1238,6 +1240,7 @@ DeclarationPragma
   | ImportPragma             { $1 }
   | ImpossiblePragma         { $1 }
   | RecordEtaPragma          { $1 }
+  | TerminatingPragma        { $1 }
   | NonTerminatingPragma     { $1 }
   | NoTerminationCheckPragma { $1 }
   | MeasurePragma            { $1 }
@@ -1311,6 +1314,11 @@ NonTerminatingPragma
   : '{-#' 'NON_TERMINATING' '#-}'
     { TerminationCheckPragma (getRange ($1,$2,$3)) NonTerminating }
 
+TerminatingPragma :: { Pragma }
+TerminatingPragma
+  : '{-#' 'TERMINATING' '#-}'
+    { TerminationCheckPragma (getRange ($1,$2,$3)) Terminating }
+
 MeasurePragma :: { Pragma }
 MeasurePragma
   : '{-#' 'MEASURE' PragmaName '#-}'
@@ -1460,17 +1468,17 @@ mkName (i, s) = do
     unless (alternating xs) $ fail $ "a name cannot contain two consecutive underscores"
     return $ Name (getRange i) xs
     where
-	isValidId Hole   = return ()
-	isValidId (Id y) = do
+        isValidId Hole   = return ()
+        isValidId (Id y) = do
           let x = rawNameToString y
           case parse defaultParseFlags [0] (lexer return) x of
-	    ParseOk _ (TokId _) -> return ()
-	    _			-> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"
+            ParseOk _ (TokId _) -> return ()
+            _                   -> fail $ "in the name " ++ s ++ ", the part " ++ x ++ " is not valid"
 
-	-- we know that there are no two Ids in a row
-	alternating (Hole : Hole : _) = False
-	alternating (_ : xs)	      = alternating xs
-	alternating []		      = True
+        -- we know that there are no two Ids in a row
+        alternating (Hole : Hole : _) = False
+        alternating (_ : xs)          = alternating xs
+        alternating []                = True
 
 -- | Create a qualified name from a list of strings
 mkQName :: [(Interval, String)] -> Parser QName
@@ -1485,8 +1493,8 @@ ensureUnqual q at Qual{}  = parseError' (rStart $ getRange q) "Qualified name not a
 -- | Match a particular name.
 isName :: String -> (Interval, String) -> Parser ()
 isName s (_,s')
-    | s == s'	= return ()
-    | otherwise	= fail $ "expected " ++ s ++ ", found " ++ s'
+    | s == s'   = return ()
+    | otherwise = fail $ "expected " ++ s ++ ", found " ++ s'
 
 -- | Build a forall pi (forall x y z -> ...)
 forallPi :: [LamBinding] -> Expr -> Expr
@@ -1498,7 +1506,7 @@ tLet r = TypedBindings r . Common.Arg defaultArgInfo . TLet r
 
 -- | Converts lambda bindings to typed bindings.
 addType :: LamBinding -> TypedBindings
-addType (DomainFull b)	 = b
+addType (DomainFull b)   = b
 addType (DomainFree info x) = TypedBindings r $ Common.Arg info $ TBind r [x] $ Underscore r Nothing
   where r = getRange x
 
@@ -1527,22 +1535,22 @@ mergeImportDirectives is = do
 verifyImportDirective :: ImportDirective -> Parser ImportDirective
 verifyImportDirective i =
     case filter ((>1) . length)
-	 $ group
-	 $ sort xs
+         $ group
+         $ sort xs
     of
-	[]  -> return i
-	yss -> let Just pos = rStart $ getRange $ head $ concat yss in
+        []  -> return i
+        yss -> let Just pos = rStart $ getRange $ head $ concat yss in
                parseErrorAt pos $
-		"repeated name" ++ s ++ " in import directive: " ++
-		concat (intersperse ", " $ map (show . head) yss)
-	    where
-		s = case yss of
-			[_] -> ""
-			_   -> "s"
+                "Repeated name" ++ s ++ " in import directive: " ++
+                concat (intersperse ", " $ map (show . head) yss)
+            where
+                s = case yss of
+                        [_] -> ""
+                        _   -> "s"
     where
-	xs = names (usingOrHiding i) ++ map renFrom (renaming i)
-	names (Using xs)    = xs
-	names (Hiding xs)   = xs
+        xs = names (usingOrHiding i) ++ map renFrom (renaming i)
+        names (Using xs)    = xs
+        names (Hiding xs)   = xs
 
 -- | Breaks up a string into substrings. Returns every maximal
 -- subsequence of zero or more characters distinct from @'.'@.
@@ -1590,34 +1598,34 @@ validHaskellModuleName = all ok . splitOnDots
 exprToLHS :: Expr -> Parser ([Expr] -> [Expr] -> LHS)
 exprToLHS e = case e of
   WithApp r e es -> LHS <$> exprToPattern e <*> mapM exprToPattern es
-  _		 -> LHS <$> exprToPattern e <*> return []
+  _              -> LHS <$> exprToPattern e <*> return []
 
 -- | Turn an expression into a pattern. Fails if the expression is not a
 --   valid pattern.
 exprToPattern :: Expr -> Parser Pattern
 exprToPattern e =
     case e of
-	Ident x			-> return $ IdentP x
-	App _ e1 e2		-> AppP <$> exprToPattern e1
-					<*> T.mapM (T.mapM exprToPattern) e2
-	Paren r e		-> ParenP r
-					<$> exprToPattern e
-	Underscore r _		-> return $ WildP r
-	Absurd r		-> return $ AbsurdP r
-	As r x e		-> AsP r x <$> exprToPattern e
-	Dot r (HiddenArg _ e)	-> return $ HiddenP r $ fmap (DotP r) e
-	Dot r e			-> return $ DotP r e
-	Lit l			-> return $ LitP l
-	HiddenArg r e		-> HiddenP r <$> T.mapM exprToPattern e
-	InstanceArg r e		-> InstanceP r <$> T.mapM exprToPattern e
-	RawApp r es		-> RawAppP r <$> mapM exprToPattern es
+        Ident x                 -> return $ IdentP x
+        App _ e1 e2             -> AppP <$> exprToPattern e1
+                                        <*> T.mapM (T.mapM exprToPattern) e2
+        Paren r e               -> ParenP r
+                                        <$> exprToPattern e
+        Underscore r _          -> return $ WildP r
+        Absurd r                -> return $ AbsurdP r
+        As r x e                -> AsP r x <$> exprToPattern e
+        Dot r (HiddenArg _ e)   -> return $ HiddenP r $ fmap (DotP r) e
+        Dot r e                 -> return $ DotP r e
+        Lit l                   -> return $ LitP l
+        HiddenArg r e           -> HiddenP r <$> T.mapM exprToPattern e
+        InstanceArg r e         -> InstanceP r <$> T.mapM exprToPattern e
+        RawApp r es             -> RawAppP r <$> mapM exprToPattern es
         Quote r                 -> return $ QuoteP r
-	_			->
+        _                       ->
           let Just pos = rStart $ getRange e in
           parseErrorAt pos $ "Not a valid pattern: " ++ show e
 
 opAppExprToPattern :: OpApp Expr -> Parser Pattern
-opAppExprToPattern (SyntaxBindingLambda _ _ _) = parseError "syntax binding lambda cannot appear in a pattern"
+opAppExprToPattern (SyntaxBindingLambda _ _ _) = parseError "Syntax binding lambda cannot appear in a pattern"
 opAppExprToPattern (Ordinary e) = exprToPattern e
 
 -- | Turn an expression into a name. Fails if the expression is not a
@@ -1663,6 +1671,7 @@ data RHSOrTypeSigs = JustRHS RHS
 
 namesOfPattern :: Pattern -> Maybe [(C.ArgInfo, Name)]
 namesOfPattern (IdentP (QName i))         = Just [(defaultArgInfo, i)]
+namesOfPattern (WildP r)                  = Just [(defaultArgInfo, C.noName r)]
 namesOfPattern (DotP _ (Ident (QName i))) = Just [(setRelevance Irrelevant defaultArgInfo, i)]
 namesOfPattern (RawAppP _ ps)             = fmap concat $ mapM namesOfPattern ps
 namesOfPattern _                          = Nothing
diff --git a/src/full/Agda/Syntax/Parser/StringLiterals.hs b/src/full/Agda/Syntax/Parser/StringLiterals.hs
index e0718da..f45ceb1 100644
--- a/src/full/Agda/Syntax/Parser/StringLiterals.hs
+++ b/src/full/Agda/Syntax/Parser/StringLiterals.hs
@@ -1,4 +1,3 @@
-
 {-| The code to lex string and character literals. Basically the same code
     as in GHC.
 -}
@@ -35,10 +34,10 @@ litString = stringToken '"' (\i s ->
 -}
 litChar :: LexAction Token
 litChar = stringToken '\'' $ \i s ->
-	    do	case s of
-		    [c]	-> return $ TokLiteral $ LitChar (getRange i) c
-		    _	-> lexError
-			    "character literal must contain a single character"
+            do  case s of
+                    [c] -> return $ TokLiteral $ LitChar (getRange i) c
+                    _   -> lexError
+                            "character literal must contain a single character"
 
 
 {--------------------------------------------------------------------------
@@ -48,9 +47,9 @@ litChar = stringToken '\'' $ \i s ->
 -- | Custom error function.
 litError :: String -> LookAhead a
 litError msg =
-    do	sync
-	liftP $ lexError $
-	    "Lexical error in string or character literal: " ++ msg
+    do  sync
+        liftP $ lexError $
+            "Lexical error in string or character literal: " ++ msg
 
 
 {--------------------------------------------------------------------------
@@ -62,13 +61,13 @@ litError msg =
 --   characters).
 stringToken :: Char -> (Interval -> String -> Parser tok) -> LexAction tok
 stringToken del mkTok inp inp' n =
-    do	setLastPos (backupPos $ lexPos inp')
+    do  setLastPos (backupPos $ lexPos inp')
         setLexInput inp'
         -- TODO: Should setPrevToken be run here? Compare with
         -- Agda.Syntax.Parser.LexActions.token.
-	tok <- runLookAhead litError $ lexString del ""
-	i   <- getParseInterval
-	mkTok i tok
+        tok <- runLookAhead litError $ lexString del ""
+        i   <- getParseInterval
+        mkTok i tok
 
 
 -- | This is where the work happens. The string argument is an accumulating
@@ -76,90 +75,90 @@ stringToken del mkTok inp inp' n =
 lexString :: Char -> String -> LookAhead String
 lexString del s =
 
-    do	c <- nextChar
-	case c of
+    do  c <- nextChar
+        case c of
 
-	    c | c == del  -> sync >> return (reverse s)
+            c | c == del  -> sync >> return (reverse s)
 
-	    '\\' ->
-		do  c' <- nextChar
-		    case c' of
-			'&'		-> sync >> lexString del s
-			c | isSpace c	-> sync >> lexStringGap del s
-			_		-> normalChar
+            '\\' ->
+                do  c' <- nextChar
+                    case c' of
+                        '&'             -> sync >> lexString del s
+                        c | isSpace c   -> sync >> lexStringGap del s
+                        _               -> normalChar
 
-	    _ -> normalChar
+            _ -> normalChar
     where
-	normalChar =
-	    do	rollback
-		c <- lexChar
-		lexString del (c:s)
+        normalChar =
+            do  rollback
+                c <- lexChar
+                lexString del (c:s)
 
 
 -- | A string gap consists of whitespace (possibly including line breaks)
 --   enclosed in backslashes. The gap is not part of the resulting string.
 lexStringGap :: Char -> String -> LookAhead String
 lexStringGap del s =
-    do	c <- eatNextChar
-	case c of
-	    '\\'	    -> lexString del s
-	    c | isSpace c   -> lexStringGap del s
-	    _		    -> fail "non-space in string gap"
+    do  c <- eatNextChar
+        case c of
+            '\\'            -> lexString del s
+            c | isSpace c   -> lexStringGap del s
+            _               -> fail "non-space in string gap"
 
 -- | Lex a single character.
 lexChar :: LookAhead Char
 lexChar =
-    do	c <- eatNextChar
-	case c of
-	    '\\'    -> lexEscape
-	    _	    -> return c
+    do  c <- eatNextChar
+        case c of
+            '\\'    -> lexEscape
+            _       -> return c
 
 -- | Lex an escaped character. Assumes the backslash has been lexed.
 lexEscape :: LookAhead Char
 lexEscape =
-    do	c <- eatNextChar
-	case c of
-	    '^'	    -> do c <- eatNextChar
-			  if c >= '@' && c <= '_'
-			    then return (chr (ord c - ord '@'))
-			    else fail "invalid control character"
-
-	    'x'	    -> readNum isHexDigit 16 hexDigit
-	    'o'	    -> readNum isOctDigit  8 octDigit
-	    x | isDigit x
-		    -> readNumAcc isDigit 10 decDigit (decDigit x)
-
-	    c ->
-		-- Try to match the input (starting with c) against the
-		-- silly escape codes.
-		do  esc <- match' c (map (id -*- return) sillyEscapeChars)
-				    (fail "bad escape code")
-		    sync
-		    return esc
+    do  c <- eatNextChar
+        case c of
+            '^'     -> do c <- eatNextChar
+                          if c >= '@' && c <= '_'
+                            then return (chr (ord c - ord '@'))
+                            else fail "invalid control character"
+
+            'x'     -> readNum isHexDigit 16 hexDigit
+            'o'     -> readNum isOctDigit  8 octDigit
+            x | isDigit x
+                    -> readNumAcc isDigit 10 decDigit (decDigit x)
+
+            c ->
+                -- Try to match the input (starting with c) against the
+                -- silly escape codes.
+                do  esc <- match' c (map (id -*- return) sillyEscapeChars)
+                                    (fail "bad escape code")
+                    sync
+                    return esc
 
 -- | Read a number in the specified base.
 readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> LookAhead Char
 readNum isDigit base conv =
-    do	c <- eatNextChar
-	if isDigit c
-	    then readNumAcc isDigit base conv (conv c)
-	    else fail "non-digit in numeral"
+    do  c <- eatNextChar
+        if isDigit c
+            then readNumAcc isDigit base conv (conv c)
+            else fail "non-digit in numeral"
 
 -- | Same as 'readNum' but with an accumulating parameter.
 readNumAcc :: (Char -> Bool) -> Int -> (Char -> Int) -> Int -> LookAhead Char
 readNumAcc isDigit base conv i = scan i
     where
-	scan i =
-	    do	inp <- getInput
-		c   <- nextChar
-		case c of
-		    c | isDigit c -> scan (i*base + conv c)
-		    _		  ->
-			do  setInput inp
-			    sync
-			    if i >= ord minBound && i <= ord maxBound
-				then return (chr i)
-				else fail "character literal out of bounds"
+        scan i =
+            do  inp <- getInput
+                c   <- nextChar
+                case c of
+                    c | isDigit c -> scan (i*base + conv c)
+                    _             ->
+                        do  setInput inp
+                            sync
+                            if i >= ord minBound && i <= ord maxBound
+                                then return (chr i)
+                                else fail "character literal out of bounds"
 
 -- | The escape codes.
 sillyEscapeChars :: [(String, Char)]
diff --git a/src/full/Agda/Syntax/Parser/Tokens.hs b/src/full/Agda/Syntax/Parser/Tokens.hs
index 87680ee..65b47ea 100644
--- a/src/full/Agda/Syntax/Parser/Tokens.hs
+++ b/src/full/Agda/Syntax/Parser/Tokens.hs
@@ -1,4 +1,3 @@
-
 module Agda.Syntax.Parser.Tokens
     ( Token(..)
     , Keyword(..)
@@ -10,19 +9,21 @@ import Agda.Syntax.Literal (Literal)
 import Agda.Syntax.Position
 
 data Keyword
-	= KwLet | KwIn | KwWhere | KwData | KwCoData
-	| KwPostulate | KwMutual | KwAbstract | KwPrivate | KwInstance
-	| KwOpen | KwImport | KwModule | KwPrimitive
-	| KwInfix | KwInfixL | KwInfixR | KwWith | KwRewrite
-	| KwSet | KwProp | KwForall | KwRecord | KwConstructor | KwField
+        = KwLet | KwIn | KwWhere | KwData | KwCoData
+        | KwPostulate | KwMutual | KwAbstract | KwPrivate | KwInstance
+        | KwOpen | KwImport | KwModule | KwPrimitive
+        | KwInfix | KwInfixL | KwInfixR | KwWith | KwRewrite
+        | KwSet | KwProp | KwForall | KwRecord | KwConstructor | KwField
         | KwInductive | KwCoInductive
-	| KwHiding | KwUsing | KwRenaming | KwTo | KwPublic
-	| KwOPTIONS | KwBUILTIN | KwLINE
-	| KwCOMPILED_DATA | KwCOMPILED_TYPE | KwCOMPILED | KwCOMPILED_EXPORT
+        | KwHiding | KwUsing | KwRenaming | KwTo | KwPublic
+        | KwOPTIONS | KwBUILTIN | KwLINE
+        | KwCOMPILED_DATA | KwCOMPILED_TYPE | KwCOMPILED | KwCOMPILED_EXPORT
         | KwCOMPILED_EPIC | KwCOMPILED_JS
-	| KwIMPORT | KwIMPOSSIBLE | KwETA | KwNO_TERMINATION_CHECK | KwNON_TERMINATING | KwMEASURE | KwSTATIC
+        | KwIMPORT | KwIMPOSSIBLE | KwETA | KwSTATIC
+        | KwNO_TERMINATION_CHECK | KwTERMINATING | KwNON_TERMINATING
+        | KwMEASURE
         | KwREWRITE
-	| KwQuoteGoal | KwQuoteContext | KwQuote | KwQuoteTerm | KwUnquote | KwUnquoteDecl | KwSyntax
+        | KwQuoteGoal | KwQuoteContext | KwQuote | KwQuoteTerm | KwUnquote | KwUnquoteDecl | KwSyntax
         | KwPatternSyn | KwTactic
     deriving (Eq, Show)
 
@@ -31,37 +32,37 @@ layoutKeywords =
     [ KwLet, KwWhere, KwPostulate, KwMutual, KwAbstract, KwPrivate, KwInstance, KwPrimitive, KwField ]
 
 data Symbol
-	= SymDot | SymSemi | SymVirtualSemi | SymBar
-	| SymColon | SymArrow | SymEqual | SymLambda
-	| SymUnderscore	| SymQuestionMark   | SymAs
-	| SymOpenParen	      | SymCloseParen
-	| SymDoubleOpenBrace  | SymDoubleCloseBrace
-	| SymOpenBrace	      | SymCloseBrace
-	| SymOpenVirtualBrace | SymCloseVirtualBrace
-	| SymOpenPragma	      | SymClosePragma | SymEllipsis | SymDotDot
+        = SymDot | SymSemi | SymVirtualSemi | SymBar
+        | SymColon | SymArrow | SymEqual | SymLambda
+        | SymUnderscore | SymQuestionMark   | SymAs
+        | SymOpenParen        | SymCloseParen
+        | SymDoubleOpenBrace  | SymDoubleCloseBrace
+        | SymOpenBrace        | SymCloseBrace
+        | SymOpenVirtualBrace | SymCloseVirtualBrace
+        | SymOpenPragma       | SymClosePragma | SymEllipsis | SymDotDot
         | SymEndComment -- ^ A misplaced end-comment "-}".
     deriving (Eq, Show)
 
 data Token
-	  -- Keywords
-	= TokKeyword Keyword Interval
-	  -- Identifiers and operators
-	| TokId		(Interval, String)
-	| TokQId	[(Interval, String)]
+          -- Keywords
+        = TokKeyword Keyword Interval
+          -- Identifiers and operators
+        | TokId         (Interval, String)
+        | TokQId        [(Interval, String)]
                         -- Non-empty namespace. The intervals for
                         -- "A.B.x" correspond to "A.", "B." and "x".
-	  -- Literals
-	| TokLiteral	Literal
-	  -- Special symbols
-	| TokSymbol Symbol Interval
-	  -- Other tokens
-	| TokString (Interval, String)  -- arbitrary string, used in pragmas
-	| TokSetN (Interval, Integer)
-	| TokTeX (Interval, String)
+          -- Literals
+        | TokLiteral    Literal
+          -- Special symbols
+        | TokSymbol Symbol Interval
+          -- Other tokens
+        | TokString (Interval, String)  -- arbitrary string, used in pragmas
+        | TokSetN (Interval, Integer)
+        | TokTeX (Interval, String)
         | TokComment (Interval, String)
-	| TokDummy	-- Dummy token to make Happy not complain
-			-- about overlapping cases.
-	| TokEOF
+        | TokDummy      -- Dummy token to make Happy not complain
+                        -- about overlapping cases.
+        | TokEOF
     deriving (Eq, Show)
 
 instance HasRange Token where
diff --git a/src/full/Agda/Syntax/Position.hs b/src/full/Agda/Syntax/Position.hs
index f07a40f..33ac69b 100644
--- a/src/full/Agda/Syntax/Position.hs
+++ b/src/full/Agda/Syntax/Position.hs
@@ -1,18 +1,18 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE NoMonomorphismRestriction  #-}
 
 #if __GLASGOW_HASKELL__ <= 700
 {-# LANGUAGE OverlappingInstances #-}
 #endif
 
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 {-| Position information for syntax. Crucial for giving good error messages.
@@ -83,10 +83,11 @@ import Test.QuickCheck.All
 import Agda.Utils.FileName hiding (tests)
 import Agda.Utils.Maybe
 import Agda.Utils.Null
+import Agda.Utils.Pretty ( (<>), Pretty(pretty) )
 import Agda.Utils.TestHelpers
 import Agda.Utils.QuickCheck
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {--------------------------------------------------------------------------
@@ -118,6 +119,7 @@ positionInvariant :: Position' a -> Bool
 positionInvariant p =
   posPos p > 0 && posLine p > 0 && posCol p > 0
 
+importantPart :: Position' a -> (a, Int32)
 importantPart p = (srcFile p, posPos p)
 
 instance Eq a => Eq (Position' a) where
@@ -126,7 +128,7 @@ instance Eq a => Eq (Position' a) where
 instance Ord a => Ord (Position' a) where
   compare = compare `on` importantPart
 
-type SrcFile     = Maybe AbsolutePath
+type SrcFile = Maybe AbsolutePath
 
 type Position = Position' SrcFile
 
@@ -136,7 +138,7 @@ type Position = Position' SrcFile
 data Interval' a = Interval { iStart, iEnd :: !(Position' a) }
     deriving (Typeable, Eq, Ord, Functor, Foldable, Traversable)
 
-type Interval     = Interval' SrcFile
+type Interval = Interval' SrcFile
 
 intervalInvariant :: Ord a => Interval' a -> Bool
 intervalInvariant i =
@@ -155,7 +157,7 @@ iLength i = posPos (iEnd i) - posPos (iStart i)
 newtype Range' a = Range [Interval' a]
   deriving (Typeable, Eq, Ord, Functor, Foldable, Traversable, Null)
 
-type Range     = Range' SrcFile
+type Range = Range' SrcFile
 
 rangeInvariant :: Range -> Bool
 rangeInvariant (Range []) = True
@@ -219,15 +221,118 @@ class KillRange a where
 
 type KillRangeT a = a -> a
 
-killRange1 f a = f (killRange a)
-killRange2 f a = killRange1 (f $ killRange a)
-killRange3 f a = killRange2 (f $ killRange a)
-killRange4 f a = killRange3 (f $ killRange a)
-killRange5 f a = killRange4 (f $ killRange a)
-killRange6 f a = killRange5 (f $ killRange a)
-killRange7 f a = killRange6 (f $ killRange a)
-killRange8 f a = killRange7 (f $ killRange a)
-killRange9 f a = killRange8 (f $ killRange a)
+killRange1 :: KillRange a => (a -> b) -> a -> b
+
+killRange2 :: (KillRange a, KillRange b) => (a -> b -> c) -> a -> b -> c
+
+killRange3 :: (KillRange a, KillRange b, KillRange c) =>
+              (a -> b -> c -> d) -> a -> b -> c -> d
+
+killRange4 :: (KillRange a, KillRange b, KillRange c, KillRange d) =>
+              (a -> b -> c -> d -> e) -> a -> b -> c -> d -> e
+
+killRange5 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+              , KillRange e ) =>
+              (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> f
+
+killRange6 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+              , KillRange e, KillRange f ) =>
+              (a -> b -> c -> d -> e -> f -> g) -> a -> b -> c -> d -> e -> f -> g
+
+killRange7 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+              , KillRange e, KillRange f, KillRange g ) =>
+              (a -> b -> c -> d -> e -> f -> g -> h) -> a -> b -> c -> d -> e -> f -> g -> h
+
+killRange8 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+              , KillRange e, KillRange f, KillRange g, KillRange h ) =>
+              (a -> b -> c -> d -> e -> f -> g -> h -> i) ->
+              a -> b -> c -> d -> e -> f -> g -> h -> i
+
+killRange9 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+              , KillRange e, KillRange f, KillRange g, KillRange h
+              , KillRange i ) =>
+              (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) ->
+              a -> b -> c -> d -> e -> f -> g -> h -> i -> j
+
+killRange10 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
+
+killRange11 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
+
+killRange12 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m
+
+killRange13 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n
+
+killRange14 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o
+
+killRange15 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n, KillRange o ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p
+
+killRange16 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n, KillRange o, KillRange p ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q
+
+killRange17 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n, KillRange o, KillRange p
+               , KillRange q ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r
+
+killRange18 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n, KillRange o, KillRange p
+               , KillRange q, KillRange r ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r -> s) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r -> s
+
+killRange19 :: ( KillRange a, KillRange b, KillRange c, KillRange d
+               , KillRange e, KillRange f, KillRange g, KillRange h
+               , KillRange i, KillRange j, KillRange k, KillRange l
+               , KillRange m, KillRange n, KillRange o, KillRange p
+               , KillRange q, KillRange r, KillRange s ) =>
+               (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r -> s -> t) ->
+               a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o -> p -> q -> r -> s -> t
+
+killRange1  f a = f (killRange a)
+killRange2  f a = killRange1 (f $ killRange a)
+killRange3  f a = killRange2 (f $ killRange a)
+killRange4  f a = killRange3 (f $ killRange a)
+killRange5  f a = killRange4 (f $ killRange a)
+killRange6  f a = killRange5 (f $ killRange a)
+killRange7  f a = killRange6 (f $ killRange a)
+killRange8  f a = killRange7 (f $ killRange a)
+killRange9  f a = killRange8 (f $ killRange a)
 killRange10 f a = killRange9 (f $ killRange a)
 killRange11 f a = killRange10 (f $ killRange a)
 killRange12 f a = killRange11 (f $ killRange a)
@@ -268,9 +373,13 @@ instance (KillRange a, KillRange b) => KillRange (Either a b) where
   killRange (Left  x) = Left  $ killRange x
   killRange (Right x) = Right $ killRange x
 
-{--------------------------------------------------------------------------
-    Pretty printing
- --------------------------------------------------------------------------}
+------------------------------------------------------------------------
+-- Showing
+------------------------------------------------------------------------
+
+-- TODO: 'Show' should output Haskell-parseable representations.
+-- The following instances are deprecated, and Pretty should be used
+-- instead.  Later, simply derive Show for these types:
 
 instance Show a => Show (Position' (Maybe a)) where
     show (Pn Nothing  _ l c) = show l ++ "," ++ show c
@@ -278,25 +387,34 @@ instance Show a => Show (Position' (Maybe a)) where
 
 instance Show a => Show (Interval' (Maybe a)) where
     show (Interval s e) = file ++ start ++ "-" ++ end
-	where
-	    f	= srcFile s
-	    sl	= posLine s
-	    el	= posLine e
-	    sc	= posCol s
-	    ec	= posCol e
-	    file = case f of
+        where
+            f   = srcFile s
+            sl  = posLine s
+            el  = posLine e
+            sc  = posCol s
+            ec  = posCol e
+            file = case f of
                      Nothing -> ""
                      Just f  -> show f ++ ":"
-	    start = show sl ++ "," ++ show sc
-	    end
-		| sl == el  = show ec
-		| otherwise = show el ++ "," ++ show ec
+            start = show sl ++ "," ++ show sc
+            end
+                | sl == el  = show ec
+                | otherwise = show el ++ "," ++ show ec
 
 instance Show a => Show (Range' (Maybe a)) where
   show r = case rangeToInterval r of
     Nothing -> ""
     Just i  -> show i
 
+------------------------------------------------------------------------
+-- Printing
+------------------------------------------------------------------------
+
+instance Pretty a => Pretty (Position' (Maybe a)) where
+    pretty (Pn Nothing  _ l c) = pretty l <> pretty "," <> pretty c
+    pretty (Pn (Just f) _ l c) =
+      pretty f <> pretty ":" <> pretty l <> pretty "," <> pretty c
+
 {--------------------------------------------------------------------------
     Functions on postitions and ranges
  --------------------------------------------------------------------------}
@@ -315,7 +433,7 @@ noRange = Range []
 --   position to the next column.
 movePos :: Position' a -> Char -> Position' a
 movePos (Pn f p l c) '\n' = Pn f (p + 1) (l + 1) 1
-movePos (Pn f p l c) _	  = Pn f (p + 1) l (c + 1)
+movePos (Pn f p l c) _    = Pn f (p + 1) l (c + 1)
 
 -- | Advance the position by a string.
 --
@@ -448,12 +566,16 @@ makeInterval s
   | Set.null s = Set.empty
   | otherwise  = Set.fromList [Set.findMin s .. Set.findMax s]
 
+prop_iLength :: Interval' Integer -> Bool
 prop_iLength i = iLength i >= 0
 
+prop_startPos :: Maybe AbsolutePath -> Bool
 prop_startPos = positionInvariant . startPos
 
+prop_noRange :: Bool
 prop_noRange = rangeInvariant noRange
 
+prop_takeI_dropI :: Interval' Integer -> Property
 prop_takeI_dropI i =
   forAll (choose (0, toInteger $ iLength i)) $ \n ->
     let s = genericReplicate n ' '
@@ -464,17 +586,20 @@ prop_takeI_dropI i =
     intervalInvariant d &&
     fuseIntervals t d == i
 
+prop_rangeToInterval :: Range' Integer -> Bool
 prop_rangeToInterval (Range []) = True
 prop_rangeToInterval r =
   intervalInvariant i &&
   iPositions i == makeInterval (rPositions r)
   where Just i = rangeToInterval r
 
+prop_continuous :: Range -> Bool
 prop_continuous r =
   rangeInvariant cr &&
   rPositions cr == makeInterval (rPositions r)
   where cr = continuous r
 
+prop_fuseIntervals :: Interval' Integer -> Property
 prop_fuseIntervals i1 =
   forAll (intervalInSameFileAs i1) $ \i2 ->
     let i = fuseIntervals i1 i2 in
@@ -488,8 +613,10 @@ prop_fuseRanges r1 r2 =
   rPositions r == Set.union (rPositions r1) (rPositions r2)
   where r = fuseRanges r1 r2
 
+prop_beginningOf :: Range -> Bool
 prop_beginningOf r = rangeInvariant (beginningOf r)
 
+prop_beginningOfFile :: Range -> Bool
 prop_beginningOfFile r = rangeInvariant (beginningOfFile r)
 
 instance Arbitrary a => Arbitrary (Position' a) where
@@ -511,8 +638,10 @@ setFile f (Interval p1 p2) =
 -- | Generates an interval located in the same file as the given
 -- interval.
 
+intervalInSameFileAs :: Interval' Integer -> Gen (Interval' Integer)
 intervalInSameFileAs i = setFile (srcFile $ iStart i) <$> arbitrary
 
+prop_intervalInSameFileAs :: Interval' Integer -> Property
 prop_intervalInSameFileAs i =
   forAll (intervalInSameFileAs i) $ \i' ->
     intervalInvariant i' &&
@@ -535,9 +664,14 @@ instance (Ord a, Arbitrary a) => Arbitrary (Range' a) where
       | otherwise            = i1 : fuse (i2 : is)
     fuse is = is
 
+prop_positionInvariant :: Position' Integer -> Bool
 prop_positionInvariant = positionInvariant
+
+prop_intervalInvariant :: Interval' Integer -> Bool
 prop_intervalInvariant = intervalInvariant
-prop_rangeInvariant    = rangeInvariant
+
+prop_rangeInvariant :: Range -> Bool
+prop_rangeInvariant = rangeInvariant
 
 instance Show (Position' Integer) where show = show . fmap Just
 instance Show (Interval' Integer) where show = show . fmap Just
diff --git a/src/full/Agda/Syntax/Scope/Base.hs b/src/full/Agda/Syntax/Scope/Base.hs
index 528454c..34d9e45 100644
--- a/src/full/Agda/Syntax/Scope/Base.hs
+++ b/src/full/Agda/Syntax/Scope/Base.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE GADTs               #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE TupleSections       #-}
 
 
 {-| This module defines the notion of a scope and operations on scopes.
@@ -12,14 +12,17 @@ module Agda.Syntax.Scope.Base where
 
 import Control.Arrow ((***), first, second)
 import Control.Applicative
+import Control.DeepSeq
 
 import Data.Function
-import Data.List
+import Data.List as List
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Typeable (Typeable)
 
+-- import Debug.Trace (trace)
+
 import Agda.Syntax.Position
 import Agda.Syntax.Common
 import Agda.Syntax.Fixity
@@ -28,10 +31,14 @@ import Agda.Syntax.Concrete.Name as C
 import Agda.Syntax.Concrete
   (ImportDirective(..), UsingOrHiding(..), ImportedName(..), Renaming(..))
 
-import qualified Agda.Utils.Map as Map
+import Agda.Utils.AssocList (AssocList)
+import qualified Agda.Utils.AssocList as AssocList
+import Agda.Utils.Functor
+import Agda.Utils.Lens
 import Agda.Utils.List
+import qualified Agda.Utils.Map as Map
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- * Scope representation
@@ -41,15 +48,24 @@ import Agda.Utils.Impossible
 data Scope = Scope
       { scopeName           :: A.ModuleName
       , scopeParents        :: [A.ModuleName]
-      , scopeNameSpaces     :: [(NameSpaceId, NameSpace)]
+      , scopeNameSpaces     :: ScopeNameSpaces
       , scopeImports        :: Map C.QName A.ModuleName
       , scopeDatatypeModule :: Bool
       }
   deriving (Typeable)
 
-data NameSpaceId = PrivateNS | PublicNS | ImportedNS | OnlyQualifiedNS
+-- | See 'Agda.Syntax.Common.Access'.
+data NameSpaceId
+  = PrivateNS        -- ^ Things not exported by this module.
+  | PublicNS         -- ^ Things defined and exported by this module.
+  | ImportedNS       -- ^ Things from open public, exported by this module.
+  | OnlyQualifiedNS  -- ^ Visible (as qualified) from outside,
+                     --   but not exported when opening the module.
+                     --   Used for qualified constructors.
   deriving (Typeable, Eq, Bounded, Enum)
 
+type ScopeNameSpaces = [(NameSpaceId, NameSpace)]
+
 localNameSpace :: Access -> NameSpaceId
 localNameSpace PublicAccess  = PublicNS
 localNameSpace PrivateAccess = PrivateNS
@@ -63,25 +79,74 @@ nameSpaceAccess _         = PublicAccess
 scopeNameSpace :: NameSpaceId -> Scope -> NameSpace
 scopeNameSpace ns = fromMaybe __IMPOSSIBLE__ . lookup ns . scopeNameSpaces
 
+-- | A lens for 'scopeNameSpaces'
+updateScopeNameSpaces :: (ScopeNameSpaces -> ScopeNameSpaces) -> Scope -> Scope
+updateScopeNameSpaces f s = s { scopeNameSpaces = f (scopeNameSpaces s) }
+
+-- | ``Monadic'' lens (Functor sufficient).
+updateScopeNameSpacesM ::
+  (Functor m) => (ScopeNameSpaces -> m ScopeNameSpaces) -> Scope -> m Scope
+updateScopeNameSpacesM f s = for (f $ scopeNameSpaces s) $ \ x ->
+  s { scopeNameSpaces = x }
+
 -- | The complete information about the scope at a particular program point
 --   includes the scope stack, the local variables, and the context precedence.
 data ScopeInfo = ScopeInfo
       { scopeCurrent    :: A.ModuleName
       , scopeModules    :: Map A.ModuleName Scope
-      , scopeLocals	:: LocalVars
+      , scopeLocals     :: LocalVars
       , scopePrecedence :: Precedence
       }
   deriving (Typeable)
 
 -- | Local variables.
-type LocalVars = [(C.Name, A.Name)]
+type LocalVars = AssocList C.Name LocalVar
+
+-- | A local variable can be shadowed by an import.
+--   In case of reference to a shadowed variable, we want to report
+--   a scope error.
+data LocalVar
+  = LocalVar    { localVar :: A.Name }
+    -- ^ Unique ID of local variable.
+  | ShadowedVar { localVar :: A.Name, localShadowedBy :: [AbstractName] }
+    -- ^ This local variable is shadowed by one or more imports.
+    --   (List not empty).
+  deriving (Typeable)
+
+instance NFData LocalVar
+
+instance Eq LocalVar where
+  (==) = (==) `on` localVar
+
+instance Ord LocalVar where
+  compare = compare `on` localVar
+
+-- | We show shadowed variables as prefixed by a ".", as not in scope.
+instance Show LocalVar where
+  show (LocalVar    x)    = show x
+  show (ShadowedVar x xs) = "." ++ show x
+
+-- | Shadow a local name by a non-empty list of imports.
+shadowLocal :: [AbstractName] -> LocalVar -> LocalVar
+shadowLocal [] _ = __IMPOSSIBLE__
+shadowLocal ys (LocalVar    x   ) = ShadowedVar x ys
+shadowLocal ys (ShadowedVar x zs) = ShadowedVar x (ys ++ zs)
+
+-- | Project name of unshadowed local variable.
+notShadowedLocal :: LocalVar -> Maybe A.Name
+notShadowedLocal (LocalVar x) = Just x
+notShadowedLocal ShadowedVar{} = Nothing
+
+-- | Get all locals that are not shadowed.
+notShadowedLocals :: LocalVars -> AssocList C.Name A.Name
+notShadowedLocals = mapMaybe $ \ (c,x) -> (c,) <$> notShadowedLocal x
 
 -- | Lens for 'scopeLocals'.
-modifyScopeLocals :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
-modifyScopeLocals f sc = sc { scopeLocals = f (scopeLocals sc) }
+updateScopeLocals :: (LocalVars -> LocalVars) -> ScopeInfo -> ScopeInfo
+updateScopeLocals f sc = sc { scopeLocals = f (scopeLocals sc) }
 
 setScopeLocals :: LocalVars -> ScopeInfo -> ScopeInfo
-setScopeLocals vars = modifyScopeLocals (const vars)
+setScopeLocals vars = updateScopeLocals (const vars)
 
 ------------------------------------------------------------------------
 -- * Name spaces
@@ -93,7 +158,7 @@ setScopeLocals vars = modifyScopeLocals (const vars)
 --   write to the abstract fully qualified names that the type checker wants to
 --   read.
 data NameSpace = NameSpace
-      { nsNames	  :: NamesInScope
+      { nsNames   :: NamesInScope
         -- ^ Maps concrete names to a list of abstract names.
       , nsModules :: ModulesInScope
         -- ^ Maps concrete module names to a list of abstract module names.
@@ -189,12 +254,20 @@ instance Eq AbstractName where
 instance Ord AbstractName where
   compare = compare `on` anameName
 
+-- | Van Laarhoven lens on 'anameName'.
+lensAnameName :: Functor m => (A.QName -> m A.QName) -> AbstractName -> m AbstractName
+lensAnameName f am = f (anameName am) <&> \ m -> am { anameName = m }
+
 instance Eq AbstractModule where
   (==) = (==) `on` amodName
 
 instance Ord AbstractModule where
   compare = compare `on` amodName
 
+-- | Van Laarhoven lens on 'amodName'.
+lensAmodName :: Functor m => (A.ModuleName -> m A.ModuleName) -> AbstractModule -> m AbstractModule
+lensAmodName f am = f (amodName am) <&> \ m -> am { amodName = m }
+
 -- * Operations on name and module maps.
 
 mergeNames :: Eq a => ThingsInScope a -> ThingsInScope a -> ThingsInScope a
@@ -211,31 +284,30 @@ emptyNameSpace = NameSpace Map.empty Map.empty
 
 -- | Map functions over the names and modules in a name space.
 mapNameSpace :: (NamesInScope   -> NamesInScope  ) ->
-		(ModulesInScope -> ModulesInScope) ->
-		NameSpace -> NameSpace
+                (ModulesInScope -> ModulesInScope) ->
+                NameSpace -> NameSpace
 mapNameSpace fd fm ns =
-  ns { nsNames	 = fd $ nsNames ns
+  ns { nsNames   = fd $ nsNames ns
      , nsModules = fm $ nsModules  ns
      }
 
 -- | Zip together two name spaces.
 zipNameSpace :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
-		(ModulesInScope -> ModulesInScope -> ModulesInScope) ->
-		NameSpace -> NameSpace -> NameSpace
+                (ModulesInScope -> ModulesInScope -> ModulesInScope) ->
+                NameSpace -> NameSpace -> NameSpace
 zipNameSpace fd fm ns1 ns2 =
-  ns1 { nsNames	  = nsNames   ns1 `fd` nsNames   ns2
+  ns1 { nsNames   = nsNames   ns1 `fd` nsNames   ns2
       , nsModules = nsModules ns1 `fm` nsModules ns2
       }
 
 -- | Map monadic function over a namespace.
-mapNameSpaceM :: Monad m =>
+mapNameSpaceM :: Applicative m =>
   (NamesInScope   -> m NamesInScope  ) ->
   (ModulesInScope -> m ModulesInScope) ->
   NameSpace -> m NameSpace
-mapNameSpaceM fd fm ns = do
-  ds <- fd $ nsNames ns
-  ms <- fm $ nsModules ns
-  return $ ns { nsNames = ds, nsModules = ms }
+mapNameSpaceM fd fm ns = update ns <$> fd (nsNames ns) <*> fm (nsModules ns)
+  where
+    update ns ds ms = ns { nsNames = ds, nsModules = ms }
 
 ------------------------------------------------------------------------
 -- * General operations on scopes
@@ -256,39 +328,36 @@ emptyScopeInfo :: ScopeInfo
 emptyScopeInfo = ScopeInfo
   { scopeCurrent    = noModuleName
   , scopeModules    = Map.singleton noModuleName emptyScope
-  , scopeLocals	    = []
+  , scopeLocals     = []
   , scopePrecedence = TopCtx
   }
 
 -- | Map functions over the names and modules in a scope.
 mapScope :: (NameSpaceId -> NamesInScope   -> NamesInScope  ) ->
-	    (NameSpaceId -> ModulesInScope -> ModulesInScope) ->
-	    Scope -> Scope
-mapScope fd fm s =
-  s { scopeNameSpaces = [ (nsid, mapNS nsid ns) | (nsid, ns) <- scopeNameSpaces s ] }
+            (NameSpaceId -> ModulesInScope -> ModulesInScope) ->
+            Scope -> Scope
+mapScope fd fm = updateScopeNameSpaces $ AssocList.mapWithKey mapNS
   where
     mapNS acc = mapNameSpace (fd acc) (fm acc)
 
 -- | Same as 'mapScope' but applies the same function to all name spaces.
 mapScope_ :: (NamesInScope   -> NamesInScope  ) ->
-	     (ModulesInScope -> ModulesInScope) ->
-	     Scope -> Scope
+             (ModulesInScope -> ModulesInScope) ->
+             Scope -> Scope
 mapScope_ fd fm = mapScope (const fd) (const fm)
 
 -- | Map monadic functions over the names and modules in a scope.
-mapScopeM :: (Functor m, Monad m) =>
+mapScopeM :: (Functor m, Applicative m) =>
   (NameSpaceId -> NamesInScope   -> m NamesInScope  ) ->
   (NameSpaceId -> ModulesInScope -> m ModulesInScope) ->
   Scope -> m Scope
-mapScopeM fd fm s = do
-  nss <- sequence [ (,) nsid <$> mapNS nsid ns | (nsid, ns) <- scopeNameSpaces s ]
-  return $ s { scopeNameSpaces = nss }
+mapScopeM fd fm = updateScopeNameSpacesM $ AssocList.mapWithKeyM mapNS
   where
     mapNS acc = mapNameSpaceM (fd acc) (fm acc)
 
 -- | Same as 'mapScopeM' but applies the same function to both the public and
 --   private name spaces.
-mapScopeM_ :: (Functor m, Monad m) =>
+mapScopeM_ :: (Functor m, Applicative m) =>
   (NamesInScope   -> m NamesInScope  ) ->
   (ModulesInScope -> m ModulesInScope) ->
   Scope -> m Scope
@@ -297,8 +366,8 @@ mapScopeM_ fd fm = mapScopeM (const fd) (const fm)
 -- | Zip together two scopes. The resulting scope has the same name as the
 --   first scope.
 zipScope :: (NameSpaceId -> NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
-	    (NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope) ->
-	    Scope -> Scope -> Scope
+            (NameSpaceId -> ModulesInScope -> ModulesInScope -> ModulesInScope) ->
+            Scope -> Scope -> Scope
 zipScope fd fm s1 s2 =
   s1 { scopeNameSpaces = [ (nsid, zipNS nsid ns1 ns2)
                          | ((nsid, ns1), (nsid', ns2)) <- zipWith' (,) (scopeNameSpaces s1) (scopeNameSpaces s2)
@@ -314,8 +383,8 @@ zipScope fd fm s1 s2 =
 -- | Same as 'zipScope' but applies the same function to both the public and
 --   private name spaces.
 zipScope_ :: (NamesInScope   -> NamesInScope   -> NamesInScope  ) ->
-	     (ModulesInScope -> ModulesInScope -> ModulesInScope) ->
-	     Scope -> Scope -> Scope
+             (ModulesInScope -> ModulesInScope -> ModulesInScope) ->
+             Scope -> Scope -> Scope
 zipScope_ fd fm = zipScope (const fd) (const fm)
 
 -- | Filter a scope keeping only concrete names matching the predicates.
@@ -364,8 +433,7 @@ mergeScopes ss = foldr1 mergeScope ss
 -- | Move all names in a scope to the given name space (except never move from
 --   Imported to Public).
 setScopeAccess :: NameSpaceId -> Scope -> Scope
-setScopeAccess a s = s { scopeNameSpaces = [ (nsid, ns nsid) | (nsid, _) <- scopeNameSpaces s ]
-		       }
+setScopeAccess a s = (`updateScopeNameSpaces` s) $ AssocList.mapWithKey $ const . ns
   where
     zero  = emptyNameSpace
     one   = allThingsInScope s
@@ -378,10 +446,9 @@ setScopeAccess a s = s { scopeNameSpaces = [ (nsid, ns nsid) | (nsid, _) <- scop
       _ | a == b             -> one
         | otherwise          -> zero
 
+-- | Update a particular name space.
 setNameSpace :: NameSpaceId -> NameSpace -> Scope -> Scope
-setNameSpace nsid ns s =
-  s { scopeNameSpaces = [ (nsid', if nsid == nsid' then ns else ns')
-                        | (nsid', ns') <- scopeNameSpaces s ] }
+setNameSpace nsid ns = updateScopeNameSpaces $ AssocList.update nsid ns
 
 -- | Add names to a scope.
 addNamesToScope :: NameSpaceId -> C.Name -> [AbstractName] -> Scope -> Scope
@@ -413,54 +480,53 @@ applyImportDirective :: ImportDirective -> Scope -> Scope
 applyImportDirective dir s = mergeScope usedOrHidden renamed
   where
     usedOrHidden = useOrHide (hideLHS (renaming dir) $ usingOrHiding dir) s
-    renamed	 = rename (renaming dir) $ useOrHide useRenamedThings s
+    renamed      = rename (renaming dir) $ useOrHide useRenamedThings s
 
     useRenamedThings = Using $ map renFrom $ renaming dir
 
     hideLHS :: [Renaming] -> UsingOrHiding -> UsingOrHiding
-    hideLHS _	i@(Using _) = i
+    hideLHS _   i@(Using _) = i
     hideLHS ren (Hiding xs) = Hiding $ xs ++ map renFrom ren
 
     useOrHide :: UsingOrHiding -> Scope -> Scope
     useOrHide (Hiding xs) s = filterNames notElem notElem xs s
-    useOrHide (Using  xs) s = filterNames elem	  elem	  xs s
+    useOrHide (Using  xs) s = filterNames elem    elem    xs s
 
     filterNames :: (C.Name -> [C.Name] -> Bool) -> (C.Name -> [C.Name] -> Bool) ->
-		   [ImportedName] -> Scope -> Scope
+                   [ImportedName] -> Scope -> Scope
     filterNames pd pm xs = filterScope' (flip pd ds) (flip pm ms)
       where
-	ds = [ x | ImportedName   x <- xs ]
-	ms = [ m | ImportedModule m <- xs ]
+        ds = [ x | ImportedName   x <- xs ]
+        ms = [ m | ImportedModule m <- xs ]
 
     filterScope' pd pm = filterScope pd pm
 
     -- Renaming
     rename :: [Renaming] -> Scope -> Scope
     rename rho = mapScope_ (Map.mapKeys $ ren drho)
-			   (Map.mapKeys $ ren mrho)
+                           (Map.mapKeys $ ren mrho)
       where
-	mrho = [ (x, y) | Renaming { renFrom = ImportedModule x, renTo = y } <- rho ]
-	drho = [ (x, y) | Renaming { renFrom = ImportedName   x, renTo = y } <- rho ]
+        mrho = [ (x, y) | Renaming { renFrom = ImportedModule x, renTo = y } <- rho ]
+        drho = [ (x, y) | Renaming { renFrom = ImportedName   x, renTo = y } <- rho ]
 
-	ren r x = maybe x id $ lookup x r
+        ren r x = fromMaybe x $ lookup x r
 
 -- | Rename the abstract names in a scope.
 renameCanonicalNames :: Map A.QName A.QName -> Map A.ModuleName A.ModuleName ->
-			Scope -> Scope
+                        Scope -> Scope
 renameCanonicalNames renD renM = mapScope_ renameD renameM
   where
-    renameD = Map.map (map $ onName  rD)
-    renameM = Map.map (map $ onMName rM)
-
-    onName  f x = x { anameName = f $ anameName x }
-    onMName f x = x { amodName  = f $ amodName  x }
+    renameD = Map.map $ map $ over lensAnameName $ \ x -> Map.findWithDefault x x renD
+    renameM = Map.map $ map $ over lensAmodName  $ \ x -> Map.findWithDefault x x renM
 
-    rD x = maybe x id $ Map.lookup x renD
-    rM x = maybe x id $ Map.lookup x renM
-
--- | Restrict the private name space of a scope
+-- | Remove private name space of a scope.
+--
+--   Should be a right identity for 'exportedNamesInScope'.
+--   @exportedNamesInScope . restrictPrivate == exportedNamesInscope at .
 restrictPrivate :: Scope -> Scope
-restrictPrivate s = setNameSpace PrivateNS emptyNameSpace $ s { scopeImports = Map.empty }
+restrictPrivate s
+  = setNameSpace PrivateNS  emptyNameSpace
+  $ s { scopeImports = Map.empty }
 
 -- | Remove names that can only be used qualified (when opening a scope)
 removeOnlyQualified :: Scope -> Scope
@@ -475,35 +541,31 @@ inScopeBecause f = mapScope_ mapName mapMod
 
 -- | Get the public parts of the public modules of a scope
 publicModules :: ScopeInfo -> Map A.ModuleName Scope
-publicModules scope = Map.filterWithKey (\m _ -> reachable m) allMods
+publicModules scope = Map.filterWithKey (\ m _ -> reachable m) allMods
   where
+    -- Get all modules in the ScopeInfo.
     allMods   = Map.map restrictPrivate $ scopeModules scope
     root      = scopeCurrent scope
+
     modules s = map amodName $ concat $ Map.elems $ allNamesInScope s
 
-    chase m = m : case Map.lookup m allMods of
-      Just s  -> concatMap chase $ modules s
-      Nothing -> __IMPOSSIBLE__
+    chase m = m : concatMap chase ms
+      where ms = maybe __IMPOSSIBLE__ modules $ Map.lookup m allMods
 
     reachable = (`elem` chase root)
 
 everythingInScope :: ScopeInfo -> NameSpace
-everythingInScope scope =
-    allThingsInScope
-    $ mergeScopes
+everythingInScope scope = allThingsInScope $ mergeScopes $
     [ s | (m, s) <- Map.toList (scopeModules scope), m `elem` current ]
   where
     this    = scopeCurrent scope
-    parents = case Map.lookup this (scopeModules scope) of
-      Just s  -> scopeParents s
-      Nothing -> __IMPOSSIBLE__
+    parents = maybe __IMPOSSIBLE__ scopeParents $ Map.lookup this $ scopeModules scope
     current = this : parents
 
 -- | Compute a flattened scope. Only include unqualified names or names
 -- qualified by modules in the first argument.
 flattenScope :: [[C.Name]] -> ScopeInfo -> Map C.QName [AbstractName]
 flattenScope ms scope =
-  -- Map.filterKeys (\q -> elem (init $ C.qnameParts q) ([]:ms)) $
   Map.unionWith (++)
     (build ms allNamesInScope root)
     imported
@@ -529,7 +591,7 @@ flattenScope ms scope =
         $ Map.unionsWith (++) $
           [ Map.mapKeys (\y -> C.Qual x y) $ build ms' exportedNamesInScope $ moduleScope m
           | (x, mods) <- Map.toList (getNames s)
-          , let ms' = [ ms' | m':ms' <- ms, m' == x ]
+          , let ms' = [ tl | hd:tl <- ms, hd == x ]
           , not $ null ms'
           , AbsModule m _ <- mods ]
 
@@ -541,61 +603,77 @@ scopeLookup :: InScope a => C.QName -> ScopeInfo -> [a]
 scopeLookup q scope = map fst $ scopeLookup' q scope
 
 scopeLookup' :: forall a. InScope a => C.QName -> ScopeInfo -> [(a, Access)]
-scopeLookup' q scope = nubBy ((==) `on` fst) $ findName q root ++ imports
+scopeLookup' q scope = nubBy ((==) `on` fst) $ findName q root ++ topImports ++ imports
   where
 
+    -- 1. Finding a name in the current scope and its parents.
+
+    moduleScope :: A.ModuleName -> Scope
+    moduleScope m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
+
     current :: Scope
     current = moduleScope $ scopeCurrent scope
 
     root    :: Scope
     root    = mergeScopes $ current : map moduleScope (scopeParents current)
 
-    -- return all possible splittings, e.g.
-    -- splitName X.Y.Z = [(X, Y.Z), (X.Y, Z)]
-    splitName :: C.QName -> [(C.QName, C.QName)]
-    splitName (C.QName x) = []
-    splitName (C.Qual x q) = (C.QName x, q) : do
-      (m, r) <- splitName q
-      return (C.Qual x m, r)
+    -- | Find a concrete, possibly qualified name in scope @s at .
+    findName :: forall a. InScope a => C.QName -> Scope -> [(a, Access)]
+    findName q0 s = case q0 of
+      C.QName x  -> lookupName x s
+      C.Qual x q -> do
+        let -- | Get the modules named @x@ in scope @s at .
+            mods :: [A.ModuleName]
+            mods = amodName . fst <$> lookupName x s
+            -- | Get the definitions named @x@ in scope @s@ and interpret them as modules.
+            -- Andreas, 2013-05-01: Issue 836 debates this feature:
+            -- Qualified constructors are qualified by their datatype rather than a module
+            defs :: [A.ModuleName]
+            defs = mnameFromList . qnameToList . anameName . fst <$> lookupName x s
+        -- Andreas, 2013-05-01:  Issue 836 complains about the feature
+        -- that constructors can also be qualified by their datatype
+        -- and projections by their record type.  This feature is off
+        -- if we just consider the modules:
+        -- m <- mods
+        -- The feature is on if we consider also the data and record types:
+        -- trace ("mods ++ defs = " ++ show (mods ++ defs)) $ do
+        m <- nub $ mods ++ defs -- record types will appear both as a mod and a def
+        -- Get the scope of module m, if any, and remove its private definitions.
+        let ss  = maybeToList $ Map.lookup m $ scopeModules scope
+            ss' = restrictPrivate <$> ss
+        -- trace ("ss  = " ++ show ss ) $ do
+        -- trace ("ss' = " ++ show ss') $ do
+        s' <- ss'
+        findName q s'
+      where
+        lookupName :: forall a. InScope a => C.Name -> Scope -> [(a, Access)]
+        lookupName x s = fromMaybe [] $ Map.lookup x $ allNamesInScope' s
 
-    imported :: C.QName -> [(A.ModuleName, Access)]
-    imported q = maybe [] ((:[]) . (, PublicAccess)) $ Map.lookup q $ scopeImports root
+    -- 2. Finding a name in the top imports.
 
     topImports :: [(a, Access)]
     topImports = case (inScopeTag :: InScopeTag a) of
       NameTag   -> []
       ModuleTag -> map (first (`AbsModule` Defined)) (imported q)
 
+    imported :: C.QName -> [(A.ModuleName, Access)]
+    imported q = map (,PublicAccess) $ maybeToList $ Map.lookup q $ scopeImports root
+
+    -- 3. Finding a name in the imports belonging to an initial part of the qualifier.
+
     imports :: [(a, Access)]
-    imports = topImports ++ do
+    imports = do
       (m, x) <- splitName q
       m <- fst <$> imported m
       findName x (restrictPrivate $ moduleScope m)
 
-    moduleScope :: A.ModuleName -> Scope
-    moduleScope m = fromMaybe __IMPOSSIBLE__ $ Map.lookup m $ scopeModules scope
-
-    lookupName :: forall a. InScope a => C.Name -> Scope -> [(a, Access)]
-    lookupName x s = maybe [] id $ Map.lookup x (allNamesInScope' s)
+    -- return all possible splittings, e.g.
+    -- splitName X.Y.Z = [(X, Y.Z), (X.Y, Z)]
+    splitName :: C.QName -> [(C.QName, C.QName)]
+    splitName (C.QName x)  = []
+    splitName (C.Qual x q) =
+      (C.QName x, q) : [ (C.Qual x m, r) | (m, r) <- splitName q ]
 
-    findName :: forall a. InScope a => C.QName -> Scope -> [(a, Access)]
-    findName (C.QName x)  s = lookupName x s
-    findName (C.Qual x q) s = do
-        -- Andreas, 2013-05-01:  Issue 836 complains about the feature
-        -- that constructors can also be qualified by their datatype
-        -- and projections by their record type.  This feature is off
-        -- if we just consider the modules:
-        -- m <- mods
-        -- The feature is on if we consider also the data and record types:
-        m <- nub $ mods ++ defs -- record types will appear both as a mod and a def
-        Just s' <- return $ Map.lookup m (scopeModules scope)
-        findName q (restrictPrivate s')
-      where
-        mods, defs :: [ModuleName]
-        mods = amodName . fst <$> lookupName x s
-        -- Andreas, 2013-05-01: Issue 836 debates this feature:
-        -- Qualified constructors are qualified by their datatype rather than a module
-        defs = mnameFromList . qnameToList . anameName . fst <$> lookupName x s
 
 -- * Inverse look-up
 
@@ -626,9 +704,8 @@ inverseScopeLookup' ambCon name scope = case name of
     len (C.QName _)  = 1
     len (C.Qual _ x) = 1 + len x
 
-    best xs = case sortBy (compare `on` len) xs of
-      []    -> Nothing
-      x : _ -> Just x
+    best :: [C.QName] -> Maybe C.QName
+    best xs = headMaybe $ sortBy (compare `on` len) xs
 
     unique :: forall a . [a] -> Bool
     unique []      = __IMPOSSIBLE__
@@ -641,7 +718,7 @@ inverseScopeLookup' ambCon name scope = case name of
 
     findName :: Ord a => Map a [(A.ModuleName, C.Name)] -> a -> [C.QName]
     findName table q = do
-      (m, x) <- maybe [] id $ Map.lookup q table
+      (m, x) <- fromMaybe [] $ Map.lookup q table
       if m `elem` current
         then return (C.QName x)
         else do
@@ -650,7 +727,7 @@ inverseScopeLookup' ambCon name scope = case name of
 
     findModule :: A.ModuleName -> [C.QName]
     findModule q = findName moduleMap q ++
-                   maybe [] id (Map.lookup q importMap)
+                   fromMaybe [] (Map.lookup q importMap)
 
     importMap = Map.unionsWith (++) $ do
       (m, s) <- scopes
@@ -707,7 +784,7 @@ instance Show NameSpace where
       pr (x, y) = show x ++ " --> " ++ show y
 
 instance Show Scope where
-  show (scope @ Scope { scopeName = name, scopeParents = parents, scopeImports = imps }) =
+  show (scope at Scope{ scopeName = name, scopeParents = parents, scopeImports = imps }) =
     unlines $
       [ "* scope " ++ show name ] ++ ind (
         concat [ blockOfLines (show nsid) (lines $ show $ scopeNameSpace nsid scope)
diff --git a/src/full/Agda/Syntax/Scope/Monad.hs b/src/full/Agda/Syntax/Scope/Monad.hs
index 0bac96a..0b7f399 100644
--- a/src/full/Agda/Syntax/Scope/Monad.hs
+++ b/src/full/Agda/Syntax/Scope/Monad.hs
@@ -12,7 +12,7 @@ import Control.Monad hiding (mapM)
 import Control.Monad.Writer hiding (mapM)
 import Control.Monad.State hiding (mapM)
 
-import Data.List
+import Data.List as List
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
@@ -30,12 +30,15 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Monad.State
 import Agda.TypeChecking.Monad.Options
 
-import Agda.Utils.Tuple
-import Agda.Utils.Fresh
-import Agda.Utils.Size
+import qualified Agda.Utils.AssocList as AssocList
+import Agda.Utils.Function
 import Agda.Utils.List
+import Agda.Utils.Maybe
+import Agda.Utils.Null (unlessNull)
+import Agda.Utils.Size
+import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- * The scope checking monad
@@ -98,9 +101,7 @@ createModule b m = do
 
 -- | Apply a function to the scope info.
 modifyScopeInfo :: (ScopeInfo -> ScopeInfo) -> ScopeM ()
-modifyScopeInfo f = do
-  scope <- getScope
-  setScope $ f scope
+modifyScopeInfo = modifyScope
 
 -- | Apply a function to the scope map.
 modifyScopes :: (Map A.ModuleName Scope -> Map A.ModuleName Scope) -> ScopeM ()
@@ -110,32 +111,24 @@ modifyScopes f = modifyScopeInfo $ \s -> s { scopeModules = f $ scopeModules s }
 modifyNamedScope :: A.ModuleName -> (Scope -> Scope) -> ScopeM ()
 modifyNamedScope m f = modifyScopes $ Map.adjust f m
 
--- | Apply a function to the current scope.
-modifyCurrentScope :: (Scope -> Scope) -> ScopeM ()
-modifyCurrentScope f = do
-  m <- getCurrentModule
-  modifyNamedScope m f
+setNamedScope :: A.ModuleName -> Scope -> ScopeM ()
+setNamedScope m s = modifyNamedScope m $ const s
 
 -- | Apply a monadic function to the top scope.
 modifyNamedScopeM :: A.ModuleName -> (Scope -> ScopeM Scope) -> ScopeM ()
-modifyNamedScopeM m f = do
-  s  <- getNamedScope m
-  s' <- f s
-  modifyNamedScope m (const s')
+modifyNamedScopeM m f = setNamedScope m =<< f =<< getNamedScope m
+
+-- | Apply a function to the current scope.
+modifyCurrentScope :: (Scope -> Scope) -> ScopeM ()
+modifyCurrentScope f = getCurrentModule >>= (`modifyNamedScope` f)
 
 modifyCurrentScopeM :: (Scope -> ScopeM Scope) -> ScopeM ()
-modifyCurrentScopeM f = do
-  m <- getCurrentModule
-  modifyNamedScopeM m f
+modifyCurrentScopeM f = getCurrentModule >>= (`modifyNamedScopeM` f)
 
 -- | Apply a function to the public or private name space.
 modifyCurrentNameSpace :: NameSpaceId -> (NameSpace -> NameSpace) -> ScopeM ()
-modifyCurrentNameSpace acc f = modifyCurrentScope action
-  where
-    action s = s { scopeNameSpaces = [ (nsid, f' nsid ns) | (nsid, ns) <- scopeNameSpaces s ] }
-
-    f' a | a == acc  = f
-         | otherwise = id
+modifyCurrentNameSpace acc f = modifyCurrentScope $ updateScopeNameSpaces $
+  AssocList.updateAt acc f
 
 setContextPrecedence :: Precedence -> ScopeM ()
 setContextPrecedence p = modifyScopeInfo $ \s -> s { scopePrecedence = p }
@@ -154,8 +147,11 @@ withContextPrecedence p m = do
 getLocalVars :: ScopeM LocalVars
 getLocalVars = scopeLocals <$> getScope
 
+modifyLocalVars :: (LocalVars -> LocalVars) -> ScopeM ()
+modifyLocalVars = modifyScope . updateScopeLocals
+
 setLocalVars :: LocalVars -> ScopeM ()
-setLocalVars vars = modifyScope $ setScopeLocals vars
+setLocalVars vars = modifyLocalVars $ const vars
 
 -- | Run a computation without changing the local variables.
 withLocalVars :: ScopeM a -> ScopeM a
@@ -216,9 +212,13 @@ resolveName = resolveName' allKindsOfNames
 resolveName' :: [KindOfName] -> C.QName -> ScopeM ResolvedName
 resolveName' kinds x = do
   scope <- getScope
-  let vars = map (C.QName -*- id) $ scopeLocals scope
+  let vars = AssocList.mapKeysMonotonic C.QName $ scopeLocals scope
   case lookup x vars of
-    Just y  -> return $ VarName $ y { nameConcrete = unqualify x }
+    -- Case: we have a local variable x.
+    Just (LocalVar y)  -> return $ VarName $ y { nameConcrete = unqualify x }
+    -- Case: ... but is shadowed by some imports.
+    Just (ShadowedVar y ys) -> typeError $ AmbiguousName x $ A.qualify_ y : map anameName ys
+    -- Case: we do not have a local variable x.
     Nothing -> case filter ((`elem` kinds) . anameKind . fst) $ scopeLookup' x scope of
       [] -> return UnknownName
       ds | all ((==ConName) . anameKind . fst) ds ->
@@ -248,25 +248,20 @@ getFixity :: C.QName -> ScopeM Fixity'
 getFixity x = do
   r <- resolveName x
   case r of
-    VarName y          -> return $ nameFixity y
-    DefinedName _ d    -> return $ nameFixity $ qnameName $ anameName d
-    FieldName d        -> return $ nameFixity $ qnameName $ anameName d
-    ConstructorName ds
-      | null fs        -> __IMPOSSIBLE__
-      | allEqual fs    -> return $ head fs
-      | otherwise      -> return defaultFixity'
-      where
-        fs = map (nameFixity . qnameName . anameName) ds
-    PatternSynResName n -> return $ nameFixity $ qnameName $ anameName n
+    VarName y           -> return $ nameFixity y
+    DefinedName _ d     -> return $ aFixity d
+    FieldName d         -> return $ aFixity d
+    ConstructorName ds  -> return $ chooseFixity $ map aFixity ds
+    PatternSynResName n -> return $ aFixity n
     UnknownName         -> __IMPOSSIBLE__
+  where
+    aFixity = nameFixity . qnameName . anameName
 
 -- * Binding names
 
 -- | Bind a variable. The abstract name is supplied as the second argument.
 bindVariable :: C.Name -> A.Name -> ScopeM ()
-bindVariable x y = do
-  scope <- getScope
-  setScope scope { scopeLocals = (x, y) : scopeLocals scope }
+bindVariable x y = modifyScope $ updateScopeLocals $ AssocList.insert x $ LocalVar y
 
 -- | Bind a defined name. Must not shadow anything.
 bindName :: Access -> KindOfName -> C.Name -> A.QName -> ScopeM ()
@@ -279,13 +274,10 @@ bindName acc kind x y = do
     ConstructorName [] -> __IMPOSSIBLE__
     ConstructorName ds
       | kind == ConName && all ((==ConName) . anameKind) ds -> return [ AbsName y kind Defined ]
-      | otherwise -> typeError $ ClashingDefinition (C.QName x) $ anameName (head' ds)
+      | otherwise -> typeError $ ClashingDefinition (C.QName x) $ anameName (headWithDefault __IMPOSSIBLE__ ds)
     PatternSynResName n -> typeError $ ClashingDefinition (C.QName x) $ anameName n
     UnknownName         -> return [AbsName y kind Defined]
   modifyCurrentScope $ addNamesToScope (localNameSpace acc) x ys
-  where
-    head' []    = {- ' -} __IMPOSSIBLE__
-    head' (x:_) = x
 
 -- | Rebind a name. Use with care!
 --   Ulf, 2014-06-29: Currently used to rebind the name defined by an
@@ -310,11 +302,9 @@ bindQModule acc q m = modifyCurrentScope $ \s ->
 
 -- | Clear the scope of any no names.
 stripNoNames :: ScopeM ()
-stripNoNames = modifyScopes $ Map.map strip
+stripNoNames = modifyScopes $ Map.map $ mapScope_ stripN stripN
   where
-    strip     = mapScope (\_ -> stripN) (\_ -> stripN)
-    stripN m  = Map.filterWithKey (const . notNoName) m
-    notNoName = not . isNoName
+    stripN = Map.filterWithKey $ const . not . isNoName
 
 type Out = (A.Ren A.ModuleName, A.Ren A.QName)
 type WSM = StateT Out ScopeM
@@ -322,50 +312,49 @@ type WSM = StateT Out ScopeM
 -- | Create a new scope with the given name from an old scope. Renames
 --   public names in the old scope to match the new name and returns the
 --   renamings.
+--
+--   Data and record types share a common abstract name with their module.
+--   This invariant needs to be preserved by @copyScope@, since constructors
+--   (fields) can be qualified by their data (record) type name (as an
+--   alternative to qualification by their module).
+--   (See Issue 836).
 copyScope :: C.QName -> A.ModuleName -> Scope -> ScopeM (Scope, (A.Ren A.ModuleName, A.Ren A.QName))
 copyScope oldc new s = first (inScopeBecause $ Applied oldc) <$> runStateT (copy new s) (Map.empty, Map.empty)
   where
+    -- | A memoizing algorithm, the renamings serving as memo structure.
+    copy :: A.ModuleName -> Scope -> StateT (A.Ren A.ModuleName, A.Ren A.QName) ScopeM Scope
     copy new s = do
       lift $ reportSLn "scope.copy" 20 $ "Copying scope " ++ show old ++ " to " ++ show new
       lift $ reportSLn "scope.copy" 50 $ show s
       s0 <- lift $ getNamedScope new
-      s' <- mapScopeM copyD copyM s
+      -- Delete private names, then copy names and modules.
+      s' <- mapScopeM_ copyD copyM $ setNameSpace PrivateNS emptyNameSpace s
+      -- Fix name and parent.
       return $ s' { scopeName    = scopeName s0
                   , scopeParents = scopeParents s0
                   }
       where
         new' = killRange new
+        newL = A.mnameToList new'
         old  = scopeName s
 
-        copyM :: NameSpaceId -> ModulesInScope -> WSM ModulesInScope
-        copyM ImportedNS      ms = traverse (mapM $ onMod renMod) ms
-        copyM PrivateNS       _  = return Map.empty
-        copyM PublicNS        ms = traverse (mapM $ onMod renMod) ms
-        copyM OnlyQualifiedNS ms = traverse (mapM $ onMod renMod) ms
+        copyD :: NamesInScope -> WSM NamesInScope
+        copyD = traverse $ mapM $ onName renName
 
-        copyD :: NameSpaceId -> NamesInScope -> WSM NamesInScope
-        copyD ImportedNS      ds = traverse (mapM $ onName renName) ds
-        copyD PrivateNS       _  = return Map.empty
-        copyD PublicNS        ds = traverse (mapM $ onName renName) ds
-        copyD OnlyQualifiedNS ds = traverse (mapM $ onName renName) ds
-
-        onMod f m = do
-          x <- f $ amodName m
-          return m { amodName = x }
+        copyM :: ModulesInScope -> WSM ModulesInScope
+        copyM = traverse $ mapM $ lensAmodName renMod
 
+        onName :: (A.QName -> WSM A.QName) -> AbstractName -> WSM AbstractName
         onName f d =
           case anameKind d of
             PatternSynName -> return d  -- Pattern synonyms are simply aliased, not renamed
-            _ -> do
-              x <- f $ anameName d
-              return d { anameName = x }
-
-        addName x y = addNames (Map.singleton x y)
-        addMod  x y = addMods (Map.singleton x y)
+            _ -> lensAnameName f d
 
-        addNames rd' = modify $ \(rm, rd) -> (rm, Map.union rd rd')
-        addMods  rm' = modify $ \(rm, rd) -> (Map.union rm rm', rd)
+        -- Adding to memo structure.
+        addName x y = modify $ second $ Map.insert x y
+        addMod  x y = modify $ first  $ Map.insert x y
 
+        -- Querying the memo structure.
         findName x = Map.lookup x <$> gets snd
         findMod  x = Map.lookup x <$> gets fst
 
@@ -373,39 +362,34 @@ copyScope oldc new s = first (inScopeBecause $ Applied oldc) <$> runStateT (copy
         renName :: A.QName -> WSM A.QName
         renName x = do
           lift $ reportSLn "scope.copy" 50 $ "  Copying " ++ show x
-          -- Check if we've seen it already
-          my <- findName x
-          case my of
-            Just y -> return y
-            Nothing -> do
-              -- First time, generate a fresh name for it
-              i <- lift fresh
-              let y = qualifyQ new' . dequalify
-                    $ x { qnameName = (qnameName x) { nameId = i } }
-              addName x y
-              return y
-          where
-            dequalify q = A.qnameFromList [last $ A.qnameToList q]
+          -- If we've seen it already, just return its copy.
+          (`fromMaybeM` findName x) $ do
+          -- We have not processed this name @x@, so copy it to some @y at .
+          -- Check whether we have already seen a module of the same name.
+          -- If yes, use its copy as @y at .
+          y <- ifJustM (findMod $ qnameToMName x) (return . mnameToQName) $ {- else -} do
+            -- First time, generate a fresh name for it.
+            i <- lift fresh
+            return $ A.qualify new' $ (qnameName x) { nameId = i }
+          addName x y
+          return y
 
         -- Change a binding M.x -> old.M'.y to M.x -> new.M'.y
         renMod :: A.ModuleName -> WSM A.ModuleName
         renMod x = do
-          -- Check if we've seen it already
-          my <- findMod x
-          case my of
-            Just y -> return y
-            Nothing -> do
-              -- Create the name of the new module
-              let y = qualifyM new' $ dequalify x
-              addMod x y
-
-              -- We need to copy the contents of included modules recursively
-              s0 <- lift $ createModule False y >> getNamedScope x
-              s  <- withCurrentModule' y $ copy y s0
-              lift $ modifyNamedScope y (const s)
-              return y
-          where
-            dequalify = A.mnameFromList . drop (size old) . A.mnameToList
+          -- If we've seen it already, just return its copy.
+          (`fromMaybeM` findMod x) $ do
+          -- We have not processed this name @x@, so copy it to some @y at .
+          -- Check whether we have seen it already, yet as  name.
+          -- If yes, use its copy as @y at .
+          y <- ifJustM (findName $ mnameToQName x) (return . qnameToMName) $ {- else -} do
+             return $ A.mnameFromList $ (newL ++) $ drop (size old) $ A.mnameToList x
+          addMod x y
+          -- We need to copy the contents of included modules recursively
+          s0 <- lift $ createModule False y >> getNamedScope x
+          s  <- withCurrentModule' y $ copy y s0
+          lift $ modifyNamedScope y (const s)
+          return y
 
 -- | Apply an import directive and check that all the names mentioned actually
 --   exist.
@@ -442,11 +426,23 @@ openModule_ :: C.QName -> ImportDirective -> ScopeM ()
 openModule_ cm dir = do
   current <- getCurrentModule
   m <- amodName <$> resolveModule cm
-  let ns = namespace current m
-  s <- setScopeAccess ns <$>
+  let acc = namespace current m
+  -- Get the scope exported by module to be opened.
+  s <- setScopeAccess acc <$>
         (applyImportDirectiveM cm dir . inScopeBecause (Opened cm) . removeOnlyQualified . restrictPrivate =<< getNamedScope m)
-  checkForClashes (scopeNameSpace ns s)
+  let ns = scopeNameSpace acc s
+  checkForClashes ns
   modifyCurrentScope (`mergeScope` s)
+  verboseS "scope.locals" 10 $ do
+    locals <- mapMaybe (\ (c,x) -> c <$ notShadowedLocal x) <$> getLocalVars
+    let newdefs = Map.keys $ nsNames ns
+        shadowed = List.intersect locals newdefs
+    reportSLn "scope.locals" 10 $ "opening module shadows the following locals vars: " ++ show shadowed
+  -- Andreas, 2014-09-03, issue 1266: shadow local variables by imported defs.
+  modifyLocalVars $ AssocList.mapWithKey $ \ c x ->
+    case Map.lookup c $ nsNames ns of
+      Nothing -> x
+      Just ys -> shadowLocal ys x
   where
     namespace m0 m1
       | not (publicOpen dir)  = PrivateNS
@@ -455,26 +451,26 @@ openModule_ cm dir = do
 
     -- Only checks for clashes that would lead to the same
     -- name being exported twice from the module.
-    checkForClashes new
-      | not (publicOpen dir) = return ()
-      | otherwise = do
+    checkForClashes new = when (publicOpen dir) $ do
 
         old <- allThingsInScope . restrictPrivate <$> (getNamedScope =<< getCurrentModule)
 
         let defClashes = Map.toList $ Map.intersectionWith (,) (nsNames new) (nsNames old)
             modClashes = Map.toList $ Map.intersectionWith (,) (nsModules new) (nsModules old)
 
+            -- No ambiguity if concrete identifier is mapped to
+            -- single, identical abstract identifiers.
             realClash (_, ([x],[y])) = x /= y
             realClash _              = True
 
+            -- No ambiguity if concrete identifier is only mapped to
+            -- constructor names.
             defClash (_, (qs0, qs1)) =
               any ((/= ConName) . anameKind) (qs0 ++ qs1)
 
-            (f & g) x = f x && g x
+        -- We report the first clashing exported identifier.
+        unlessNull (filter (\ x -> realClash x && defClash x) defClashes) $
+          \ ((x, (_, q:_)) : _) -> typeError $ ClashingDefinition (C.QName x) (anameName q)
 
-        case filter (realClash & defClash) defClashes of
-          (x, (_, q:_)):_ -> typeError $ ClashingDefinition (C.QName x) (anameName q)
-          _               -> return ()
-        case filter realClash modClashes of
-          (_, (m0:_, m1:_)):_ -> typeError $ ClashingModule (amodName m0) (amodName m1)
-          _                   -> return ()
+        unlessNull (filter realClash modClashes) $ \ ((_, (m0:_, m1:_)) : _) ->
+          typeError $ ClashingModule (amodName m0) (amodName m1)
diff --git a/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs b/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
index 8ab7b48..31e6675 100644
--- a/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
+++ b/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs
@@ -1,12 +1,13 @@
--- {-# OPTIONS -fwarn-unused-binds #-}
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE PatternGuards          #-}
+{-# LANGUAGE TupleSections          #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-- {-# OPTIONS -fwarn-unused-binds #-}
 
 {-| The translation of abstract syntax to concrete syntax has two purposes.
     First it allows us to pretty print abstract syntax values without having to
@@ -34,6 +35,7 @@ import Control.Applicative hiding (empty)
 import Control.Monad.Reader
 
 import Data.List as List hiding (null)
+import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.Set (Set)
@@ -55,11 +57,12 @@ import Agda.TypeChecking.Monad.State (getScope)
 import Agda.TypeChecking.Monad.Base  (TCM, NamedMeta(..))
 import Agda.TypeChecking.Monad.Options
 
-import Agda.Utils.Monad hiding (bracket)
+import qualified Agda.Utils.AssocList as AssocList
+import Agda.Utils.Monad
 import Agda.Utils.Null
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- Environment ------------------------------------------------------------
@@ -164,7 +167,7 @@ unsafeQNameToName (C.Qual _ x) = unsafeQNameToName x
 lookupName :: A.Name -> AbsToCon C.Name
 lookupName x = do
   names <- asks $ scopeLocals . currentScope
-  case lookup x $ map swap names of
+  case lookup x $ mapMaybe (\ (c,x) -> (,c) <$> notShadowedLocal x) names of
       Just y  -> return y
       Nothing -> return $ nameConcrete x
 
@@ -197,9 +200,8 @@ bindName x ret = do
     True           -> bindName (nextName x) ret
     False          ->
         local (\e -> e { takenNames   = Set.insert y $ takenNames e
-                       , currentScope = (currentScope e)
-                          { scopeLocals = (y, x) : scopeLocals (currentScope e)
-                          }
+                       , currentScope = (`updateScopeLocals` currentScope e) $
+                           AssocList.insert y (LocalVar x)
                        }
               ) $ ret y
 
@@ -349,6 +351,7 @@ instance ToConcrete A.ModuleName C.QName where
 instance ToConcrete A.Expr C.Expr where
     toConcrete (Var x)            = Ident . C.QName <$> toConcrete x
     toConcrete (Def x)            = Ident <$> toConcrete x
+    toConcrete (Proj x)           = Ident <$> toConcrete x
     toConcrete (Con (AmbQ (x:_))) = Ident <$> toConcrete x
     toConcrete (Con (AmbQ []))    = __IMPOSSIBLE__
         -- for names we have to use the name from the info, since the abstract
@@ -826,9 +829,13 @@ instance ToConcrete RangeAndPragma C.Pragma where
 
 -- Left hand sides --------------------------------------------------------
 
+noImplicitArgs :: A.Patterns -> A.Patterns
 noImplicitArgs = filter (noImplicit . namedArg)
+
+noImplicitPats :: [A.Pattern] -> [A.Pattern]
 noImplicitPats = filter noImplicit
 
+noImplicit :: A.Pattern -> Bool
 noImplicit (A.ImplicitP _) = False
 noImplicit _               = True
 
@@ -962,13 +969,6 @@ recoverOpApp bracket opApp view e mDefault = case view e of
     where
       xs       = C.nameParts $ C.unqualify n
       numHoles = length (filter (== Hole) xs)
-{- UNUSED
-      msg      = concat [ "doQName "
-                        , showList xs ""
-                        , " on "
-                        , show (length es)
-                        , " args" ]
--}
 
   -- binary case
   doQName fixity n as
diff --git a/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs b/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
index d37082c..2c0fd75 100644
--- a/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
+++ b/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverlappingInstances   #-}
+{-# LANGUAGE PatternGuards          #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE UndecidableInstances   #-}
 
 {-| Translation from "Agda.Syntax.Concrete" to "Agda.Syntax.Abstract". Involves scope analysis,
     figuring out infix operator precedences and tidying up definitions.
@@ -27,10 +27,9 @@ module Agda.Syntax.Translation.ConcreteToAbstract
     , PatName, APatName, LetDef, LetDefs
     ) where
 
-import Prelude hiding (mapM)
+import Prelude hiding (mapM, null)
 import Control.Applicative
 import Control.Monad.Reader hiding (mapM)
-import Control.Monad.Error hiding (mapM)
 
 import Data.Foldable (Foldable, traverse_)
 import Data.Traversable (mapM, traverse)
@@ -54,7 +53,8 @@ import Agda.Syntax.Scope.Base
 import Agda.Syntax.Scope.Monad
 
 import Agda.TypeChecking.Monad.Base (TypeError(..), Call(..), typeError,
-                                     TCErr(..), extendlambdaname)
+                                     TCErr(..), extendedLambdaName, fresh,
+                                     freshName, freshName_, freshNoName)
 import Agda.TypeChecking.Monad.Benchmark (billTo, billTop, reimburseTop)
 import qualified Agda.TypeChecking.Monad.Benchmark as Bench
 import Agda.TypeChecking.Monad.Trace (traceCall, setCurrentRange)
@@ -68,14 +68,15 @@ import Agda.Interaction.FindFile (checkModuleName)
 import {-# SOURCE #-} Agda.Interaction.Imports (scopeCheckImport)
 import Agda.Interaction.Options
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.FileName
 import Agda.Utils.Functor
-import Agda.Utils.Fresh
 import Agda.Utils.List
 import Agda.Utils.Monad
+import Agda.Utils.Null
 import Agda.Utils.Pretty
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 import Agda.ImpossibleTest (impossibleTest)
 
@@ -83,12 +84,20 @@ import Agda.ImpossibleTest (impossibleTest)
     Exceptions
  --------------------------------------------------------------------------}
 
-notAModuleExpr e            = typeError $ NotAModuleExpr e
-notAnExpression e           = typeError $ NotAnExpression e
-notAValidLetBinding d       = typeError $ NotAValidLetBinding d
+-- notAModuleExpr e = typeError $ NotAModuleExpr e
+
+notAnExpression :: C.Expr -> ScopeM A.Expr
+notAnExpression e = typeError $ NotAnExpression e
+
+nothingAppliedToHiddenArg :: C.Expr -> ScopeM A.Expr
 nothingAppliedToHiddenArg e = typeError $ NothingAppliedToHiddenArg e
+
+nothingAppliedToInstanceArg :: C.Expr -> ScopeM A.Expr
 nothingAppliedToInstanceArg e = typeError $ NothingAppliedToInstanceArg e
 
+notAValidLetBinding :: NiceDeclaration -> ScopeM a
+notAValidLetBinding d = typeError $ NotAValidLetBinding d
+
 -- Debugging
 
 printLocals :: Int -> String -> ScopeM ()
@@ -122,9 +131,8 @@ expandEllipsis p ps (C.Clause x (C.Ellipsis _ ps' eqs es) rhs wh wcs) =
 
 -- | Make sure that each variable occurs only once.
 checkPatternLinearity :: [A.Pattern' e] -> ScopeM ()
-checkPatternLinearity ps = case xs \\ nub xs of
-    []  -> return ()
-    ys  -> typeError $ RepeatedVariablesInPattern $ nub ys
+checkPatternLinearity ps = unlessNull (duplicates xs) $ \ ys -> do
+  typeError $ RepeatedVariablesInPattern ys
   where
     xs = concatMap vars ps
     vars :: A.Pattern' e -> [C.Name]
@@ -172,7 +180,7 @@ recordConstructorType fields = build fs
 -- | @checkModuleApplication modapp m0 x dir = return (modapp', renD, renM)@
 --
 --   @m0@ is the new (abstract) module name and
---   @x@ its concret form (used for error messages).
+--   @x@ its concrete form (used for error messages).
 checkModuleApplication
   :: C.ModuleApplication
   -> ModuleName
@@ -183,11 +191,11 @@ checkModuleApplication
 checkModuleApplication (C.SectionApp _ tel e) m0 x dir' =
   -- For the following, set the current module to be m0.
   withCurrentModule m0 $ do
-    -- check that expression @e@ is of the form @m args@
+    -- Check that expression @e@ is of the form @m args at .
     (m, args) <- parseModuleApplication e
-    -- scope check the telescope (introduces bindings!)
+    -- Scope check the telescope (introduces bindings!).
     tel' <- toAbstract tel
-    -- scope the old module name, the module args
+    -- Scope check the old module name and the module args.
     (m1, args') <- toAbstract (OldModuleName m, args)
     -- Drop constructors (OnlyQualified) if there are arguments. The record constructor
     -- isn't properly in the record module, so copying it will lead to badness.
@@ -226,7 +234,7 @@ checkModuleMacro
   -> OpenShortHand
   -> ImportDirective
   -> ScopeM [a]
-checkModuleMacro apply r p x modapp open dir = withLocalVars $ do
+checkModuleMacro apply r p x modapp open dir = do
     notPublicWithoutOpen open dir
 
     m0 <- toAbstract (NewModuleName x)
@@ -239,9 +247,11 @@ checkModuleMacro apply r p x modapp open dir = withLocalVars $ do
                 DontOpen  -> dir
                 DoOpen    -> defaultImportDir
 
-    (modapp', renD, renM) <- checkModuleApplication modapp m0 x dir'
+    -- Restore the locals after module application has been checked.
+    (modapp', renD, renM) <- withLocalVars $ checkModuleApplication modapp m0 x dir'
     bindModule p x m0
     printScope "mod.inst.copy.after" 20 "after copying"
+    -- Andreas, 2014-09-02 openModule_ might shadow some locals!
     when (open == DoOpen) $
       openModule_ (C.QName x) dir
     printScope "mod.inst" 20 $ show open
@@ -284,7 +294,7 @@ concreteToAbstract scope x = withScope_ scope (toAbstract x)
 -- | Things that can be translated to abstract syntax are instances of this
 --   class.
 class ToAbstract concrete abstract | concrete -> abstract where
-    toAbstract    :: concrete -> ScopeM abstract
+    toAbstract :: concrete -> ScopeM abstract
 
 -- | This function should be used instead of 'toAbstract' for things that need
 --   to keep track of precedences to make sure that we don't forget about it.
@@ -353,9 +363,9 @@ instance ToAbstract (NewName C.BoundName) A.Name where
 nameExpr :: AbstractName -> A.Expr
 nameExpr d = mk (anameKind d) $ anameName d
   where
-    mk DefName        x = Def x
-    mk FldName        x = Def x
-    mk ConName        x = Con $ AmbQ [x]
+    mk DefName        x = A.Def x
+    mk FldName        x = A.Proj x
+    mk ConName        x = A.Con $ AmbQ [x]
     mk PatternSynName x = A.PatternSyn x
     mk QuotableName   x = A.App i (A.Quote i) (defaultNamedArg $ A.Def x)
       where i = ExprRange (getRange x)
@@ -468,8 +478,7 @@ mkArg' info e                   = Common.Arg (setHiding NotHidden info) e
 
 -- | By default, arguments are @Relevant at .
 mkArg :: C.Expr -> C.Arg C.Expr
--- mkArg (C.Dot _ e) = mkArg' Irrelevant e
-mkArg e           = mkArg' defaultArgInfo e
+mkArg e = mkArg' defaultArgInfo e
 
 
 -- | Parse a possibly dotted C.Expr as A.Expr.  Bool = True if dotted.
@@ -492,21 +501,68 @@ toAbstractDot prec e = do
         e <- toAbstractCtx prec e
         return (e, False)
 
+-- | An argument @OpApp C.Expr@ to an operator can have binders,
+--   in case the operator is some @syntax at -notation.
+--   For these binders, we have to create lambda-abstractions.
 toAbstractOpArg :: Precedence -> OpApp C.Expr -> ScopeM A.Expr
-toAbstractOpArg ctx (Ordinary e) = toAbstractCtx ctx e
+toAbstractOpArg ctx (Ordinary e)                 = toAbstractCtx ctx e
 toAbstractOpArg ctx (SyntaxBindingLambda r bs e) = toAbstractLam r bs e ctx
 
+-- | Translate concrete expression under at least one binder into nested
+--   lambda abstraction in abstract syntax.
 toAbstractLam :: Range -> [C.LamBinding] -> C.Expr -> Precedence -> ScopeM A.Expr
 toAbstractLam r bs e ctx = do
-        localToAbstract (map (C.DomainFull . makeDomainFull) bs) $ \bs ->
-          case bs of
-            b:bs' -> do
-              e        <- toAbstractCtx ctx e
-              let info = ExprRange r
-              return $ A.Lam info b $ foldr mkLam e bs'
-              where
-                  mkLam b e = A.Lam (ExprRange $ fuseRange b e) b e
-            [] -> __IMPOSSIBLE__
+  -- Translate the binders
+  localToAbstract (map (C.DomainFull . makeDomainFull) bs) $ \ bs -> do
+    -- Translate the body
+    e <- toAbstractCtx ctx e
+    -- We have at least one binder.  Get first @b@ and rest @bs at .
+    caseList bs __IMPOSSIBLE__ $ \ b bs -> do
+    return $ A.Lam (ExprRange r) b $ foldr mkLam e bs
+  where
+    mkLam b e = A.Lam (ExprRange $ fuseRange b e) b e
+
+-- | Scope check extended lambda expression.
+scopeCheckExtendedLam :: Range -> [(C.LHS, C.RHS, WhereClause)] -> ScopeM A.Expr
+scopeCheckExtendedLam r cs = do
+  whenM isInsideDotPattern $
+    typeError $ GenericError "Extended lambdas are not allowed in dot patterns"
+
+  -- Find an unused name for the extended lambda definition.
+  cname <- nextlamname r 0 extendedLambdaName
+  name  <- freshAbstractName_ cname
+  reportSLn "scope.extendedLambda" 10 $ "new extended lambda name: " ++ show name
+  qname <- qualifyName_ name
+  bindName PrivateAccess DefName cname qname
+
+  -- Compose a function definition an scope check it.
+  let
+    insertApp (C.RawAppP r es) = C.RawAppP r $ IdentP (C.QName cname) : es
+    insertApp (C.IdentP q    ) = C.RawAppP r $ IdentP (C.QName cname) : [C.IdentP q]
+      where r = getRange q
+    insertApp _ = __IMPOSSIBLE__
+    d = C.FunDef r [] defaultFixity' ConcreteDef TerminationCheck cname $
+          for cs $ \ (lhs, rhs, wh) -> -- wh == NoWhere, see parser for more info
+            C.Clause cname (mapLhsOriginalPattern insertApp lhs) rhs wh []
+  scdef <- toAbstract d
+
+  -- Create the abstract syntax for the extended lambda.
+  case scdef of
+    A.ScopedDecl si [A.FunDef di qname' NotDelayed cs] -> do
+      setScope si  -- This turns into an A.ScopedExpr si $ A.ExtendedLam...
+      return $ A.ExtendedLam (ExprRange r) di qname' cs
+    _ -> __IMPOSSIBLE__
+
+  where
+    -- Get a concrete name that is not yet in scope.
+    nextlamname :: Range -> Int -> String -> ScopeM C.Name
+    nextlamname r i s = do
+      let cname = C.Name r [Id $ stringToRawName $ s ++ show i]
+      rn <- resolveName $ C.QName cname
+      case rn of
+        UnknownName -> return cname
+        _           -> nextlamname r (i+1) s
+
 
 
 instance ToAbstract C.Expr A.Expr where
@@ -546,15 +602,6 @@ instance ToAbstract C.Expr A.Expr where
           parseApplication es
         toAbstract e
 
-{- Andreas, 2010-09-06 STALE COMMENT
-  -- Dots are used in dot patterns and in irrelevant function space .A n -> B
-  -- we propagate dots out from the head of applications
-
-      C.Dot r e1 -> do
-        t1 <- toAbstract e1
-        return $ A.Dot t1
--}
-
   -- Application
       C.App r e1 e2 -> do
         e1 <- toAbstractCtx FunctionCtx e1
@@ -570,7 +617,7 @@ instance ToAbstract C.Expr A.Expr where
         es <- mapM (toAbstractCtx WithArgCtx) es
         return $ A.WithApp (ExprRange r) e es
 
-  -- Malplaced hidden argument
+  -- Misplaced hidden argument
       C.HiddenArg _ _ -> nothingAppliedToHiddenArg e
       C.InstanceArg _ _ -> nothingAppliedToInstanceArg e
 
@@ -580,36 +627,9 @@ instance ToAbstract C.Expr A.Expr where
       C.Lam r bs e -> toAbstractLam r bs e TopCtx
 
   -- Extended Lambda
-      C.ExtendedLam r cs ->
-        ifM isInsideDotPattern (typeError $ GenericError "Extended lambdas are not allowed in dot patterns") $ do
-        cname <- nextlamname r 0 extendlambdaname
-        name  <- freshAbstractName_ cname
-        reportSLn "toabstract.extendlambda" 10 $ "new extended lambda name: " ++ show name
-        qname <- qualifyName_ name
-        bindName PrivateAccess DefName cname qname
-        let insertApp (C.RawAppP r es) = C.RawAppP r ((IdentP (C.QName cname)) : es)
-            insertApp (C.IdentP q) = C.RawAppP (getRange q) ((IdentP (C.QName cname)) : [C.IdentP q])
-            insertApp _ = __IMPOSSIBLE__
-            insertHead (C.LHS p wps eqs with) = C.LHS (insertApp p) wps eqs with
-            insertHead (C.Ellipsis r wps eqs with) = C.Ellipsis r wps eqs with
-        scdef <- toAbstract (C.FunDef r [] defaultFixity' ConcreteDef TerminationCheck cname
-                               (map (\(lhs,rhs,wh) -> -- wh = NoWhere, see parser for more info
-                                      C.Clause cname (insertHead lhs) rhs wh []) cs))
-        case scdef of
-          (A.ScopedDecl si [A.FunDef di qname' NotDelayed cs]) -> do
-            setScope si
-            return $ A.ExtendedLam (ExprRange r) di qname' cs
-          _ -> __IMPOSSIBLE__
-          where
-            nextlamname :: Range -> Int -> String -> ScopeM C.Name
-            nextlamname r i s = do
-              let cname_pre = C.Name r [Id $ stringToRawName $ s ++ show i]
-              rn <- resolveName (C.QName cname_pre)
-              case rn of
-                UnknownName -> return $ cname_pre
-                _           -> nextlamname r (i+1) s
-
--- Irrelevant non-dependent function type
+      C.ExtendedLam r cs -> scopeCheckExtendedLam r cs
+
+  -- Relevant and irrelevant non-dependent function type
 
       C.Fun r e1 e2 -> do
         Common.Arg info (e0, dotted) <- traverse (toAbstractDot FunctionSpaceDomainCtx) $ mkArg e1
@@ -618,16 +638,7 @@ instance ToAbstract C.Expr A.Expr where
         e2 <- toAbstractCtx TopCtx e2
         return $ A.Fun (ExprRange r) e1 e2
 
-{-
--- Other function types
-
-      C.Fun r e1 e2 -> do
-        e1 <- toAbstractCtx FunctionSpaceDomainCtx $ mkArg e1
-        e2 <- toAbstractCtx TopCtx e2
-        let info = ExprRange r
-        return $ A.Fun info e1 e2
--}
-
+  -- Dependent function type
       e0@(C.Pi tel e) ->
         localToAbstract tel $ \tel -> do
         e    <- toAbstractCtx TopCtx e
@@ -727,9 +738,10 @@ scopeCheckNiceModule
   -> ScopeM [A.Declaration]
   -> ScopeM [A.Declaration]
 scopeCheckNiceModule r p name tel checkDs
-  | telHasOpenStms tel = do
+  | telHasOpenStmsOrModuleMacros tel = do
       -- Andreas, 2013-12-10:
-      -- If the module telescope contains open statements,
+      -- If the module telescope contains open statements
+      -- or module macros (Issue 1299),
       -- add an extra anonymous module around the current one.
       -- Otherwise, the open statements would create
       -- identifiers in the parent scope of the current module.
@@ -764,20 +776,20 @@ scopeCheckNiceModule r p name tel checkDs
           defaultImportDir { publicOpen = True }
       return ds
 
--- | Check whether a telescope has open declarations.
-telHasOpenStms :: C.Telescope -> Bool
-telHasOpenStms = any isOpenBinds
+-- | Check whether a telescope has open declarations or module macros.
+telHasOpenStmsOrModuleMacros :: C.Telescope -> Bool
+telHasOpenStmsOrModuleMacros = any yesBinds
   where
-    isOpenBinds (C.TypedBindings _ tb) = isOpenBind $ unArg tb
-    isOpenBind C.TBind{}     = False
-    isOpenBind (C.TLet _ ds) = any isOpen ds
-    isOpen (C.ModuleMacro _ _ _ DoOpen _) = True
-    isOpen C.Open{}          = True
-    isOpen C.Import{}        = __IMPOSSIBLE__
-    isOpen (C.Mutual   _ ds) = any isOpen ds
-    isOpen (C.Abstract _ ds) = any isOpen ds
-    isOpen (C.Private  _ ds) = any isOpen ds
-    isOpen   _               = False
+    yesBinds (C.TypedBindings _ tb) = yesBind $ unArg tb
+    yesBind C.TBind{}     = False
+    yesBind (C.TLet _ ds) = any yes ds
+    yes C.ModuleMacro{}   = True
+    yes C.Open{}          = True
+    yes C.Import{}        = __IMPOSSIBLE__
+    yes (C.Mutual   _ ds) = any yes ds
+    yes (C.Abstract _ ds) = any yes ds
+    yes (C.Private  _ ds) = any yes ds
+    yes _                 = False
 
 {- UNUSED
 telHasLetStms :: C.Telescope -> Bool
@@ -869,13 +881,17 @@ data TopLevelInfo = TopLevelInfo
 topLevelModuleName :: TopLevelInfo -> A.ModuleName
 topLevelModuleName topLevel = scopeCurrent (insideScope topLevel)
 
--- Top-level declarations are always (import|open)* module
+-- | Top-level declarations are always
+--   @
+--     (import|open)*         -- a bunch of possibly opened imports
+--     module ThisModule ...  -- the top-level module of this file
+--   @
 instance ToAbstract (TopLevel [C.Declaration]) TopLevelInfo where
     toAbstract (TopLevel file ds) =
       -- A file is a bunch of preliminary decls (imports etc.)
       -- plus a single module decl.
       case splitAt (length ds - 1) ds of
-        (ds', [C.Module r m0 tel ds]) -> do
+        (outsideDecls, [C.Module r m0 tel insideDecls]) -> do
           -- If the module name is _ compute the name from the file path
           m <- if isNoName m0
                 then return $ C.QName $ C.Name noRange [Id $ stringToRawName $ rootName file]
@@ -888,10 +904,12 @@ instance ToAbstract (TopLevel [C.Declaration]) TopLevelInfo where
                   return m0
           setTopLevelModule m
           am           <- toAbstract (NewModuleQName m)
-          ds'          <- toAbstract ds'
-          (scope0, ds) <- scopeCheckModule r m am tel $ toAbstract ds
-          scope        <- getScope
-          return $ TopLevelInfo (ds' ++ ds) scope scope0
+          -- Scope check the declarations outside
+          outsideDecls <- toAbstract outsideDecls
+          (insideScope, insideDecls) <- scopeCheckModule r m am tel $
+             toAbstract insideDecls
+          outsideScope <- getScope
+          return $ TopLevelInfo (outsideDecls ++ insideDecls) outsideScope insideScope
         _ -> __IMPOSSIBLE__
 
 -- | runs Syntax.Concrete.Definitions.niceDeclarations on main module
@@ -909,7 +927,9 @@ instance ToAbstract [C.Declaration] [A.Declaration] where
     noNoTermCheck (C.Pragma (C.TerminationCheckPragma r NoTerminationCheck)) =
       typeError $ SafeFlagNoTerminationCheck
     noNoTermCheck (C.Pragma (C.TerminationCheckPragma r NonTerminating)) =
-      typeError $ SafeFlagNoTerminationCheck
+      typeError $ SafeFlagNonTerminating
+    noNoTermCheck (C.Pragma (C.TerminationCheckPragma r Terminating)) =
+      typeError $ SafeFlagTerminating
     noNoTermCheck d = return d
 
 newtype LetDefs = LetDefs [C.Declaration]
@@ -972,20 +992,20 @@ instance ToAbstract LetDef [A.LetBinding] where
             -- You can't open public in a let
             NiceOpen r x dirs | not (C.publicOpen dirs) -> do
               m       <- toAbstract (OldModuleName x)
-              n       <- length . scopeLocals <$> getScope
               openModule_ x dirs
-              return [A.LetOpen (ModuleInfo
-                                   { minfoRange  = r
-                                   , minfoAsName = Nothing
-                                   , minfoAsTo   = renamingRange dirs
-                                   , minfoOpenShort = Nothing
-                                   , minfoDirective = Just dirs
-                                   })
-                                m
-                     ]
+              let minfo = ModuleInfo
+                    { minfoRange  = r
+                    , minfoAsName = Nothing
+                    , minfoAsTo   = renamingRange dirs
+                    , minfoOpenShort = Nothing
+                    , minfoDirective = Just dirs
+                    }
+              return [A.LetOpen minfo m]
 
             NiceModuleMacro r p x modapp open dir | not (C.publicOpen dir) ->
-              checkModuleMacro LetApply r p x modapp open dir
+              -- Andreas, 2014-10-09, Issue 1299: module macros in lets need
+              -- to be private
+              checkModuleMacro LetApply r PrivateAccess x modapp open dir
 
             _   -> notAValidLetBinding d
         where
@@ -1176,14 +1196,14 @@ instance ToAbstract NiceDeclaration A.Declaration where
       printScope "open" 20 $ "opening " ++ show x
       openModule_ x dir
       printScope "open" 20 $ "result:"
-      return [A.Open (ModuleInfo
-                        { minfoRange  = r
-                        , minfoAsName = Nothing
-                        , minfoAsTo   = renamingRange dir
-                        , minfoOpenShort = Nothing
-                        , minfoDirective = Just dir
-                        })
-                     m]
+      let minfo = ModuleInfo
+            { minfoRange     = r
+            , minfoAsName    = Nothing
+            , minfoAsTo      = renamingRange dir
+            , minfoOpenShort = Nothing
+            , minfoDirective = Just dir
+            }
+      return [A.Open minfo m]
 
     NicePragma r p -> do
       ps <- toAbstract p
@@ -1222,21 +1242,17 @@ instance ToAbstract NiceDeclaration A.Declaration where
             Nothing -> (x,                  noRange,   Nothing)
             Just a  -> (C.QName (asName a), asRange a, Just (asName a))
       case open of
-        DoOpen   -> do
-          toAbstract [ C.Open r name dir ]
-          return ()
-        DontOpen -> do
-          -- If not opening import directives are applied to the original scope
-          modifyNamedScopeM m $ applyImportDirectiveM x dir
-      return [ A.Import (ModuleInfo
-                           { minfoRange  = r
-                           , minfoAsName = theAsName
-                           , minfoAsTo   =
-                               getRange (theAsSymbol, renamingRange dir)
-                           , minfoOpenShort = Just open
-                           , minfoDirective = Just dir
-                           })
-                        m ]
+        DoOpen   -> void $ toAbstract [ C.Open r name dir ]
+        -- If not opening, import directives are applied to the original scope.
+        DontOpen -> modifyNamedScopeM m $ applyImportDirectiveM x dir
+      let minfo = ModuleInfo
+            { minfoRange     = r
+            , minfoAsName    = theAsName
+            , minfoAsTo      = getRange (theAsSymbol, renamingRange dir)
+            , minfoOpenShort = Just open
+            , minfoDirective = Just dir
+            }
+      return [ A.Import minfo m ]
 
     NiceUnquoteDecl r fx p a tc x e -> do
       y <- freshAbstractQName fx x
@@ -1253,6 +1269,7 @@ instance ToAbstract NiceDeclaration A.Declaration where
       bindName PublicAccess PatternSynName n y
       defn@(as, p) <- withLocalVars $ do
          p  <- toAbstract =<< toAbstract =<< parsePatternSyn p
+         checkPatternLinearity [p]
          as <- (traverse . mapM) (unVarName <=< resolveName . C.QName) as
          as <- (map . fmap) unBlind <$> toAbstract ((map . fmap) Blind as)
          return (as, p)
@@ -1275,6 +1292,8 @@ instance ToAbstract NiceDeclaration A.Declaration where
 data IsRecordCon = YesRec | NoRec
 data ConstrDecl = ConstrDecl IsRecordCon A.ModuleName IsAbstract Access C.NiceDeclaration
 
+bindConstructorName :: ModuleName -> C.Name -> Fixity'-> IsAbstract ->
+                       Access -> IsRecordCon -> ScopeM A.QName
 bindConstructorName m x f a p record = do
   -- The abstract name is the qualified one
   y <- withCurrentModule m $ freshAbstractQName f x
@@ -1312,6 +1331,7 @@ instance ToAbstract C.Pragma [A.Pragma] where
       e <- toAbstract $ OldQName x
       case e of
         A.Def x          -> return [ A.RewritePragma x ]
+        A.Proj x         -> return [ A.RewritePragma x ]
         A.Con (AmbQ [x]) -> return [ A.RewritePragma x ]
         A.Con x          -> fail $ "REWRITE used on ambiguous name " ++ show x
         _       -> __IMPOSSIBLE__
@@ -1329,6 +1349,7 @@ instance ToAbstract C.Pragma [A.Pragma] where
       e <- toAbstract $ OldQName x
       y <- case e of
             A.Def x -> return x
+            A.Proj x -> return x -- TODO: do we need to do s.th. special for projections? (Andreas, 2014-10-12)
             A.Con _ -> fail "Use COMPILED_DATA for constructors" -- TODO
             _       -> __IMPOSSIBLE__
       return [ A.CompiledPragma y hs ]
@@ -1336,7 +1357,6 @@ instance ToAbstract C.Pragma [A.Pragma] where
       e <- toAbstract $ OldQName x
       y <- case e of
             A.Def x -> return x
-            --A.Con x -> return x
             _       -> __IMPOSSIBLE__
       return [ A.CompiledExportPragma y hs ]
     toAbstract (C.CompiledEpicPragma _ x ep) = do
@@ -1349,6 +1369,7 @@ instance ToAbstract C.Pragma [A.Pragma] where
       e <- toAbstract $ OldQName x
       y <- case e of
             A.Def x -> return x
+            A.Proj x -> return x
             A.Con (AmbQ [x]) -> return x
             A.Con x -> fail ("COMPILED_JS used on ambiguous name " ++ show x)
             _       -> __IMPOSSIBLE__
@@ -1583,6 +1604,7 @@ instance ToAbstract C.Pattern (A.Pattern' C.Expr) where
         getHiding p == NotHidden = do
       e <- toAbstract (OldQName x)
       let quoted (A.Def x) = return x
+          quoted (A.Proj x) = return x
           quoted (A.Con (AmbQ [x])) = return x
           quoted (A.Con (AmbQ xs))  = typeError $ GenericError $ "quote: Ambigous name: " ++ show xs
           quoted (A.ScopedExpr _ e) = quoted e
@@ -1644,34 +1666,47 @@ instance ToAbstract C.Pattern (A.Pattern' C.Expr) where
 -- right precedences for the various arguments.
 toAbstractOpApp :: C.QName -> [C.NamedArg (OpApp C.Expr)] -> ScopeM A.Expr
 toAbstractOpApp op es = do
+    -- Get the notation for the operator.
     f  <- getFixity op
-    let (_,_,parts) = oldToNewNotation $ (op, f)
+    let parts = notation . oldToNewNotation $ (op, f)
+    -- We can throw away the @BindingHoles@, since binders
+    -- have been preprocessed into @OpApp C.Expr at .
+    let nonBindingParts = filter (not . isBindingHole) parts
+    -- We should be left with as many holes as we have been given args @es at .
+    -- If not, crash.
+    unless (length (filter isAHole nonBindingParts) == length es) __IMPOSSIBLE__
+    -- Translate operator and its arguments (each in the right context).
     op <- toAbstract (OldQName op)
-    foldl' app op <$> left (theFixity f) [p | p <- parts, not (isBindingHole p)] es
-    where
-        app e arg = A.App (ExprRange (fuseRange e arg)) e (setArgColors [] arg)
-
-        toAbsOpArg cxt = traverse $ traverse $ toAbstractOpArg cxt
-
-        left f (IdPart _ : xs) es = inside f xs es
-        left f (_ : xs) (e : es) = do
-            e  <- toAbsOpArg (LeftOperandCtx f) e
-            es <- inside f xs es
-            return (e : es)
-        left f (_  : _)  [] = __IMPOSSIBLE__
-        left f []        _  = __IMPOSSIBLE__
-
-        inside f [x]          es    = right f x es
-        inside f (IdPart _ : xs) es = inside f xs es
-        inside f (_  : xs) (e : es) = do
-            e  <- toAbsOpArg InsideOperandCtx e
-            es <- inside f xs es
-            return (e : es)
-        inside _ (_ : _) [] = __IMPOSSIBLE__
-        inside _ []         _  = __IMPOSSIBLE__
-
-        right _ (IdPart _)  [] = return []
-        right f _          [e] = do
-            e <- toAbsOpArg (RightOperandCtx f) e
-            return [e]
-        right _ _     _  = __IMPOSSIBLE__
+    foldl' app op <$> left (theFixity f) nonBindingParts es
+  where
+    -- Build an application in the abstract syntax, with correct Range.
+    app e arg = A.App (ExprRange (fuseRange e arg)) e (setArgColors [] arg)
+
+    -- Translate an argument (inside @C.NamedArg . OpApp@).
+    toAbsOpArg cxt = traverse $ traverse $ toAbstractOpArg cxt
+
+    -- The hole left to the first @IdPart@ is filled with an expression in @LeftOperandCtx at .
+    left f (IdPart _ : xs) es = inside f xs es
+    left f (_ : xs) (e : es) = do
+        e  <- toAbsOpArg (LeftOperandCtx f) e
+        es <- inside f xs es
+        return (e : es)
+    left f (_  : _)  [] = __IMPOSSIBLE__
+    left f []        _  = __IMPOSSIBLE__
+
+    -- The holes in between the @IdPart at s is filled with an expression in @InsideOperandCtx at .
+    inside f [x]          es    = right f x es
+    inside f (IdPart _ : xs) es = inside f xs es
+    inside f (_  : xs) (e : es) = do
+        e  <- toAbsOpArg InsideOperandCtx e
+        es <- inside f xs es
+        return (e : es)
+    inside _ (_ : _) [] = __IMPOSSIBLE__
+    inside _ []         _  = __IMPOSSIBLE__
+
+    -- The hole right of the last @IdPart@ is filled with an expression in @RightOperandCtx at .
+    right _ (IdPart _)  [] = return []
+    right f _          [e] = do
+        e <- toAbsOpArg (RightOperandCtx f) e
+        return [e]
+    right _ _     _  = __IMPOSSIBLE__
diff --git a/src/full/Agda/Syntax/Translation/InternalToAbstract.hs b/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
index db761a5..da47b35 100644
--- a/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
+++ b/src/full/Agda/Syntax/Translation/InternalToAbstract.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TupleSections          #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE UndecidableInstances   #-}
 
 {-|
     Translating from internal syntax to abstract syntax. Enables nice
@@ -29,7 +29,6 @@ import Prelude hiding (mapM_, mapM)
 import Control.Applicative
 import Control.Arrow
 import Control.Monad.State hiding (mapM_, mapM)
-import Control.Monad.Error hiding (mapM_, mapM)
 import Control.Monad.Reader hiding (mapM_, mapM)
 
 import Data.Foldable (foldMap)
@@ -63,13 +62,14 @@ import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Telescope
 import Agda.TypeChecking.DropArgs
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- Composition of reified applications ------------------------------------
@@ -151,7 +151,7 @@ instance Reify DisplayTerm Expr where
   reify d = case d of
     DTerm v -> reifyTerm False v
     DDot  v -> reify v
-    DCon c vs -> apps (A.Con (AmbQ [c])) =<< reifyIArgs vs
+    DCon c vs -> apps (A.Con (AmbQ [conName c])) =<< reifyIArgs vs
     DDef f vs -> apps (A.Def f) =<< reifyIArgs vs
     DWithApp u us vs -> do
       (e, es) <- reify (u, us)
@@ -220,7 +220,7 @@ reifyDisplayFormP lhs@(A.SpineLHS i f ps wps) =
 
     okTerm (I.Var _ []) = True
     okTerm (I.Con c vs) = all okArg vs
-    okTerm (I.Def x []) = show x == "_" -- Handling wildcards in display forms
+    okTerm (I.Def x []) = isNoName $ qnameToConcrete x -- Handling wildcards in display forms
     okTerm _            = True -- False
 
     -- Flatten a dt into (parentName, parentArgs, withArgs).
@@ -229,7 +229,7 @@ reifyDisplayFormP lhs@(A.SpineLHS i f ps wps) =
       (f, vs, ds0) -> (f, vs, ds0 ++ ds1 ++ map (DTerm . unArg) ds2)
     flattenWith (DDef f vs) = (f, vs, [])     -- .^ hacky, but we should only hit this when printing debug info
     flattenWith (DTerm (I.Def f es)) =
-      let vs = maybe __IMPOSSIBLE__ id $ mapM isApplyElim es
+      let vs = fromMaybe __IMPOSSIBLE__ $ mapM isApplyElim es
       in (f, map (fmap DTerm) vs, [])
     flattenWith _ = __IMPOSSIBLE__
 
@@ -249,7 +249,7 @@ reifyDisplayFormP lhs@(A.SpineLHS i f ps wps) =
 
         termToPat (DTerm (I.Var n [])) = return $ ps !! n
 
-        termToPat (DCon c vs)          = A.ConP ci (AmbQ [c]) <$> do
+        termToPat (DCon c vs)          = A.ConP ci (AmbQ [conName c]) <$> do
           mapM argToPat =<< reifyIArgs' vs
 
         termToPat (DTerm (I.Con c vs)) = A.ConP ci (AmbQ [conName c]) <$> do
@@ -274,10 +274,10 @@ reifyDisplayFormP lhs@(A.SpineLHS i f ps wps) =
             I.Con c vs ->
               apps (A.Con (AmbQ [conName c])) =<< argsToExpr vs
             I.Def f es -> do
-              let vs = maybe __IMPOSSIBLE__ id $ mapM isApplyElim es
+              let vs = fromMaybe __IMPOSSIBLE__ $ mapM isApplyElim es
               apps (A.Def f) =<< argsToExpr vs
             I.Var n es -> do
-              let vs = maybe __IMPOSSIBLE__ id $ mapM isApplyElim es
+              let vs = fromMaybe __IMPOSSIBLE__ $ mapM isApplyElim es
               -- Andreas, 2014-06-11  Issue 1177
               -- due to β-normalization in substitution,
               -- even the pattern variables @n < len@ can be
@@ -790,6 +790,7 @@ instance DotVars A.Expr where
     A.ScopedExpr _ e       -> dotVars e
     A.Var x                -> Set.singleton x -- add any expression variable
     A.Def _                -> Set.empty
+    A.Proj _               -> Set.empty
     A.Con _                -> Set.empty
     A.Lit _                -> Set.empty
     A.QuestionMark{}       -> Set.empty
@@ -846,7 +847,7 @@ reifyPatterns tel perm ps = evalStateT (reifyArgs ps) 0
 
     translate = (vars !!)
       where
-        vars = permute (invertP perm) [0..]
+        vars = permute (invertP __IMPOSSIBLE__ perm) [0..]
 
     reifyPat :: I.Pattern -> StateT Nat TCM A.Pattern
     reifyPat p = case p of
diff --git a/src/full/Agda/Termination/CallGraph.hs b/src/full/Agda/Termination/CallGraph.hs
index 90e161d..635ea95 100644
--- a/src/full/Agda/Termination/CallGraph.hs
+++ b/src/full/Agda/Termination/CallGraph.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE ImplicitParams             #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 -- | Call graphs and related concepts, more or less as defined in
 --     \"A Predicative Analysis of Structural Recursion\" by
@@ -20,6 +20,7 @@ module Agda.Termination.CallGraph
   , (>*<)
     -- * Call graphs
   , CallGraph(..)
+  , targetNodes
   , fromList
   , toList
   , empty
@@ -34,14 +35,15 @@ module Agda.Termination.CallGraph
 
 import Prelude hiding (null)
 
+import Data.Foldable (Foldable)
+import qualified Data.Foldable as Fold
 import Data.Function
+import qualified Data.List as List
 import Data.Map (Map, (!))
 import qualified Data.Map as Map
-import qualified Data.List as List
 import Data.Monoid
-
-import Data.Foldable (Foldable)
-import qualified Data.Foldable as Fold
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.Traversable (Traversable)
 import qualified Data.Traversable as Trav
 
@@ -70,7 +72,7 @@ import Agda.Utils.QuickCheck hiding (label)
 import Agda.Utils.TestHelpers
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -125,6 +127,12 @@ instance Monoid cinfo => CallComb (Call cinfo) where
 newtype CallGraph cinfo = CallGraph { theCallGraph :: Graph Node Node (CMSet cinfo) }
   deriving (Show)
 
+
+-- | Returns all the nodes with incoming edges.  Somewhat expensive. @O(e)@.
+
+targetNodes :: CallGraph cinfo -> Set Node
+targetNodes = Graph.targetNodes . theCallGraph
+
 -- | Converts a call graph to a list of calls with associated meta
 --   information.
 
@@ -230,7 +238,7 @@ combineNewOldCallGraph (CallGraph new) (CallGraph old) = CallGraph -*- CallGraph
 -- h@ are present in the graph, then @f -> h@ should also be present.
 
 complete :: (?cutoff :: CutOff) => Monoid cinfo => CallGraph cinfo -> CallGraph cinfo
-complete cs = trampoline (mapFst (not . null) . completionStep cs) cs
+complete cs = repeatWhile (mapFst (not . null) . completionStep cs) cs
 
 completionStep :: (?cutoff :: CutOff) => Monoid cinfo =>
   CallGraph cinfo -> CallGraph cinfo -> (CallGraph cinfo, CallGraph cinfo)
diff --git a/src/full/Agda/Termination/CallMatrix.hs b/src/full/Agda/Termination/CallMatrix.hs
index 034b07f..40a30e9 100644
--- a/src/full/Agda/Termination/CallMatrix.hs
+++ b/src/full/Agda/Termination/CallMatrix.hs
@@ -1,13 +1,13 @@
--- {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+-- {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE ImplicitParams             #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 module Agda.Termination.CallMatrix where
 
diff --git a/src/full/Agda/Termination/Inlining.hs b/src/full/Agda/Termination/Inlining.hs
index d7482e9..9cb52a6 100644
--- a/src/full/Agda/Termination/Inlining.hs
+++ b/src/full/Agda/Termination/Inlining.hs
@@ -70,7 +70,7 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 
 import Agda.Utils.Impossible
-#include "../undefined.h"
+#include "undefined.h"
 
 inlineWithClauses :: QName -> Clause -> TCM [Clause]
 inlineWithClauses f cl = inTopContext $ do
@@ -207,7 +207,7 @@ inline f pcl t wf wcl = inTopContext $ addCtxTel (clauseTel wcl) $ do
     dtermToPat v =
       case v of
         DWithApp{}       -> __IMPOSSIBLE__   -- I believe
-        DCon c vs        -> ConP (ConHead c []) Nothing . map (fmap unnamed)
+        DCon c vs        -> ConP c Nothing . map (fmap unnamed)
                               <$> mapM (traverse dtermToPat) vs
         DDef{}           -> DotP (dtermToTerm v) <$ skip
         DDot v           -> DotP v <$ skip
@@ -233,7 +233,7 @@ expandWithFunctionCall f es = do
 
 dtermToTerm :: DisplayTerm -> Term
 dtermToTerm (DWithApp d ds vs)     = dtermToTerm d `apply` (map (defaultArg . dtermToTerm) ds ++ vs)
-dtermToTerm (DCon c args)          = Con (ConHead c []) $ map (fmap dtermToTerm) args
+dtermToTerm (DCon c args)          = Con c $ map (fmap dtermToTerm) args
 dtermToTerm (DDef f args)          = Def f $ map (Apply . fmap dtermToTerm) args
 dtermToTerm (DDot v)               = v
 dtermToTerm (DTerm v)              = v
diff --git a/src/full/Agda/Termination/Monad.hs b/src/full/Agda/Termination/Monad.hs
index f14e382..91bef83 100644
--- a/src/full/Agda/Termination/Monad.hs
+++ b/src/full/Agda/Termination/Monad.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 -- | The monad for the termination checker.
 --
@@ -14,7 +14,6 @@
 module Agda.Termination.Monad where
 
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.State
@@ -22,7 +21,7 @@ import Control.Monad.State
 import Data.Functor ((<$>))
 import qualified Data.List as List
 
-import Agda.Interaction.Options (defaultCutOff)
+import Agda.Interaction.Options
 
 import Agda.Syntax.Abstract (QName,IsProjP(..))
 import Agda.Syntax.Common   (Delayed(..), Induction(..), Dom(..))
@@ -40,6 +39,7 @@ import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Records
 import Agda.TypeChecking.Substitute
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Pretty (Pretty)
@@ -47,7 +47,7 @@ import qualified Agda.Utils.Pretty as P
 import Agda.Utils.VarSet (VarSet)
 import qualified Agda.Utils.VarSet as VarSet
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | The mutual block we are checking.
@@ -172,13 +172,46 @@ class (Functor m, Monad m) => MonadTer m where
 newtype TerM a = TerM { terM :: ReaderT TerEnv TCM a }
   deriving (Functor, Applicative, Monad)
 
-runTerm :: TerEnv -> TerM a -> TCM a
-runTerm tenv (TerM m) = runReaderT m tenv
-
 instance MonadTer TerM where
   terAsk     = TerM $ ask
   terLocal f = TerM . local f . terM
 
+-- | Generic run method for termination monad.
+runTer :: TerEnv -> TerM a -> TCM a
+runTer tenv (TerM m) = runReaderT m tenv
+
+-- | Run TerM computation in default environment (created from options).
+
+runTerDefault :: TerM a -> TCM a
+runTerDefault cont = do
+
+  -- Assemble then initial configuration of the termination environment.
+
+  cutoff <- optTerminationDepth <$> pragmaOptions
+
+  -- Get the name of size suc (if sized types are enabled)
+  suc <- sizeSucName
+
+  -- The name of sharp (if available).
+  sharp <- fmap nameOfSharp <$> coinductionKit
+
+  guardingTypeConstructors <-
+    optGuardingTypeConstructors <$> pragmaOptions
+
+  -- Andreas, 2014-08-28
+  -- We do not inline with functions if --without-K.
+  inlineWithFunctions <- not . optWithoutK <$> pragmaOptions
+
+  let tenv = defaultTerEnv
+        { terGuardingTypeConstructors = guardingTypeConstructors
+        , terInlineWithFunctions      = inlineWithFunctions
+        , terSizeSuc                  = suc
+        , terSharp                    = sharp
+        , terCutOff                   = cutoff
+        }
+
+  runTer tenv cont
+
 -- * Termination monad is a 'MonadTCM'.
 
 instance MonadReader TCEnv TerM where
@@ -198,7 +231,7 @@ instance MonadTCM TerM where
 instance MonadError TCErr TerM where
   throwError = liftTCM . throwError
   catchError m handler = TerM $ ReaderT $ \ tenv -> do
-    runTerm tenv m `catchError` (\ err -> runTerm tenv $ handler err)
+    runTer tenv m `catchError` (\ err -> runTer tenv $ handler err)
 
 -- * Modifiers and accessors for the termination environment in the monad.
 
@@ -399,7 +432,11 @@ data DeBruijnPat' a
     -- ^ The name refers to either an ordinary
     --   constructor or the successor function on sized types.
   | LitDBP Literal
+    -- ^ Literal.  Also abused to censor part of a pattern.
+  | TermDBP Term
+    -- ^ Part of dot pattern that cannot be converted into a pattern.
   | ProjDBP QName
+    -- ^ Projection pattern.
   deriving (Functor, Show)
 
 instance IsProjP (DeBruijnPat' a) where
@@ -407,11 +444,23 @@ instance IsProjP (DeBruijnPat' a) where
   isProjP _           = Nothing
 
 instance PrettyTCM DeBruijnPat where
-  prettyTCM (VarDBP i)    = text $ show i
-  prettyTCM (ConDBP c ps) = parens (prettyTCM c <+> hsep (map prettyTCM ps))
+  prettyTCM (VarDBP i)    = prettyTCM $ var i
+  prettyTCM (ConDBP c ps) = parens $ do prettyTCM c <+> hsep (map prettyTCM ps)
   prettyTCM (LitDBP l)    = prettyTCM l
+  prettyTCM (TermDBP v)   = parens $ prettyTCM v
   prettyTCM (ProjDBP d)   = prettyTCM d
 
+-- | How long is the path to the deepest variable?
+patternDepth :: DeBruijnPat' a -> Int
+patternDepth p =
+  case p of
+    ConDBP _ ps -> succ $ maximum $ 0 : map patternDepth ps
+    VarDBP{}    -> 0
+    LitDBP{}    -> 0
+    TermDBP{}   -> 0
+    ProjDBP{}   -> 0
+
+
 -- | A dummy pattern used to mask a pattern that cannot be used
 --   for structural descent.
 
@@ -441,6 +490,7 @@ instance UsableSizeVars DeBruijnPat where
       VarDBP i    -> ifM terGetUseSizeLt (return $ VarSet.singleton i) (return $ mempty)
       ConDBP c ps -> conUseSizeLt c $ usableSizeVars ps
       LitDBP{}    -> return mempty
+      TermDBP{}   -> return mempty
       ProjDBP{}   -> return mempty
 
 instance UsableSizeVars [DeBruijnPat] where
diff --git a/src/full/Agda/Termination/Order.hs b/src/full/Agda/Termination/Order.hs
index be8a7e7..b513927 100644
--- a/src/full/Agda/Termination/Order.hs
+++ b/src/full/Agda/Termination/Order.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE ImplicitParams       #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | An Abstract domain of relative sizes, i.e., differences
@@ -15,7 +15,7 @@ module Agda.Termination.Order
   , supremum, infimum
   , orderSemiring
   , le, lt, unknown, orderMat, collapseO
-  , decreasing, isDecr
+  , nonIncreasing, decreasing, isDecr
   , NotWorse(..)
   , tests
   ) where
@@ -35,7 +35,7 @@ import Agda.Utils.Pretty hiding (empty)
 import Agda.Utils.QuickCheck
 import Agda.Utils.TestHelpers
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -200,9 +200,13 @@ lt = Decr 1
 unknown :: Order
 unknown = Unknown
 
+nonIncreasing :: Order -> Bool
+nonIncreasing (Decr k) = k >= 0
+nonIncreasing _        = False
+
 decreasing :: Order -> Bool
-decreasing (Decr k) | k > 0 = True
-decreasing _ = False
+decreasing (Decr k) = k > 0
+decreasing _        = False
 
 -- | Matrix-shaped order is decreasing if any diagonal element is decreasing.
 isDecr :: Order -> Bool
diff --git a/src/full/Agda/Termination/RecCheck.hs b/src/full/Agda/Termination/RecCheck.hs
index b651e18..100192f 100644
--- a/src/full/Agda/Termination/RecCheck.hs
+++ b/src/full/Agda/Termination/RecCheck.hs
@@ -56,8 +56,8 @@ anyDefs names a = do
   -- Prepare function to lookup metas outside of TCM
   st <- getMetaStore
   let lookup x = case mvInstantiation <$> Map.lookup x st of
-        Just (InstV v) -> Just v
-        _              -> Nothing
+        Just (InstV _ v) -> Just v    -- TODO: ignoring the lambdas might be bad?
+        _                -> Nothing
       -- we collect only those used definitions that are in @names@
       emb d = if d `elem` names then [d] else []
   -- get all the Defs that are in names
diff --git a/src/full/Agda/Termination/Semiring.hs b/src/full/Agda/Termination/Semiring.hs
index aca2cfa..624e337 100644
--- a/src/full/Agda/Termination/Semiring.hs
+++ b/src/full/Agda/Termination/Semiring.hs
@@ -80,6 +80,7 @@ instance SemiRing Integer where
 integerSemiring :: Semiring Integer
 integerSemiring = Semiring { add = (+), mul = (*), zero = 0 } -- , one = 1 }
 
+prop_integerSemiring :: Integer -> Integer -> Integer -> Bool
 prop_integerSemiring = semiringInvariant integerSemiring
 
 -- | The standard semiring on 'Int's.
@@ -97,6 +98,7 @@ instance SemiRing Int where
 intSemiring :: Semiring Int
 intSemiring = Semiring { add = (+), mul = (*), zero = 0 } -- , one = 1 }
 
+prop_intSemiring :: Int -> Int -> Int -> Bool
 prop_intSemiring = semiringInvariant intSemiring
 
 -- | The standard semiring on 'Bool's.
@@ -105,6 +107,7 @@ boolSemiring :: Semiring Bool
 boolSemiring =
   Semiring { add = (||), mul = (&&), zero = False } --, one = True }
 
+prop_boolSemiring :: Bool -> Bool -> Bool -> Bool
 prop_boolSemiring = semiringInvariant boolSemiring
 
 ------------------------------------------------------------------------
diff --git a/src/full/Agda/Termination/SparseMatrix.hs b/src/full/Agda/Termination/SparseMatrix.hs
index 19e940a..b90a538 100644
--- a/src/full/Agda/Termination/SparseMatrix.hs
+++ b/src/full/Agda/Termination/SparseMatrix.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE DeriveFoldable         #-}
+{-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE DeriveTraversable      #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE NamedFieldPuns         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TupleSections          #-}
 
 {- | Sparse matrices.
 
@@ -78,7 +78,7 @@ import Agda.Utils.QuickCheck
 import Agda.Utils.TestHelpers
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -563,6 +563,7 @@ matrix :: (Arbitrary i, Integral i, Arbitrary b, HasZero b)
   => Size i -> Gen (Matrix i b)
 matrix sz = matrixUsingRowGen sz (\n -> vectorOf (fromIntegral n) arbitrary)
 
+prop_matrix :: Size Int -> Property
 prop_matrix sz = forAll (matrix sz :: Gen TM) $ \ m -> size m == sz
 
 -- | Generate a matrix of arbitrary size.
@@ -605,10 +606,10 @@ prop_diagonal :: TM -> Bool
 prop_diagonal m@(Matrix (Size r c) _) =
     length (diagonal m) == min r c
 
-prop_diagonal' n =
-  forAll natural $ \n ->
-  forAll (matrix (Size n n) :: Gen TM) $ \m ->
-    length (diagonal m) == n
+-- prop_diagonal' n =
+--   forAll natural $ \n ->
+--   forAll (matrix (Size n n) :: Gen TM) $ \m ->
+--     length (diagonal m) == n
 
 -- | Transposing twice is the identity.
 
@@ -647,6 +648,7 @@ prop_zipMatrices_correct m1 m2 =
 
 -- | Matrix addition is well-defined, associative and commutative.
 
+prop_add :: Size Int -> Property
 prop_add sz =
   forAll (three (matrix sz :: Gen TM)) $ \(m1, m2, m3) ->
     let m' = add (+) m1 m2 in
@@ -693,6 +695,7 @@ prop_interAssocWith_correct xs ys =
 
 -- | Matrix multiplication is well-defined and associative.
 
+prop_mul :: Size Int -> Property
 prop_mul sz =
   mapSize (`div` 2) $
   forAll (two natural) $ \(c2, c3) ->
diff --git a/src/full/Agda/Termination/TermCheck.hs b/src/full/Agda/Termination/TermCheck.hs
index de8099d..5139949 100644
--- a/src/full/Agda/Termination/TermCheck.hs
+++ b/src/full/Agda/Termination/TermCheck.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE ImplicitParams             #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 {- Checking for Structural recursion
    Authors: Andreas Abel, Nils Anders Danielsson, Ulf Norell,
@@ -20,14 +20,17 @@ module Agda.Termination.TermCheck
     , Result, DeBruijnPat
     ) where
 
+import Prelude hiding (null)
+
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.State
 
-import Data.List as List
+import Data.List hiding (null)
+import qualified Data.List as List
 import Data.Maybe (mapMaybe, isJust, fromMaybe)
 import Data.Monoid
 import qualified Data.Map as Map
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Traversable (traverse)
 
@@ -41,8 +44,8 @@ import Agda.Syntax.Literal (Literal(LitString))
 
 import Agda.Termination.CutOff
 import Agda.Termination.Monad
-import Agda.Termination.CallGraph (CallGraph)
-import Agda.Termination.CallGraph as CallGraph
+import Agda.Termination.CallGraph hiding (null)
+import qualified Agda.Termination.CallGraph as CallGraph
 import Agda.Termination.CallMatrix hiding (null)
 import Agda.Termination.Order     as Order
 import qualified Agda.Termination.SparseMatrix as Matrix
@@ -74,13 +77,14 @@ import Agda.Utils.List
 import Agda.Utils.Size
 import Agda.Utils.Maybe
 import Agda.Utils.Monad -- (mapM', forM', ifM, or2M, and2M)
+import Agda.Utils.Null
 import Agda.Utils.Permutation
 import Agda.Utils.Pointed
 import Agda.Utils.Pretty (render)
 import Agda.Utils.VarSet (VarSet)
 import qualified Agda.Utils.VarSet as VarSet
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Call graph with call info for composed calls.
@@ -92,7 +96,6 @@ type Calls = CallGraph CallPath
 
 type Result = [TerminationError]
 
-
 -- | Termination check a single declaration.
 
 termDecl :: A.Declaration -> TCM Result
@@ -187,7 +190,7 @@ termMutual i ds = if names == [] then return mempty else
         billTo [Benchmark.Termination, Benchmark.RecCheck] $ recursive allNames
 
   -- NO_TERMINATION_CHECK
-  if (Info.mutualTermCheck i == NoTerminationCheck) then do
+  if (Info.mutualTermCheck i `elem` [ NoTerminationCheck, Terminating ]) then do
       reportSLn "term.warn.yes" 2 $ "Skipping termination check for " ++ show names
       forM_ allNames $ \ q -> setTerminates q True -- considered terminating!
       return mempty
@@ -203,43 +206,24 @@ termMutual i ds = if names == [] then return mempty else
       return mempty)
    $ {- else -} do
 
-     -- Assemble then initial configuration of the termination environment.
-
-     cutoff <- optTerminationDepth <$> pragmaOptions
-
-     reportSLn "term.top" 10 $ "Termination checking " ++ show names ++
-       " with cutoff=" ++ show cutoff ++ "..."
-
-     -- Get the name of size suc (if sized types are enabled)
-     suc <- sizeSucName
-
-     -- The name of sharp (if available).
-     sharp <- fmap nameOfSharp <$> coinductionKit
-
-     guardingTypeConstructors <-
-       optGuardingTypeConstructors <$> pragmaOptions
-
-     -- Andreas, 2014-08-28
-     -- We do not inline with functions if --without-K.
-     inlineWithFunctions <- not . optWithoutK <$> pragmaOptions
-
-     let tenv = defaultTerEnv
-           { terGuardingTypeConstructors = guardingTypeConstructors
-           , terInlineWithFunctions      = inlineWithFunctions
-           , terSizeSuc                  = suc
-           , terSharp                    = sharp
-           , terCutOff                   = cutoff
-           , terMutual                   = allNames
-           , terUserNames                = names
+     -- Set the mutual names in the termination environment.
+     let setNames e = e
+           { terMutual    = allNames
+           , terUserNames = names
            }
+         runTerm cont = runTerDefault $ do
+           cutoff <- terGetCutOff
+           reportSLn "term.top" 10 $ "Termination checking " ++ show names ++
+             " with cutoff=" ++ show cutoff ++ "..."
+           terLocal setNames cont
 
      -- New check currently only makes a difference for copatterns.
      -- Since it is slow, only invoke it if --copatterns.
      res <- ifM (optCopatterns <$> pragmaOptions)
          -- Then: New check, one after another.
-         (runTerm tenv $ forM' allNames $ termFunction)
+         (runTerm $ forM' allNames $ termFunction)
          -- Else: Old check, all at once.
-         (runTerm tenv $ termMutual')
+         (runTerm $ termMutual')
 
      -- record result of termination check in signature
      let terminates = List.null res
@@ -300,6 +284,10 @@ termMutual' = do
         show (names) ++ " does termination check"
       return mempty
 
+-- ASR (08 November 2014). The type of the function could be
+--
+-- @Either a b -> TerM (Either a b)@.
+billToTerGraph :: a -> TerM a
 billToTerGraph = billPureTo [Benchmark.Termination, Benchmark.Graph]
 
 -- | @reportCalls@ for debug printing.
@@ -337,9 +325,9 @@ reportCalls no calls = do
          step cs = do
            let (new, cs') = completionStep cs0 cs
            report " New call matrices " new
-           return (not $ CallGraph.null new, cs')
+           return $ if CallGraph.null new then Left () else Right cs'
      report " Initial call matrices " cs0
-     void $ trampolineM step cs0
+     trampolineM step cs0
 
    -- Print the result of completion.
    let calls' = CallGraph.complete calls
@@ -376,10 +364,22 @@ termFunction name = do
    reportTarget target
    terSetTarget target $ do
 
-   -- Collect all recursive calls in the block,
-   -- taking the target of the current function into account.
-
-   let collect = forM' allNames termDef
+   -- Collect the recursive calls in the block which (transitively)
+   -- involve @name@,
+   -- taking the target of @name@ into account for computing guardedness.
+
+   let collect = (`trampolineM` (Set.singleton index, mempty, mempty)) $ \ (todo, done, calls) -> do
+         if null todo then return $ Left calls else do
+         -- Extract calls originating from indices in @todo at .
+         new <- forM' todo $ \ i ->
+           termDef $ fromMaybe __IMPOSSIBLE__ $ allNames !!! i
+         -- Mark those functions as processed and add the calls to the result.
+         let done'  = done `mappend` todo
+             calls' = new  `mappend` calls
+         -- Compute the new todo list:
+             todo' = CallGraph.targetNodes new Set.\\ done'
+         -- Jump the trampoline.
+         return $ Right (todo', done', calls')
 
    -- First try to termination check ignoring the dot patterns
    calls1 <- terSetUseDotPatterns False $ collect
@@ -423,6 +423,15 @@ typeEndsInDef t = liftTCM $ do
     _        -> return Nothing
 
 -- | Termination check a definition by pattern matching.
+--
+--   TODO: Refactor!
+--   As this function may be called twice,
+--   once disregarding dot patterns,
+--   the second time regarding dot patterns,
+--   it is better if we separated bare call extraction
+--   from computing the change in structural order.
+--   Only the latter depends on the choice whether we
+--   consider dot patterns or not.
 termDef :: QName -> TerM Calls
 termDef name = terSetCurrent name $ do
 
@@ -452,12 +461,20 @@ termDef name = terSetCurrent name $ do
 
 -- | Mask arguments and result for termination checking
 --   according to type of function.
---   Only arguments of data/record type are counted in.
+--   Only arguments of types ending in data/record or Size are counted in.
 setMasks :: Type -> TerM a -> TerM a
 setMasks t cont = do
-  TelV tel core <- liftTCM $ telView t
-  ds <- liftTCM $ mapM ((isJust <.> isDataOrRecord) <=< (reduce . unEl . snd . unDom)) $ telToList tel
-  d  <- liftTCM . isJust <.> isDataOrRecord . unEl $ t
+  (ds, d) <- liftTCM $ do
+    TelV tel core <- telView t
+    -- Check argument types
+    ds <- forM (telToList tel) $ \ t -> do
+      TelV _ t <- telView $ snd $ unDom t
+      (isJust <$> isDataOrRecord (unEl t)) `or2M` (isJust <$> isSizeType t)
+    -- Check result types
+    d  <- isJust <.> isDataOrRecord . unEl $ core
+    unless d $
+      reportSLn "term.mask" 20 $ "result type is not data or record type, ignoring guardedness for --without-K"
+    return (ds, d)
   terSetMaskArgs (ds ++ repeat False) $ terSetMaskResult d $ cont
 
 {- Termination check clauses:
@@ -503,18 +520,27 @@ matchingTarget conf t = maybe (return True) (match t) (currentTarget conf)
 -}
 
 -- | Convert a term (from a dot pattern) to a DeBruijn pattern.
+--
+--   The term is first normalized and stripped of all non-coinductive projections.
 
 termToDBP :: Term -> TerM DeBruijnPat
 termToDBP t = ifNotM terGetUseDotPatterns (return unusedVar) $ {- else -} do
-  suc <- terGetSizeSuc
-  t <- liftTCM $ stripAllProjections =<< constructorForm t
-  case ignoreSharing t of
-    Var i []    -> return $ VarDBP i
-    Con c args  -> ConDBP (conName c) <$> mapM (termToDBP . unArg) args
-    Def s [Apply arg] | Just s == suc
-                -> ConDBP s . (:[]) <$> termToDBP (unArg arg)
-    Lit l       -> return $ LitDBP l
-    _           -> return unusedVar
+    suc <- terGetSizeSuc
+    let
+      loop :: Term -> TCM DeBruijnPat
+      loop t = do
+        t <- constructorForm t
+        case ignoreSharing t of
+          -- Constructors.
+          Con c args  -> ConDBP (conName c) <$> mapM (loop . unArg) args
+          Def s [Apply arg] | Just s == suc
+                      -> ConDBP s . (:[]) <$> loop (unArg arg)
+          DontCare t  -> __IMPOSSIBLE__  -- removed by stripAllProjections
+          -- Leaves.
+          Var i []    -> return $ VarDBP i
+          Lit l       -> return $ LitDBP l
+          t           -> return $ TermDBP t
+    liftTCM $ loop =<< stripAllProjections =<< normalise t
 
 
 -- | Masks coconstructor patterns in a deBruijn pattern.
@@ -530,12 +556,15 @@ stripCoConstructors p = do
     -- The remaining (atomic) patterns cannot contain coconstructors, obviously.
     VarDBP{}  -> return p
     LitDBP{}  -> return p
+    TermDBP{} -> return p  -- Can contain coconstructors, but they do not count here.
     ProjDBP{} -> return p
 
 -- | Masks all non-data/record type patterns if --without-K.
 maskNonDataArgs :: [DeBruijnPat] -> TerM [DeBruijnPat]
-maskNonDataArgs ps = do
-  zipWith (\ p d -> if d then p else unusedVar) ps <$> terGetMaskArgs
+maskNonDataArgs ps = zipWith mask ps <$> terGetMaskArgs
+  where
+    mask p at ProjDBP{} _ = p
+    mask p           d = if d then p else unusedVar
 
 -- | cf. 'TypeChecking.Coverage.Match.buildMPatterns'
 openClause :: Permutation -> [Pattern] -> ClauseBody -> TerM ([DeBruijnPat], Maybe Term)
@@ -551,7 +580,7 @@ openClause perm ps body = do
     -- length of the telescope
     n    = size perm
     -- the variables as a map from the body variables to the clause telescope
-    xs   = permute (invertP perm) $ downFrom (size perm)
+    xs   = permute (invertP __IMPOSSIBLE__ perm) $ downFrom (size perm)
 
     tick = do x : xs <- get; put xs; return x
 
@@ -1115,12 +1144,13 @@ offsetFromConstructor :: MonadTCM tcm => QName -> tcm Int
 offsetFromConstructor c = maybe 1 (const 0) <$> do
   liftTCM $ isRecordConstructor c
 
--- | Compute the sub patterns of a 'DeBruijnPat'.
+-- | Compute the proper subpatterns of a 'DeBruijnPat'.
 subPatterns :: DeBruijnPat -> [DeBruijnPat]
 subPatterns p = case p of
-  VarDBP _    -> []
   ConDBP c ps -> ps ++ concatMap subPatterns ps
+  VarDBP _    -> []
   LitDBP _    -> []
+  TermDBP _   -> []
   ProjDBP _   -> []
 
 compareTerm :: Term -> DeBruijnPat -> TerM Order
@@ -1186,11 +1216,11 @@ instance StripAllProjections Term where
 --   Precondition: top meta variable resolved
 
 compareTerm' :: Term -> DeBruijnPat -> TerM Order
-compareTerm' v0 p = do
+compareTerm' v p = do
   suc  <- terGetSizeSuc
   cutoff <- terGetCutOff
   let ?cutoff = cutoff
-  let v = ignoreSharing v0
+  v <- return $ ignoreSharing v
   case (v, p) of
 
     -- Andreas, 2013-11-20 do not drop projections,
@@ -1234,25 +1264,41 @@ compareTerm' v0 p = do
       increase <$> offsetFromConstructor (conName c)
                <*> (infimum <$> mapM (\ t -> compareTerm' (unArg t) p) ts)
 
-    (t, p) | isSubTerm t p -> return Order.le
-
-    _ -> return Order.unknown
-
--- TODO: isSubTerm should compute a size difference (Order)
-isSubTerm :: Term -> DeBruijnPat -> Bool
-isSubTerm t p = equal t p || properSubTerm t p
+    -- Andreas, 2014-09-22, issue 1281:
+    -- For metas, termination checking should be optimistic.
+    -- If there is any instance of the meta making termination
+    -- checking succeed, then we should not fail.
+    -- Thus, we assume the meta will be instantiated with the
+    -- deepest variable in @p at .
+    -- For sized types, the depth is maximally context length - 1,
+    -- which is the number of SIZELT hypotheses one can have in a context.
+    (MetaV{}, p) -> Order.decr . max (patternDepth p) . pred <$> getContextSize
+
+    (t, p) -> return $ subTerm t p
+
+-- | @subTerm@ computes a size difference (Order)
+subTerm :: (?cutoff :: CutOff) => Term -> DeBruijnPat -> Order
+subTerm t p = if equal t p then Order.le else properSubTerm t p
   where
     equal (Shared p) dbp = equal (derefPtr p) dbp
     equal (Con c ts) (ConDBP c' ps) =
       and $ (conName c == c')
           : (length ts == length ps)
           : zipWith equal (map unArg ts) ps
-    equal (Var i []) (VarDBP j) = i == j
-    equal (Lit l) (LitDBP l') = l == l'
+    equal (Var i []) (VarDBP i') = i == i'
+    equal (Lit l)    (LitDBP l') = l == l'
+    -- Terms.
+    -- Checking for identity here is very fragile.
+    -- However, we cannot do much more, as we are not allowed to normalize t.
+    -- (It might diverge, and we are just in the process of termination checking.)
+    equal t         (TermDBP t') = t == t'
     equal _ _ = False
 
-    properSubTerm t (ConDBP _ ps) = any (isSubTerm t) ps
-    properSubTerm _ _ = False
+    properSubTerm t (ConDBP _ ps) = decrease 1 $ supremum $ map (subTerm t) ps
+    properSubTerm _ _ = Order.unknown
+
+isSubTerm :: (?cutoff :: CutOff) => Term -> DeBruijnPat -> Bool
+isSubTerm t p = nonIncreasing $ subTerm t p
 
 compareConArgs :: Args -> [DeBruijnPat] -> TerM Order
 compareConArgs ts ps = do
@@ -1285,13 +1331,14 @@ compareConArgs ts ps = do
 
 compareVar :: Nat -> DeBruijnPat -> TerM Order
 compareVar i (VarDBP j)    = compareVarVar i j
-compareVar i (LitDBP _)    = return $ Order.unknown
-compareVar i (ProjDBP _)   = return $ Order.unknown
 compareVar i (ConDBP c ps) = do
   cutoff <- terGetCutOff
   let ?cutoff = cutoff
   decrease <$> offsetFromConstructor c
            <*> (Order.supremum <$> mapM (compareVar i) ps)
+compareVar i LitDBP{}  = return $ Order.unknown
+compareVar i TermDBP{} = return $ Order.unknown
+compareVar i ProjDBP{} = return $ Order.unknown
 
 -- | Compare two variables.
 --
diff --git a/src/full/Agda/Termination/Termination.hs b/src/full/Agda/Termination/Termination.hs
index e0eb67c..cdab9e4 100644
--- a/src/full/Agda/Termination/Termination.hs
+++ b/src/full/Agda/Termination/Termination.hs
@@ -72,7 +72,7 @@ endos cs = [ m | c <- cs, source c == target c
            ]
 
 checkIdems :: (Monoid cinfo, ?cutoff :: CutOff) => [CallMatrixAug cinfo] -> Either cinfo ()
-checkIdems calls = caseMaybe (mhead offending) (Right ()) $ Left . augCallInfo
+checkIdems calls = caseMaybe (headMaybe offending) (Right ()) $ Left . augCallInfo
   where
     -- Every idempotent call must have decrease, otherwise it offends us.
     offending = filter (not . hasDecrease) $ filter idempotent calls
diff --git a/src/full/Agda/Tests.hs b/src/full/Agda/Tests.hs
index bfa2f18..627420b 100644
--- a/src/full/Agda/Tests.hs
+++ b/src/full/Agda/Tests.hs
@@ -1,4 +1,3 @@
-
 -- | Responsible for running all internal tests.
 module Agda.Tests (testSuite) where
 
@@ -12,26 +11,28 @@ import Agda.Interaction.Highlighting.Range    as InteRang   (tests)
 import Agda.Interaction.Options               as InteOpti   (tests)
 import Agda.Syntax.Parser.Parser              as SyntPars   (tests)
 import Agda.Syntax.Position                   as SyntPosi   (tests)
-import Agda.Termination.CallGraph	      as TermCall   (tests)
-import Agda.Termination.CallMatrix	      as TermCM     (tests)
+import Agda.Termination.CallGraph             as TermCall   (tests)
+import Agda.Termination.CallMatrix            as TermCM     (tests)
 -- import Agda.Termination.Lexicographic         as TermLex    (tests)
 -- import Agda.Termination.Matrix                as TermMatrix (tests)
-import Agda.Termination.Order    	      as TermOrd    (tests)
-import Agda.Termination.Semiring	      as TermRing   (tests)
+import Agda.Termination.Order                 as TermOrd    (tests)
+import Agda.Termination.Semiring              as TermRing   (tests)
 import Agda.Termination.SparseMatrix          as TermSparse (tests)
-import Agda.Termination.Termination	      as TermTerm   (tests)
+import Agda.Termination.Termination           as TermTerm   (tests)
 import Agda.TypeChecking.Irrelevance          as Irrel      (tests)
 import Agda.TypeChecking.Tests                as TypeChck   (tests)
 import Agda.TypeChecking.SizedTypes.Tests     as SizedTypes (tests)
-import Agda.Utils.BiMap 	              as UtilBiMap  (tests)
-import Agda.Utils.Cluster 	              as UtilClust  (tests)
-import Agda.Utils.Either	              as UtilEith   (tests)
+import Agda.Utils.Bag                         as UtilBag    (tests)
+import Agda.Utils.BiMap                       as UtilBiMap  (tests)
+import Agda.Utils.Cluster                     as UtilClust  (tests)
+import Agda.Utils.Either                      as UtilEith   (tests)
 import Agda.Utils.Favorites                   as UtilFav    (tests)
 import Agda.Utils.FileName                    as UtilFile   (tests)
 import Agda.Utils.Graph.AdjacencyMap          as UtilGrap   (tests)
 import Agda.Utils.Graph.AdjacencyMap.Unidirectional as UtilGraphUni (tests)
 import Agda.Utils.List                        as UtilList   (tests)
 import Agda.Utils.PartialOrd                  as UtilPOrd   (tests)
+import Agda.Utils.Permutation.Tests           as UtilPerm   (tests)
 import Agda.Utils.Warshall                    as UtilWarsh  (tests)
 
 testSuite :: IO Bool
@@ -39,6 +40,7 @@ testSuite = runTests "QuickCheck test suite:"
   [ Irrel.tests
   , SizedTypes.tests
   , UtilFav.tests
+  , UtilPerm.tests
   , UtilPOrd.tests
   , CompEnco.tests
   , InteEmac.tests
@@ -57,6 +59,7 @@ testSuite = runTests "QuickCheck test suite:"
   , TermSparse.tests
   , TermTerm.tests
   , TypeChck.tests
+  , UtilBag.tests
   , UtilBiMap.tests
   , UtilClust.tests
   , UtilEith.tests
diff --git a/src/full/Agda/TheTypeChecker.hs b/src/full/Agda/TheTypeChecker.hs
index 7b5376c..4b0abb1 100644
--- a/src/full/Agda/TheTypeChecker.hs
+++ b/src/full/Agda/TheTypeChecker.hs
@@ -1,4 +1,3 @@
-
 module Agda.TheTypeChecker
   ( checkDecls, checkDecl
   , inferExpr, checkExpr
diff --git a/src/full/Agda/TypeChecking/Abstract.hs b/src/full/Agda/TypeChecking/Abstract.hs
index 111bda5..7f65788 100644
--- a/src/full/Agda/TypeChecking/Abstract.hs
+++ b/src/full/Agda/TypeChecking/Abstract.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Functions for abstracting terms over other terms.
@@ -18,7 +18,7 @@ import Agda.TypeChecking.Substitute
 import Agda.Utils.List (splitExactlyAt)
 import Agda.Utils.Impossible
 
-#include "../undefined.h"
+#include "undefined.h"
 
 piAbstractTerm :: Term -> Type -> Type -> Type
 piAbstractTerm v a b = fun a (abstractTerm v b)
@@ -56,7 +56,7 @@ class AbstractTerm a where
   abstractTerm :: Term -> a -> a
 
 instance AbstractTerm Term where
-  abstractTerm u v | Just es <- u `isPrefixOf` v = Var 0 es
+  abstractTerm u v | Just es <- u `isPrefixOf` v = Var 0 $ raise 1 es
                    | otherwise                   =
     case v of
 -- Andreas, 2013-10-20: the original impl. works only at base types
diff --git a/src/full/Agda/TypeChecking/CheckInternal.hs b/src/full/Agda/TypeChecking/CheckInternal.hs
index 7c4f66b..eedb07a 100644
--- a/src/full/Agda/TypeChecking/CheckInternal.hs
+++ b/src/full/Agda/TypeChecking/CheckInternal.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- Initially authored by Andreas, 2013-10-22.
@@ -35,7 +35,7 @@ import Agda.Utils.Functor (($>))
 import Agda.Utils.Monad
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Entry point for e.g. checking WithFunctionType.
@@ -177,11 +177,24 @@ checkDef' f a es t = do
 -}
 
 checkSpine :: Type -> Term -> Elims -> Type -> TCM ()
-checkSpine a self es t = inferSpine a self es >>= (`subtype` t)
+checkSpine a self es t = do
+  reportSDoc "tc.check.internal" 20 $ sep
+    [ text "checking spine "
+    , text "("
+    , prettyTCM self
+    , text " : "
+    , prettyTCM a
+    , text ")"
+    , prettyTCM es
+    , text " : "
+    , prettyTCM t
+    ]
+  inferSpine a self es >>= (`subtype` t)
 
 checkArgs :: Type -> Term -> Args -> Type -> TCM ()
 checkArgs a self vs t = checkSpine a self (map Apply vs) t
 
+-- | @checkArgInfo actual expected at .
 checkArgInfo :: I.ArgInfo -> I.ArgInfo -> TCM ()
 checkArgInfo ai ai' = do
   checkHiding    (getHiding ai)     (getHiding ai')
diff --git a/src/full/Agda/TypeChecking/CompiledClause.hs b/src/full/Agda/TypeChecking/CompiledClause.hs
index 19692e2..eb9ce69 100644
--- a/src/full/Agda/TypeChecking/CompiledClause.hs
+++ b/src/full/Agda/TypeChecking/CompiledClause.hs
@@ -1,9 +1,15 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE TypeOperators      #-}
+
+-- | Case trees.
+--
+--   After coverage checking, pattern matching is translated
+--   to case trees, i.e., a tree of successive case splits
+--   on one variable at a time.
 
 module Agda.TypeChecking.CompiledClause where
 
@@ -19,34 +25,33 @@ import Agda.Syntax.Literal
 
 import Agda.Utils.Pretty
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
-type key :-> value = Map key value
-
 data WithArity c = WithArity { arity :: Int, content :: c }
   deriving (Typeable, Functor, Foldable, Traversable)
 
 -- | Branches in a case tree.
+
 data Case c = Branches
-  { conBranches    :: QName :-> WithArity c -- ^ Map from constructor (or projection) names to their arity and the case subtree.  (Projections have arity 0.)
-  , litBranches    :: Literal :-> c         -- ^ Map from literal to case subtree.
-  , catchAllBranch :: Maybe c               -- ^ (Possibly additional) catch-all clause.
+  { conBranches    :: Map QName (WithArity c)
+    -- ^ Map from constructor (or projection) names to their arity
+    --   and the case subtree.  (Projections have arity 0.)
+  , litBranches    :: Map Literal c
+    -- ^ Map from literal to case subtree.
+  , catchAllBranch :: Maybe c
+    -- ^ (Possibly additional) catch-all clause.
   }
   deriving (Typeable, Functor, Foldable, Traversable)
 
 -- | Case tree with bodies.
+
 data CompiledClauses
   = Case Int (Case CompiledClauses)
     -- ^ @Case n bs@ stands for a match on the @n at -th argument
     -- (counting from zero) with @bs@ as the case branches.
     -- If the @n at -th argument is a projection, we have only 'conBranches'.
     -- with arity 0.
-{-
-  | CoCase Int (QName :-> CompiledClauses)
-    -- ^ @CoCase n bs@ matches on projections.
-    --   Catch-all is not meaningful here.
--}
   | Done [Arg ArgName] Term
     -- ^ @Done xs b@ stands for the body @b@ where the @xs@ contains hiding
     --   and name suggestions for the free variables. This is needed to build
@@ -56,16 +61,23 @@ data CompiledClauses
     -- ^ Absurd case.
   deriving (Typeable)
 
+emptyBranches :: Case CompiledClauses
 emptyBranches = Branches Map.empty Map.empty Nothing
+
+litCase :: Literal -> c -> Case c
 litCase l x = Branches Map.empty (Map.singleton l x) Nothing
+
+conCase :: QName -> WithArity c -> Case c
 conCase c x = Branches (Map.singleton c x) Map.empty Nothing
-catchAll x  = Branches Map.empty Map.empty (Just x)
+
+catchAll :: c -> Case c
+catchAll x = Branches Map.empty Map.empty (Just x)
 
 instance Monoid c => Monoid (WithArity c) where
- mempty = WithArity __IMPOSSIBLE__ mempty
- mappend (WithArity n1 c1) (WithArity n2 c2)
-  | n1 == n2  = WithArity n1 $ mappend c1 c2
-  | otherwise = __IMPOSSIBLE__   -- arity must match!
+  mempty = WithArity __IMPOSSIBLE__ mempty
+  mappend (WithArity n1 c1) (WithArity n2 c2)
+    | n1 == n2  = WithArity n1 $ mappend c1 c2
+    | otherwise = __IMPOSSIBLE__   -- arity must match!
 
 instance Monoid m => Monoid (Case m) where
   mempty = Branches Map.empty Map.empty Nothing
@@ -94,7 +106,7 @@ instance Pretty a => Pretty (Case a) where
       prC Nothing = []
       prC (Just x) = [text "_ ->" <+> pretty x]
 
-prettyMap :: (Show k, Pretty v) => (k :-> v) -> [Doc]
+prettyMap :: (Show k, Pretty v) => Map k v -> [Doc]
 prettyMap m = [ sep [ text (show x ++ " ->")
                     , nest 2 $ pretty v ]
               | (x, v) <- Map.toList m ]
@@ -106,9 +118,3 @@ instance Pretty CompiledClauses where
     sep [ text ("case " ++ show n ++ " of")
         , nest 2 $ pretty bs
         ]
-{-
-  pretty (CoCase n bs) =
-    sep [ text ("cocase " ++ show n ++ " of")
-        , nest 2 $ vcat $ prettyMap bs
-        ]
--}
diff --git a/src/full/Agda/TypeChecking/CompiledClause/Compile.hs b/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
index a127b01..aa07064 100644
--- a/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
+++ b/src/full/Agda/TypeChecking/CompiledClause/Compile.hs
@@ -18,10 +18,10 @@ import Agda.TypeChecking.RecordPatterns
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Pretty
 
-import Agda.Utils.Functor
+import Agda.Utils.Functor (($>))
 import Agda.Utils.List
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Process function clauses into case tree.
@@ -73,7 +73,6 @@ compileWithSplitTree t cs = case t of
     -- after end of split tree, continue with left-to-right strategy
 
   where
-
     compiles :: SplitTrees -> Case Cls -> Case CompiledClauses
     compiles ts br at Branches{ conBranches = cons
                            , litBranches = lits
@@ -179,7 +178,7 @@ expandCatchAlls single n cs =
     -- True if nth pattern is variable or there are less than n patterns.
     isCatchAllNth ps = all (isVar . unArg) $ take 1 $ drop n ps
 
-    nth qs = fromMaybe __IMPOSSIBLE__ $ mhead $ drop n qs
+    nth qs = headWithDefault __IMPOSSIBLE__ $ drop n qs
 
     classify (LitP l)     = Left l
     classify (ConP c _ _) = Right c
diff --git a/src/full/Agda/TypeChecking/CompiledClause/Match.hs b/src/full/Agda/TypeChecking/CompiledClause/Match.hs
index f40d849..7833baa 100644
--- a/src/full/Agda/TypeChecking/CompiledClause/Match.hs
+++ b/src/full/Agda/TypeChecking/CompiledClause/Match.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.TypeChecking.CompiledClause.Match where
@@ -20,7 +20,7 @@ import Agda.TypeChecking.Substitute
 
 import Agda.Utils.Maybe
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 matchCompiled :: CompiledClauses -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Args) Term)
diff --git a/src/full/Agda/TypeChecking/Constraints.hs b/src/full/Agda/TypeChecking/Constraints.hs
index 4ed935a..8c6f191 100644
--- a/src/full/Agda/TypeChecking/Constraints.hs
+++ b/src/full/Agda/TypeChecking/Constraints.hs
@@ -4,7 +4,6 @@ module Agda.TypeChecking.Constraints where
 
 import Control.Monad.State
 import Control.Monad.Reader
-import Control.Monad.Error
 import Control.Applicative
 import Data.List as List
 
@@ -23,11 +22,11 @@ import {-# SOURCE #-} Agda.TypeChecking.MetaVars
 import {-# SOURCE #-} Agda.TypeChecking.Empty
 -- import {-# SOURCE #-} Agda.TypeChecking.UniversePolymorphism -- RETIRED
 
-import Agda.Utils.Fresh
+import Agda.Utils.Except ( MonadError(throwError) )
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Catches pattern violation errors and adds a constraint.
@@ -40,8 +39,8 @@ catchConstraint c v = liftTCM $
         -- a lot slower (+20% total time on standard library). How is that possible??
         -- The problem is most likely that there are internal catchErrors which forgets the
         -- state. catchError should preserve the state on pattern violations.
-       PatternErr s -> put s >> addConstraint c
-       _	    -> throwError err
+       PatternErr{} -> addConstraint c
+       _            -> throwError err
 
 addConstraint :: Constraint -> TCM ()
 addConstraint c = do
@@ -175,12 +174,12 @@ solveConstraint_ (UnBlock m)                =
       BlockedConst t -> do
         reportSDoc "tc.constr.blocked" 15 $
           text ("blocked const " ++ show m ++ " :=") <+> prettyTCM t
-        assignTerm m t
+        assignTerm m [] t
       PostponedTypeCheckingProblem cl unblock -> enterClosure cl $ \prob -> do
         ifNotM unblock (addConstraint $ UnBlock m) $ do
           tel <- getContextTelescope
           v   <- liftTCM $ checkTypeCheckingProblem prob
-          assignTerm m $ teleLam tel v
+          assignTerm m (telToArgs tel) v
       -- Andreas, 2009-02-09, the following were IMPOSSIBLE cases
       -- somehow they pop up in the context of sized types
       --
diff --git a/src/full/Agda/TypeChecking/Conversion.hs b/src/full/Agda/TypeChecking/Conversion.hs
index b206338..7955956 100644
--- a/src/full/Agda/TypeChecking/Conversion.hs
+++ b/src/full/Agda/TypeChecking/Conversion.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.Conversion where
@@ -9,7 +9,6 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.State
-import Control.Monad.Error
 
 import Data.List hiding (sort)
 import qualified Data.List as List
@@ -45,13 +44,14 @@ import Agda.TypeChecking.ProjectionLike (elimView)
 
 import Agda.Interaction.Options
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.Functor (($>))
 import Agda.Utils.Monad
 import Agda.Utils.Maybe
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {- MOVED to TypeChecking.Level
@@ -70,7 +70,7 @@ tryConversion m = (noConstraints m $> True)
 sameVars :: Elims -> Elims -> Bool
 sameVars xs ys = and $ zipWith same xs ys
     where
-	same (Apply (Arg _ (Var n []))) (Apply (Arg _ (Var m []))) = n == m
+        same (Apply (Arg _ (Var n []))) (Apply (Arg _ (Var m []))) = n == m
         same _ _ = False
 
 -- | @intersectVars us vs@ checks whether all relevant elements in @us@ and @vs@
@@ -174,10 +174,9 @@ compareTerm cmp a u v = do
         "shortcut successful\n  result: " ++ show u
     -- Should be ok with catchError_ but catchError is much safer since we don't
     -- rethrow errors.
-    m `orelse` h = m `catchError` \err -> case err of
-                    PatternErr s -> put s >> h
-                    _            -> h
+    orelse m h = catchError m (\_ -> h)
 
+unifyPointers :: Comparison -> Term -> Term -> TCM () -> TCM ()
 unifyPointers _ _ _ action = action
 -- unifyPointers cmp _ _ action | cmp /= CmpEq = action
 -- unifyPointers _ u v action = do
@@ -243,29 +242,35 @@ compareTerm' cmp a m n =
           isrec <- isEtaRecord r
           if isrec
             then do
-              dontHaveCopatterns <- not . optCopatterns <$> pragmaOptions
+              sig <- getSignature
               let ps = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
               -- Andreas, 2010-10-11: allowing neutrals to be blocked things does not seem
               -- to change Agda's behavior
               --    isNeutral Blocked{}          = False
                   isNeutral = isNeutral' . fmap ignoreSharing
                   isMeta    = isMeta'    . fmap ignoreSharing
-                  isNeutral' (NotBlocked Con{}) = False
+                  isNeutral' (NotBlocked Con{}) = return False
               -- Andreas, 2013-09-18: this is expensive:
               -- should only do this when copatterns are on
-                  isNeutral' (NotBlocked Def{}) = dontHaveCopatterns -- a def by copattern can reduce if projected
-                  isNeutral' _                  = True
+                  isNeutral' (NotBlocked (Def q _)) = do
+                    d <- getConstInfo q
+                    return $ case d of
+                      Defn {theDef = Function {funCopatternLHS = True}} -> False -- a def by copattern can reduce if projected
+                      _                                                 -> True
+                  isNeutral' _                  = return True
                   isMeta' (NotBlocked MetaV{})  = True
                   isMeta' _                     = False
 
               reportSDoc "tc.conv.term" 30 $ prettyTCM a <+> text "is eta record type"
               m <- reduceB m
+              mNeutral <- isNeutral m
               n <- reduceB n
+              nNeutral <- isNeutral n
               case (m, n) of
                 _ | isMeta m || isMeta n ->
                     compareAtom cmp a' (ignoreBlocking m) (ignoreBlocking n)
 
-                _ | isNeutral m && isNeutral n -> do
+                _ | mNeutral && nNeutral -> do
                     -- Andreas 2011-03-23: (fixing issue 396)
                     -- if we are dealing with a singleton record,
                     -- we can succeed immediately
@@ -338,8 +343,8 @@ compareTel t1 t2 cmp tel1 tel2 =
 
           addCtx name dom1 $
             if dependent
-	    then guardConstraint c checkDom
-	    else checkDom >> solveConstraint_ c
+            then guardConstraint c checkDom
+            else checkDom >> solveConstraint_ c
 -}
   where
     -- Andreas, 2011-05-10 better report message about types
@@ -388,7 +393,7 @@ compareAtom cmp t m n =
     -- if a PatternErr is thrown, rebuild constraint!
     catchConstraint (ValueCmp cmp t m n) $ do
       reportSDoc "tc.conv.atom" 50 $
-	text "compareAtom" <+> fsep [ prettyTCM m <+> prettyTCM cmp
+        text "compareAtom" <+> fsep [ prettyTCM m <+> prettyTCM cmp
                                     , prettyTCM n
                                     , text ":" <+> prettyTCM t ]
       -- Andreas: what happens if I cut out the eta expansion here?
@@ -401,7 +406,7 @@ compareAtom cmp t m n =
       -- constructorForm changes literal to constructors
       -- only needed if the other side is not a literal
       (mb'', nb'') <- case (ignoreSharing $ ignoreBlocking mb', ignoreSharing $ ignoreBlocking nb') of
-	(Lit _, Lit _) -> return (mb', nb')
+        (Lit _, Lit _) -> return (mb', nb')
         _ -> (,) <$> traverse constructorForm mb'
                  <*> traverse constructorForm nb'
 
@@ -417,7 +422,7 @@ compareAtom cmp t m n =
             n <- normalise n    -- is this what we want?
             m <- normalise m
             if m == n
-                then return ()	-- Check syntactic equality for blocked terms
+                then return ()  -- Check syntactic equality for blocked terms
                 else postpone
 
           dir = fromCmp cmp
@@ -428,7 +433,7 @@ compareAtom cmp t m n =
       unifyPointers cmp (ignoreBlocking mb') (ignoreBlocking nb') $ do    -- this needs to go after eta expansion to avoid creating infinite terms
 
       reportSDoc "tc.conv.atom" 30 $
-	text "compareAtom" <+> fsep [ prettyTCM mb <+> prettyTCM cmp
+        text "compareAtom" <+> fsep [ prettyTCM mb <+> prettyTCM cmp
                                     , prettyTCM nb
                                     , text ":" <+> prettyTCM t ]
       case (ignoreSharing <$> mb, ignoreSharing <$> nb) of
@@ -455,12 +460,12 @@ compareAtom cmp t m n =
                 -- instantiate later meta variables first
                 let (solve1, solve2)
                       | (p1,x) > (p2,y) = (l,r)
-                      | otherwise	= (r,l)
+                      | otherwise       = (r,l)
                       where l = assign dir x xArgs n
                             r = assign rid y yArgs m
 
                     try m h = m `catchError_` \err -> case err of
-                      PatternErr s -> put s >> h
+                      PatternErr{} -> h
                       _            -> throwError err
 
                 -- First try the one with the highest priority. If that doesn't
@@ -468,9 +473,9 @@ compareAtom cmp t m n =
                 try solve1 solve2
 
         -- one side a meta, the other an unblocked term
-	(NotBlocked (MetaV x es), _) -> assign dir x es n
-	(_, NotBlocked (MetaV x es)) -> assign rid x es m
-        (Blocked{}, Blocked{})	-> checkSyntacticEquality
+        (NotBlocked (MetaV x es), _) -> assign dir x es n
+        (_, NotBlocked (MetaV x es)) -> assign rid x es m
+        (Blocked{}, Blocked{})  -> checkSyntacticEquality
         (Blocked{}, _)    -> useInjectivity cmp t m n
         (_,Blocked{})     -> useInjectivity cmp t m n
         _ -> do
@@ -481,15 +486,15 @@ compareAtom cmp t m n =
           m <- elimView False m
           n <- elimView False n
           case (ignoreSharing m, ignoreSharing n) of
-	    (Pi{}, Pi{}) -> equalFun m n
+            (Pi{}, Pi{}) -> equalFun m n
 
-	    (Sort s1, Sort s2) -> compareSort CmpEq s1 s2
+            (Sort s1, Sort s2) -> compareSort CmpEq s1 s2
 
-	    (Lit l1, Lit l2) | l1 == l2 -> return ()
-	    (Var i es, Var i' es') | i == i' -> do
-		a <- typeOfBV i
+            (Lit l1, Lit l2) | l1 == l2 -> return ()
+            (Var i es, Var i' es') | i == i' -> do
+                a <- typeOfBV i
                 -- Variables are invariant in their arguments
-		compareElims [] a (var i) es es'
+                compareElims [] a (var i) es es'
             (Def f es, Def f' es') | f == f' -> do
                 a   <- defType <$> getConstInfo f
                 pol <- getPolarity' cmp f
@@ -546,8 +551,8 @@ compareAtom cmp t m n =
                     reportSLn "tc.conv.elim" 50 $ "v (raw) = " ++ show v
                     compareElims pol a v els1 els2
 -}
-	    (Con x xArgs, Con y yArgs)
-		| x == y -> do
+            (Con x xArgs, Con y yArgs)
+                | x == y -> do
                     -- Get the type of the constructor instantiated to the datatype parameters.
                     a' <- conType x t
                     -- Constructors are invariant in their arguments
@@ -584,13 +589,13 @@ compareAtom cmp t m n =
             _ -> impossible
 -}
         equalFun t1 t2 = case (ignoreSharing t1, ignoreSharing t2) of
-	  (Pi dom1@(Dom i1 a1@(El a1s a1t)) b1, Pi (Dom i2 a2) b2)
-	    | argInfoHiding i1 /= argInfoHiding i2 -> typeError $ UnequalHiding t1 t2
+          (Pi dom1@(Dom i1 a1@(El a1s a1t)) b1, Pi (Dom i2 a2) b2)
+            | argInfoHiding i1 /= argInfoHiding i2 -> typeError $ UnequalHiding t1 t2
             -- Andreas 2010-09-21 compare r1 and r2, but ignore forcing annotations!
-	    | not (compareRelevance cmp (ignoreForced $ argInfoRelevance i2)
+            | not (compareRelevance cmp (ignoreForced $ argInfoRelevance i2)
                                         (ignoreForced $ argInfoRelevance i1))
                 -> typeError $ UnequalRelevance cmp t1 t2
-	    | otherwise -> verboseBracket "tc.conv.fun" 15 "compare function types" $ do
+            | otherwise -> verboseBracket "tc.conv.fun" 15 "compare function types" $ do
                 reportSDoc "tc.conv.fun" 20 $ nest 2 $ vcat
                   [ text "t1 =" <+> prettyTCM t1
                   , text "t2 =" <+> prettyTCM t2 ]
@@ -620,7 +625,7 @@ compareAtom cmp t m n =
                   then guardConstraint conCoDom checkDom
                   else checkDom >> solveConstraint_ conCoDom
 -}
-	  _ -> __IMPOSSIBLE__
+          _ -> __IMPOSSIBLE__
 
 compareRelevance :: Comparison -> Relevance -> Relevance -> Bool
 compareRelevance CmpEq  = (==)
@@ -836,14 +841,14 @@ compareType :: Comparison -> Type -> Type -> TCM ()
 compareType cmp ty1@(El s1 a1) ty2@(El s2 a2) =
     verboseBracket "tc.conv.type" 20 "compareType" $
     catchConstraint (TypeCmp cmp ty1 ty2) $ do
-	reportSDoc "tc.conv.type" 50 $ vcat
+        reportSDoc "tc.conv.type" 50 $ vcat
           [ text "compareType" <+> sep [ prettyTCM ty1 <+> prettyTCM cmp
                                        , prettyTCM ty2 ]
           , hsep [ text "   sorts:", prettyTCM s1, text " and ", prettyTCM s2 ]
           ]
 -- Andreas, 2011-4-27 should not compare sorts, but currently this is needed
 -- for solving sort and level metas
-	compareSort CmpEq s1 s2 `catchError` \err -> case err of
+        compareSort CmpEq s1 s2 `catchError` \err -> case err of
           TypeError _ e -> do
             reportSDoc "tc.conv.type" 30 $ vcat
               [ text "sort comparison failed"
@@ -873,8 +878,8 @@ compareType cmp ty1@(El s1 a1) ty2@(El s2 a2) =
                 -- throwError err
                 compareSort CmpEq s1 s2
           _             -> throwError err
-	compareTerm cmp (sort s1) a1 a2
-	return ()
+        compareTerm cmp (sort s1) a1 a2
+        return ()
 
 leqType :: Type -> Type -> TCM ()
 leqType = compareType CmpLeq
@@ -962,28 +967,28 @@ leqSort :: Sort -> Sort -> TCM ()
 leqSort s1 s2 =
   ifM typeInType (return ()) $
     catchConstraint (SortCmp CmpLeq s1 s2) $
-    do	(s1,s2) <- reduce (s1,s2)
+    do  (s1,s2) <- reduce (s1,s2)
         let postpone = addConstraint (SortCmp CmpLeq s1 s2)
         reportSDoc "tc.conv.sort" 30 $
           sep [ text "leqSort"
               , nest 2 $ fsep [ prettyTCM s1 <+> text "=<"
                               , prettyTCM s2 ]
               ]
-	case (s1, s2) of
+        case (s1, s2) of
 
             (Type a, Type b) -> leqLevel a b
 
-	    (Prop    , Prop    )	     -> return ()
-	    (Type _  , Prop    )	     -> notLeq s1 s2
+            (Prop    , Prop    )             -> return ()
+            (Type _  , Prop    )             -> notLeq s1 s2
 
-	    (Prop    , Type _  )	     -> return ()
+            (Prop    , Type _  )             -> return ()
 
             (_       , Inf     )             -> return ()
             (Inf     , _       )             -> equalSort s1 s2
             (DLub{}  , _       )             -> postpone
             (_       , DLub{}  )             -> postpone
     where
-	notLeq s1 s2 = typeError $ NotLeqSort s1 s2
+        notLeq s1 s2 = typeError $ NotLeqSort s1 s2
 
 leqLevel :: Level -> Level -> TCM ()
 leqLevel a b = liftTCM $ do
@@ -1271,13 +1276,13 @@ equalSort s1 s2 =
                                      , text (show s2) ]
                      ]
               ]
-	case (s1, s2) of
+        case (s1, s2) of
 
             (Type a  , Type b  ) -> equalLevel a b
 
-	    (Prop    , Prop    ) -> return ()
-	    (Type _  , Prop    ) -> notEq s1 s2
-	    (Prop    , Type _  ) -> notEq s1 s2
+            (Prop    , Prop    ) -> return ()
+            (Type _  , Prop    ) -> notEq s1 s2
+            (Prop    , Type _  ) -> notEq s1 s2
 
             (Inf     , Inf     )             -> return ()
             (Inf     , Type (Max as@(_:_)))  -> mapM_ (isInf $ notEq s1 s2) as
@@ -1297,7 +1302,7 @@ equalSort s1 s2 =
             (DLub{}  , _       )             -> postpone
             (_       , DLub{}  )             -> postpone
     where
-	notEq s1 s2 = typeError $ UnequalSorts s1 s2
+        notEq s1 s2 = typeError $ UnequalSorts s1 s2
 
         isInf notok ClosedLevel{} = notok
         isInf notok (Plus _ l) = case l of
diff --git a/src/full/Agda/TypeChecking/Coverage.hs b/src/full/Agda/TypeChecking/Coverage.hs
index 49947d6..e71c431 100644
--- a/src/full/Agda/TypeChecking/Coverage.hs
+++ b/src/full/Agda/TypeChecking/Coverage.hs
@@ -1,12 +1,25 @@
-{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fwarn-unused-imports #-}
+
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternGuards    #-}
+{-# LANGUAGE TupleSections    #-}
+
+{-| Coverage checking, case splitting, and splitting for refine tactics.
 
-module Agda.TypeChecking.Coverage where
+ -}
+
+module Agda.TypeChecking.Coverage
+  ( SplitClause(..), clauseToSplitClause, fixTarget
+  , Covering(..), splitClauses
+  , coverageCheck
+  , splitClauseWithAbsurd
+  , splitLast
+  , splitResult
+  ) where
 
 import Control.Monad
-import Control.Monad.Error
+import Control.Monad.Trans ( lift )
 import Control.Applicative hiding (empty)
 
 import Data.List
@@ -31,9 +44,8 @@ import Agda.TypeChecking.Monad.Context
 
 import Agda.TypeChecking.Rules.LHS.Problem (FlexibleVar(..),flexibleVarFromHiding)
 import Agda.TypeChecking.Rules.LHS.Unify
-import Agda.TypeChecking.Rules.LHS.Instantiate
-import Agda.TypeChecking.Rules.LHS
-import qualified Agda.TypeChecking.Rules.LHS.Split as Split
+import Agda.TypeChecking.Rules.LHS.Instantiate (instantiateTel)
+import Agda.TypeChecking.Rules.LHS (instantiatePattern)
 
 import Agda.TypeChecking.Coverage.Match
 import Agda.TypeChecking.Coverage.SplitTree
@@ -48,7 +60,8 @@ import Agda.TypeChecking.Irrelevance
 
 import Agda.Interaction.Options
 
-import Agda.Utils.Functor (for, ($>))
+import Agda.Utils.Either
+import Agda.Utils.Functor
 import Agda.Utils.List
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
@@ -56,16 +69,37 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data SplitClause = SClause
-      { scTel    :: Telescope            -- ^ Type of variables in @scPats at .
-      , scPerm   :: Permutation          -- ^ How to get from the variables in the patterns to the telescope.
-      , scPats   :: [I.NamedArg Pattern] -- ^ The patterns leading to the currently considered branch of the split tree.
-      , scSubst  :: Substitution         -- ^ Substitution from @scTel@ to old context.
-      , scTarget :: Maybe (I.Arg Type)   -- ^ The type of the rhs.
-      }
+  { scTel    :: Telescope
+    -- ^ Type of variables in @scPats at .
+  , scPerm   :: Permutation
+    -- ^ How to get from the variables in the patterns to the telescope.
+  , scPats   :: [I.NamedArg Pattern]
+    -- ^ The patterns leading to the currently considered branch of
+    --   the split tree.
+  , scSubst  :: Substitution
+    -- ^ Substitution from 'scTel' to old context.
+    --   Only needed directly after split on variable:
+    --   * To update 'scTarget'
+    --   * To rename other split variables when splitting on
+    --     multiple variables.
+    --   @scSubst@ is not ``transitive'', i.e., does not record
+    --   the substitution from the original context to 'scTel'
+    --   over a series of splits.  It is freshly computed
+    --   after each split by 'computeNeighborhood'; also
+    --   'splitResult', which does not split on a variable,
+    --   should reset it to the identity 'idS', lest it be
+    --   applied to 'scTarget' again, leading to Issue 1294.
+  , scTarget :: Maybe (I.Arg Type)
+    -- ^ The type of the rhs, living in context 'scTel'.
+    --   This invariant is broken before calls to 'fixTarget';
+    --   there, 'scTarget' lives in the old context.
+    --   'fixTarget' moves 'scTarget' to the new context by applying
+    --   substitution 'scSubst'.
+  }
 
 -- | A @Covering@ is the result of splitting a 'SplitClause'.
 data Covering = Covering
@@ -90,29 +124,6 @@ clauseToSplitClause cl = SClause
 
 type CoverM = ExceptionT SplitError TCM
 
-{- UNUSED
-typeOfVar :: Telescope -> Nat -> Dom Type
-typeOfVar tel n
-  | n >= len  = __IMPOSSIBLE__
-  | otherwise = fmap snd  -- throw away name, keep Arg Type
-                  $ ts !! fromIntegral (len - 1 - n)
-  where
-    len = genericLength ts
-    ts  = telToList tel
--}
-
--- | Old top-level function for checking pattern coverage.
---   DEPRECATED
-checkCoverage :: QName -> TCM ()
-checkCoverage f = do
-  d <- getConstInfo f
-  case theDef d of
-    Function{ funProjection = Nothing, funClauses = cs@(_:_) } -> do
-      coverageCheck f (defType d) cs
-      return ()
-    Function{ funProjection = Just _ } -> __IMPOSSIBLE__
-    _ -> __IMPOSSIBLE__
-
 -- | Top-level function for checking pattern coverage.
 coverageCheck :: QName -> Type -> [Clause] -> TCM SplitTree
 coverageCheck f t cs = do
@@ -168,7 +179,6 @@ cover f cs sc@(SClause tel perm ps _ target) = do
       reportSLn "tc.cover.cover" 10 $ "pattern covered by clause " ++ show i
       -- Check if any earlier clauses could match with appropriate literals
       let is = [ j | (j, c) <- zip [0..i-1] cs, matchLits c ups perm ]
-      -- OLD: let is = [ j | (j, c) <- zip [0..] (genericTake i cs), matchLits c ps perm ]
       reportSLn "tc.cover.cover"  10 $ "literal matches: " ++ show is
       return (SplittingDone (size tel), Set.fromList (i : is), [])
     No       ->  do
@@ -182,46 +192,14 @@ cover f cs sc@(SClause tel perm ps _ target) = do
       let done = return (SplittingDone (size tel), Set.empty, [ps])
       caseMaybeM (splitResult f sc) done $ \ (Covering n scs) -> do
         (projs, (trees, useds, psss)) <- mapSnd unzip3 . unzip <$> do
-          forM scs $ \ (proj, sc') -> (proj,) <$> do cover f cs =<< fixTarget sc'
-          -- OR: mapM (traverseF $ cover f cs <=< fixTarget) scs
+          mapM (traverseF $ cover f cs <=< (snd <.> fixTarget)) scs
+          -- OR:
+          -- forM scs $ \ (proj, sc') -> (proj,) <$> do
+          --   cover f cs =<< do
+          --     snd <$> fixTarget sc'
         let tree = SplitAt n $ zip projs trees
         return (tree, Set.unions useds, concat psss)
 
-      -- caseMaybe target done $ \ t -> do
-      --   isR <- addCtxTel tel $ isRecordType $ unArg t
-      --   case isR of
-      --     Just (_r, vs, Record{ recFields = fs }) -> do
-      --       reportSDoc "tc.cover" 20 $ sep
-      --         [ text $ "we are of record type _r = " ++ show _r
-      --         , text   "applied to parameters vs = " <+> (addCtxTel tel $ prettyTCM vs)
-      --         , text $ "and have fields       fs = " ++ show fs
-      --         ]
-      --       fvs <- freeVarsToApply f
-      --       let es = patternsToElims perm ps
-      --       let self  = defaultArg $ Def f (map Apply fvs) `applyE` es
-      --           pargs = vs ++ [self]
-      --       reportSDoc "tc.cover" 20 $ sep
-      --         [ text   "we are              self = " <+> (addCtxTel tel $ prettyTCM $ unArg self)
-      --         ]
-      --       (projs, (trees, useds, psss)) <- mapSnd unzip3 . unzip <$> do
-      --         forM fs $ \ proj -> do
-      --           -- compute the new target
-      --           dType <- defType <$> do getConstInfo $ unArg proj -- WRONG: typeOfConst $ unArg proj
-      --           let -- type of projection instantiated at self
-      --               target' = Just $ proj $> dType `apply` pargs
-      --               sc' = sc { scPats   = scPats sc ++ [fmap (Named Nothing . ProjP) proj]
-      --                        , scTarget = target'
-      --                        }
-      --           (unArg proj,) <$> do cover f cs =<< fixTarget sc'
-      --       let -- WRONG: -- n = length ps -- past the last argument, is pos. of proj pat.
-      --           -- n = size tel -- past the last variable, is pos. of proj pat. DURING SPLITTING
-      --           n = permRange perm -- Andreas & James, 2013-11-19 includes the dot patterns!
-      --           -- See test/succeed/CopatternsAndDotPatterns.agda for a case with dot patterns
-      --           -- and copatterns which fails for @n = size tel@ with a broken case tree.
-      --           tree = SplitAt n $ zip projs trees
-      --       return (tree, Set.unions useds, concat psss)
-      --     _ -> done
-
     -- case: split on variable
     Block bs -> do
       reportSLn "tc.cover.strategy" 20 $ "blocking vars = " ++ show bs
@@ -255,7 +233,7 @@ splitStrategy bs tel = return $ updateLast clearBlockingVarCons xs
   -- Otherwise, we will not get a nice error message.
   where
     xs       = bs
-{-
+{- KEEP!
 --  Andreas, 2012-10-13
 --  The following split strategy which prefers all-constructor columns
 --  fails on test/fail/CoverStrategy
@@ -290,32 +268,57 @@ isDatatype ind at = do
           | otherwise -> do
               let (ps, is) = genericSplitAt np args
               return (d, ps, is, cs)
-        Record{recPars = np, recConHead = con} ->
-          return (d, args, [], [conName con])
+        Record{recPars = np, recConHead = con, recInduction = i}
+          | i == Just CoInductive && ind /= CoInductive ->
+              throw CoinductiveDatatype
+          | otherwise ->
+              return (d, args, [], [conName con])
         _ -> throw NotADatatype
     _ -> throw NotADatatype
 
--- | update the target type, add more patterns to split clause
--- if target becomes a function type.
-fixTarget :: SplitClause -> TCM SplitClause
-fixTarget sc at SClause{ scSubst = sigma, scTarget = target } =
-  caseMaybe target (return sc) $ \ a -> do
-    reportSDoc "tc.cover.target" 20 $
-      text "target type before substitution: " <+> prettyTCM a
+-- | Update the target type, add more patterns to split clause
+--   if target becomes a function type.
+--   Returns @True@ if new patterns were added.
+fixTarget :: SplitClause -> TCM (Bool, SplitClause)
+fixTarget sc at SClause{ scTel = sctel, scPerm = perm, scPats = ps, scSubst = sigma, scTarget = target } =
+  caseMaybe target (return (False, sc)) $ \ a -> do
+    reportSDoc "tc.cover.target" 20 $ sep
+      [ text "split clause telescope: " <+> prettyTCM sctel
+      , text "old permutation       : " <+> prettyTCM perm
+      , text "old patterns          : " <+> sep (map (prettyTCM . namedArg) ps)
+      ]
+    reportSDoc "tc.cover.target" 30 $ sep
+      [ text "target type before substitution (variables may be wrong): " <+> do
+          addContext sctel $ prettyTCM a
+      ]
     TelV tel b <- telView $ applySubst sigma $ unArg a
-    reportSDoc "tc.cover.target" 10 $
-      text "telescope (after substitution): " <+> prettyTCM tel
-    let n      = size tel
-        lgamma = telToList tel
-        xs     = for lgamma $ \ (Common.Dom ai (x, _)) -> Common.Arg ai $ namedVarP "_"
-    if (n == 0) then return sc { scTarget = Just $ a $> b }
-     else return $ SClause
-      { scTel    = telFromList $ telToList (scTel sc) ++ lgamma
-      , scPerm   = liftP n $ scPerm sc
-      , scPats   = scPats sc ++ xs
-      , scSubst  = liftS n $ sigma
-      , scTarget = Just $ a $> b
-      }
+    reportSDoc "tc.cover.target" 10 $ sep
+      [ text "target type telescope (after substitution): " <+> do
+          addContext sctel $ prettyTCM tel
+      , text "target type core      (after substitution): " <+> do
+          addContext sctel $ addContext tel $ prettyTCM b
+      ]
+    let n         = size tel
+        lgamma    = telToList tel
+        xs        = for lgamma $ \ (Common.Dom ai (x, _)) -> Common.Arg ai $ namedVarP "_"
+        -- Compute new split clause
+        sctel'    = telFromList $ telToList (raise n sctel) ++ lgamma
+        perm'     = liftP n $ scPerm sc
+        -- Dot patterns in @ps@ need to be raised!  (Issue 1298)
+        ps'       = raise n ps ++ xs
+        newTarget = Just $ a $> b
+        sc'       = SClause
+          { scTel    = sctel'
+          , scPerm   = perm'
+          , scPats   = ps'
+          , scSubst  = liftS n $ sigma
+          , scTarget = newTarget
+          }
+    reportSDoc "tc.cover.target" 20 $ sep
+      [ text "new split clause"
+      , prettyTCM sc'
+      ]
+    return $ if n == 0 then (False, sc { scTarget = newTarget }) else (True, sc')
 
 -- | @computeNeighbourhood delta1 delta2 perm d pars ixs hix hps con@
 --
@@ -513,6 +516,8 @@ splitClauseWithAbsurd :: Clause -> Nat -> TCM (Either SplitError (Either SplitCl
 splitClauseWithAbsurd c x = split' Inductive (clauseToSplitClause c) (BlockingVar x Nothing)
 
 -- | Entry point from @TypeChecking.Empty@ and @Interaction.BasicOps at .
+--   @splitLast CoInductive@ is used in the @refine@ tactics.
+
 splitLast :: Induction -> Telescope -> [I.NamedArg Pattern] -> TCM (Either SplitError Covering)
 splitLast ind tel ps = split ind sc (BlockingVar 0 Nothing)
   where sc = SClause tel (idP $ size tel) ps __IMPOSSIBLE__ Nothing
@@ -539,7 +544,7 @@ split ind sc x = fmap (blendInAbsurdClause (splitDbIndexToLevel sc x)) <$>
     split' ind sc x
   where
     blendInAbsurdClause :: Nat -> Either SplitClause Covering -> Covering
-    blendInAbsurdClause n = either (const $ Covering n []) id
+    blendInAbsurdClause n = fromRight (const $ Covering n [])
 
     splitDbIndexToLevel :: SplitClause -> BlockingVar -> Nat
     splitDbIndexToLevel sc at SClause{ scTel = tel, scPerm = perm } x =
@@ -548,6 +553,7 @@ split ind sc x = fmap (blendInAbsurdClause (splitDbIndexToLevel sc x)) <$>
 -- | Convert a de Bruijn index relative to a telescope to a de Buijn level.
 --   The result should be the argument (counted from left, starting with 0)
 --   to split at (dot patterns included!).
+dbIndexToLevel :: Telescope -> Permutation -> Int -> Nat
 dbIndexToLevel tel perm x = if n < 0 then __IMPOSSIBLE__ else n
   where n = if k < 0 then __IMPOSSIBLE__ else permute perm [0..] !! k
         k = size tel - x - 1
@@ -599,15 +605,13 @@ split' ind sc@(SClause tel perm ps _ target) (BlockingVar x mcons) = liftTCM $ r
   -- cons = constructors of this datatype
   (d, pars, ixs, cons) <- inContextOfT $ isDatatype ind t
 
-  --liftTCM $ whenM (optWithoutK <$> pragmaOptions) $
-  --  inContextOfT $ Split.wellFormedIndices (unDom t)
-
   -- Compute the neighbourhoods for the constructors
   ns <- catMaybes <$> do
     forM cons $ \ con ->
       fmap (con,) <$> do
-        Trav.mapM (\sc -> lift $ fixTarget $ sc { scTarget = target }) =<< do
-          computeNeighbourhood delta1 n delta2 perm d pars ixs hix hps con
+        msc <- computeNeighbourhood delta1 n delta2 perm d pars ixs hix hps con
+        Trav.forM msc $ \ sc -> lift $ snd <$> fixTarget sc{ scTarget = target }
+
   case ns of
     []  -> do
       let absurd = VarP "()"
@@ -644,6 +648,7 @@ split' ind sc@(SClause tel perm ps _ target) (BlockingVar x mcons) = liftTCM $ r
     _  -> return $ Right $ Covering xDBLevel ns
 
   where
+    xDBLevel :: Nat
     xDBLevel = dbIndexToLevel tel perm x
 
     inContextOfT :: MonadTCM tcm => tcm a -> tcm a
@@ -716,7 +721,28 @@ splitResult f sc@(SClause tel perm ps _ target) = do
             let -- type of projection instantiated at self
                 target' = Just $ proj $> dType `apply` pargs
                 sc' = sc { scPats   = scPats sc ++ [fmap (Named Nothing . ProjP) proj]
+                         , scSubst  = idS
                          , scTarget = target'
                          }
             return (unArg proj, sc')
       _ -> done
+
+-- * Boring instances
+
+-- | For debugging only.
+instance PrettyTCM SplitClause where
+  prettyTCM (SClause tel perm pats sigma target) = sep
+    [ text "SplitClause"
+    , nest 2 $ vcat
+      [ text "tel          = " <+> prettyTCM tel
+      , text "perm         = " <+> prettyTCM perm
+      , text "pats         = " <+> sep (map (prettyTCM . namedArg) pats)
+      , text "subst        = " <+> (text . show) sigma
+      , text "target       = " <+> do
+          caseMaybe target empty $ \ t -> do
+            addContext tel $ prettyTCM t
+      , text "subst target = " <+> do
+          caseMaybe target empty $ \ t -> do
+            addContext tel $ prettyTCM $ applySubst sigma t
+      ]
+    ]
diff --git a/src/full/Agda/TypeChecking/Coverage/Match.hs b/src/full/Agda/TypeChecking/Coverage/Match.hs
index e916a95..d67b442 100644
--- a/src/full/Agda/TypeChecking/Coverage/Match.hs
+++ b/src/full/Agda/TypeChecking/Coverage/Match.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE PatternGuards #-}
 
@@ -22,7 +22,7 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.List
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {-| Given
@@ -78,7 +78,7 @@ data MPat
 buildMPatterns :: Permutation -> [Arg Pattern] -> [Arg MPat]
 buildMPatterns perm ps = evalState (mapM (traverse build) ps) xs
   where
-    xs   = permute (invertP perm) $ downFrom (size perm)
+    xs   = permute (invertP __IMPOSSIBLE__ perm) $ downFrom (size perm)
     tick = do x : xs <- get; put xs; return x
 
     build (VarP _)        = VarMP <$> tick
diff --git a/src/full/Agda/TypeChecking/Coverage/SplitTree.hs b/src/full/Agda/TypeChecking/Coverage/SplitTree.hs
index 670e3fa..0c0bf04 100644
--- a/src/full/Agda/TypeChecking/Coverage/SplitTree.hs
+++ b/src/full/Agda/TypeChecking/Coverage/SplitTree.hs
@@ -20,7 +20,7 @@ import Agda.Syntax.Abstract.Name
 
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type SplitTree  = SplitTree'  QName
@@ -93,4 +93,5 @@ instance Arbitrary CName where
   arbitrary = CName <$> elements
     [ "zero", "suc", "nil", "cons", "left", "right", "just", "nothing" ]
 
+testSplitTreePrinting :: IO ()
 testSplitTreePrinting = sample (arbitrary :: Gen (SplitTree' CName))
diff --git a/src/full/Agda/TypeChecking/Datatypes.hs b/src/full/Agda/TypeChecking/Datatypes.hs
index 75bcd20..ca1d986 100644
--- a/src/full/Agda/TypeChecking/Datatypes.hs
+++ b/src/full/Agda/TypeChecking/Datatypes.hs
@@ -17,7 +17,7 @@ import Agda.TypeChecking.Substitute
 
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -126,10 +126,12 @@ isDataOrRecordType d = do
     Record{}   -> return $ Just IsRecord
     _          -> return $ Nothing
 
+-- | Precodition: 'Term' is 'reduce'd.
 isDataOrRecord :: Term -> TCM (Maybe QName)
-isDataOrRecord (Def d _)  = fmap (const d) <$> isDataOrRecordType d
-isDataOrRecord (Shared p) = isDataOrRecord (derefPtr p)
-isDataOrRecord _          = return Nothing
+isDataOrRecord v = do
+  case ignoreSharing v of
+    Def d _ -> fmap (const d) <$> isDataOrRecordType d
+    _       -> return Nothing
 
 getNumberOfParameters :: QName -> TCM (Maybe Nat)
 getNumberOfParameters d = do
diff --git a/src/full/Agda/TypeChecking/DisplayForm.hs b/src/full/Agda/TypeChecking/DisplayForm.hs
index 7b774f6..a61e820 100644
--- a/src/full/Agda/TypeChecking/DisplayForm.hs
+++ b/src/full/Agda/TypeChecking/DisplayForm.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.DisplayForm where
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad
 import Control.Monad.Trans.Maybe
 
 import Data.Traversable (traverse)
@@ -20,7 +20,7 @@ import Agda.TypeChecking.Level
 import Agda.Utils.List
 import Agda.Utils.Maybe
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Find a matching display form for @q vs at .
@@ -38,7 +38,7 @@ displayForm q vs = do
         "displayForm: context = " ++ show n ++
         ", dfs = " ++ show (map openThingCtxIds odfs)
     -- Use only the display forms that can be opened in the current context.
-    dfs	  <- catMaybes <$> mapM tryOpen odfs
+    dfs   <- catMaybes <$> mapM tryOpen odfs
     scope <- getScope
     -- Keep the display forms that match the application @c vs at .
     ms <- do
@@ -54,7 +54,7 @@ displayForm q vs = do
       , "result      : " ++ show (foldr (const . Just) Nothing ms)
       ]
     -- Return the first display form that matches.
-    return $ mhead ms
+    return $ headMaybe ms
 
 --  Andreas, 2014-06-11: The following error swallowing
 --  is potentially harmful, making debugging harder.
@@ -71,7 +71,7 @@ displayForm q vs = do
     -- hd (DTerm (Con x _))    = Just $ conName x
     -- hd (DTerm (Shared p))   = hd (DTerm $ derefPtr p)
     -- hd (DWithApp d _ _) = hd d
-    -- hd _		    = Nothing
+    -- hd _                 = Nothing
 
 -- | Match a 'DisplayForm' @q ps = v@ against @q vs at .
 --   Return the 'DisplayTerm' @v[us]@ if the match was successful,
@@ -80,10 +80,9 @@ matchDisplayForm :: DisplayForm -> Args -> MaybeT TCM DisplayTerm
 matchDisplayForm (Display _ ps v) vs
   | length ps > length vs = mzero
   | otherwise             = do
+      let (vs0, vs1) = splitAt (length ps) vs
       us <- match ps $ raise 1 $ map unArg vs0
       return $ applySubst (parallelS $ reverse us) v `apply` vs1
-  where
-    (vs0, vs1) = splitAt (length ps) vs
 
 -- | Class @Match@ for matching a term @p@ in the role of a pattern
 --   against a term @v at .
@@ -118,7 +117,7 @@ instance Match a => Match (Elim' a) where
 
 instance Match Term where
   match p v = case (ignoreSharing p, ignoreSharing v) of
-    (Var 0 [], v)                  -> return [subst __IMPOSSIBLE__ v]
+    (Var 0 [], v)                  -> return [strengthen __IMPOSSIBLE__ v]
     (Var i ps, Var j vs) | i == j  -> match ps vs
     (Def c ps, Def d vs) | c == d  -> match ps vs
     (Con c ps, Con d vs) | c == d  -> match ps vs
diff --git a/src/full/Agda/TypeChecking/DropArgs.hs b/src/full/Agda/TypeChecking/DropArgs.hs
index ead5577..b855f8c 100644
--- a/src/full/Agda/TypeChecking/DropArgs.hs
+++ b/src/full/Agda/TypeChecking/DropArgs.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.DropArgs where
@@ -13,7 +13,7 @@ import Agda.TypeChecking.CompiledClause
 
 import Agda.Utils.Permutation
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
diff --git a/src/full/Agda/TypeChecking/Errors.hs b/src/full/Agda/TypeChecking/Errors.hs
index 62a03e9..cdff5ff 100644
--- a/src/full/Agda/TypeChecking/Errors.hs
+++ b/src/full/Agda/TypeChecking/Errors.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.Errors
@@ -14,10 +14,9 @@ module Agda.TypeChecking.Errors
 import Prelude hiding (null)
 
 import Control.Monad.State
-import Control.Monad.Error
 
 import Data.Function
-import Data.List (nub, sortBy)
+import Data.List (nub, sortBy, intercalate)
 import Data.Maybe
 import qualified Data.Map as Map (empty)
 
@@ -41,13 +40,14 @@ import Agda.TypeChecking.Monad.Options
 import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Reduce (instantiate)
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.FileName
 import Agda.Utils.Function
 import Agda.Utils.Monad
 import Agda.Utils.Null hiding (empty)
 import qualified Agda.Utils.Pretty as P
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -61,9 +61,9 @@ prettyError err = liftTCM $ show <$> prettyError' err []
   prettyError' :: TCErr -> [TCErr] -> TCM Doc
   prettyError' err errs
     | length errs > 3 = fsep (
-	pwords "total panic: error when printing error from printing error from printing error." ++
-	pwords "I give up! Approximations of errors (original error last):" )
-	$$ vcat (map (text . tcErrString) errs)
+        pwords "total panic: error when printing error from printing error from printing error." ++
+        pwords "I give up! Approximations of errors (original error last):" )
+        $$ vcat (map (text . tcErrString) errs)
     | otherwise = applyUnless (null errs) (text "panic: error when printing error!" $$) $ do
         (prettyTCM err $$ vcat (map (text . ("when printing error " ++) . tcErrString) errs))
         `catchError` \ err' -> prettyError' err' (err:errs)
@@ -76,10 +76,7 @@ prettyError err = liftTCM $ show <$> prettyError' err []
 -- Invariant: The fields are never empty at the same time.
 
 data Warnings = Warnings
-  { terminationProblems   :: Maybe TCErr
-    -- ^ Termination checking problems are not reported if
-    -- 'optTerminationCheck' is 'False'.
-  , unsolvedMetaVariables :: [Range]
+  { unsolvedMetaVariables :: [Range]
     -- ^ Meta-variable problems are reported as type errors unless
     -- 'optAllowUnsolved' is 'True'.
   , unsolvedConstraints   :: Constraints
@@ -89,10 +86,10 @@ data Warnings = Warnings
 -- | Turns warnings into an error. Even if several errors are possible
 --   only one is raised.
 warningsToError :: Warnings -> TCM a
-warningsToError (Warnings Nothing [] []) = __IMPOSSIBLE__
-warningsToError (Warnings _ w@(_:_) _)   = typeError $ UnsolvedMetas w
-warningsToError (Warnings _ _ w@(_:_))   = typeError $ UnsolvedConstraints w
-warningsToError (Warnings (Just w) _ _)  = throwError w
+warningsToError (Warnings [] [])     = typeError $ SolvedButOpenHoles
+warningsToError (Warnings w@(_:_) _) = typeError $ UnsolvedMetas w
+warningsToError (Warnings _ w@(_:_)) = typeError $ UnsolvedConstraints w
+
 
 ---------------------------------------------------------------------------
 -- * Helpers
@@ -120,7 +117,7 @@ tcErrString err = show (getRange err) ++ " " ++ case err of
     TypeError _ cl  -> errorString $ clValue cl
     Exception r s   -> show r ++ " " ++ s
     IOException r e -> show r ++ " " ++ show e
-    PatternErr _    -> "PatternErr"
+    PatternErr{}    -> "PatternErr"
     {- AbortAssign _   -> "AbortAssign" -- UNUSED -}
 
 errorString :: TypeError -> String
@@ -131,6 +128,8 @@ errorString err = case err of
     AmbiguousParseForLHS{}                   -> "AmbiguousParseForLHS"
 --    AmbiguousParseForPatternSynonym{}        -> "AmbiguousParseForPatternSynonym"
     AmbiguousTopLevelModuleName {}           -> "AmbiguousTopLevelModuleName"
+    BadArgumentsToPatternSynonym{}           -> "BadArgumentsToPatternSynonym"
+    TooFewArgumentsToPatternSynonym{}        -> "TooFewArgumentsToPatternSynonym"
     BothWithAndRHS                           -> "BothWithAndRHS"
     BuiltinInParameterisedModule{}           -> "BuiltinInParameterisedModule"
     BuiltinMustBeConstructor{}               -> "BuiltinMustBeConstructor"
@@ -203,12 +202,13 @@ errorString err = case err of
     NothingAppliedToInstanceArg{}            -> "NothingAppliedToInstanceArg"
     OverlappingProjects {}                   -> "OverlappingProjects"
     PatternShadowsConstructor {}             -> "PatternShadowsConstructor"
-    PatternSynonymArityMismatch {}           -> "PatternSynonymArityMismatch"
     PropMustBeSingleton                      -> "PropMustBeSingleton"
     RepeatedVariablesInPattern{}             -> "RepeatedVariablesInPattern"
     SafeFlagPostulate{}                      -> "SafeFlagPostulate"
     SafeFlagPragma{}                         -> "SafeFlagPragma"
     SafeFlagNoTerminationCheck{}             -> "SafeFlagNoTerminationCheck"
+    SafeFlagNonTerminating{}                 -> "SafeFlagNonTerminating"
+    SafeFlagTerminating{}                    -> "SafeFlagTerminating"
     SafeFlagPrimTrustMe{}                    -> "SafeFlagPrimTrustMe"
     ShadowedModule{}                         -> "ShadowedModule"
     ShouldBeASort{}                          -> "ShouldBeASort"
@@ -238,13 +238,16 @@ errorString err = case err of
 --    UnequalTelescopes{}                      -> "UnequalTelescopes" -- UNUSED
     UnequalColors{}                          -> "UnequalTelescopes"
     HeterogeneousEquality{}                  -> "HeterogeneousEquality"
+    WithOnFreeVariable{}                     -> "WithOnFreeVariable"
     UnexpectedWithPatterns{}                 -> "UnexpectedWithPatterns"
     UninstantiatedDotPattern{}               -> "UninstantiatedDotPattern"
     UninstantiatedModule{}                   -> "UninstantiatedModule"
     UnreachableClauses{}                     -> "UnreachableClauses"
     UnsolvedConstraints{}                    -> "UnsolvedConstraints"
     UnsolvedMetas{}                          -> "UnsolvedMetas"
+    SolvedButOpenHoles{}                     -> "SolvedButOpenHoles"
     UnusedVariableInPatternSynonym           -> "UnusedVariableInPatternSynonym"
+    UnquoteFailed{}                          -> "UnquoteFailed"
     WithClausePatternMismatch{}              -> "WithClausePatternMismatch"
     WithoutKError{}                          -> "WithoutKError"
     WrongHidingInApplication{}               -> "WrongHidingInApplication"
@@ -262,13 +265,13 @@ instance PrettyTCM TCErr where
         -- Andreas, 2014-03-23
         -- This use of localState seems ok since we do not collect
         -- Benchmark info during printing errors.
-	TypeError s e -> localState $ do
-	    put s
-	    sayWhen (envRange $ clEnv e) (envCall $ clEnv e) $ prettyTCM e
-	Exception r s   -> sayWhere r $ fwords s
-	IOException r e -> sayWhere r $ fwords $ show e
-	PatternErr _    -> sayWhere err $ panic "uncaught pattern violation"
-	{- AbortAssign _   -> sayWhere err $ panic "uncaught aborted assignment" -- UNUSED -}
+        TypeError s e -> localState $ do
+            put s
+            sayWhen (envRange $ clEnv e) (envCall $ clEnv e) $ prettyTCM e
+        Exception r s   -> sayWhere r $ fwords s
+        IOException r e -> sayWhere r $ fwords $ show e
+        PatternErr{}    -> sayWhere err $ panic "uncaught pattern violation"
+        {- AbortAssign _   -> sayWhere err $ panic "uncaught aborted assignment" -- UNUSED -}
 
 instance PrettyTCM CallInfo where
   prettyTCM c = do
@@ -284,57 +287,57 @@ dropTopLevelModule (QName (MName ns) n) = QName (MName (drop 1 ns)) n
 
 instance PrettyTCM TypeError where
     prettyTCM err = do
-	case err of
-	    InternalError s  -> panic s
-	    NotImplemented s -> fwords $ "Not implemented: " ++ s
-	    NotSupported s -> fwords $ "Not supported: " ++ s
-	    CompilationError s -> sep [fwords "Compilation error:", text s]
-	    GenericError s   -> fwords s
-	    GenericDocError d   -> return d
-	    TerminationCheckFailed because ->
+        case err of
+            InternalError s  -> panic s
+            NotImplemented s -> fwords $ "Not implemented: " ++ s
+            NotSupported s -> fwords $ "Not supported: " ++ s
+            CompilationError s -> sep [fwords "Compilation error:", text s]
+            GenericError s   -> fwords s
+            GenericDocError d   -> return d
+            TerminationCheckFailed because ->
               fwords "Termination checking failed for the following functions:"
-              $$ (nest 2 $
-                    fsep (punctuate comma (map (text . show . dropTopLevelModule)
-                                               (concatMap termErrFunctions because))))
+              $$ (nest 2 $ fsep $ punctuate comma $
+                   map (pretty . dropTopLevelModule) $
+                     concatMap termErrFunctions because)
               $$ fwords "Problematic calls:"
               $$ (nest 2 $ fmap (P.vcat . nub) $
                     mapM prettyTCM $ sortBy (compare `on` callInfoRange) $
                     concatMap termErrCalls because)
-	    PropMustBeSingleton -> fwords
-		"Datatypes in Prop must have at most one constructor when proof irrelevance is enabled"
-	    DataMustEndInSort t -> fsep $
-		pwords "The type of a datatype must end in a sort."
-		++ [prettyTCM t] ++ pwords "isn't a sort."
+            PropMustBeSingleton -> fwords
+                "Datatypes in Prop must have at most one constructor when proof irrelevance is enabled"
+            DataMustEndInSort t -> fsep $
+                pwords "The type of a datatype must end in a sort."
+                ++ [prettyTCM t] ++ pwords "isn't a sort."
 {- UNUSED:
-	    DataTooManyParameters -> fsep $ pwords "Too many parameters given to data type."
+            DataTooManyParameters -> fsep $ pwords "Too many parameters given to data type."
 -}
-	    ShouldEndInApplicationOfTheDatatype t -> fsep $
-		pwords "The target of a constructor must be the datatype applied to its parameters,"
-		++ [prettyTCM t] ++ pwords "isn't"
-	    ShouldBeAppliedToTheDatatypeParameters s t -> fsep $
-		pwords "The target of the constructor should be" ++ [prettyTCM s] ++
-		pwords "instead of" ++ [prettyTCM t]
-	    ShouldBeApplicationOf t q -> fsep $
-		pwords "The pattern constructs an element of" ++ [prettyTCM q] ++
-		pwords "which is not the right datatype"
-	    ShouldBeRecordType t -> fsep $
-		pwords "Expected non-abstract record type, found " ++ [prettyTCM t]
-	    ShouldBeRecordPattern p -> fsep $
-		pwords "Expected record pattern" -- ", found " ++ [prettyTCM p]
-	    NotAProjectionPattern p -> fsep $
-		pwords "Not a valid projection for a copattern: " ++ [ prettyA p ]
-	    DifferentArities ->
-		fwords "The number of arguments in the defining equations differ"
-	    WrongHidingInLHS -> do
-		fwords "Unexpected implicit argument"
-	    WrongHidingInLambda t -> do
-		fwords "Found an implicit lambda where an explicit lambda was expected"
-	    WrongIrrelevanceInLambda t -> do
-		fwords "Found an irrelevant lambda where a relevant lambda was expected"
-	    WrongNamedArgument a -> fsep $
-		pwords "Function does not accept argument " ++ [prettyTCM a] -- ++ pwords " (wrong argument name)"
-	    WrongHidingInApplication t -> do
-		fwords "Found an implicit application where an explicit application was expected"
+            ShouldEndInApplicationOfTheDatatype t -> fsep $
+                pwords "The target of a constructor must be the datatype applied to its parameters,"
+                ++ [prettyTCM t] ++ pwords "isn't"
+            ShouldBeAppliedToTheDatatypeParameters s t -> fsep $
+                pwords "The target of the constructor should be" ++ [prettyTCM s] ++
+                pwords "instead of" ++ [prettyTCM t]
+            ShouldBeApplicationOf t q -> fsep $
+                pwords "The pattern constructs an element of" ++ [prettyTCM q] ++
+                pwords "which is not the right datatype"
+            ShouldBeRecordType t -> fsep $
+                pwords "Expected non-abstract record type, found " ++ [prettyTCM t]
+            ShouldBeRecordPattern p -> fsep $
+                pwords "Expected record pattern" -- ", found " ++ [prettyTCM p]
+            NotAProjectionPattern p -> fsep $
+                pwords "Not a valid projection for a copattern: " ++ [ prettyA p ]
+            DifferentArities ->
+                fwords "The number of arguments in the defining equations differ"
+            WrongHidingInLHS -> do
+                fwords "Unexpected implicit argument"
+            WrongHidingInLambda t -> do
+                fwords "Found an implicit lambda where an explicit lambda was expected"
+            WrongIrrelevanceInLambda t -> do
+                fwords "Found an irrelevant lambda where a relevant lambda was expected"
+            WrongNamedArgument a -> fsep $
+                pwords "Function does not accept argument " ++ [prettyTCM a] -- ++ pwords " (wrong argument name)"
+            WrongHidingInApplication t -> do
+                fwords "Found an implicit application where an explicit application was expected"
             HidingMismatch h h' -> fwords $
               "Expected " ++ verbalize (Indefinite h') ++ " argument, but found " ++
               verbalize (Indefinite h) ++ " argument"
@@ -367,7 +370,9 @@ instance PrettyTCM TypeError where
               pwords "The constructor" ++ [prettyTCM c] ++ pwords "expects" ++
               [text (show expect)] ++ pwords "arguments (including hidden ones), but has been given" ++ [text (show given)] ++ pwords "(including hidden ones)"
             CantResolveOverloadedConstructorsTargetingSameDatatype d cs -> fsep $
-              pwords ("Can't resolve overloaded constructors targeting the same datatype (" ++ show d ++ "):") ++ map (text . show) cs
+              pwords ("Can't resolve overloaded constructors targeting the same datatype ("
+              ++ show (qnameToConcrete d) ++ "):")
+              ++ map pretty cs
             DoesNotConstructAnElementOf c t -> fsep $
               pwords "The constructor" ++ [prettyTCM c] ++
               pwords "does not construct an element of" ++ [prettyTCM t]
@@ -418,24 +423,24 @@ instance PrettyTCM TypeError where
               pwords "is not parameterized, but is being applied to arguments"
             ModuleArityMismatch m tel@(ExtendTel _ _) args -> fsep $
               pwords "The arguments to " ++ [prettyTCM m] ++ pwords "does not fit the telescope" ++
-	      [prettyTCM tel]
+              [prettyTCM tel]
             ShouldBeEmpty t [] -> fsep $
-		[prettyTCM t] ++ pwords "should be empty, but that's not obvious to me"
-	    ShouldBeEmpty t ps -> fsep (
-		[prettyTCM t] ++
+                [prettyTCM t] ++ pwords "should be empty, but that's not obvious to me"
+            ShouldBeEmpty t ps -> fsep (
+                [prettyTCM t] ++
                 pwords "should be empty, but the following constructor patterns are valid:"
               ) $$ nest 2 (vcat $ map (showPat 0) ps)
 
-	    ShouldBeASort t -> fsep $
-		[prettyTCM t] ++ pwords "should be a sort, but it isn't"
-	    ShouldBePi t -> fsep $
-		[prettyTCM t] ++ pwords "should be a function type, but it isn't"
-	    NotAProperTerm ->
-		fwords "Found a malformed term"
-	    SetOmegaNotValidType ->
-		fwords "Setω is not a valid type"
-	    InvalidType v -> fsep $
-		[prettyTCM v] ++ pwords "is not a valid type"
+            ShouldBeASort t -> fsep $
+                [prettyTCM t] ++ pwords "should be a sort, but it isn't"
+            ShouldBePi t -> fsep $
+                [prettyTCM t] ++ pwords "should be a function type, but it isn't"
+            NotAProperTerm ->
+                fwords "Found a malformed term"
+            SetOmegaNotValidType ->
+                fwords "Setω is not a valid type"
+            InvalidType v -> fsep $
+                [prettyTCM v] ++ pwords "is not a valid type"
             SplitOnIrrelevant p t -> fsep $
                 pwords "Cannot pattern match" ++ [prettyA p] ++
                 pwords "against irrelevant type" ++ [prettyTCM t]
@@ -443,142 +448,146 @@ instance PrettyTCM TypeError where
                 text "Identifier" : prettyTCM x : pwords "is declared irrelevant, so it cannot be used here"
             VariableIsIrrelevant x -> fsep $
                 text "Variable" : prettyTCM x : pwords "is declared irrelevant, so it cannot be used here"
-	    UnequalBecauseOfUniverseConflict cmp s t -> fsep $
-		[prettyTCM s, notCmp cmp, prettyTCM t, text "because this would result in an invalid use of Setω" ]
- 	    UnequalTerms cmp s t a -> do
+            UnequalBecauseOfUniverseConflict cmp s t -> fsep $
+                [prettyTCM s, notCmp cmp, prettyTCM t, text "because this would result in an invalid use of Setω" ]
+            UnequalTerms cmp s t a -> do
                 (d1, d2, d) <- prettyInEqual s t
-		fsep $ [return d1, notCmp cmp, return d2] ++ pwords "of type" ++ [prettyTCM a] ++ [return d]
+                fsep $ [return d1, notCmp cmp, return d2] ++ pwords "of type" ++ [prettyTCM a] ++ [return d]
 -- UnequalLevel is UNUSED
---	    UnequalLevel cmp s t -> fsep $
---		[prettyTCM s, notCmp cmp, prettyTCM t]
+--          UnequalLevel cmp s t -> fsep $
+--              [prettyTCM s, notCmp cmp, prettyTCM t]
 -- UnequalTelescopes is UNUSED
---	    UnequalTelescopes cmp a b -> fsep $
---		[prettyTCM a, notCmp cmp, prettyTCM b]
-	    UnequalTypes cmp a b -> prettyUnequal a (notCmp cmp) b
+--          UnequalTelescopes cmp a b -> fsep $
+--              [prettyTCM a, notCmp cmp, prettyTCM b]
+            UnequalTypes cmp a b -> prettyUnequal a (notCmp cmp) b
 --                fsep $ [prettyTCM a, notCmp cmp, prettyTCM b]
             UnequalColors a b -> error "TODO guilhem 4"
-	    HeterogeneousEquality u a v b -> fsep $
+            HeterogeneousEquality u a v b -> fsep $
                 pwords "Refuse to solve heterogeneous constraint" ++
                 [prettyTCM u] ++ pwords ":" ++ [prettyTCM a] ++ pwords "=?=" ++
                 [prettyTCM v] ++ pwords ":" ++ [prettyTCM b]
-	    UnequalRelevance cmp a b -> fsep $
-		[prettyTCM a, notCmp cmp, prettyTCM b] ++
+            UnequalRelevance cmp a b -> fsep $
+                [prettyTCM a, notCmp cmp, prettyTCM b] ++
 -- Andreas 2010-09-21 to reveal Forced annotations, print also uglily
---		[text $ show a, notCmp cmp, text $ show b] ++
-		pwords "because one is a relevant function type and the other is an irrelevant function type"
-	    UnequalHiding a b -> fsep $
-		[prettyTCM a, text "!=", prettyTCM b] ++
-		pwords "because one is an implicit function type and the other is an explicit function type"
-	    UnequalSorts s1 s2 -> fsep $
-		[prettyTCM s1, text "!=", prettyTCM s2]
-	    NotLeqSort s1 s2 -> fsep $
-		pwords "The type of the constructor does not fit in the sort of the datatype, since"
-		++ [prettyTCM s1] ++ pwords "is not less or equal than" ++ [prettyTCM s2]
-	    TooFewFields r xs -> fsep $
-		pwords "Missing fields" ++ punctuate comma (map pretty xs) ++
-		pwords "in an element of the record" ++ [prettyTCM r]
-	    TooManyFields r xs -> fsep $
-		pwords "The record type" ++ [prettyTCM r] ++
-		pwords "does not have the fields" ++ punctuate comma (map pretty xs)
-	    DuplicateConstructors xs -> fsep $
-		pwords "Duplicate constructors" ++ punctuate comma (map pretty xs) ++
-		pwords "in datatype"
-	    DuplicateFields xs -> fsep $
-		pwords "Duplicate fields" ++ punctuate comma (map pretty xs) ++
-		pwords "in record"
+--              [text $ show a, notCmp cmp, text $ show b] ++
+                pwords "because one is a relevant function type and the other is an irrelevant function type"
+            UnequalHiding a b -> fsep $
+                [prettyTCM a, text "!=", prettyTCM b] ++
+                pwords "because one is an implicit function type and the other is an explicit function type"
+            UnequalSorts s1 s2 -> fsep $
+                [prettyTCM s1, text "!=", prettyTCM s2]
+            NotLeqSort s1 s2 -> fsep $
+                pwords "The type of the constructor does not fit in the sort of the datatype, since"
+                ++ [prettyTCM s1] ++ pwords "is not less or equal than" ++ [prettyTCM s2]
+            TooFewFields r xs -> fsep $
+                pwords "Missing fields" ++ punctuate comma (map pretty xs) ++
+                pwords "in an element of the record" ++ [prettyTCM r]
+            TooManyFields r xs -> fsep $
+                pwords "The record type" ++ [prettyTCM r] ++
+                pwords "does not have the fields" ++ punctuate comma (map pretty xs)
+            DuplicateConstructors xs -> fsep $
+                pwords "Duplicate constructors" ++ punctuate comma (map pretty xs) ++
+                pwords "in datatype"
+            DuplicateFields xs -> fsep $
+                pwords "Duplicate fields" ++ punctuate comma (map pretty xs) ++
+                pwords "in record"
+            WithOnFreeVariable e -> fsep $
+              pwords "Cannot `with` on variable " ++ [prettyA e] ++
+              pwords " bound in a module telescope (or patterns of a parent clause)"
             UnexpectedWithPatterns ps -> fsep $
               pwords "Unexpected with patterns" ++ (punctuate (text " |") $ map prettyA ps)
             WithClausePatternMismatch p q -> fsep $
               pwords "With clause pattern " ++ [prettyA p] ++
               pwords " is not an instance of its parent pattern " ++ [prettyTCM q]
                  -- TODO: prettier printing for internal patterns
-	    MetaCannotDependOn m ps i -> fsep $
-		    pwords "The metavariable" ++ [prettyTCM $ MetaV m []] ++ pwords "cannot depend on" ++ [pvar i] ++
-		    pwords "because it" ++ deps
-		where
+            MetaCannotDependOn m ps i -> fsep $
+                    pwords "The metavariable" ++ [prettyTCM $ MetaV m []] ++ pwords "cannot depend on" ++ [pvar i] ++
+                    pwords "because it" ++ deps
+                where
                     pvar = prettyTCM . I.var
-		    deps = case map pvar ps of
-			[]  -> pwords "does not depend on any variables"
-			[x] -> pwords "only depends on the variable" ++ [x]
-			xs  -> pwords "only depends on the variables" ++ punctuate comma xs
+                    deps = case map pvar ps of
+                        []  -> pwords "does not depend on any variables"
+                        [x] -> pwords "only depends on the variable" ++ [x]
+                        xs  -> pwords "only depends on the variables" ++ punctuate comma xs
 
-	    MetaOccursInItself m -> fsep $
-		pwords "Cannot construct infinite solution of metavariable" ++ [prettyTCM $ MetaV m []]
+            MetaOccursInItself m -> fsep $
+                pwords "Cannot construct infinite solution of metavariable" ++ [prettyTCM $ MetaV m []]
             BuiltinMustBeConstructor s e -> fsep $
                 [prettyA e] ++ pwords "must be a constructor in the binding to builtin" ++ [text s]
-	    NoSuchBuiltinName s -> fsep $
-		pwords "There is no built-in thing called" ++ [text s]
-	    DuplicateBuiltinBinding b x y -> fsep $
-		pwords "Duplicate binding for built-in thing" ++ [text b <> comma] ++
-		pwords "previous binding to" ++ [prettyTCM x]
-	    NoBindingForBuiltin x -> fsep $
-		pwords "No binding for builtin thing" ++ [text x <> comma] ++
-		pwords ("use {-# BUILTIN " ++ x ++ " name #-} to bind it to 'name'")
-	    NoSuchPrimitiveFunction x -> fsep $
-		pwords "There is no primitive function called" ++ [text x]
-	    BuiltinInParameterisedModule x -> fwords $
-		"The BUILTIN pragma cannot appear inside a bound context " ++
-		"(for instance, in a parameterised module or as a local declaration)"
+            NoSuchBuiltinName s -> fsep $
+                pwords "There is no built-in thing called" ++ [text s]
+            DuplicateBuiltinBinding b x y -> fsep $
+                pwords "Duplicate binding for built-in thing" ++ [text b <> comma] ++
+                pwords "previous binding to" ++ [prettyTCM x]
+            NoBindingForBuiltin x -> fsep $
+                pwords "No binding for builtin thing" ++ [text x <> comma] ++
+                pwords ("use {-# BUILTIN " ++ x ++ " name #-} to bind it to 'name'")
+            NoSuchPrimitiveFunction x -> fsep $
+                pwords "There is no primitive function called" ++ [text x]
+            BuiltinInParameterisedModule x -> fwords $
+                "The BUILTIN pragma cannot appear inside a bound context " ++
+                "(for instance, in a parameterised module or as a local declaration)"
             IllegalLetInTelescope tb -> fsep $
                 -- pwords "The binding" ++
                 [pretty tb] ++
                 pwords " is not allowed in a telescope here."
-	    NoRHSRequiresAbsurdPattern ps -> fwords $
-		"The right-hand side can only be omitted if there " ++
-		"is an absurd pattern, () or {}, in the left-hand side."
-	    AbsurdPatternRequiresNoRHS ps -> fwords $
-		"The right-hand side must be omitted if there " ++
-		"is an absurd pattern, () or {}, in the left-hand side."
-	    LocalVsImportedModuleClash m -> fsep $
-		pwords "The module" ++ [text $ show m] ++
-		pwords "can refer to either a local module or an imported module"
-	    UnsolvedMetas rs ->
-		fsep ( pwords "Unsolved metas at the following locations:" )
-		$$ nest 2 (vcat $ map prettyTCM rs)
-	    UnsolvedConstraints cs ->
-		fsep ( pwords "Failed to solve the following constraints:" )
-		$$ nest 2 (vcat $ map prettyConstraint cs)
+            NoRHSRequiresAbsurdPattern ps -> fwords $
+                "The right-hand side can only be omitted if there " ++
+                "is an absurd pattern, () or {}, in the left-hand side."
+            AbsurdPatternRequiresNoRHS ps -> fwords $
+                "The right-hand side must be omitted if there " ++
+                "is an absurd pattern, () or {}, in the left-hand side."
+            LocalVsImportedModuleClash m -> fsep $
+                pwords "The module" ++ [text $ show m] ++
+                pwords "can refer to either a local module or an imported module"
+            SolvedButOpenHoles -> text "Module cannot be imported since it has open interaction points"
+            UnsolvedMetas rs ->
+                fsep ( pwords "Unsolved metas at the following locations:" )
+                $$ nest 2 (vcat $ map prettyTCM rs)
+            UnsolvedConstraints cs ->
+                fsep ( pwords "Failed to solve the following constraints:" )
+                $$ nest 2 (vcat $ map prettyConstraint cs)
               where prettyConstraint :: ProblemConstraint -> TCM Doc
                     prettyConstraint c = f (prettyTCM c)
                       where
                         r   = getRange c
                         f d = if null (show r) then d else d $$ nest 4 (text "[ at" <+> prettyTCM r  <+> text "]")
-	    CyclicModuleDependency ms ->
-		fsep (pwords "cyclic module dependency:")
-		$$ nest 2 (vcat $ map pretty ms)
-	    FileNotFound x files ->
-		fsep ( pwords "Failed to find source of module" ++ [pretty x] ++
-		       pwords "in any of the following locations:"
-		     ) $$ nest 2 (vcat $ map (text . filePath) files)
+            CyclicModuleDependency ms ->
+                fsep (pwords "cyclic module dependency:")
+                $$ nest 2 (vcat $ map pretty ms)
+            FileNotFound x files ->
+                fsep ( pwords "Failed to find source of module" ++ [pretty x] ++
+                       pwords "in any of the following locations:"
+                     ) $$ nest 2 (vcat $ map (text . filePath) files)
             OverlappingProjects f m1 m2 ->
-	        fsep ( pwords "The file" ++ [text (filePath f)] ++
+                fsep ( pwords "The file" ++ [text (filePath f)] ++
                        pwords "can be accessed via several project roots. Both" ++
                        [pretty m1] ++ pwords "and" ++ [pretty m2] ++
                        pwords "point to this file."
                      )
-	    AmbiguousTopLevelModuleName x files ->
-		fsep ( pwords "Ambiguous module name. The module name" ++
+            AmbiguousTopLevelModuleName x files ->
+                fsep ( pwords "Ambiguous module name. The module name" ++
                        [pretty x] ++
-		       pwords "could refer to any of the following files:"
-		     ) $$ nest 2 (vcat $ map (text . filePath) files)
-	    ClashingFileNamesFor x files ->
-		fsep ( pwords "Multiple possible sources for module" ++ [text $ show x] ++
-		       pwords "found:"
-		     ) $$ nest 2 (vcat $ map (text . filePath) files)
+                       pwords "could refer to any of the following files:"
+                     ) $$ nest 2 (vcat $ map (text . filePath) files)
+            ClashingFileNamesFor x files ->
+                fsep ( pwords "Multiple possible sources for module" ++ [text $ show x] ++
+                       pwords "found:"
+                     ) $$ nest 2 (vcat $ map (text . filePath) files)
             ModuleDefinedInOtherFile mod file file' -> fsep $
               pwords "You tried to load" ++ [text (filePath file)] ++
               pwords "which defines the module" ++ [pretty mod <> text "."] ++
               pwords "However, according to the include path this module should" ++
               pwords "be defined in" ++ [text (filePath file') <> text "."]
-	    ModuleNameDoesntMatchFileName given files ->
+            ModuleNameDoesntMatchFileName given files ->
               fsep (pwords "The name of the top level module does not match the file name. The module" ++
                    [ pretty given ] ++ pwords "should be defined in one of the following files:")
-	      $$ nest 2 (vcat $ map (text . filePath) files)
+              $$ nest 2 (vcat $ map (text . filePath) files)
             BothWithAndRHS -> fsep $
               pwords "Unexpected right hand side"
-	    NotInScope xs ->
-		fsep (pwords "Not in scope:") $$ nest 2 (vcat $ map name xs)
-		where
+            NotInScope xs ->
+                fsep (pwords "Not in scope:") $$ nest 2 (vcat $ map name xs)
+                where
                   name x = fsep [ pretty x, text "at" <+> prettyTCM (getRange x), suggestion (show x) ]
                   suggestion s
                     | elem ':' s    = parens $ text "did you forget space around the ':'?"
@@ -586,72 +595,72 @@ instance PrettyTCM TypeError where
                     | otherwise     = empty
                     where
                       two = zipWith (\a b -> [a,b]) s (tail s)
-	    NoSuchModule x -> fsep $
-		pwords "No such module" ++ [pretty x]
-	    AmbiguousName x ys -> vcat
-	      [ fsep $ pwords "Ambiguous name" ++ [pretty x <> text "."] ++
-		       pwords "It could refer to any one of"
-	      , nest 2 $ vcat $ map nameWithBinding ys
+            NoSuchModule x -> fsep $
+                pwords "No such module" ++ [pretty x]
+            AmbiguousName x ys -> vcat
+              [ fsep $ pwords "Ambiguous name" ++ [pretty x <> text "."] ++
+                       pwords "It could refer to any one of"
+              , nest 2 $ vcat $ map nameWithBinding ys
               , fwords "(hint: Use C-c C-w (in Emacs) if you want to know why)"
-	      ]
-	    AmbiguousModule x ys -> vcat
-	      [ fsep $ pwords "Ambiguous module name" ++ [pretty x <> text "."] ++
-		       pwords "It could refer to any one of"
-	      , nest 2 $ vcat $ map help ys
+              ]
+            AmbiguousModule x ys -> vcat
+              [ fsep $ pwords "Ambiguous module name" ++ [pretty x <> text "."] ++
+                       pwords "It could refer to any one of"
+              , nest 2 $ vcat $ map help ys
               , fwords "(hint: Use C-c C-w (in Emacs) if you want to know why)"
-	      ]
+              ]
               where
                 help :: ModuleName -> TCM Doc
                 help m = do
                   b <- isDatatypeModule m
                   sep [prettyTCM m, if b then text "(datatype module)" else empty]
-	    UninstantiatedModule x -> fsep (
-		    pwords "Cannot access the contents of the parameterised module" ++ [pretty x <> text "."] ++
-		    pwords "To do this the module first has to be instantiated. For instance:"
-		) $$ nest 2 (hsep [ text "module", pretty x <> text "'", text "=", pretty x, text "e1 .. en" ])
-	    ClashingDefinition x y -> fsep $
-		pwords "Multiple definitions of" ++ [pretty x <> text "."] ++
-		pwords "Previous definition at" ++ [prettyTCM $ nameBindingSite $ qnameName y]
-	    ClashingModule m1 m2 -> fsep $
-		pwords "The modules" ++ [prettyTCM m1, text "and", prettyTCM m2] ++ pwords "clash."
-	    ClashingImport x y -> fsep $
-		pwords "Import clash between" ++ [pretty x, text "and", prettyTCM y]
-	    ClashingModuleImport x y -> fsep $
-		pwords "Module import clash between" ++ [pretty x, text "and", prettyTCM y]
-	    PatternShadowsConstructor x c -> fsep $
+            UninstantiatedModule x -> fsep (
+                    pwords "Cannot access the contents of the parameterised module" ++ [pretty x <> text "."] ++
+                    pwords "To do this the module first has to be instantiated. For instance:"
+                ) $$ nest 2 (hsep [ text "module", pretty x <> text "'", text "=", pretty x, text "e1 .. en" ])
+            ClashingDefinition x y -> fsep $
+                pwords "Multiple definitions of" ++ [pretty x <> text "."] ++
+                pwords "Previous definition at" ++ [prettyTCM $ nameBindingSite $ qnameName y]
+            ClashingModule m1 m2 -> fsep $
+                pwords "The modules" ++ [prettyTCM m1, text "and", prettyTCM m2] ++ pwords "clash."
+            ClashingImport x y -> fsep $
+                pwords "Import clash between" ++ [pretty x, text "and", prettyTCM y]
+            ClashingModuleImport x y -> fsep $
+                pwords "Module import clash between" ++ [pretty x, text "and", prettyTCM y]
+            PatternShadowsConstructor x c -> fsep $
                 pwords "The pattern variable" ++ [prettyTCM x] ++
                 pwords "has the same name as the constructor" ++ [prettyTCM c]
             DuplicateImports m xs -> fsep $
                 pwords "Ambiguous imports from module" ++ [pretty m] ++ pwords "for" ++
                 punctuate comma (map pretty xs)
-	    ModuleDoesntExport m xs -> fsep $
-		pwords "The module" ++ [pretty m] ++ pwords "doesn't export the following:" ++
-		punctuate comma (map pretty xs)
-	    NotAModuleExpr e -> fsep $
-		pwords "The right-hand side of a module definition must have the form 'M e1 .. en'" ++
-		pwords "where M is a module name. The expression" ++ [pretty e, text "doesn't."]
+            ModuleDoesntExport m xs -> fsep $
+                pwords "The module" ++ [pretty m] ++ pwords "doesn't export the following:" ++
+                punctuate comma (map pretty xs)
+            NotAModuleExpr e -> fsep $
+                pwords "The right-hand side of a module definition must have the form 'M e1 .. en'" ++
+                pwords "where M is a module name. The expression" ++ [pretty e, text "doesn't."]
             FieldOutsideRecord -> fsep $
               pwords "Field appearing outside record declaration."
             InvalidPattern p -> fsep $
               pretty p : pwords "is not a valid pattern"
-	    RepeatedVariablesInPattern xs -> fsep $
-	      pwords "Repeated variables in left hand side:" ++ map pretty xs
-	    NotAnExpression e -> fsep $
-		[pretty e] ++ pwords "is not a valid expression."
-	    NotAValidLetBinding nd -> fwords $
-		"Not a valid let-declaration"
-	    NothingAppliedToHiddenArg e	-> fsep $
-		[pretty e] ++ pwords "cannot appear by itself. It needs to be the argument to" ++
-		pwords "a function expecting an implicit argument."
-	    NothingAppliedToInstanceArg e -> fsep $
-		[pretty e] ++ pwords "cannot appear by itself. It needs to be the argument to" ++
-		pwords "a function expecting an instance argument."
-	    NoParseForApplication es -> fsep $
-		pwords "Could not parse the application" ++ [pretty $ C.RawApp noRange es]
-	    AmbiguousParseForApplication es es' -> fsep (
-		    pwords "Don't know how to parse" ++ [pretty_es <> (text ".")] ++
-		    pwords "Could mean any one of:"
-		) $$ nest 2 (vcat $ map pretty' es')
+            RepeatedVariablesInPattern xs -> fsep $
+              pwords "Repeated variables in pattern:" ++ map pretty xs
+            NotAnExpression e -> fsep $
+                [pretty e] ++ pwords "is not a valid expression."
+            NotAValidLetBinding nd -> fwords $
+                "Not a valid let-declaration"
+            NothingAppliedToHiddenArg e -> fsep $
+                [pretty e] ++ pwords "cannot appear by itself. It needs to be the argument to" ++
+                pwords "a function expecting an implicit argument."
+            NothingAppliedToInstanceArg e -> fsep $
+                [pretty e] ++ pwords "cannot appear by itself. It needs to be the argument to" ++
+                pwords "a function expecting an instance argument."
+            NoParseForApplication es -> fsep $
+                pwords "Could not parse the application" ++ [pretty $ C.RawApp noRange es]
+            AmbiguousParseForApplication es es' -> fsep (
+                    pwords "Don't know how to parse" ++ [pretty_es <> (text ".")] ++
+                    pwords "Could mean any one of:"
+                ) $$ nest 2 (vcat $ map pretty' es')
               where
                 pretty_es :: TCM Doc
                 pretty_es = pretty $ C.RawApp noRange es
@@ -674,22 +683,24 @@ instance PrettyTCM TypeError where
                 fromOrdinary :: C.OpApp e -> e
                 fromOrdinary (C.Ordinary e) = e
                 fromOrdinary _ = __IMPOSSIBLE__
+            BadArgumentsToPatternSynonym x -> fsep $
+                pwords "Bad arguments to pattern synonym " ++ [prettyTCM x]
+            TooFewArgumentsToPatternSynonym x -> fsep $
+                pwords "Too few arguments to pattern synonym " ++ [prettyTCM x]
             UnusedVariableInPatternSynonym -> fsep $
                 pwords "Unused variable in pattern synonym."
-            PatternSynonymArityMismatch x -> fsep $
-                pwords "Arity mismatch when using pattern synonym" ++ [prettyTCM x]
-	    NoParseForLHS IsLHS p -> fsep $
-		pwords "Could not parse the left-hand side" ++ [pretty p]
-	    NoParseForLHS IsPatSyn p -> fsep $
-		pwords "Could not parse the pattern synonym" ++ [pretty p]
+            NoParseForLHS IsLHS p -> fsep $
+                pwords "Could not parse the left-hand side" ++ [pretty p]
+            NoParseForLHS IsPatSyn p -> fsep $
+                pwords "Could not parse the pattern synonym" ++ [pretty p]
 {- UNUSED
-	    NoParseForPatternSynonym p -> fsep $
-		pwords "Could not parse the pattern synonym" ++ [pretty p]
+            NoParseForPatternSynonym p -> fsep $
+                pwords "Could not parse the pattern synonym" ++ [pretty p]
 -}
-	    AmbiguousParseForLHS lhsOrPatSyn p ps -> fsep (
-		    pwords "Don't know how to parse" ++ [pretty_p <> text "."] ++
-		    pwords "Could mean any one of:"
-		) $$ nest 2 (vcat $ map pretty' ps)
+            AmbiguousParseForLHS lhsOrPatSyn p ps -> fsep (
+                    pwords "Don't know how to parse" ++ [pretty_p <> text "."] ++
+                    pwords "Could mean any one of:"
+                ) $$ nest 2 (vcat $ map pretty' ps)
               where
                 pretty_p :: TCM Doc
                 pretty_p = pretty p
@@ -711,14 +722,14 @@ instance PrettyTCM TypeError where
                 unambiguousP (C.OpAppP r op xs) = foldl C.AppP (C.IdentP op) xs
                 unambiguousP e = e
 {- UNUSED
-	    AmbiguousParseForPatternSynonym p ps -> fsep (
-		    pwords "Don't know how to parse" ++ [pretty p <> text "."] ++
-		    pwords "Could mean any one of:"
-		) $$ nest 2 (vcat $ map pretty ps)
+            AmbiguousParseForPatternSynonym p ps -> fsep (
+                    pwords "Don't know how to parse" ++ [pretty p <> text "."] ++
+                    pwords "Could mean any one of:"
+                ) $$ nest 2 (vcat $ map pretty ps)
 -}
-	    IncompletePatternMatching v args -> fsep $
-		pwords "Incomplete pattern matching for" ++ [prettyTCM v <> text "."] ++
-		pwords "No match for" ++ map prettyTCM args
+            IncompletePatternMatching v args -> fsep $
+                pwords "Incomplete pattern matching for" ++ [prettyTCM v <> text "."] ++
+                pwords "No match for" ++ map prettyTCM args
             UnreachableClauses f pss -> fsep $
                 pwords "Unreachable" ++ pwords (plural (length pss) "clause")
                 where
@@ -747,7 +758,6 @@ instance PrettyTCM TypeError where
                            pwords "unification problems (inferred index ≟ expected index):"
                   ] ++
                   zipWith (\c g -> nest 2 $ prettyTCM c <+> text "≟" <+> prettyTCM g) cIxs gIxs)
-
             CoverageCantSplitIrrelevantType a -> fsep $
               pwords "Cannot split on argument of irrelevant datatype" ++ [prettyTCM a]
 
@@ -759,34 +769,56 @@ instance PrettyTCM TypeError where
             WithoutKError a u v -> fsep $
               pwords "Cannot eliminate reflexive equation" ++ [prettyTCM u] ++ pwords "=" ++ [prettyTCM v] ++ pwords "of type" ++ [prettyTCM a] ++ pwords "because K has been disabled."
 
-	    NotStrictlyPositive d ocs -> fsep $
-		pwords "The datatype" ++ [prettyTCM d] ++ pwords "is not strictly positive, because"
-		++ prettyOcc "it" ocs
-		where
-		    prettyOcc _ [] = []
-		    prettyOcc it (OccCon d c r : ocs) = concat
-			[ pwords it, pwords "occurs", prettyR r
-			, pwords "in the constructor", [prettyTCM c], pwords "of"
-			, [prettyTCM d <> com ocs], prettyOcc "which" ocs
-			]
-		    prettyOcc it (OccClause f n r : ocs) = concat
-			[ pwords it, pwords "occurs", prettyR r
-			, pwords "in the", [th n], pwords "clause of"
-			, [prettyTCM f <> com ocs], prettyOcc "which" ocs
-			]
-		    prettyR NonPositively = pwords "negatively"
-		    prettyR (ArgumentTo i q) =
-			pwords "as the" ++ [th i] ++
-			pwords "argument to" ++ [prettyTCM q]
-		    th 0 = text "first"
-		    th 1 = text "second"
-		    th 2 = text "third"
-		    th n = text (show $ n - 1) <> text "th"
-
-		    com []    = empty
-		    com (_:_) = comma
+            NotStrictlyPositive d ocs -> fsep $
+                pwords "The datatype" ++ [prettyTCM d] ++ pwords "is not strictly positive, because"
+                ++ prettyOcc "it" ocs
+                where
+                    prettyOcc _ [] = []
+                    prettyOcc it (OccCon d c r : ocs) = concat
+                        [ pwords it, pwords "occurs", prettyR r
+                        , pwords "in the constructor", [prettyTCM c], pwords "of"
+                        , [prettyTCM d <> com ocs], prettyOcc "which" ocs
+                        ]
+                    prettyOcc it (OccClause f n r : ocs) = concat
+                        [ pwords it, pwords "occurs", prettyR r
+                        , pwords "in the", [th n], pwords "clause of"
+                        , [prettyTCM f <> com ocs], prettyOcc "which" ocs
+                        ]
+                    prettyR NonPositively = pwords "negatively"
+                    prettyR (ArgumentTo i q) =
+                        pwords "as the" ++ [th i] ++
+                        pwords "argument to" ++ [prettyTCM q]
+                    th 0 = text "first"
+                    th 1 = text "second"
+                    th 2 = text "third"
+                    th n = text (show $ n - 1) <> text "th"
+
+                    com []    = empty
+                    com (_:_) = comma
             IFSNoCandidateInScope t -> fsep $
                 pwords "No variable of type" ++ [prettyTCM t] ++ pwords "was found in scope."
+            UnquoteFailed e -> case e of
+                (BadVisibility msg arg) -> fsep $
+                  pwords $ "Unable to unquote the argument. It should be `" ++ msg ++ "'."
+                (ConInsteadOfDef x def con) -> do
+                  fsep $ pwords ("Use " ++ con ++ " instead of " ++ def ++ " for constructor") ++ [prettyTCM x]
+                (DefInsteadOfCon x def con) -> do
+                  fsep $ pwords ("Use " ++ def ++ " instead of " ++ con ++ " for non-constructor") ++ [prettyTCM x]
+                (NotAConstructor kind t) ->
+                  fwords "Unable to unquote the term"
+                  $$ nest 2 (prettyTCM t)
+                  $$ fwords ("of type " ++ kind ++ ". Reason: not a constructor.")
+                (NotALiteral kind t) ->
+                  fwords "Unable to unquote the term"
+                  $$ nest 2 (prettyTCM t)
+                  $$ fwords ("of type " ++ kind ++ ". Reason: not a literal value.")
+                (RhsUsesDottedVar ixs t) ->
+                  fwords "Unable to unquote the term"
+                  $$ nest 2 (prettyTCM t)
+                  $$ fwords "of type Clause. Reason: the right-hand side contains variables that are referring to a dot pattern."
+                  $$ fwords ("Offending De Bruijn indices: " ++ intercalate ", " (map show ixs) ++ ".")
+                (BlockedOnMeta m) -> __IMPOSSIBLE__
+                (UnquotePanic err) -> __IMPOSSIBLE__
             SafeFlagPostulate e -> fsep $
                 pwords "Cannot postulate" ++ [pretty e] ++ pwords "with safe flag"
             SafeFlagPragma xs ->
@@ -795,6 +827,8 @@ instance PrettyTCM TypeError where
                 in fsep $ [fwords ("Cannot set OPTION pragma" ++ plural)]
                           ++ map text xs ++ [fwords "with safe flag."]
             SafeFlagNoTerminationCheck -> fsep (pwords "Cannot use NO_TERMINATION_CHECK pragma with safe flag.")
+            SafeFlagNonTerminating -> fsep (pwords "Cannot use NON_TERMINATING pragma with safe flag.")
+            SafeFlagTerminating -> fsep (pwords "Cannot use TERMINATING pragma with safe flag.")
             SafeFlagPrimTrustMe -> fsep (pwords "Cannot use primTrustMe with safe flag")
             NeedOptionCopatterns -> fsep (pwords "Option --copatterns needed to enable destructor patterns")
           where
@@ -877,43 +911,43 @@ instance PrettyTCM SplitError where
 
 instance PrettyTCM Call where
     prettyTCM c = case c of
-	CheckClause t cl _  -> fsep $
-	    pwords "when checking that the clause"
-	    ++ [P.prettyA cl] ++ pwords "has type" ++ [prettyTCM t]
-	CheckPattern p tel t _ -> addCtxTel tel $ fsep $
-	    pwords "when checking that the pattern"
-	    ++ [prettyA p] ++ pwords "has type" ++ [prettyTCM t]
-	CheckLetBinding b _ -> fsep $
-	    pwords "when checking the let binding" ++ [P.prettyA b]
-	InferExpr e _ -> fsep $
-	    pwords "when inferring the type of" ++ [prettyA e]
-	CheckExprCall e t _ -> fsep $
-	    pwords "when checking that the expression"
-	    ++ [prettyA e] ++ pwords "has type" ++ [prettyTCM t]
-	IsTypeCall e s _ -> fsep $
-	    pwords "when checking that the expression"
-	    ++ [prettyA e] ++ pwords "is a type of sort" ++ [prettyTCM s]
-	IsType_ e _ -> fsep $
-	    pwords "when checking that the expression"
-	    ++ [prettyA e] ++ pwords "is a type"
-	CheckArguments r es t0 t1 _ -> fsep $
-	    pwords "when checking that" ++
-	    map hPretty es ++ pwords "are valid arguments to a function of type" ++ [prettyTCM t0]
-	CheckRecDef _ x ps cs _ ->
-	    fsep $ pwords "when checking the definition of" ++ [prettyTCM x]
-	CheckDataDef _ x ps cs _ ->
-	    fsep $ pwords "when checking the definition of" ++ [prettyTCM x]
-	CheckConstructor d _ _ (A.Axiom _ _ _ c _) _ -> fsep $
-	    pwords "when checking the constructor" ++ [prettyTCM c] ++
-	    pwords "in the declaration of" ++ [prettyTCM d]
-	CheckConstructor _ _ _ _ _ -> __IMPOSSIBLE__
-	CheckFunDef _ f _ _ ->
-	    fsep $ pwords "when checking the definition of" ++ [prettyTCM f]
-	CheckPragma _ p _ ->
-	    fsep $ pwords "when checking the pragma" ++ [prettyA $ RangeAndPragma noRange p]
-	CheckPrimitive _ x e _ -> fsep $
-	    pwords "when checking that the type of the primitive function" ++
-	    [prettyTCM x] ++ pwords "is" ++ [prettyA e]
+        CheckClause t cl _  -> fsep $
+            pwords "when checking that the clause"
+            ++ [P.prettyA cl] ++ pwords "has type" ++ [prettyTCM t]
+        CheckPattern p tel t _ -> addCtxTel tel $ fsep $
+            pwords "when checking that the pattern"
+            ++ [prettyA p] ++ pwords "has type" ++ [prettyTCM t]
+        CheckLetBinding b _ -> fsep $
+            pwords "when checking the let binding" ++ [P.prettyA b]
+        InferExpr e _ -> fsep $
+            pwords "when inferring the type of" ++ [prettyA e]
+        CheckExprCall e t _ -> fsep $
+            pwords "when checking that the expression"
+            ++ [prettyA e] ++ pwords "has type" ++ [prettyTCM t]
+        IsTypeCall e s _ -> fsep $
+            pwords "when checking that the expression"
+            ++ [prettyA e] ++ pwords "is a type of sort" ++ [prettyTCM s]
+        IsType_ e _ -> fsep $
+            pwords "when checking that the expression"
+            ++ [prettyA e] ++ pwords "is a type"
+        CheckArguments r es t0 t1 _ -> fsep $
+            pwords "when checking that" ++
+            map hPretty es ++ pwords "are valid arguments to a function of type" ++ [prettyTCM t0]
+        CheckRecDef _ x ps cs _ ->
+            fsep $ pwords "when checking the definition of" ++ [prettyTCM x]
+        CheckDataDef _ x ps cs _ ->
+            fsep $ pwords "when checking the definition of" ++ [prettyTCM x]
+        CheckConstructor d _ _ (A.Axiom _ _ _ c _) _ -> fsep $
+            pwords "when checking the constructor" ++ [prettyTCM c] ++
+            pwords "in the declaration of" ++ [prettyTCM d]
+        CheckConstructor _ _ _ _ _ -> __IMPOSSIBLE__
+        CheckFunDef _ f _ _ ->
+            fsep $ pwords "when checking the definition of" ++ [prettyTCM f]
+        CheckPragma _ p _ ->
+            fsep $ pwords "when checking the pragma" ++ [prettyA $ RangeAndPragma noRange p]
+        CheckPrimitive _ x e _ -> fsep $
+            pwords "when checking that the type of the primitive function" ++
+            [prettyTCM x] ++ pwords "is" ++ [prettyA e]
         CheckWithFunctionType e _ -> fsep $
             pwords "when checking that the type" ++
             [prettyA e] ++ pwords "of the generated with function is well-formed"
@@ -922,37 +956,37 @@ instance PrettyTCM Call where
             pwords "matches the inferred value" ++ [prettyTCM v]
         CheckPatternShadowing c _ -> fsep $
             pwords "when checking the clause" ++ [P.prettyA c]
-	InferVar x _ ->
-	    fsep $ pwords "when inferring the type of" ++ [prettyTCM x]
-	InferDef _ x _ ->
-	    fsep $ pwords "when inferring the type of" ++ [prettyTCM x]
+        InferVar x _ ->
+            fsep $ pwords "when inferring the type of" ++ [prettyTCM x]
+        InferDef _ x _ ->
+            fsep $ pwords "when inferring the type of" ++ [prettyTCM x]
         CheckIsEmpty r t _ ->
             fsep $ pwords "when checking that" ++ [prettyTCM t] ++ pwords "has no constructors"
-	ScopeCheckExpr e _ ->
-	    fsep $ pwords "when scope checking" ++ [pretty e]
-	ScopeCheckDeclaration d _ ->
-	    fwords "when scope checking the declaration" $$
-	    nest 2 (pretty $ simpleDecl d)
-	ScopeCheckLHS x p _ ->
-	    fsep $ pwords "when scope checking the left-hand side" ++ [pretty p] ++
-		   pwords "in the definition of" ++ [pretty x]
+        ScopeCheckExpr e _ ->
+            fsep $ pwords "when scope checking" ++ [pretty e]
+        ScopeCheckDeclaration d _ ->
+            fwords "when scope checking the declaration" $$
+            nest 2 (pretty $ simpleDecl d)
+        ScopeCheckLHS x p _ ->
+            fsep $ pwords "when scope checking the left-hand side" ++ [pretty p] ++
+                   pwords "in the definition of" ++ [pretty x]
         NoHighlighting _ -> empty
-	SetRange r _ ->
-	    fsep (pwords "when doing something at") <+> prettyTCM r
+        SetRange r _ ->
+            fsep (pwords "when doing something at") <+> prettyTCM r
         CheckSectionApplication _ m1 modapp _ -> fsep $
           pwords "when checking the module application" ++
           [prettyA $ A.Apply info m1 modapp Map.empty Map.empty]
           where
             info = A.ModuleInfo noRange noRange Nothing Nothing Nothing
 
-	where
+        where
             hPretty :: I.Arg (Named_ Expr) -> TCM Doc
             hPretty a = do
                 info <- reify $ argInfo a
                 pretty =<< (abstractToConcreteCtx (hiddenArgumentCtx (getHiding a))
                          $ Common.Arg info $ unArg a)
 
-	    simpleDecl = D.notSoNiceDeclaration
+            simpleDecl = D.notSoNiceDeclaration
 
 ---------------------------------------------------------------------------
 -- * Natural language
diff --git a/src/full/Agda/TypeChecking/EtaContract.hs b/src/full/Agda/TypeChecking/EtaContract.hs
index 684d044..52d77df 100644
--- a/src/full/Agda/TypeChecking/EtaContract.hs
+++ b/src/full/Agda/TypeChecking/EtaContract.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards    #-}
 
 -- | Compute eta short normal forms.
 module Agda.TypeChecking.EtaContract where
@@ -19,7 +19,7 @@ import {-# SOURCE #-} Agda.TypeChecking.Records
 import {-# SOURCE #-} Agda.TypeChecking.Datatypes
 import Agda.Utils.Monad
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- TODO: move to Agda.Syntax.Internal.SomeThing
@@ -75,7 +75,7 @@ etaOnce v = case v of
           | (isIrrelevant info || isVar0 v)
                     && allowed imp info
                     && not (freeIn 0 u) ->
-            return $ subst __IMPOSSIBLE__ u
+            return $ strengthen __IMPOSSIBLE__ u
         _ -> return v
     where
       isVar0 (Shared p)               = __IMPOSSIBLE__ -- isVar0 (derefPtr p)
diff --git a/src/full/Agda/TypeChecking/Forcing.hs b/src/full/Agda/TypeChecking/Forcing.hs
index 2dc84cf..bd9862c 100644
--- a/src/full/Agda/TypeChecking/Forcing.hs
+++ b/src/full/Agda/TypeChecking/Forcing.hs
@@ -13,7 +13,7 @@ import Agda.Utils.Size
 import Agda.Utils.Monad
 import Agda.Interaction.Options
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 addForcingAnnotations :: Type -> TCM Type
diff --git a/src/full/Agda/TypeChecking/Free.hs b/src/full/Agda/TypeChecking/Free.hs
index 19e87e0..727dbcc 100644
--- a/src/full/Agda/TypeChecking/Free.hs
+++ b/src/full/Agda/TypeChecking/Free.hs
@@ -1,13 +1,30 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Computing the free variables of a term.
+--
+-- The distinction between rigid and strongly rigid occurrences comes from:
+--   Jason C. Reed, PhD thesis, 2009, page 96 (see also his LFMTP 2009 paper)
+--
+-- The main idea is that x = t(x) is unsolvable if x occurs strongly rigidly
+-- in t.  It might have a solution if the occurrence is not strongly rigid, e.g.
+--
+--   x = \f -> suc (f (x (\ y -> k)))  has  x = \f -> suc (f (suc k))
+--
+-- [Jason C. Reed, PhD thesis, page 106]
+--
+-- Under coinductive constructors, occurrences are never strongly rigid.
+-- Also, function types and lambdas do not establish strong rigidity.
+-- Only inductive constructors do so.
+-- (See issue 1271).
+
 module Agda.TypeChecking.Free
     ( FreeVars(..)
-    , Free(..)
-    , FreeConf(..), IgnoreSorts(..)
+    , Free
+    , IgnoreSorts(..)
     , freeVars
+    , freeVarsIgnore
     , allVars
     , relevantVars
     , rigidVars
@@ -18,52 +35,70 @@ module Agda.TypeChecking.Free
     , occurrence
     ) where
 
-import qualified Agda.Utils.VarSet as Set
-import Agda.Utils.VarSet (VarSet)
+import Control.Applicative hiding (empty)
+import Control.Monad.Reader
+
+import Data.Foldable (foldMap)
+import Data.Monoid
 
 import Agda.Syntax.Common hiding (Arg, Dom, NamedArg)
 import Agda.Syntax.Internal
 
-import Agda.Utils.Impossible
-#include "../undefined.h"
+import Agda.Utils.Function
+import Agda.Utils.Functor
+import Agda.Utils.Monad
+import Agda.Utils.VarSet (VarSet)
+import qualified Agda.Utils.VarSet as Set
 
--- | The distinction between rigid and strongly rigid occurrences comes from:
---   Jason C. Reed, PhD thesis, 2009, page 96 (see also his LFMTP 2009 paper)
---
--- The main idea is that x = t(x) is unsolvable if x occurs strongly rigidly
--- in t.  It might have a solution if the occurrence is not strongly rigid, e.g.
---
---   x = \f -> suc (f (x (\ y -> k)))  has  x = \f -> suc (f (suc k))
---
--- [Jason C. Reed, PhD thesis, page 106]
+#include "undefined.h"
+import Agda.Utils.Impossible
 
 -- | Free variables of a term, (disjointly) partitioned into strongly and
 --   and weakly rigid variables, flexible variables and irrelevant variables.
 data FreeVars = FV
-  { stronglyRigidVars :: VarSet -- ^ variables at top and under constructors
-  , weaklyRigidVars   :: VarSet -- ^ ord. rigid variables, e.g., in arguments of variables
-  , flexibleVars      :: VarSet -- ^ variables occuring in arguments of metas. These are potentially free, depending how the meta variable is instantiated.
-  , irrelevantVars    :: VarSet -- ^ variables in irrelevant arguments and under a @DontCare@, i.e., in irrelevant positions
-  , unusedVars        :: VarSet -- ^ variables in 'UnusedArg'uments
+  { stronglyRigidVars :: VarSet
+    -- ^ Variables under only and at least one inductive constructor(s).
+  , unguardedVars     :: VarSet
+    -- ^ Variables at top or only under inductive record constructors
+    --   λs and Πs.
+    --   The purpose of recording these separately is that they
+    --   can still become strongly rigid if put under a constructor
+    --   whereas weakly rigid ones stay weakly rigid.
+  , weaklyRigidVars   :: VarSet
+    -- ^ Ordinary rigid variables, e.g., in arguments of variables.
+  , flexibleVars      :: VarSet
+    -- ^ Variables occuring in arguments of metas.
+    --   These are only potentially free, depending how the meta variable is instantiated.
+  , irrelevantVars    :: VarSet
+    -- ^ Variables in irrelevant arguments and under a @DontCare@, i.e.,
+    --   in irrelevant positions.
+  , unusedVars        :: VarSet
+    -- ^ Variables in 'UnusedArg'uments.
   }
 
+-- | Rigid variables: either strongly rigid, unguarded, or weakly rigid.
 rigidVars :: FreeVars -> VarSet
-rigidVars fv = Set.union (stronglyRigidVars fv) (weaklyRigidVars fv)
-
--- | @allVars fv@ includes irrelevant variables.
-allVars :: FreeVars -> VarSet
-allVars fv = Set.unions [rigidVars fv, flexibleVars fv, irrelevantVars fv, unusedVars fv]
+rigidVars fv = Set.unions
+  [ stronglyRigidVars fv
+  ,     unguardedVars fv
+  ,   weaklyRigidVars fv
+  ]
 
 -- | All but the irrelevant variables.
 relevantVars :: FreeVars -> VarSet
 relevantVars fv = Set.unions [rigidVars fv, flexibleVars fv]
 
+-- | @allVars fv@ includes irrelevant variables.
+allVars :: FreeVars -> VarSet
+allVars fv = Set.unions [relevantVars fv, irrelevantVars fv, unusedVars fv]
+
 data Occurrence
   = NoOccurrence
   | Irrelevantly
-  | StronglyRigid
-  | WeaklyRigid
-  | Flexible
+  | StronglyRigid -- ^ Under at least one and only inductive constructors.
+  | Unguarded     -- ^ In top position, or only under inductive record constructors.
+  | WeaklyRigid   -- ^ In arguments to variables and definitions.
+  | Flexible      -- ^ In arguments of metas.
   | Unused
   deriving (Eq,Show)
 
@@ -73,6 +108,7 @@ data Occurrence
 occurrence :: Nat -> FreeVars -> Occurrence
 occurrence x fv
   | x `Set.member` stronglyRigidVars fv = StronglyRigid
+  | x `Set.member` unguardedVars     fv = Unguarded
   | x `Set.member` weaklyRigidVars   fv = WeaklyRigid
   | x `Set.member` flexibleVars      fv = Flexible
   | x `Set.member` irrelevantVars    fv = Irrelevantly
@@ -83,6 +119,7 @@ occurrence x fv
 flexible :: FreeVars -> FreeVars
 flexible fv =
     fv { stronglyRigidVars = Set.empty
+       , unguardedVars     = Set.empty
        , weaklyRigidVars   = Set.empty
        , flexibleVars      = relevantVars fv
        }
@@ -91,9 +128,30 @@ flexible fv =
 weakly :: FreeVars -> FreeVars
 weakly fv = fv
   { stronglyRigidVars = Set.empty
+  , unguardedVars     = Set.empty
   , weaklyRigidVars   = rigidVars fv
   }
 
+-- | Mark unguarded variables as strongly rigid.  Useful when traversion arguments of inductive constructors.
+strongly :: FreeVars -> FreeVars
+strongly fv = fv
+  { stronglyRigidVars = stronglyRigidVars fv `Set.union` unguardedVars fv
+  , unguardedVars     = Set.empty
+  }
+
+-- | What happens to the variables occurring under a constructor?
+underConstructor :: ConHead -> FreeVars -> FreeVars
+underConstructor (ConHead c i fs) =
+  case (i,fs) of
+    -- Coinductive (record) constructors admit infinite cycles:
+    (CoInductive, _)   -> weakly
+    -- Inductive data constructors do not admit infinite cycles:
+    (Inductive, [])    -> strongly
+    -- Inductive record constructors do not admit infinite cycles,
+    -- but this cannot be proven inside Agda.
+    -- Thus, unification should not prove it either.
+    (Inductive, (_:_)) -> id
+
 -- | Mark all free variables as irrelevant.
 irrelevantly :: FreeVars -> FreeVars
 irrelevantly fv = empty { irrelevantVars = allVars fv }
@@ -107,32 +165,35 @@ unused fv = empty
 
 -- | Pointwise union.
 union :: FreeVars -> FreeVars -> FreeVars
-union (FV sv1 rv1 fv1 iv1 uv1) (FV sv2 rv2 fv2 iv2 uv2) =
-  FV (Set.union sv1 sv2) (Set.union rv1 rv2) (Set.union fv1 fv2) (Set.union iv1 iv2) (Set.union uv1 uv2)
+union (FV sv1 gv1 rv1 fv1 iv1 uv1) (FV sv2 gv2 rv2 fv2 iv2 uv2) =
+  FV (Set.union sv1 sv2) (Set.union gv1 gv2) (Set.union rv1 rv2) (Set.union fv1 fv2) (Set.union iv1 iv2) (Set.union uv1 uv2)
 
 unions :: [FreeVars] -> FreeVars
 unions = foldr union empty
 
 empty :: FreeVars
-empty = FV Set.empty Set.empty Set.empty Set.empty Set.empty
+empty = FV Set.empty Set.empty Set.empty Set.empty Set.empty Set.empty
+
+-- | Free variable sets form a monoid under 'union'.
+instance Monoid FreeVars where
+  mempty  = empty
+  mappend = union
+  mconcat = unions
 
 -- | @delete x fv@ deletes variable @x@ from variable set @fv at .
 delete :: Nat -> FreeVars -> FreeVars
-delete n (FV sv rv fv iv uv) = FV (Set.delete n sv) (Set.delete n rv) (Set.delete n fv) (Set.delete n iv) (Set.delete n uv)
+delete n (FV sv gv rv fv iv uv) = FV (Set.delete n sv) (Set.delete n gv) (Set.delete n rv) (Set.delete n fv) (Set.delete n iv) (Set.delete n uv)
 
 -- | @subtractFV n fv@ subtracts $n$ from each free variable in @fv at .
 subtractFV :: Nat -> FreeVars -> FreeVars
-subtractFV n (FV sv rv fv iv uv) = FV (Set.subtract n sv) (Set.subtract n rv) (Set.subtract n fv) (Set.subtract n iv) (Set.subtract n uv)
+subtractFV n (FV sv gv rv fv iv uv) = FV (Set.subtract n sv) (Set.subtract n gv) (Set.subtract n rv) (Set.subtract n fv) (Set.subtract n iv) (Set.subtract n uv)
 
--- | A single (strongly) rigid variable.
+-- | A single unguarded variable.
 singleton :: Nat -> FreeVars
-singleton x = empty { stronglyRigidVars = Set.singleton x }
+singleton x = empty { unguardedVars = Set.singleton x }
 
 -- * Collecting free variables.
 
-class Free a where
-  freeVars'   :: FreeConf -> a -> FreeVars
-
 -- | Where should we skip sorts in free variable analysis?
 data IgnoreSorts
   = IgnoreNot            -- ^ Do not skip.
@@ -141,75 +202,115 @@ data IgnoreSorts
   deriving (Eq, Show)
 
 data FreeConf = FreeConf
-  { fcIgnoreSorts   :: IgnoreSorts -- ^ Ignore free variables in sorts.
+  { fcIgnoreSorts   :: !IgnoreSorts
+    -- ^ Ignore free variables in sorts.
+  , fcContext       :: !Int
+    -- ^ Under how many binders have we stepped?
+  }
+
+initFreeConf :: FreeConf
+initFreeConf = FreeConf
+  { fcIgnoreSorts = IgnoreNot
+  , fcContext     = 0
   }
 
 -- | Doesn't go inside solved metas, but collects the variables from a
 -- metavariable application @X ts@ as @flexibleVars at .
 freeVars :: Free a => a -> FreeVars
-freeVars = freeVars' FreeConf{ fcIgnoreSorts = IgnoreNot }
+freeVars t = freeVars' t `runReader` initFreeConf
+
+freeVarsIgnore :: Free a => IgnoreSorts -> a -> FreeVars
+freeVarsIgnore i t = freeVars' t `runReader` initFreeConf{ fcIgnoreSorts = i }
+
+-- | Return type of fold over syntax.
+type FreeT = Reader FreeConf FreeVars
+
+instance Monoid FreeT where
+  mempty  = pure mempty
+  mappend = liftA2 mappend
+  mconcat = mconcat <.> sequence
+
+-- | Base case: a variable.
+variable :: Int -> FreeT
+variable n = do
+  m <- (n -) <$> asks fcContext
+  if m >= 0 then pure $ singleton m else mempty
+
+-- | Going under a binder.
+bind :: FreeT -> FreeT
+bind = local $ \ e -> e { fcContext = 1 + fcContext e }
+
+class Free a where
+  freeVars'   :: a -> FreeT
 
 instance Free Term where
-  freeVars' conf t = case t of
-    Var n ts   -> singleton n `union` weakly (freeVars' conf ts)
-    Lam _ t    -> freeVars' conf t
-    Lit _      -> empty
-    Def _ ts   -> weakly $ freeVars' conf ts  -- because we are not in TCM
+  freeVars' t = case t of
+    Var n ts   -> variable n `mappend` do weakly <$> freeVars' ts
+    -- λ is not considered guarding, as
+    -- we cannot prove that x ≡ λy.x is impossible.
+    Lam _ t    -> freeVars' t
+    Lit _      -> mempty
+    Def _ ts   -> weakly <$> freeVars' ts  -- because we are not in TCM
       -- we cannot query whether we are dealing with a data/record (strongly r.)
       -- or a definition by pattern matching (weakly rigid)
       -- thus, we approximate, losing that x = List x is unsolvable
-    Con _ ts   -> freeVars' conf ts
-    Pi a b     -> freeVars' conf (a,b)
-    Sort s     -> freeVars' conf s
-    Level l    -> freeVars' conf l
-    MetaV _ ts -> flexible $ freeVars' conf ts
-    DontCare mt -> irrelevantly $ freeVars' conf mt
-    Shared p    -> freeVars' conf (derefPtr p)
-    ExtLam cs ts -> freeVars' conf (cs, ts)
+    Con c ts   -> underConstructor c <$> freeVars' ts
+    -- Pi is not guarding, since we cannot prove that A ≡ B → A is impossible.
+    -- Even as we do not permit infinite type expressions,
+    -- we cannot prove their absence (as Set is not inductive).
+    -- Also, this is incompatible with univalence (HoTT).
+    Pi a b     -> freeVars' (a,b)
+    Sort s     -> freeVars' s
+    Level l    -> freeVars' l
+    MetaV _ ts -> flexible <$> freeVars' ts
+    DontCare mt -> irrelevantly <$> freeVars' mt
+    Shared p    -> freeVars' (derefPtr p)
+    ExtLam cs ts -> freeVars' (cs, ts)
 
 instance Free Type where
-  freeVars' conf (El s t)
-    | fcIgnoreSorts conf == IgnoreNot = freeVars' conf (s, t)
-    | otherwise                       = freeVars' conf t
+  freeVars' (El s t) =
+    ifM ((IgnoreNot ==) <$> asks fcIgnoreSorts)
+      {- then -} (freeVars' (s, t))
+      {- else -} (freeVars' t)
 
 instance Free Sort where
-  freeVars' conf s
-    | fcIgnoreSorts conf == IgnoreAll = empty
-    | otherwise                       = case s of
-      Type a     -> freeVars' conf a
-      Prop       -> empty
-      Inf        -> empty
-      DLub s1 s2 -> weakly $ freeVars' conf (s1, s2)
+  freeVars' s =
+    ifM ((IgnoreAll ==) <$> asks fcIgnoreSorts) mempty $ {- else -}
+    case s of
+      Type a     -> freeVars' a
+      Prop       -> mempty
+      Inf        -> mempty
+      DLub s1 s2 -> weakly <$> freeVars' (s1, s2)
 
 instance Free Level where
-  freeVars' conf (Max as) = freeVars' conf as
+  freeVars' (Max as) = freeVars' as
 
 instance Free PlusLevel where
-  freeVars' conf ClosedLevel{} = empty
-  freeVars' conf (Plus _ l)    = freeVars' conf l
+  freeVars' ClosedLevel{} = mempty
+  freeVars' (Plus _ l)    = freeVars' l
 
 instance Free LevelAtom where
-  freeVars' conf l = case l of
-    MetaLevel _ vs   -> flexible $ freeVars' conf vs
-    NeutralLevel v   -> freeVars' conf v
-    BlockedLevel _ v -> freeVars' conf v
-    UnreducedLevel v -> freeVars' conf v
+  freeVars' l = case l of
+    MetaLevel _ vs   -> flexible <$> freeVars' vs
+    NeutralLevel v   -> freeVars' v
+    BlockedLevel _ v -> freeVars' v
+    UnreducedLevel v -> freeVars' v
 
 instance Free a => Free [a] where
-  freeVars' conf = unions . map (freeVars' conf)
+  freeVars' = foldMap freeVars'
 
 instance Free a => Free (Maybe a) where
-  freeVars' conf = maybe empty (freeVars' conf)
+  freeVars' = foldMap freeVars'
 
 instance (Free a, Free b) => Free (a,b) where
-  freeVars' conf (x,y) = freeVars' conf x `union` freeVars' conf y
+  freeVars' (x,y) = freeVars' x `mappend` freeVars' y
 
 instance Free a => Free (Elim' a) where
-  freeVars' conf (Apply a) = freeVars' conf a
-  freeVars' conf (Proj{} ) = empty
+  freeVars' (Apply a) = freeVars' a
+  freeVars' (Proj{} ) = mempty
 
 instance Free a => Free (Arg a) where
-  freeVars' conf a = f $ freeVars' conf $ unArg a
+  freeVars' a = f <$> freeVars' (unArg a)
     where f = case getRelevance a of
                Irrelevant -> irrelevantly
                UnusedArg  -> unused
@@ -217,41 +318,41 @@ instance Free a => Free (Arg a) where
 
 
 instance Free a => Free (Dom a) where
-  freeVars' conf = freeVars' conf . unDom
+  freeVars' = freeVars' . unDom
 
 instance Free a => Free (Abs a) where
-  freeVars' conf (Abs   _ b) = subtractFV 1 $ delete 0 $ freeVars' conf b
-  freeVars' conf (NoAbs _ b) = freeVars' conf b
+  freeVars' (Abs   _ b) = bind $ freeVars' b
+  freeVars' (NoAbs _ b) = freeVars' b
 
 instance Free a => Free (Tele a) where
-  freeVars' conf EmptyTel	   = empty
-  freeVars' conf (ExtendTel a tel) = freeVars' conf (a, tel)
+  freeVars' EmptyTel          = mempty
+  freeVars' (ExtendTel a tel) = freeVars' (a, tel)
 
 instance Free ClauseBody where
-  freeVars' conf (Body t)   = freeVars' conf t
-  freeVars' conf (Bind b)   = freeVars' conf b
-  freeVars' conf  NoBody    = empty
+  freeVars' (Body t)   = freeVars' t
+  freeVars' (Bind b)   = freeVars' b
+  freeVars'  NoBody    = mempty
 
 instance Free Clause where
-  freeVars' conf = freeVars' conf . clauseBody
+  freeVars' = freeVars' . clauseBody
 
 freeIn :: Free a => Nat -> a -> Bool
 freeIn v t = v `Set.member` allVars (freeVars t)
 
 freeInIgnoringSorts :: Free a => Nat -> a -> Bool
 freeInIgnoringSorts v t =
-  v `Set.member` allVars (freeVars' FreeConf{ fcIgnoreSorts = IgnoreAll } t)
+  v `Set.member` allVars (freeVarsIgnore IgnoreAll t)
 
 freeInIgnoringSortAnn :: Free a => Nat -> a -> Bool
 freeInIgnoringSortAnn v t =
-  v `Set.member` allVars (freeVars' FreeConf{ fcIgnoreSorts = IgnoreInAnnotations } t)
+  v `Set.member` allVars (freeVarsIgnore IgnoreInAnnotations t)
 
 relevantInIgnoringSortAnn :: Free a => Nat -> a -> Bool
 relevantInIgnoringSortAnn v t =
-  v `Set.member` relevantVars (freeVars' FreeConf{ fcIgnoreSorts = IgnoreInAnnotations } t)
+  v `Set.member` relevantVars (freeVarsIgnore IgnoreInAnnotations t)
 
 relevantIn :: Free a => Nat -> a -> Bool
-relevantIn v t = v `Set.member` relevantVars (freeVars' FreeConf{ fcIgnoreSorts = IgnoreAll } t)
+relevantIn v t = v `Set.member` relevantVars (freeVarsIgnore IgnoreAll t)
 
 -- | Is the variable bound by the abstraction actually used?
 isBinderUsed :: Free a => Abs a -> Bool
diff --git a/src/full/Agda/TypeChecking/Implicit.hs b/src/full/Agda/TypeChecking/Implicit.hs
index ca79598..19d6473 100644
--- a/src/full/Agda/TypeChecking/Implicit.hs
+++ b/src/full/Agda/TypeChecking/Implicit.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 {-| Functions for inserting implicit arguments at the right places.
@@ -22,7 +22,7 @@ import Agda.TypeChecking.Pretty
 
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | @implicitArgs n expand t@ generates up to @n@ implicit arguments
@@ -76,8 +76,8 @@ introImplicits expand t = do
 ---------------------------------------------------------------------------
 
 data ImplicitInsertion
-      = ImpInsert [Hiding]	  -- ^ this many implicits have to be inserted
-      | BadImplicits	  -- ^ hidden argument where there should have been a non-hidden arg
+      = ImpInsert [Hiding]        -- ^ this many implicits have to be inserted
+      | BadImplicits      -- ^ hidden argument where there should have been a non-hidden arg
       | NoSuchName ArgName -- ^ bad named argument
       | NoInsertNeeded
   deriving (Show)
@@ -108,4 +108,4 @@ insertImplicit a ts =
       | x == y && hidingx == getHiding a = impInsert $ reverse hs
       | x == y && hidingx /= getHiding a = BadImplicits
       | otherwise = find (getHiding a:hs) x hidingx ts
-    find i x _ []			     = NoSuchName x
+    find i x _ []                            = NoSuchName x
diff --git a/src/full/Agda/TypeChecking/Injectivity.hs b/src/full/Agda/TypeChecking/Injectivity.hs
index 9ed5710..38e632c 100644
--- a/src/full/Agda/TypeChecking/Injectivity.hs
+++ b/src/full/Agda/TypeChecking/Injectivity.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE TupleSections #-}
 
 module Agda.TypeChecking.Injectivity where
@@ -6,7 +6,6 @@ module Agda.TypeChecking.Injectivity where
 import Prelude hiding (mapM)
 
 import Control.Applicative
-import Control.Monad.Error hiding (mapM, forM)
 import Control.Monad.State hiding (mapM, forM)
 import Control.Monad.Reader hiding (mapM, forM)
 
@@ -16,6 +15,7 @@ import qualified Data.Set as Set
 import Data.Maybe
 import Data.Traversable hiding (for)
 
+import qualified Agda.Syntax.Abstract.Name as A
 import Agda.Syntax.Common
 import Agda.Syntax.Internal
 
@@ -29,11 +29,12 @@ import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Constraints
 import Agda.TypeChecking.Polarity
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.List
 import Agda.Utils.Functor
 import Agda.Utils.Permutation
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 headSymbol :: Term -> TCM (Maybe TermHead)
@@ -78,7 +79,8 @@ headSymbol v = do -- ignoreAbstractMode $ do
 checkInjectivity :: QName -> [Clause] -> TCM FunctionInverse
 checkInjectivity f cs
   | pointLess cs = do
-      reportSLn "tc.inj.check" 20 $ "Injectivity of " ++ show f ++ " would be pointless."
+      reportSLn "tc.inj.check.pointless" 20 $
+        "Injectivity of " ++ show (A.qnameToConcrete f) ++ " would be pointless."
       return NotInjective
   where
     -- Is it pointless to use injectivity for this function?
@@ -125,6 +127,8 @@ functionInverse v = case ignoreSharing v of
 data InvView = Inv QName [Elim] (Map TermHead Clause)
              | NoInv
 
+data MaybeAbort = Abort | KeepGoing
+
 useInjectivity :: Comparison -> Type -> Term -> Term -> TCM ()
 useInjectivity cmp a u v = do
   reportSDoc "tc.inj.use" 30 $ fsep $
@@ -178,7 +182,7 @@ useInjectivity cmp a u v = do
     invert org f ftype inv args (Just h) = case Map.lookup h inv of
       Nothing -> typeError $ UnequalTerms cmp u v a
       Just cl at Clause{ clauseTel  = tel
-                    , clausePerm = perm } -> do
+                    , clausePerm = perm } -> maybeAbort $ do
           let ps = clausePats cl
           -- These are what dot patterns should be instantiated at
           ms <- map unArg <$> newTelMeta tel
@@ -189,7 +193,7 @@ useInjectivity cmp a u v = do
             , text "  ps   =" <+> prettyList (map (text . show) ps)
             ]
           -- and this is the order the variables occur in the patterns
-          let ms' = permute (invertP $ compactP perm) ms
+          let ms' = permute (invertP __IMPOSSIBLE__ $ compactP perm) ms
           let sub = parallelS (reverse ms)
           margs <- runReaderT (evalStateT (mapM metaElim ps) ms') sub
           reportSDoc "tc.inj.invert" 20 $ vcat
@@ -207,7 +211,7 @@ useInjectivity cmp a u v = do
           -- The clause might not give as many patterns as there
           -- are arguments (point-free style definitions).
           let args' = take (length margs) args
-          compareElims pol ftype org margs args'
+          compareElims pol ftype (Def f []) margs args'
 {- Andreas, 2011-05-09 allow unsolved constraints as long as progress
           unless (null cs) $ do
             reportSDoc "tc.inj.invert" 30 $
@@ -219,21 +223,21 @@ useInjectivity cmp a u v = do
           org <- reduce org
           h <- headSymbol org
           case h of
-            Just h  -> compareTerm cmp a u v
+            Just h  -> KeepGoing <$ compareTerm cmp a u v
             Nothing -> do
-             reportSDoc "tc.inj.invert" 30 $ vcat
-               [ text "aborting inversion;" <+> prettyTCM org
-               , text "plainly," <+> text (show org)
-               , text "has TermHead" <+> text (show h)
-               , text "which does not expose a constructor"
-               ]
-             patternViolation
-        `catchError` \err -> case err of
-          TypeError   {} -> throwError err
-          Exception   {} -> throwError err
-          IOException {} -> throwError err
-          PatternErr  {} -> fallBack
-          {- AbortAssign {} -> fallBack -- UNUSED -}
+              reportSDoc "tc.inj.invert" 30 $ vcat
+                [ text "aborting inversion;" <+> prettyTCM org
+                , text "plainly," <+> text (show org)
+                , text "has TermHead" <+> text (show h)
+                , text "which does not expose a constructor"
+                ]
+              return Abort
+
+    maybeAbort m = do
+      (a, s) <- localTCStateSaving m
+      case a of
+        KeepGoing -> put s
+        Abort     -> fallBack
 
     nextMeta = do
       m : ms <- get
diff --git a/src/full/Agda/TypeChecking/InstanceArguments.hs b/src/full/Agda/TypeChecking/InstanceArguments.hs
index 6ee28dd..d689d74 100644
--- a/src/full/Agda/TypeChecking/InstanceArguments.hs
+++ b/src/full/Agda/TypeChecking/InstanceArguments.hs
@@ -3,7 +3,6 @@
 module Agda.TypeChecking.InstanceArguments where
 
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.Map as Map
@@ -26,10 +25,12 @@ import {-# SOURCE #-} Agda.TypeChecking.Rules.Term (checkArguments)
 import {-# SOURCE #-} Agda.TypeChecking.MetaVars
 import {-# SOURCE #-} Agda.TypeChecking.Conversion
 
+import Agda.Utils.Except ( MonadError(catchError, throwError), runExceptT )
+import Agda.Utils.Lens
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | A candidate solution for an instance meta is a term with its type.
@@ -105,6 +106,7 @@ initialIFSCandidates t = do
 --   with suggested name @s at .
 initializeIFSMeta :: String -> Type -> TCM Term
 initializeIFSMeta s t = do
+  t <- reduce t  -- see Issue 1321
   cands <- initialIFSCandidates t
   newIFSMeta s t cands
 
@@ -118,7 +120,7 @@ initializeIFSMeta s t = do
 --   its type again.
 findInScope :: MetaId -> Maybe Candidates -> TCM ()
 findInScope m Nothing = do
-  reportSLn "tc.constr.findInScope" 20 $ "The type of the FindInScope constraint isn't known, trying to find it again."
+  reportSLn "tc.instance" 20 $ "The type of the FindInScope constraint isn't known, trying to find it again."
   t <- getMetaType m
   cands <- initialIFSCandidates t
   case cands of
@@ -133,11 +135,11 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
     -- Andreas, 2013-12-28 issue 1003:
     -- If instance meta is already solved, simply discard the constraint.
     ifM (isInstantiatedMeta m) (return Nothing) $ do
-    reportSLn "tc.constr.findInScope" 15 $
+    reportSLn "tc.instance" 15 $
       "findInScope 2: constraint: " ++ show m ++ "; candidates left: " ++ show (length cands)
     t <- normalise =<< getMetaTypeInContext m
-    reportSDoc "tc.constr.findInScope" 15 $ text "findInScope 3: t =" <+> prettyTCM t
-    reportSLn "tc.constr.findInScope" 70 $ "findInScope 3: t: " ++ show t
+    reportSDoc "tc.instance" 15 $ text "findInScope 3: t =" <+> prettyTCM t
+    reportSLn "tc.instance" 70 $ "findInScope 3: t: " ++ show t
     mv <- lookupMeta m
     -- If there are recursive instances, it's not safe to instantiate
     -- metavariables in the goal, so we freeze them before checking candidates.
@@ -151,18 +153,18 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
       filterM (shouldFreeze rigid) (allMetas t)
     forM_ metas $ \ m -> updateMetaVar m $ \ mv -> mv { mvFrozen = Frozen }
     cands <- checkCandidates m t cands
-    reportSLn "tc.constr.findInScope" 15 $
+    reportSLn "tc.instance" 15 $
       "findInScope 4: cands left: " ++ show (length cands)
     unfreezeMeta metas
     case cands of
 
       [] -> do
-        reportSDoc "tc.constr.findInScope" 15 $
+        reportSDoc "tc.instance" 15 $
           text "findInScope 5: not a single candidate found..."
         typeError $ IFSNoCandidateInScope t
 
       [(term, t')] -> do
-        reportSDoc "tc.constr.findInScope" 15 $ vcat
+        reportSDoc "tc.instance" 15 $ vcat
           [ text "findInScope 5: found one candidate"
           , nest 2 $ prettyTCM term
           , text "of type " <+> prettyTCM t'
@@ -170,7 +172,7 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
           ]
 
         -- if t' takes initial hidden arguments, apply them
-        ca <- liftTCM $ runErrorT $ checkArguments ExpandLast ExpandInstanceArguments (getRange mv) [] t' t
+        ca <- liftTCM $ runExceptT $ checkArguments ExpandLast ExpandInstanceArguments (getRange mv) [] t' t
         case ca of
           Left _ -> __IMPOSSIBLE__
           Right (args, t'') -> do
@@ -183,14 +185,14 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
             ctxArgs <- getContextArgs
             v <- (`applyDroppingParameters` args) =<< reduce term
             assignV DirEq m ctxArgs v
-            reportSDoc "tc.constr.findInScope" 10 $ vcat
+            reportSDoc "tc.instance" 10 $ vcat
               [ text "solved by instance search:"
               , prettyTCM m <+> text ":=" <+> prettyTCM v
               ]
             return Nothing
 
       cs -> do
-        reportSDoc "tc.constr.findInScope" 15 $
+        reportSDoc "tc.instance" 15 $
           text ("findInScope 5: more than one candidate found: ") <+>
           prettyTCM (List.map fst cs)
         return (Just cs)
@@ -210,7 +212,7 @@ findInScope' m cands = ifM (isFrozen m) (return (Just cands)) $ do
 -- search, since the constraint limits the solution space.
 rigidlyConstrainedMetas :: TCM [MetaId]
 rigidlyConstrainedMetas = do
-  cs <- (++) <$> gets stSleepingConstraints <*> gets stAwakeConstraints
+  cs <- (++) <$> use stSleepingConstraints <*> use stAwakeConstraints
   catMaybes <$> mapM rigidMetas cs
   where
     isRigid v =
@@ -256,10 +258,10 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
   where
     checkCandidateForMeta :: MetaId -> Type -> Term -> Type -> TCM Bool
     checkCandidateForMeta m t term t' =
-      verboseBracket "tc.constr.findInScope" 20 ("checkCandidateForMeta " ++ show m) $ do
+      verboseBracket "tc.instance" 20 ("checkCandidateForMeta " ++ show m) $ do
       liftTCM $ flip catchError handle $ do
-        reportSLn "tc.constr.findInScope" 70 $ "  t: " ++ show t ++ "\n  t':" ++ show t' ++ "\n  term: " ++ show term ++ "."
-        reportSDoc "tc.constr.findInScope" 20 $ vcat
+        reportSLn "tc.instance" 70 $ "  t: " ++ show t ++ "\n  t':" ++ show t' ++ "\n  term: " ++ show term ++ "."
+        reportSDoc "tc.instance" 20 $ vcat
           [ text "checkCandidateForMeta"
           , text "t    =" <+> prettyTCM t
           , text "t'   =" <+> prettyTCM t'
@@ -268,11 +270,11 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
         localTCState $ do
            -- domi: we assume that nothing below performs direct IO (except
            -- for logging and such, I guess)
-          ca <- runErrorT $ checkArguments ExpandLast ExpandInstanceArguments noRange [] t' t
+          ca <- runExceptT $ checkArguments ExpandLast ExpandInstanceArguments noRange [] t' t
           case ca of
             Left _ -> return False
             Right (args, t'') -> do
-              reportSDoc "tc.constr.findInScope" 20 $
+              reportSDoc "tc.instance" 20 $
                 text "instance search: checking" <+> prettyTCM t''
                 <+> text "<=" <+> prettyTCM t
               -- if constraints remain, we abort, but keep the candidate
@@ -280,7 +282,7 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
               --tel <- getContextTelescope
               ctxArgs <- getContextArgs
               v <- (`applyDroppingParameters` args) =<< reduce term
-              reportSDoc "tc.constr.findInScope" 15 $ vcat
+              reportSDoc "tc.instance" 15 $ vcat
                 [ text "instance search: attempting"
                 , nest 2 $ prettyTCM m <+> text ":=" <+> prettyTCM v
                 ]
@@ -294,7 +296,7 @@ checkCandidates m t cands = localTCState $ disableDestructiveUpdate $ do
               return True
       where
         handle err = do
-          reportSDoc "tc.constr.findInScope" 50 $
+          reportSDoc "tc.instance" 50 $
             text "assignment failed:" <+> prettyTCM err
           return False
     isIFSConstraint :: Constraint -> Bool
diff --git a/src/full/Agda/TypeChecking/Level.hs b/src/full/Agda/TypeChecking/Level.hs
index a1a3f45..dc934a2 100644
--- a/src/full/Agda/TypeChecking/Level.hs
+++ b/src/full/Agda/TypeChecking/Level.hs
@@ -2,7 +2,6 @@
 
 module Agda.TypeChecking.Level where
 
-import Control.Monad.Error
 import Control.Applicative
 import Data.List as List
 
@@ -14,7 +13,9 @@ import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Reduce.Monad ()
 import Agda.TypeChecking.Monad.Builtin
 
-#include "../undefined.h"
+import Agda.Utils.Except ( MonadError(catchError) )
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data LevelKit = LevelKit
@@ -93,6 +94,7 @@ unlevelWithKit LevelKit{ lvlZero = zer, lvlSuc = suc, lvlMax = max } (Max as) =
     []  -> zer
     as  -> foldr1 max as
 
+unPlusV :: Term -> (Term -> Term) -> PlusLevel -> Term
 unPlusV zer suc (ClosedLevel n) = foldr (.) id (genericReplicate n suc) zer
 unPlusV _   suc (Plus n a)      = foldr (.) id (genericReplicate n suc) (unLevelAtom a)
 
diff --git a/src/full/Agda/TypeChecking/LevelConstraints.hs b/src/full/Agda/TypeChecking/LevelConstraints.hs
index 52db0c4..9423c9a 100644
--- a/src/full/Agda/TypeChecking/LevelConstraints.hs
+++ b/src/full/Agda/TypeChecking/LevelConstraints.hs
@@ -1,4 +1,3 @@
-
 module Agda.TypeChecking.LevelConstraints ( simplifyLevelConstraint ) where
 
 import Agda.Syntax.Common (Nat)
@@ -33,6 +32,7 @@ simplifyLevelConstraint n new old =
 data Leq = PlusLevel :=< PlusLevel
   deriving (Show, Eq)
 
+inequalities :: Constraint -> [Leq]
 inequalities (LevelCmp CmpEq (Max [a, b]) (Max [c]))
   | a == c = [b :=< a]
   | b == c = [a :=< b]
diff --git a/src/full/Agda/TypeChecking/MetaVars.hs b/src/full/Agda/TypeChecking/MetaVars.hs
index bbb6848..fbf76e9 100644
--- a/src/full/Agda/TypeChecking/MetaVars.hs
+++ b/src/full/Agda/TypeChecking/MetaVars.hs
@@ -1,14 +1,13 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE RelaxedPolyRec #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE RelaxedPolyRec       #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.MetaVars where
 
 import Control.Monad.Reader
-import Control.Monad.Error
 
 import Data.Function
 import Data.List hiding (sort)
@@ -42,7 +41,13 @@ import Agda.TypeChecking.SizedTypes (boundedSizeMetaHook, isSizeProblem)
 -- import {-# SOURCE #-} Agda.TypeChecking.CheckInternal (checkInternal)
 import Agda.TypeChecking.MetaVars.Occurs
 
-import Agda.Utils.Fresh
+import Agda.Utils.Except
+  ( Error(noMsg)
+  , ExceptT
+  , MonadError(throwError)
+  , runExceptT
+  )
+
 import Agda.Utils.List
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
@@ -51,7 +56,7 @@ import Agda.Utils.Tuple
 import Agda.Utils.Permutation
 import qualified Agda.Utils.VarSet as Set
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Find position of a value in a list.
@@ -68,12 +73,12 @@ isBlockedTerm x = do
     reportSLn "tc.meta.blocked" 12 $ "is " ++ show x ++ " a blocked term? "
     i <- mvInstantiation <$> lookupMeta x
     let r = case i of
-	    BlockedConst{}                 -> True
+            BlockedConst{}                 -> True
             PostponedTypeCheckingProblem{} -> True
-	    InstV{}                        -> False
-	    InstS{}                        -> False
-	    Open{}                         -> False
-	    OpenIFS{}                      -> False
+            InstV{}                        -> False
+            InstS{}                        -> False
+            Open{}                         -> False
+            OpenIFS{}                      -> False
     reportSLn "tc.meta.blocked" 12 $
       if r then "  yes, because " ++ show i else "  no"
     return r
@@ -96,16 +101,16 @@ isEtaExpandable x = do
 --   The instantiation should not be an 'InstV' or 'InstS' and the 'MetaId'
 --   should point to something 'Open' or a 'BlockedConst'.
 --   Further, the meta variable may not be 'Frozen'.
-assignTerm :: MetaId -> Term -> TCM ()
-assignTerm x t = do
+assignTerm :: MetaId -> [I.Arg ArgName] -> Term -> TCM ()
+assignTerm x tel v = do
      -- verify (new) invariants
     whenM (isFrozen x) __IMPOSSIBLE__
-    assignTerm' x t
+    assignTerm' x tel v
 
 -- | Skip frozen check.  Used for eta expanding frozen metas.
-assignTerm' :: MetaId -> Term -> TCM ()
-assignTerm' x t = do
-    reportSLn "tc.meta.assign" 70 $ show x ++ " := " ++ show t
+assignTerm' :: MetaId -> [I.Arg ArgName] -> Term -> TCM ()
+assignTerm' x tel v = do
+    reportSLn "tc.meta.assign" 70 $ show x ++ " := " ++ show v ++ "\n  in " ++ show tel
      -- verify (new) invariants
     whenM (not <$> asks envAssignMetas) __IMPOSSIBLE__
 
@@ -123,14 +128,14 @@ assignTerm' x t = do
     -- dontAssignMetas $ do
     --   checkInternal t . jMetaType . mvJudgement =<< lookupMeta x
 
-    let i = metaInstance (killRange t)
+    let i = metaInstance tel v
     verboseS "profile.metas" 10 $ liftTCM $ tickMax "max-open-metas" . size =<< getOpenMetas
     modifyMetaStore $ ins x i
     etaExpandListeners x
     wakeupConstraints x
     reportSLn "tc.meta.assign" 20 $ "completed assignment of " ++ show x
   where
-    metaInstance = InstV
+    metaInstance tel v = InstV tel v
     ins x i store = Map.adjust (inst i) x store
     inst i mv = mv { mvInstantiation = i }
 
@@ -177,7 +182,7 @@ newTypeMeta_  = newTypeMeta =<< (workOnTypes $ newSortMeta)
 --   lambdas in front of it.
 newIFSMeta :: MetaNameSuggestion -> Type -> Maybe [(Term, Type)] -> TCM Term
 newIFSMeta s t cands = do
-  let TelV tel t' = telView' t
+  TelV tel t' <- telView t
   addCtxTel tel $ do
     vs  <- getContextArgs
     ctx <- getContextTelescope
@@ -192,8 +197,8 @@ newIFSMetaCtx s t vs cands = do
     ]
   i0 <- createMetaInfo
   let i = i0 { miNameSuggestion = s }
-  let TelV tel _ = telView' t
-      perm = idP (size tel)
+  TelV tel _ <- telView t
+  let perm = idP (size tel)
   x <- newMeta' OpenIFS i normalMetaPriority perm (HasType () t)
   reportSDoc "tc.meta.new" 50 $ fsep
     [ nest 2 $ text (show x) <+> text ":" <+> prettyTCM t
@@ -230,8 +235,8 @@ newValueMeta' b t = do
 newValueMetaCtx' :: RunMetaOccursCheck -> Type -> Args -> TCM Term
 newValueMetaCtx' b t vs = do
   i <- createMetaInfo' b
-  let TelV tel a = telView' t
-      perm = idP (size tel)
+  TelV tel a <- telView t
+  let perm = idP (size tel)
   x <- newMeta i normalMetaPriority perm (HasType () t)
   reportSDoc "tc.meta.new" 50 $ fsep
     [ text "new meta:"
@@ -248,6 +253,8 @@ newTelMeta :: Telescope -> TCM Args
 newTelMeta tel = newArgsMeta (abstract tel $ El Prop $ Sort Prop)
 
 type Condition = I.Dom Type -> Abs Type -> Bool
+
+trueCondition :: Condition
 trueCondition _ _ = True
 
 newArgsMeta :: Type -> TCM Args
@@ -289,7 +296,7 @@ newRecordMeta r pars = do
 
 newRecordMetaCtx :: QName -> Args -> Telescope -> Args -> TCM Term
 newRecordMetaCtx r pars tel ctx = do
-  ftel	 <- flip apply pars <$> getRecordFieldTypes r
+  ftel   <- flip apply pars <$> getRecordFieldTypes r
   fields <- newArgsMetaCtx (telePi_ ftel $ sort Prop) tel ctx
   con    <- getRecordConstructor r
   return $ Con con fields
@@ -394,7 +401,7 @@ problemType (CheckArgs _ _ _ _ _ t _) = t
 etaExpandListeners :: MetaId -> TCM ()
 etaExpandListeners m = do
   ls <- getMetaListeners m
-  clearMetaListeners m	-- we don't really have to do this
+  clearMetaListeners m  -- we don't really have to do this
   mapM_ wakeupListener ls
 
 -- | Wake up a meta listener and let it do its thing
@@ -454,8 +461,8 @@ etaExpandMeta kinds m = whenM (isEtaExpandable m) $ do
     lvl@(Def r es) ->
       ifM (isEtaRecord r) {- then -} (do
         let ps = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
-	let expand = do
-              u <- abstract tel <$> do withMetaInfo' meta $ newRecordMetaCtx r ps tel $ teleArgs tel
+        let expand = do
+              u <- withMetaInfo' meta $ newRecordMetaCtx r ps tel $ teleArgs tel
               inTopContext $ do
                 verboseS "tc.meta.eta" 15 $ do
                   du <- prettyTCM u
@@ -463,7 +470,7 @@ etaExpandMeta kinds m = whenM (isEtaExpandable m) $ do
                 -- Andreas, 2012-03-29: No need for occurrence check etc.
                 -- we directly assign the solution for the meta
                 -- 2012-05-23: We also bypass the check for frozen.
-                noConstraints $ assignTerm' m u  -- should never produce any constraints
+                noConstraints $ assignTerm' m (telToArgs tel) u  -- should never produce any constraints
         if Records `elem` kinds then
           expand
          else if (SingletonRecords `elem` kinds) then do
@@ -480,7 +487,7 @@ etaExpandMeta kinds m = whenM (isEtaExpandable m) $ do
         reportSLn "tc.meta.eta" 20 $ "Expanding level meta to 0 (type-in-type)"
         -- Andreas, 2012-03-30: No need for occurrence check etc.
         -- we directly assign the solution for the meta
-        noConstraints $ assignTerm m (abstract tel $ Level $ Max [])
+        noConstraints $ assignTerm m (telToArgs tel) (Level $ Max [])
      ) $ {- else -} dontExpand
     _ -> dontExpand
 
@@ -563,8 +570,8 @@ assign dir x args v = do
           reportSLn "tc.meta.assign" 25 $ "aborting: meta is frozen!"
           patternViolation
 
-	-- We never get blocked terms here anymore. TODO: we actually do. why?
-	whenM (isBlockedTerm x) patternViolation
+        -- We never get blocked terms here anymore. TODO: we actually do. why?
+        whenM (isBlockedTerm x) patternViolation
 
         -- Andreas, 2010-10-15 I want to see whether rhs is blocked
         reportSLn "tc.meta.assign" 50 $ "MetaVars.assign: I want to see whether rhs is blocked"
@@ -623,17 +630,17 @@ assign dir x args v = do
                  , text "fvars lhs (irr):" <+> sep (map (text . show) irrVL)
                  ]
 
-	-- Check that the x doesn't occur in the right hand side.
+        -- Check that the x doesn't occur in the right hand side.
         -- Prune mvars on rhs such that they can only depend on varsL.
         -- Herein, distinguish relevant and irrelevant vars,
         -- since when abstracting irrelevant lhs vars, they may only occur
         -- irrelevantly on rhs.
-	v <- liftTCM $ occursCheck x (relVL, irrVL) v
+        v <- liftTCM $ occursCheck x (relVL, irrVL) v
 
-	reportSLn "tc.meta.assign" 15 "passed occursCheck"
-	verboseS "tc.meta.assign" 30 $ do
-	  let n = size v
-	  when (n > 200) $ reportSDoc "tc.meta.assign" 30 $
+        reportSLn "tc.meta.assign" 15 "passed occursCheck"
+        verboseS "tc.meta.assign" 30 $ do
+          let n = size v
+          when (n > 200) $ reportSDoc "tc.meta.assign" 30 $
             sep [ text "size" <+> text (show n)
 --                , nest 2 $ text "type" <+> prettyTCM t
                 , nest 2 $ text "term" <+> prettyTCM v
@@ -648,9 +655,9 @@ assign dir x args v = do
         reportSDoc "tc.meta.assign" 20 $
           text "fvars rhs:" <+> sep (map (text . show) $ Set.toList fvs)
 
-	-- Check that the arguments are variables
-	mids <- do
-          res <- runErrorT $ inverseSubst args
+        -- Check that the arguments are variables
+        mids <- do
+          res <- runExceptT $ inverseSubst args
           case res of
             -- all args are variables
             Right ids -> do
@@ -671,7 +678,7 @@ assign dir x args v = do
           Just ids -> do
             -- Check linearity
             ids <- do
-              res <- runErrorT $ checkLinearity {- (`Set.member` fvs) -} ids
+              res <- runExceptT $ checkLinearity {- (`Set.member` fvs) -} ids
               case res of
                 -- case: linear
                 Right ids -> return ids
@@ -719,15 +726,16 @@ attemptInertRHSImprovement m args v = do
   -- Solve the meta with _M := \ xs -> D (_Y1 xs) .. (_Yn xs), for fresh metas
   -- _Yi.
   metaArgs <- inTopContext $ addCtxTel tel $ newArgsMeta a
-  let varArgs  = map Apply $ reverse $ zipWith (\i a -> var i <$ a) [0..] (reverse args)
-      sol      = foldr (\a -> Lam (argInfo a) . Abs "x") (mkRHS metaArgs) args
+  let varArgs = map Apply $ reverse $ zipWith (\i a -> var i <$ a) [0..] (reverse args)
+      sol     = mkRHS metaArgs
+      argTel  = map ("x" <$) args
   reportSDoc "tc.meta.inert" 30 $ nest 2 $ vcat
     [ text "a       =" <+> prettyTCM a
     , text "tel     =" <+> prettyTCM tel
     , text "metas   =" <+> prettyList (map prettyTCM metaArgs)
     , text "sol     =" <+> prettyTCM sol
     ]
-  assignTerm m sol
+  assignTerm m argTel sol
   patternViolation  -- throwing a pattern violation here lets the constraint
                     -- machinery worry about restarting the comparison.
   where
@@ -830,10 +838,11 @@ assignMeta' m x t n ids v = do
     -- ALT 2: O(m)
     let assocToList i l = case l of
           _           | i >= m -> []
-          ((j,u) : l) | i == j -> u              : assocToList (i+1) l
-          _                    -> __IMPOSSIBLE__ : assocToList (i+1) l
+          ((j,u) : l) | i == j -> Just u  : assocToList (i+1) l
+          _                    -> Nothing : assocToList (i+1) l
         ivs = assocToList 0 ids
-    return $ applySubst (ivs ++# raiseS n)  v
+        rho = prependS __IMPOSSIBLE__ ivs $ raiseS n
+    return $ applySubst rho v
 
   -- Metas are top-level so we do the assignment at top-level.
   inTopContext $ do
@@ -853,12 +862,10 @@ assignMeta' m x t n ids v = do
     when (size tel' < n)
        patternViolation -- WAS: __IMPOSSIBLE__
 
-    -- The solution.
-    let u = killRange $ abstract tel' v'
     -- Perform the assignment (and wake constraints).
     reportSDoc "tc.meta.assign" 10 $
-      text "solving" <+> prettyTCM x <+> text ":=" <+> prettyTCM u
-    assignTerm x u
+      text "solving" <+> prettyTCM x <+> text ":=" <+> prettyTCM (abstract tel' v')
+    assignTerm x (telToArgs tel') v'
 
 
 -- | Turn the assignment problem @_X args <= SizeLt u@ into
@@ -892,7 +899,7 @@ subtypingForSizeLt dir   x mvar t args v cont = do
       -- so we cannot fall back to the original handler.
       let xArgs = MetaV x $ map Apply args
           v'    = Def qSizeLt [Apply $ Arg ai yArgs]
-          c     = dirToCmp (`ValueCmp` set0) dir xArgs v'
+          c     = dirToCmp (`ValueCmp` sizeUniv) dir xArgs v'
       catchConstraint c $ cont v'
     _ -> fallback
 
@@ -929,7 +936,8 @@ instance Error ProjVarExc where
   noMsg = __IMPOSSIBLE__
 
 instance NoProjectedVar Term where
-  noProjectedVar (Var i es) | Just qs@(_:_) <- mapM isProjElim es = Left $ ProjVarExc i qs
+  noProjectedVar (Var i es)
+    | qs@(_:_) <- takeWhileJust id $ map isProjElim es = Left $ ProjVarExc i qs
   noProjectedVar _ = return ()
 
 instance NoProjectedVar a => NoProjectedVar (I.Arg a) where
@@ -996,7 +1004,7 @@ type SubstCand = [(Nat,Term)] -- ^ a possibly non-deterministic substitution
 
 -- | Turn non-det substitution into proper substitution, if possible.
 --   Otherwise, raise the error.
-checkLinearity :: SubstCand -> ErrorT () TCM SubstCand
+checkLinearity :: SubstCand -> ExceptT () TCM SubstCand
 checkLinearity ids0 = do
   let ids = sortBy (compare `on` fst) ids0  -- see issue 920
   let grps = groupOn fst ids
@@ -1004,7 +1012,7 @@ checkLinearity ids0 = do
   where
     -- | Non-determinism can be healed if type is singleton. [Issue 593]
     --   (Same as for irrelevance.)
-    makeLinear :: SubstCand -> ErrorT () TCM SubstCand
+    makeLinear :: SubstCand -> ExceptT () TCM SubstCand
     makeLinear []            = __IMPOSSIBLE__
     makeLinear grp@[_]       = return grp
     makeLinear (p@(i,t) : _) =
@@ -1060,7 +1068,7 @@ instance Error InvertExcept where
 --   Linearity, i.e., whether the substitution is deterministic,
 --   has to be checked separately.
 --
-inverseSubst :: Args -> ErrorT InvertExcept TCM SubstCand
+inverseSubst :: Args -> ExceptT InvertExcept TCM SubstCand
 inverseSubst args = map (mapFst unArg) <$> loop (zip args terms)
   where
     loop  = foldM isVarOrIrrelevant []
@@ -1072,7 +1080,7 @@ inverseSubst args = map (mapFst unArg) <$> loop (zip args terms)
       throwError CantInvert
     neutralArg = throwError NeutralArg
 
-    isVarOrIrrelevant :: Res -> (I.Arg Term, Term) -> ErrorT InvertExcept TCM Res
+    isVarOrIrrelevant :: Res -> (I.Arg Term, Term) -> ExceptT InvertExcept TCM Res
     isVarOrIrrelevant vars (arg, t) =
       case ignoreSharing <$> arg of
         -- i := x
@@ -1146,10 +1154,6 @@ inverseSubst args = map (mapFst unArg) <$> loop (zip args terms)
       -- filter out duplicate irrelevants
       filter (not . (\ a@(Arg info j, t) -> isIrrelevant info && i == j)) vars
 
-
-
-
-
 -- | Used in 'Agda.Interaction.BasicOps.giveExpr'.
 updateMeta :: MetaId -> Term -> TCM ()
 updateMeta mI v = do
diff --git a/src/full/Agda/TypeChecking/MetaVars.hs-boot b/src/full/Agda/TypeChecking/MetaVars.hs-boot
index 4166338..ef21be7 100644
--- a/src/full/Agda/TypeChecking/MetaVars.hs-boot
+++ b/src/full/Agda/TypeChecking/MetaVars.hs-boot
@@ -1,17 +1,17 @@
 module Agda.TypeChecking.MetaVars where
 
-import Agda.Syntax.Internal	    ( MetaId, Term, Type, Args, Abs, Dom, Telescope )
+import Agda.Syntax.Internal         ( MetaId, Term, Type, Arg, Args, Abs, Dom, Telescope )
 import Agda.Syntax.Internal.Generic ( TermLike )
 import Agda.TypeChecking.Monad.Base ( TCM, RunMetaOccursCheck(..), CompareDirection(..) )
 
 type Condition = Dom Type -> Abs Type -> Bool
 newArgsMeta'      :: Condition -> Type -> TCM Args
 newArgsMeta       :: Type -> TCM Args
-assignTerm        :: MetaId -> Term -> TCM ()
+assignTerm        :: MetaId -> [Arg String] -> Term -> TCM ()
 etaExpandMetaSafe :: MetaId -> TCM ()
 assignV           :: CompareDirection -> MetaId -> Args -> Term -> TCM ()
-assign 		      :: CompareDirection -> MetaId -> Args -> Term -> TCM ()
-newIFSMeta 	      :: String -> Type -> Maybe [(Term, Type)] -> TCM Term
+assign                :: CompareDirection -> MetaId -> Args -> Term -> TCM ()
+newIFSMeta            :: String -> Type -> Maybe [(Term, Type)] -> TCM Term
 newValueMeta      :: RunMetaOccursCheck -> Type -> TCM Term
 newNamedValueMeta :: RunMetaOccursCheck -> String -> Type -> TCM Term
 newTelMeta        :: Telescope -> TCM Args
diff --git a/src/full/Agda/TypeChecking/MetaVars/Mention.hs b/src/full/Agda/TypeChecking/MetaVars/Mention.hs
index c59d817..f032dbc 100644
--- a/src/full/Agda/TypeChecking/MetaVars/Mention.hs
+++ b/src/full/Agda/TypeChecking/MetaVars/Mention.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 module Agda.TypeChecking.MetaVars.Mention where
 
 import Agda.Syntax.Common
@@ -6,7 +9,7 @@ import Agda.Syntax.Internal as I
 import Agda.TypeChecking.Monad
 
 import Agda.Utils.Impossible
-#include "../../undefined.h"
+#include "undefined.h"
 
 class MentionsMeta t where
   mentionsMeta :: MetaId -> t -> Bool
diff --git a/src/full/Agda/TypeChecking/MetaVars/Occurs.hs b/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
index b819621..c0ee637 100644
--- a/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
+++ b/src/full/Agda/TypeChecking/MetaVars/Occurs.hs
@@ -1,12 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.MetaVars.Occurs where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 
@@ -23,11 +22,18 @@ import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Free hiding (Occurrence(..))
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Records
-import Agda.TypeChecking.Datatypes (isDataOrRecordType)
 import {-# SOURCE #-} Agda.TypeChecking.MetaVars
 -- import Agda.TypeChecking.MetaVars
 
 import Agda.Utils.Either
+
+import Agda.Utils.Except
+  ( ExceptT
+  , MonadError(catchError, throwError)
+  , runExceptT
+  )
+
+import Agda.Utils.Lens
 import Agda.Utils.List (takeWhileJust)
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
@@ -35,7 +41,7 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 import qualified Agda.Utils.VarSet as VarSet
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 {- To address issue 585 (meta var occurrences in mutual defs)
@@ -74,8 +80,7 @@ successful).  This way, we do not duplicate work.
 -}
 
 modifyOccursCheckDefs :: (Set QName -> Set QName) -> TCM ()
-modifyOccursCheckDefs f = modify $ \ st ->
-  st { stOccursCheckDefs = f (stOccursCheckDefs st) }
+modifyOccursCheckDefs f = stOccursCheckDefs %= f
 
 -- | Set the names of definitions to be looked at
 --   to the defs in the current mutual block.
@@ -87,7 +92,7 @@ initOccursCheck mv = modifyOccursCheckDefs . const =<<
 
 -- | Is a def in the list of stuff to be checked?
 defNeedsChecking :: QName -> TCM Bool
-defNeedsChecking d = Set.member d <$> gets stOccursCheckDefs
+defNeedsChecking d = Set.member d <$> use stOccursCheckDefs
 
 -- | Remove a def from the list of defs to be looked at.
 tallyDef :: QName -> TCM ()
@@ -226,14 +231,14 @@ instance Occurs Term where
                 abort (strongly ctx) $ MetaCannotDependOn m (takeRelevant xs) i
               -- is a singleton type with unique inhabitant sv
               Right (Just sv) -> return $ sv `applyE` es
-        Lam h f	    -> Lam h <$> occ (leaveTop ctx) f
+        Lam h f     -> Lam h <$> occ (leaveTop ctx) f
         Level l     -> Level <$> occ ctx l  -- stay in Top
-        Lit l	    -> return v
+        Lit l       -> return v
         DontCare v  -> dontCare <$> occurs red Irrel m (goIrrelevant xs) v
         Def d es    -> Def d <$> occDef d (leaveTop ctx) es
         Con c vs    -> Con c <$> occ (leaveTop ctx) vs  -- if strongly rigid, remain so
-        Pi a b	    -> uncurry Pi <$> occ (leaveTop ctx) (a,b)
-        Sort s	    -> Sort <$> occ (leaveTop ctx) s
+        Pi a b      -> uncurry Pi <$> occ (leaveTop ctx) (a,b)
+        Sort s      -> Sort <$> occ (leaveTop ctx) s
         v at Shared{}  -> updateSharedTerm (occ ctx) v
         ExtLam{}    -> __IMPOSSIBLE__
         MetaV m' es -> do
@@ -442,7 +447,7 @@ instance Occurs a => Occurs [a] where
 --   reduction for a suitable instantiation of the meta variable.
 prune :: MetaId -> Args -> [Nat] -> TCM PruneResult
 prune m' vs xs = do
-  caseEitherM (runErrorT $ mapM (hasBadRigid xs) $ map unArg vs)
+  caseEitherM (runExceptT $ mapM (hasBadRigid xs) $ map unArg vs)
     (const $ return PrunedNothing) $ \ kills -> do
   reportSDoc "tc.meta.kill" 10 $ vcat
     [ text "attempting kills"
@@ -470,7 +475,7 @@ prune m' vs xs = do
 --   @hasBadRigid xs v = Nothing@ means that
 --   we cannot prune at all as one of the meta args is matchable.
 --   (See issue 1147.)
-hasBadRigid :: [Nat] -> Term -> ErrorT () TCM Bool
+hasBadRigid :: [Nat] -> Term -> ExceptT () TCM Bool
 hasBadRigid xs t = do
   -- We fail if we encounter a matchable argument.
   let failure = throwError ()
@@ -590,7 +595,7 @@ killedType :: [(I.Dom (ArgName, Type), Bool)] -> Type -> ([I.Arg Bool], Type)
 killedType [] b = ([], b)
 killedType ((arg@(Dom info _), kill) : kills) b
   | dontKill  = (Arg info False : args, mkPi arg b') -- OLD: telePi (telFromList [arg]) b')
-  | otherwise = (Arg info True  : args, subst __IMPOSSIBLE__ b')
+  | otherwise = (Arg info True  : args, strengthen __IMPOSSIBLE__ b')
   where
     (args, b') = killedType kills b
     dontKill = not kill || 0 `freeIn` b'
@@ -608,14 +613,15 @@ performKill kills m a = do
   etaExpandMetaSafe m'
   let vars = reverse [ Arg info (var i) | (i, Arg info False) <- zip [0..] kills ]
       lam b a = Lam (argInfo a) (Abs "v" b)
-      u       = foldl' lam (MetaV m' $ map Apply vars) kills
+      tel     = map ("v" <$) (reverse kills)
+      u       = MetaV m' $ map Apply vars
 {- OLD CODE
       hs   = reverse [ argHiding a | a <- kills ]
       lam h b = Lam h (Abs "v" b)
       u       = foldr lam (MetaV m' vars) hs
 -}
   dbg m' u
-  assignTerm m u
+  assignTerm m tel u
   where
     dbg m' u = reportSDoc "tc.meta.kill" 10 $ vcat
       [ text "actual killing"
diff --git a/src/full/Agda/TypeChecking/Monad/Base.hs b/src/full/Agda/TypeChecking/Monad/Base.hs
index 1145491..186c546 100644
--- a/src/full/Agda/TypeChecking/Monad/Base.hs
+++ b/src/full/Agda/TypeChecking/Monad/Base.hs
@@ -1,18 +1,18 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE ExistentialQuantification  #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE Rank2Types                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 module Agda.TypeChecking.Monad.Base where
 
@@ -20,7 +20,6 @@ import Control.Arrow ((***), first, second)
 import qualified Control.Concurrent as C
 import Control.DeepSeq
 import Control.Exception as E
-import Control.Monad.Error
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Writer
@@ -29,10 +28,12 @@ import Control.Applicative
 
 import Data.Function
 import Data.Int
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import qualified Data.List as List
+import Data.Maybe
 import Data.Map as Map
 import Data.Set as Set
-import Data.Sequence as Seq
 import Data.Typeable (Typeable)
 import Data.Foldable
 import Data.Traversable
@@ -45,6 +46,8 @@ import qualified Agda.Syntax.Concrete as C
 import qualified Agda.Syntax.Concrete.Definitions as D
 import qualified Agda.Syntax.Abstract as A
 import Agda.Syntax.Internal as I
+import Agda.Syntax.Internal.Pattern ()
+import Agda.Syntax.Fixity
 import Agda.Syntax.Position
 import Agda.Syntax.Scope.Base
 
@@ -63,75 +66,106 @@ import qualified Agda.Compiler.JS.Syntax as JS
 import Agda.TypeChecking.Monad.Base.Benchmark (Benchmark)
 import qualified Agda.TypeChecking.Monad.Base.Benchmark as Benchmark
 
+import Agda.Utils.Except
+  ( Error(noMsg, strMsg)
+  , ExceptT
+  , MonadError(catchError, throwError)
+  )
+
 import Agda.Utils.FileName
-import Agda.Utils.Fresh
 import Agda.Utils.HashMap as HMap
 import Agda.Utils.Hash
+import Agda.Utils.Lens
 import Agda.Utils.Permutation
 import Agda.Utils.Pretty
 import Agda.Utils.Time
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
 -- * Type checking state
 ---------------------------------------------------------------------------
 
-data TCState =
-    TCSt { stFreshThings       :: FreshThings
-         , stSyntaxInfo        :: CompressedFile
-           -- ^ Highlighting info.
-         , stTokens            :: CompressedFile
-           -- ^ Highlighting info for tokens (but not those tokens for
-           -- which highlighting exists in 'stSyntaxInfo').
-         , stTermErrs          :: Seq TerminationError
-	 , stMetaStore	       :: MetaStore
-	 , stInteractionPoints :: InteractionPoints
-	 , stAwakeConstraints    :: Constraints
-	 , stSleepingConstraints :: Constraints
-         , stDirty               :: Bool
-         , stOccursCheckDefs   :: Set QName
-           -- ^ Definitions to be considered during occurs check.
-           --   Initialized to the current mutual block before the check.
-           --   During occurs check, we remove definitions from this set
-           --   as soon we have checked them.
-	 , stSignature	       :: Signature
-           -- ^ Declared identifiers of the current file.
-           --   These will be serialized after successful type checking.
-	 , stImports	       :: Signature
-           -- ^ Imported declared identifiers.
-           --   Those most not be serialized!
-	 , stImportedModules   :: Set ModuleName
-         , stModuleToSource    :: ModuleToSource
-	 , stVisitedModules    :: VisitedModules
-         , stCurrentModule     :: Maybe ModuleName
-           -- ^ The current module is available after it has been type
-           -- checked.
-	 , stScope	       :: ScopeInfo
-         , stPatternSyns       :: A.PatternSynDefns
-           -- ^ Pattern synonyms of the current file.  Serialized.
-         , stPatternSynImports :: A.PatternSynDefns
-           -- ^ Imported pattern synonyms.  Must not be serialized!
-         , stInstanceDefs      :: TempInstanceTable
-	 , stPragmaOptions     :: PragmaOptions
-           -- ^ Options applying to the current file. @OPTIONS@
-           -- pragmas only affect this field.
-	 , stStatistics	       :: Statistics
-           -- ^ Counters to collect various statistics about meta variables etc.
-	 , stMutualBlocks      :: Map MutualId (Set QName)
-	 , stLocalBuiltins     :: BuiltinThings PrimFun
-         , stImportedBuiltins  :: BuiltinThings PrimFun
-         , stHaskellImports    :: Set String
-           -- ^ Imports that should be generated by the compiler (this
-           -- includes imports from imported modules).
-         , stPersistent        :: PersistentTCState
-           -- ^ Options which apply to all files, unless overridden.
-  	 }
+data TCState = TCSt
+  { stPreScopeState   :: !PreScopeState
+    -- ^ The state which is frozen after scope checking.
+  , stPostScopeState  :: !PostScopeState
+    -- ^ The state which is modified after scope checking.
+  , stPersistentState :: !PersistentTCState
+    -- ^ State which is forever, like a diamond.
+  }
+
+data PreScopeState = PreScopeState
+  { stPreTokens             :: CompressedFile -- from lexer
+    -- ^ Highlighting info for tokens (but not those tokens for
+    -- which highlighting exists in 'stSyntaxInfo').
+  , stPreInteractionPoints  :: InteractionPoints -- scope checker first
+  , stPreImports            :: Signature  -- XX populated by scopec hecker
+    -- ^ Imported declared identifiers.
+    --   Those most not be serialized!
+  , stPreImportedModules    :: Set ModuleName  -- imports logic
+  , stPreModuleToSource     :: ModuleToSource   -- imports
+  , stPreVisitedModules     :: VisitedModules   -- imports
+  , stPreScope              :: ScopeInfo
+    -- generated by scope checker, current file: which modules you have, public definitions, current file, maps concrete names to abstract names.
+  , stPrePatternSyns        :: A.PatternSynDefns
+    -- ^ Pattern synonyms of the current file.  Serialized.
+  , stPrePatternSynImports  :: A.PatternSynDefns
+    -- ^ Imported pattern synonyms.  Must not be serialized!
+  , stPrePragmaOptions      :: PragmaOptions
+    -- ^ Options applying to the current file. @OPTIONS@
+    -- pragmas only affect this field.
+  , stPreImportedBuiltins   :: BuiltinThings PrimFun
+  , stPreHaskellImports     :: Set String
+    -- ^ Imports that should be generated by the compiler (this
+    -- includes imports from imported modules).
+  , stPreFreshInteractionId :: InteractionId
+  , stPreFreshNameId        :: NameId
+  }
+
+type DisambiguatedNames = IntMap A.QName
+
+data PostScopeState = PostScopeState
+  { stPostSyntaxInfo          :: CompressedFile
+    -- ^ Highlighting info.
+  , stPostDisambiguatedNames  :: !DisambiguatedNames
+    -- ^ Disambiguation carried out by the type checker.
+    --   Maps position of first name character to disambiguated @'A.QName'@
+    --   for each @'A.AmbiguousQName'@ already passed by the type checker.
+  , stPostMetaStore           :: MetaStore
+  , stPostInteractionPoints   :: InteractionPoints -- scope checker first
+  , stPostAwakeConstraints    :: Constraints
+  , stPostSleepingConstraints :: Constraints
+  , stPostDirty               :: Bool -- local
+    -- ^ Dirty when a constraint is added, used to prevent pointer update.
+    -- Currently unused.
+  , stPostOccursCheckDefs     :: Set QName -- local
+    -- ^ Definitions to be considered during occurs check.
+    --   Initialized to the current mutual block before the check.
+    --   During occurs check, we remove definitions from this set
+    --   as soon we have checked them.
+  , stPostSignature           :: Signature
+    -- ^ Declared identifiers of the current file.
+    --   These will be serialized after successful type checking.
+  , stPostCurrentModule       :: Maybe ModuleName
+    -- ^ The current module is available after it has been type
+    -- checked.
+  , stPostInstanceDefs        :: TempInstanceTable
+  , stPostStatistics          :: Statistics
+    -- ^ Counters to collect various statistics about meta variables etc.
+    --   Only for current file.
+  , stPostMutualBlocks        :: Map MutualId (Set QName)
+  , stPostLocalBuiltins       :: BuiltinThings PrimFun
+  , stPostFreshMetaId         :: MetaId
+  , stPostFreshMutualId       :: MutualId
+  , stPostFreshCtxId          :: CtxId
+  , stPostFreshProblemId      :: ProblemId
+  , stPostFreshInt            :: Int
+  }
 
 -- | A part of the state which is not reverted when an error is thrown
 -- or the state is reset.
-
 data PersistentTCState = PersistentTCSt
   { stDecodedModules    :: DecodedModules
   , stPersistentOptions :: CommandLineOptions
@@ -142,6 +176,8 @@ data PersistentTCState = PersistentTCSt
   , stBenchmark         :: !Benchmark
     -- ^ Structure to track how much CPU time was spent on which Agda phase.
     --   Needs to be a strict field to avoid space leaks!
+  , stAccumStatistics   :: !Statistics
+    -- ^ Should be strict field.
   }
 
 -- | Empty persistent state.
@@ -152,85 +188,259 @@ initPersistentState = PersistentTCSt
   , stDecodedModules            = Map.empty
   , stInteractionOutputCallback = defaultInteractionOutputCallback
   , stBenchmark                 = Benchmark.empty
+  , stAccumStatistics           = Map.empty
   }
 
-data FreshThings =
-	Fresh { fMeta	     :: MetaId
-	      , fInteraction :: InteractionId
-	      , fMutual	     :: MutualId
-	      , fName	     :: NameId
-	      , fCtx	     :: CtxId
-              , fProblem     :: ProblemId
-              , fInt         :: Int
-                -- ^ Can be used for various things.
-	      }
-    deriving (Show)
-
 -- | Empty state of type checker.
 
+initPreScopeState :: PreScopeState
+initPreScopeState = PreScopeState
+  { stPreTokens               = mempty
+  , stPreInteractionPoints    = Map.empty
+  , stPreImports              = emptySignature
+  , stPreImportedModules      = Set.empty
+  , stPreModuleToSource       = Map.empty
+  , stPreVisitedModules       = Map.empty
+  , stPreScope                = emptyScopeInfo
+  , stPrePatternSyns          = Map.empty
+  , stPrePatternSynImports    = Map.empty
+  , stPrePragmaOptions        = defaultInteractionOptions
+  , stPreImportedBuiltins     = Map.empty
+  , stPreHaskellImports       = Set.empty
+  , stPreFreshInteractionId   = 0
+  , stPreFreshNameId          = NameId 0 0
+  }
+
+initPostScopeState :: PostScopeState
+initPostScopeState = PostScopeState
+  { stPostSyntaxInfo           = mempty
+  , stPostDisambiguatedNames   = IntMap.empty
+  , stPostMetaStore            = Map.empty
+  , stPostInteractionPoints    = Map.empty
+  , stPostAwakeConstraints     = []
+  , stPostSleepingConstraints  = []
+  , stPostDirty                = False
+  , stPostOccursCheckDefs      = Set.empty
+  , stPostSignature            = emptySignature
+  , stPostCurrentModule        = Nothing
+  , stPostInstanceDefs         = (Map.empty , [])
+  , stPostStatistics           = Map.empty
+  , stPostMutualBlocks         = Map.empty
+  , stPostLocalBuiltins        = Map.empty
+  , stPostFreshMetaId          = 0
+  , stPostFreshMutualId        = 0
+  , stPostFreshCtxId           = 0
+  , stPostFreshProblemId       = 1
+  , stPostFreshInt             = 0
+  }
+
 initState :: TCState
 initState = TCSt
-  { stFreshThings          = (Fresh 0 0 0 (NameId 0 0) 0 0 0) { fProblem = 1 }
-  , stMetaStore            = Map.empty
-  , stSyntaxInfo           = mempty
-  , stTokens               = mempty
-  , stTermErrs             = Seq.empty
-  , stInteractionPoints    = Map.empty
-  , stAwakeConstraints     = []
-  , stSleepingConstraints  = []
-  , stDirty                = False
-  , stOccursCheckDefs      = Set.empty
-  , stSignature            = emptySignature
-  , stImports              = emptySignature
-  , stImportedModules      = Set.empty
-  , stModuleToSource       = Map.empty
-  , stVisitedModules       = Map.empty
-  , stCurrentModule        = Nothing
-  , stScope                = emptyScopeInfo
-  , stPatternSyns          = Map.empty
-  , stPatternSynImports    = Map.empty
-  , stInstanceDefs         = (Map.empty , [])
-  , stPragmaOptions        = defaultInteractionOptions
-  , stStatistics	   = Map.empty
-  , stMutualBlocks         = Map.empty
-  , stLocalBuiltins        = Map.empty
-  , stImportedBuiltins     = Map.empty
-  , stHaskellImports       = Set.empty
-  , stPersistent           = initPersistentState
+  { stPreScopeState   = initPreScopeState
+  , stPostScopeState  = initPostScopeState
+  , stPersistentState = initPersistentState
   }
 
+-- * st-prefixed lenses
+------------------------------------------------------------------------
+
+stTokens :: Lens' CompressedFile TCState
+stTokens f s =
+  f (stPreTokens (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreTokens = x}}
+
+stImports :: Lens' Signature TCState
+stImports f s =
+  f (stPreImports (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreImports = x}}
+
+stImportedModules :: Lens' (Set ModuleName) TCState
+stImportedModules f s =
+  f (stPreImportedModules (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreImportedModules = x}}
+
+stModuleToSource :: Lens' ModuleToSource TCState
+stModuleToSource f s =
+  f (stPreModuleToSource (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreModuleToSource = x}}
+
+stVisitedModules :: Lens' VisitedModules TCState
+stVisitedModules f s =
+  f (stPreVisitedModules (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreVisitedModules = x}}
+
+stScope :: Lens' ScopeInfo TCState
+stScope f s =
+  f (stPreScope (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreScope = x}}
+
+stPatternSyns :: Lens' A.PatternSynDefns TCState
+stPatternSyns f s =
+  f (stPrePatternSyns (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPrePatternSyns = x}}
+
+stPatternSynImports :: Lens' A.PatternSynDefns TCState
+stPatternSynImports f s =
+  f (stPrePatternSynImports (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPrePatternSynImports = x}}
+
+stPragmaOptions :: Lens' PragmaOptions TCState
+stPragmaOptions f s =
+  f (stPrePragmaOptions (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPrePragmaOptions = x}}
+
+stImportedBuiltins :: Lens' (BuiltinThings PrimFun) TCState
+stImportedBuiltins f s =
+  f (stPreImportedBuiltins (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreImportedBuiltins = x}}
+
+stHaskellImports :: Lens' (Set String) TCState
+stHaskellImports f s =
+  f (stPreHaskellImports (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreHaskellImports = x}}
+
+stFreshInteractionId :: Lens' InteractionId TCState
+stFreshInteractionId f s =
+  f (stPreFreshInteractionId (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreFreshInteractionId = x}}
+
+stFreshNameId :: Lens' NameId TCState
+stFreshNameId f s =
+  f (stPreFreshNameId (stPreScopeState s)) <&>
+  \x -> s {stPreScopeState = (stPreScopeState s) {stPreFreshNameId = x}}
+
+stSyntaxInfo :: Lens' CompressedFile TCState
+stSyntaxInfo f s =
+  f (stPostSyntaxInfo (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostSyntaxInfo = x}}
+
+stDisambiguatedNames :: Lens' DisambiguatedNames TCState
+stDisambiguatedNames f s =
+  f (stPostDisambiguatedNames (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostDisambiguatedNames = x}}
+
+stMetaStore :: Lens' MetaStore TCState
+stMetaStore f s =
+  f (stPostMetaStore (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostMetaStore = x}}
+
+stInteractionPoints :: Lens' InteractionPoints TCState
+stInteractionPoints f s =
+  f (stPostInteractionPoints (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostInteractionPoints = x}}
+
+stAwakeConstraints :: Lens' Constraints TCState
+stAwakeConstraints f s =
+  f (stPostAwakeConstraints (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostAwakeConstraints = x}}
+
+stSleepingConstraints :: Lens' Constraints TCState
+stSleepingConstraints f s =
+  f (stPostSleepingConstraints (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostSleepingConstraints = x}}
+
+stDirty :: Lens' Bool TCState
+stDirty f s =
+  f (stPostDirty (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostDirty = x}}
+
+stOccursCheckDefs :: Lens' (Set QName) TCState
+stOccursCheckDefs f s =
+  f (stPostOccursCheckDefs (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostOccursCheckDefs = x}}
+
+stSignature :: Lens' Signature TCState
+stSignature f s =
+  f (stPostSignature (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostSignature = x}}
+
+stCurrentModule :: Lens' (Maybe ModuleName) TCState
+stCurrentModule f s =
+  f (stPostCurrentModule (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostCurrentModule = x}}
+
+stInstanceDefs :: Lens' TempInstanceTable TCState
+stInstanceDefs f s =
+  f (stPostInstanceDefs (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostInstanceDefs = x}}
+
+stStatistics :: Lens' Statistics TCState
+stStatistics f s =
+  f (stPostStatistics (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostStatistics = x}}
+
+stMutualBlocks :: Lens' (Map MutualId (Set QName)) TCState
+stMutualBlocks f s =
+  f (stPostMutualBlocks (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostMutualBlocks = x}}
+
+stLocalBuiltins :: Lens' (BuiltinThings PrimFun) TCState
+stLocalBuiltins f s =
+  f (stPostLocalBuiltins (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostLocalBuiltins = x}}
+
+stFreshMetaId :: Lens' MetaId TCState
+stFreshMetaId f s =
+  f (stPostFreshMetaId (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostFreshMetaId = x}}
+
+stFreshMutualId :: Lens' MutualId TCState
+stFreshMutualId f s =
+  f (stPostFreshMutualId (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostFreshMutualId = x}}
+
+stFreshCtxId :: Lens' CtxId TCState
+stFreshCtxId f s =
+  f (stPostFreshCtxId (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostFreshCtxId = x}}
+
+stFreshProblemId :: Lens' ProblemId TCState
+stFreshProblemId f s =
+  f (stPostFreshProblemId (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostFreshProblemId = x}}
+
+stFreshInt :: Lens' Int TCState
+stFreshInt f s =
+  f (stPostFreshInt (stPostScopeState s)) <&>
+  \x -> s {stPostScopeState = (stPostScopeState s) {stPostFreshInt = x}}
+
 stBuiltinThings :: TCState -> BuiltinThings PrimFun
-stBuiltinThings s = stLocalBuiltins s `Map.union` stImportedBuiltins s
-
-instance HasFresh MetaId FreshThings where
-    nextFresh s = (i, s { fMeta = i + 1 })
-	where
-	    i = fMeta s
-
-instance HasFresh MutualId FreshThings where
-    nextFresh s = (i, s { fMutual = i + 1 })
-	where
-	    i = fMutual s
-
-instance HasFresh InteractionId FreshThings where
-    nextFresh s = (i, s { fInteraction = i + 1 })
-	where
-	    i = fInteraction s
-
-instance HasFresh NameId FreshThings where
-    nextFresh s = (i, s { fName = succ i })
-	where
-	    i = fName s
-
-instance HasFresh CtxId FreshThings where
-    nextFresh s = (i, s { fCtx = succ i })
-	where
-	    i = fCtx s
-
-instance HasFresh Int FreshThings where
-    nextFresh s = (i, s { fInt = succ i })
-	where
-	    i = fInt s
+stBuiltinThings s = (s^.stLocalBuiltins) `Map.union` (s^.stImportedBuiltins)
+
+-- * Fresh things
+------------------------------------------------------------------------
+
+class Enum i => HasFresh i where
+    freshLens :: Lens' i TCState
+
+nextFresh :: HasFresh i => TCState -> (i, TCState)
+nextFresh s =
+  let c = s^.freshLens
+  in (c, set freshLens (succ c) s)
+
+fresh :: (HasFresh i, MonadState TCState m) => m i
+fresh =
+    do  c <- use freshLens
+        freshLens .= succ c
+        return c
+
+instance HasFresh MetaId where
+  freshLens = stFreshMetaId
+
+instance HasFresh MutualId where
+  freshLens = stFreshMutualId
+
+instance HasFresh InteractionId where
+  freshLens = stFreshInteractionId
+
+instance HasFresh NameId where
+  freshLens = stFreshNameId
+
+instance HasFresh CtxId where
+  freshLens = stFreshCtxId
+
+instance HasFresh Int where
+  freshLens = stFreshInt
 
 newtype ProblemId = ProblemId Nat
   deriving (Typeable, Eq, Ord, Enum, Real, Integral, Num)
@@ -238,15 +448,37 @@ newtype ProblemId = ProblemId Nat
 instance Show ProblemId where
   show (ProblemId n) = show n
 
-instance HasFresh ProblemId FreshThings where
-  nextFresh s = (i, s { fProblem = succ i })
-    where i = fProblem s
+instance HasFresh ProblemId where
+  freshLens = stFreshProblemId
+
+freshName :: (MonadState TCState m, HasFresh NameId) => Range -> String -> m Name
+freshName r s = do
+  i <- fresh
+  return $ mkName r i s
+
+freshNoName :: (MonadState TCState m, HasFresh NameId) => Range -> m Name
+freshNoName r =
+    do  i <- fresh
+        return $ Name i (C.NoName noRange i) r defaultFixity'
+
+freshNoName_ :: (MonadState TCState m, HasFresh NameId) => m Name
+freshNoName_ = freshNoName noRange
 
-instance HasFresh i FreshThings => HasFresh i TCState where
-    nextFresh s = ((,) $! i) $! s { stFreshThings = f }
-	where
-	    (i, f) = nextFresh $ stFreshThings s
+-- | Create a fresh name from @a at .
+class FreshName a where
+  freshName_ :: (MonadState TCState m, HasFresh NameId) => a -> m Name
 
+instance FreshName (Range, String) where
+  freshName_ = uncurry freshName
+
+instance FreshName String where
+  freshName_ = freshName noRange
+
+instance FreshName Range where
+  freshName_ = freshNoName
+
+instance FreshName () where
+  freshName_ () = freshNoName_
 
 ---------------------------------------------------------------------------
 -- ** Managing file names
@@ -269,8 +501,7 @@ sourceToModule =
   Map.fromList
      .  List.map (\(m, f) -> (f, m))
      .  Map.toList
-     .  stModuleToSource
-    <$> get
+    <$> use stModuleToSource
 
 ---------------------------------------------------------------------------
 -- ** Interface
@@ -298,10 +529,15 @@ data Interface = Interface
   , iModuleName      :: ModuleName
     -- ^ Module name of this interface.
   , iScope           :: Map ModuleName Scope
+    -- ^ Scope defined by this module.
   , iInsideScope     :: ScopeInfo
     -- ^ Scope after we loaded this interface.
     --   Used in 'Agda.Interaction.BasicOps.AtTopLevel'
     --   and     'Agda.Interaction.CommandLine.CommandLine.interactionLoop'.
+    --
+    --   Andreas, AIM XX: For performance reason, this field is
+    --   not serialized, so if you deserialize an interface, @iInsideScope@
+    --   will be empty.  You need to type-check the file to get @iInsideScope at .
   , iSignature       :: Signature
   , iBuiltin         :: BuiltinThings (String, QName)
   , iHaskellImports  :: Set String
@@ -324,10 +560,10 @@ iFullHash i = combineHashes $ iSourceHash i : List.map snd (iImportedModules i)
 ---------------------------------------------------------------------------
 
 data Closure a = Closure { clSignature  :: Signature
-			 , clEnv	:: TCEnv
-			 , clScope	:: ScopeInfo
-			 , clValue	:: a
-			 }
+                         , clEnv        :: TCEnv
+                         , clScope      :: ScopeInfo
+                         , clValue      :: a
+                         }
     deriving (Typeable)
 
 instance Show a => Show (Closure a) where
@@ -339,8 +575,8 @@ instance HasRange a => HasRange (Closure a) where
 buildClosure :: a -> TCM (Closure a)
 buildClosure x = do
     env   <- ask
-    sig   <- gets stSignature
-    scope <- gets stScope
+    sig   <- use stSignature
+    scope <- use stScope
     return $ Closure sig env scope x
 
 ---------------------------------------------------------------------------
@@ -439,8 +675,8 @@ data Open a = OpenThing { openThingCtxIds :: [CtxId], openThing :: a }
 ---------------------------------------------------------------------------
 
 data Judgement t a
-	= HasType { jMetaId :: a, jMetaType :: t }
-	| IsSort  { jMetaId :: a, jMetaType :: t } -- Andreas, 2011-04-26: type needed for higher-order sort metas
+        = HasType { jMetaId :: a, jMetaType :: t }
+        | IsSort  { jMetaId :: a, jMetaType :: t } -- Andreas, 2011-04-26: type needed for higher-order sort metas
     deriving (Typeable, Functor, Foldable, Traversable)
 
 instance (Show t, Show a) => Show (Judgement t a) where
@@ -452,17 +688,17 @@ instance (Show t, Show a) => Show (Judgement t a) where
 ---------------------------------------------------------------------------
 
 data MetaVariable =
-	MetaVar	{ mvInfo	  :: MetaInfo
-		, mvPriority	  :: MetaPriority -- ^ some metavariables are more eager to be instantiated
+        MetaVar { mvInfo          :: MetaInfo
+                , mvPriority      :: MetaPriority -- ^ some metavariables are more eager to be instantiated
                 , mvPermutation   :: Permutation
                   -- ^ a metavariable doesn't have to depend on all variables
                   --   in the context, this "permutation" will throw away the
                   --   ones it does not depend on
-		, mvJudgement	  :: Judgement Type MetaId
-		, mvInstantiation :: MetaInstantiation
-		, mvListeners	  :: Set Listener -- ^ meta variables scheduled for eta-expansion but blocked by this one
+                , mvJudgement     :: Judgement Type MetaId
+                , mvInstantiation :: MetaInstantiation
+                , mvListeners     :: Set Listener -- ^ meta variables scheduled for eta-expansion but blocked by this one
                 , mvFrozen        :: Frozen -- ^ are we past the point where we can instantiate this meta variable?
-		}
+                }
     deriving (Typeable)
 
 data Listener = EtaExpand MetaId
@@ -490,11 +726,11 @@ data Frozen
     deriving (Eq, Show)
 
 data MetaInstantiation
-	= InstV Term         -- ^ solved by term
-	| InstS Term         -- ^ solved by @Lam .. Sort s@
-	| Open               -- ^ unsolved
-	| OpenIFS            -- ^ open, to be instantiated as "implicit from scope"
-	| BlockedConst Term  -- ^ solution blocked by unsolved constraints
+        = InstV [Arg String] Term -- ^ solved by term (abstracted over some free variables)
+        | InstS Term         -- ^ solved by @Lam .. Sort s@
+        | Open               -- ^ unsolved
+        | OpenIFS            -- ^ open, to be instantiated as "implicit from scope"
+        | BlockedConst Term  -- ^ solution blocked by unsolved constraints
         | PostponedTypeCheckingProblem (Closure TypeCheckingProblem) (TCM Bool)
     deriving (Typeable)
 
@@ -504,7 +740,7 @@ data TypeCheckingProblem
   deriving (Typeable)
 
 instance Show MetaInstantiation where
-  show (InstV t) = "InstV (" ++ show t ++ ")"
+  show (InstV tel t) = "InstV " ++ show tel ++ " (" ++ show t ++ ")"
   show (InstS s) = "InstS (" ++ show s ++ ")"
   show Open      = "Open"
   show OpenIFS   = "OpenIFS"
@@ -615,17 +851,17 @@ data Signature = Sig
       }
   deriving (Typeable, Show)
 
-type Sections	 = Map ModuleName Section
+type Sections    = Map ModuleName Section
 type Definitions = HashMap QName Definition
 
 data Section = Section
       { secTelescope :: Telescope
-      , secFreeVars  :: Nat	    -- ^ This is the number of parameters when
-				    --	 we're inside the section and 0
-				    --	 outside. It's used to know how much of
-				    --	 the context to apply function from the
-				    --	 section to when translating from
-				    --	 abstract to internal syntax.
+      , secFreeVars  :: Nat         -- ^ This is the number of parameters when
+                                    --   we're inside the section and 0
+                                    --   outside. It's used to know how much of
+                                    --   the context to apply function from the
+                                    --   section to when translating from
+                                    --   abstract to internal syntax.
       }
   deriving (Typeable, Show)
 
@@ -666,7 +902,7 @@ data DisplayTerm
     --   The list of 'DisplayTerm's are the with expressions @ws at .
     --   The 'Args' are additional arguments @us@
     --   (possible in case the with-application is of function type).
-  | DCon QName [Arg DisplayTerm]
+  | DCon ConHead [Arg DisplayTerm]
     -- ^ @c vs at .
   | DDef QName [Arg DisplayTerm]
     -- ^ @d vs at .
@@ -680,8 +916,11 @@ data DisplayTerm
 defaultDisplayForm :: QName -> [Open DisplayForm]
 defaultDisplayForm c = []
 
+defRelevance :: Definition -> Relevance
 defRelevance = argInfoRelevance . defArgInfo
-defColors    = argInfoColors    . defArgInfo
+
+defColors :: Definition -> [Color]
+defColors = argInfoColors . defArgInfo
 
 type RewriteRules = [RewriteRule]
 
@@ -699,7 +938,7 @@ data RewriteRule = RewriteRule
 data Definition = Defn
   { defArgInfo        :: ArgInfo -- ^ Hiding should not be used.
   , defName           :: QName
-  , defType           :: Type	 -- ^ Type of the lifted definition.
+  , defType           :: Type    -- ^ Type of the lifted definition.
   , defPolarity       :: [Polarity]
   , defArgOccurrences :: [Occurrence]
   , defDisplay        :: [Open DisplayForm]
@@ -801,7 +1040,7 @@ data Projection = Projection
 
 data Defn = Axiom
             -- ^ Postulate.
-	  | Function
+          | Function
             { funClauses        :: [Clause]
             , funCompiled       :: Maybe CompiledClauses
               -- ^ 'Nothing' while function is still type-checked.
@@ -834,8 +1073,10 @@ data Defn = Axiom
             , funWith           :: Maybe QName
               -- ^ Is this a generated with-function? If yes, then what's the
               --   name of the parent function.
+            , funCopatternLHS   :: Bool
+              -- ^ Is this a function defined by copatterns?
             }
-	  | Datatype
+          | Datatype
             { dataPars           :: Nat            -- ^ Number of parameters.
             , dataSmallPars      :: Permutation    -- ^ Parameters that are maybe small.
             , dataNonLinPars     :: Drop Permutation  -- ^ Parameters that appear in indices.
@@ -847,7 +1088,7 @@ data Defn = Axiom
             , dataMutual         :: [QName]        -- ^ Mutually recursive functions, @data at s and @record at s.  Does not include this data type.
             , dataAbstr          :: IsAbstract
             }
-	  | Record
+          | Record
             { recPars           :: Nat                  -- ^ Number of parameters.
             , recClause         :: Maybe Clause
             , recConHead        :: ConHead              -- ^ Constructor name and fields.
@@ -866,14 +1107,14 @@ data Defn = Axiom
             , recRecursive      :: Bool                 -- ^ Recursive record.  Implies @recEtaEquality = False at .  Projections are not size-preserving.
             , recAbstr          :: IsAbstract
             }
-	  | Constructor
+          | Constructor
             { conPars   :: Nat         -- ^ Number of parameters.
-	    , conSrcCon :: ConHead     -- ^ Name of (original) constructor and fields. (This might be in a module instance.)
-	    , conData   :: QName       -- ^ Name of datatype or record type.
-	    , conAbstr  :: IsAbstract
+            , conSrcCon :: ConHead     -- ^ Name of (original) constructor and fields. (This might be in a module instance.)
+            , conData   :: QName       -- ^ Name of datatype or record type.
+            , conAbstr  :: IsAbstract
             , conInd    :: Induction   -- ^ Inductive or coinductive?
             }
-	  | Primitive
+          | Primitive
             { primAbstr :: IsAbstract
             , primName  :: String
             , primClauses :: [Clause]
@@ -900,8 +1141,11 @@ emptyFunction = Function
   , funTerminates  = Nothing
   , funExtLam      = Nothing
   , funWith        = Nothing
+  , funCopatternLHS = False
   }
 
+isCopatternLHS :: [Clause] -> Bool
+isCopatternLHS = List.any (List.any (isJust . A.isProjP) . clausePats)
 
 recCon :: Defn -> QName
 recCon Record{ recConHead } = conName recConHead
@@ -979,10 +1223,10 @@ allReductions :: AllowedReductions
 allReductions = [minBound..pred maxBound]
 
 data PrimFun = PrimFun
-	{ primFunName		:: QName
-	, primFunArity		:: Arity
-	, primFunImplementation :: [Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term)
-	}
+        { primFunName           :: QName
+        , primFunArity          :: Arity
+        , primFunImplementation :: [Arg Term] -> ReduceM (Reduced MaybeReducedArgs Term)
+        }
     deriving (Typeable)
 
 defClauses :: Definition -> [Clause]
@@ -1048,7 +1292,7 @@ data TermHead = SortHead
 ---------------------------------------------------------------------------
 
 newtype MutualId = MutId Int32
-  deriving (Typeable, Eq, Ord, Show, Num)
+  deriving (Typeable, Eq, Ord, Show, Num, Enum)
 
 ---------------------------------------------------------------------------
 -- ** Statistics
@@ -1061,31 +1305,31 @@ type Statistics = Map String Integer
 ---------------------------------------------------------------------------
 
 data Call = CheckClause Type A.SpineClause (Maybe Clause)
-	  | forall a. CheckPattern A.Pattern Telescope Type (Maybe a)
-	  | CheckLetBinding A.LetBinding (Maybe ())
-	  | InferExpr A.Expr (Maybe (Term, Type))
-	  | CheckExprCall A.Expr Type (Maybe Term)
-	  | CheckDotPattern A.Expr Term (Maybe Constraints)
-	  | CheckPatternShadowing A.SpineClause (Maybe ())
-	  | IsTypeCall A.Expr Sort (Maybe Type)
-	  | IsType_ A.Expr (Maybe Type)
-	  | InferVar Name (Maybe (Term, Type))
-	  | InferDef Range QName (Maybe (Term, Type))
-	  | CheckArguments Range [NamedArg A.Expr] Type Type (Maybe (Args, Type))
-	  | CheckDataDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())
-	  | CheckRecDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())
-	  | CheckConstructor QName Telescope Sort A.Constructor (Maybe ())
-	  | CheckFunDef Range Name [A.Clause] (Maybe ())
-	  | CheckPragma Range A.Pragma (Maybe ())
-	  | CheckPrimitive Range Name A.Expr (Maybe ())
+          | forall a. CheckPattern A.Pattern Telescope Type (Maybe a)
+          | CheckLetBinding A.LetBinding (Maybe ())
+          | InferExpr A.Expr (Maybe (Term, Type))
+          | CheckExprCall A.Expr Type (Maybe Term)
+          | CheckDotPattern A.Expr Term (Maybe Constraints)
+          | CheckPatternShadowing A.SpineClause (Maybe ())
+          | IsTypeCall A.Expr Sort (Maybe Type)
+          | IsType_ A.Expr (Maybe Type)
+          | InferVar Name (Maybe (Term, Type))
+          | InferDef Range QName (Maybe (Term, Type))
+          | CheckArguments Range [NamedArg A.Expr] Type Type (Maybe (Args, Type))
+          | CheckDataDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())
+          | CheckRecDef Range Name [A.LamBinding] [A.Constructor] (Maybe ())
+          | CheckConstructor QName Telescope Sort A.Constructor (Maybe ())
+          | CheckFunDef Range Name [A.Clause] (Maybe ())
+          | CheckPragma Range A.Pragma (Maybe ())
+          | CheckPrimitive Range Name A.Expr (Maybe ())
           | CheckIsEmpty Range Type (Maybe ())
           | CheckWithFunctionType A.Expr (Maybe ())
           | CheckSectionApplication Range ModuleName A.ModuleApplication (Maybe ())
-	  | ScopeCheckExpr C.Expr (Maybe A.Expr)
-	  | ScopeCheckDeclaration D.NiceDeclaration (Maybe [A.Declaration])
-	  | ScopeCheckLHS C.Name C.Pattern (Maybe A.LHS)
+          | ScopeCheckExpr C.Expr (Maybe A.Expr)
+          | ScopeCheckDeclaration D.NiceDeclaration (Maybe [A.Declaration])
+          | ScopeCheckLHS C.Name C.Pattern (Maybe A.LHS)
           | forall a. NoHighlighting (Maybe a)
-	  | forall a. SetRange Range (Maybe a)	-- ^ used by 'setCurrentRange'
+          | forall a. SetRange Range (Maybe a)  -- ^ used by 'setCurrentRange'
     deriving (Typeable)
 
 instance HasRange Call where
@@ -1155,8 +1399,8 @@ data BuiltinInfo =
 type BuiltinThings pf = Map String (Builtin pf)
 
 data Builtin pf
-	= Builtin Term
-	| Prim pf
+        = Builtin Term
+        | Prim pf
     deriving (Typeable, Show, Functor, Foldable, Traversable)
 
 ---------------------------------------------------------------------------
@@ -1201,24 +1445,25 @@ ifTopLevelAndHighlightingLevelIs l m = do
 
 data TCEnv =
     TCEnv { envContext             :: Context
-	  , envLetBindings         :: LetBindings
-	  , envCurrentModule       :: ModuleName
-	  , envCurrentPath         :: AbsolutePath
+          , envLetBindings         :: LetBindings
+          , envCurrentModule       :: ModuleName
+          , envCurrentPath         :: AbsolutePath
             -- ^ The path to the file that is currently being
             -- type-checked.
           , envAnonymousModules    :: [(ModuleName, Nat)] -- ^ anonymous modules and their number of free variables
-	  , envImportPath          :: [C.TopLevelModuleName] -- ^ to detect import cycles
-	  , envMutualBlock         :: Maybe MutualId -- ^ the current (if any) mutual block
+          , envImportPath          :: [C.TopLevelModuleName] -- ^ to detect import cycles
+          , envMutualBlock         :: Maybe MutualId -- ^ the current (if any) mutual block
+          , envTerminationCheck    :: TerminationCheck ()  -- ^ are we inside the scope of a termination pragma
           , envSolvingConstraints  :: Bool
                 -- ^ Are we currently in the process of solving active constraints?
           , envAssignMetas         :: Bool
             -- ^ Are we allowed to assign metas?
           , envActiveProblems      :: [ProblemId]
-	  , envAbstractMode        :: AbstractMode
-		-- ^ When checking the typesignature of a public definition
-		--   or the body of a non-abstract definition this is true.
-		--   To prevent information about abstract things leaking
-		--   outside the module.
+          , envAbstractMode        :: AbstractMode
+                -- ^ When checking the typesignature of a public definition
+                --   or the body of a non-abstract definition this is true.
+                --   To prevent information about abstract things leaking
+                --   outside the module.
           , envRelevance           :: Relevance
                 -- ^ Are we checking an irrelevant argument? (=@Irrelevant@)
                 -- Then top-level irrelevant declarations are enabled.
@@ -1283,21 +1528,22 @@ data TCEnv =
                 -- ^ The rules for translating internal to abstract syntax are
                 --   slightly different when the internal term comes from an
                 --   unquote.
-	  }
+          }
     deriving (Typeable)
 
 initEnv :: TCEnv
-initEnv = TCEnv { envContext	         = []
-		, envLetBindings         = Map.empty
-		, envCurrentModule       = noModuleName
-	        , envCurrentPath         = __IMPOSSIBLE__
+initEnv = TCEnv { envContext             = []
+                , envLetBindings         = Map.empty
+                , envCurrentModule       = noModuleName
+                , envCurrentPath         = __IMPOSSIBLE__
                 , envAnonymousModules    = []
-		, envImportPath          = []
-		, envMutualBlock         = Nothing
+                , envImportPath          = []
+                , envMutualBlock         = Nothing
+                , envTerminationCheck    = TerminationCheck
                 , envSolvingConstraints  = False
                 , envActiveProblems      = [0]
                 , envAssignMetas         = True
-		, envAbstractMode        = ConcreteMode
+                , envAbstractMode        = ConcreteMode
   -- Andreas, 2013-02-21:  This was 'AbstractMode' until now.
   -- However, top-level checks for mutual blocks, such as
   -- constructor-headedness, should not be able to look into
@@ -1326,20 +1572,20 @@ initEnv = TCEnv { envContext	         = []
                 , envPrintDomainFreePi      = False
                 , envInsideDotPattern       = False
                 , envReifyUnquoted          = False
-		}
+                }
 
 ---------------------------------------------------------------------------
 -- ** Context
 ---------------------------------------------------------------------------
 
 -- | The @Context@ is a stack of 'ContextEntry's.
-type Context	  = [ContextEntry]
-data ContextEntry = Ctx { ctxId	   :: CtxId
-			, ctxEntry :: Dom (Name, Type)
-			}
+type Context      = [ContextEntry]
+data ContextEntry = Ctx { ctxId    :: CtxId
+                        , ctxEntry :: Dom (Name, Type)
+                        }
   deriving (Typeable)
 
-newtype CtxId	  = CtxId Nat
+newtype CtxId     = CtxId Nat
   deriving (Typeable, Eq, Ord, Show, Enum, Real, Integral, Num)
 
 ---------------------------------------------------------------------------
@@ -1377,10 +1623,10 @@ data ExpandInstances
 ---------------------------------------------------------------------------
 
 -- Occurence of a name in a datatype definition
-data Occ = OccCon { occDatatype	:: QName
-	          , occConstructor :: QName
-	          , occPosition	:: OccPos
-	          }
+data Occ = OccCon { occDatatype :: QName
+                  , occConstructor :: QName
+                  , occPosition :: OccPos
+                  }
          | OccClause { occFunction :: QName
                      , occClause   :: Int
                      , occPosition :: OccPos
@@ -1404,9 +1650,8 @@ data CallInfo = CallInfo
 -- no Eq, Ord instances: too expensive! (see issues 851, 852)
 
 -- | We only 'show' the name of the callee.
-instance Show CallInfo where show = show . callInfoTarget
-
-instance Pretty CallInfo where pretty = text . show . callInfoTarget
+instance Show   CallInfo where show   = show . callInfoTarget
+instance Pretty CallInfo where pretty = text . show
 
 -- | Information about a mutual block which did not pass the
 -- termination checker.
@@ -1434,29 +1679,43 @@ instance Error SplitError where
   noMsg  = strMsg ""
   strMsg = GenericSplitError
 
+data UnquoteError
+  = BadVisibility String (I.Arg I.Term)
+  | ConInsteadOfDef QName String String
+  | DefInsteadOfCon QName String String
+  | NotAConstructor String I.Term       -- ^ @NotAConstructor kind term@
+  | NotALiteral String I.Term
+  | RhsUsesDottedVar [Int] I.Term
+  | BlockedOnMeta MetaId
+  | UnquotePanic String
+  deriving (Show)
+
+instance Error UnquoteError where
+  strMsg msg = UnquotePanic msg
+
 data TypeError
-	= InternalError String
-	| NotImplemented String
-	| NotSupported String
+        = InternalError String
+        | NotImplemented String
+        | NotSupported String
         | CompilationError String
-	| TerminationCheckFailed [TerminationError]
-	| PropMustBeSingleton
-	| DataMustEndInSort Term
+        | TerminationCheckFailed [TerminationError]
+        | PropMustBeSingleton
+        | DataMustEndInSort Term
 {- UNUSED
         | DataTooManyParameters
             -- ^ In @data D xs where@ the number of parameters @xs@ does not fit the
             --   the parameters given in the forward declaraion @data D Gamma : T at .
 -}
-	| ShouldEndInApplicationOfTheDatatype Type
-	    -- ^ The target of a constructor isn't an application of its
-	    -- datatype. The 'Type' records what it does target.
-	| ShouldBeAppliedToTheDatatypeParameters Term Term
-	    -- ^ The target of a constructor isn't its datatype applied to
-	    --	 something that isn't the parameters. First term is the correct
-	    --	 target and the second term is the actual target.
-	| ShouldBeApplicationOf Type QName
-	    -- ^ Expected a type to be an application of a particular datatype.
-	| ConstructorPatternInWrongDatatype QName QName -- ^ constructor, datatype
+        | ShouldEndInApplicationOfTheDatatype Type
+            -- ^ The target of a constructor isn't an application of its
+            -- datatype. The 'Type' records what it does target.
+        | ShouldBeAppliedToTheDatatypeParameters Term Term
+            -- ^ The target of a constructor isn't its datatype applied to
+            --   something that isn't the parameters. First term is the correct
+            --   target and the second term is the actual target.
+        | ShouldBeApplicationOf Type QName
+            -- ^ Expected a type to be an application of a particular datatype.
+        | ConstructorPatternInWrongDatatype QName QName -- ^ constructor, datatype
         | IndicesNotConstructorApplications [Arg Term] -- ^ Indices.
         | IndexVariablesNotDistinct [Nat] [Arg Term] -- ^ Variables, indices.
         | IndicesFreeInParameters [Nat] [Arg Term] [Arg Term]
@@ -1466,42 +1725,42 @@ data TypeError
         | CantResolveOverloadedConstructorsTargetingSameDatatype QName [QName]
           -- ^ Datatype, constructors.
         | DoesNotConstructAnElementOf QName Type -- ^ constructor, type
-	| DifferentArities
-	    -- ^ Varying number of arguments for a function.
-	| WrongHidingInLHS
-	    -- ^ The left hand side of a function definition has a hidden argument
-	    --	 where a non-hidden was expected.
-	| WrongHidingInLambda Type
-	    -- ^ Expected a non-hidden function and found a hidden lambda.
-	| WrongHidingInApplication Type
-	    -- ^ A function is applied to a hidden argument where a non-hidden was expected.
+        | DifferentArities
+            -- ^ Varying number of arguments for a function.
+        | WrongHidingInLHS
+            -- ^ The left hand side of a function definition has a hidden argument
+            --   where a non-hidden was expected.
+        | WrongHidingInLambda Type
+            -- ^ Expected a non-hidden function and found a hidden lambda.
+        | WrongHidingInApplication Type
+            -- ^ A function is applied to a hidden argument where a non-hidden was expected.
         | WrongNamedArgument (I.NamedArg A.Expr)
             -- ^ A function is applied to a hidden named argument it does not have.
-	| WrongIrrelevanceInLambda Type
-	    -- ^ Expected a relevant function and found an irrelevant lambda.
+        | WrongIrrelevanceInLambda Type
+            -- ^ Expected a relevant function and found an irrelevant lambda.
         | HidingMismatch Hiding Hiding
             -- ^ The given hiding does not correspond to the expected hiding.
         | RelevanceMismatch Relevance Relevance
             -- ^ The given relevance does not correspond to the expected relevane.
         | ColorMismatch [Color] [Color]
             -- ^ The given color does not correspond to the expected color.
-	| NotInductive Term
+        | NotInductive Term
           -- ^ The term does not correspond to an inductive data type.
-	| UninstantiatedDotPattern A.Expr
-	| IlltypedPattern A.Pattern Type
-	| IllformedProjectionPattern A.Pattern
-	| CannotEliminateWithPattern (A.NamedArg A.Pattern) Type
-	| TooManyArgumentsInLHS Type
-	| WrongNumberOfConstructorArguments QName Nat Nat
-	| ShouldBeEmpty Type [Pattern]
-	| ShouldBeASort Type
-	    -- ^ The given type should have been a sort.
-	| ShouldBePi Type
-	    -- ^ The given type should have been a pi.
-	| ShouldBeRecordType Type
-	| ShouldBeRecordPattern Pattern
+        | UninstantiatedDotPattern A.Expr
+        | IlltypedPattern A.Pattern Type
+        | IllformedProjectionPattern A.Pattern
+        | CannotEliminateWithPattern (A.NamedArg A.Pattern) Type
+        | TooManyArgumentsInLHS Type
+        | WrongNumberOfConstructorArguments QName Nat Nat
+        | ShouldBeEmpty Type [Pattern]
+        | ShouldBeASort Type
+            -- ^ The given type should have been a sort.
+        | ShouldBePi Type
+            -- ^ The given type should have been a pi.
+        | ShouldBeRecordType Type
+        | ShouldBeRecordPattern Pattern
         | NotAProjectionPattern (A.NamedArg A.Pattern)
-	| NotAProperTerm
+        | NotAProperTerm
         | SetOmegaNotValidType
         | InvalidType Term
             -- ^ This term is not a type expression.
@@ -1509,49 +1768,50 @@ data TypeError
         | DefinitionIsIrrelevant QName
         | VariableIsIrrelevant Name
 --        | UnequalLevel Comparison Term Term  -- UNUSED
-	| UnequalTerms Comparison Term Term Type
-	| UnequalTypes Comparison Type Type
---	| UnequalTelescopes Comparison Telescope Telescope -- UNUSED
-	| UnequalRelevance Comparison Term Term
-	    -- ^ The two function types have different relevance.
-	| UnequalHiding Term Term
-	    -- ^ The two function types have different hiding.
-	| UnequalColors Term Term
-	    -- ^ The two function types have different color.
-	| UnequalSorts Sort Sort
+        | UnequalTerms Comparison Term Term Type
+        | UnequalTypes Comparison Type Type
+--      | UnequalTelescopes Comparison Telescope Telescope -- UNUSED
+        | UnequalRelevance Comparison Term Term
+            -- ^ The two function types have different relevance.
+        | UnequalHiding Term Term
+            -- ^ The two function types have different hiding.
+        | UnequalColors Term Term
+            -- ^ The two function types have different color.
+        | UnequalSorts Sort Sort
         | UnequalBecauseOfUniverseConflict Comparison Term Term
         | HeterogeneousEquality Term Type Term Type
             -- ^ We ended up with an equality constraint where the terms
             --   have different types.  This is not supported.
-	| NotLeqSort Sort Sort
-	| MetaCannotDependOn MetaId [Nat] Nat
-	    -- ^ The arguments are the meta variable, the parameters it can
-	    --	 depend on and the paratemeter that it wants to depend on.
-	| MetaOccursInItself MetaId
-	| GenericError String
-	| GenericDocError Doc
+        | NotLeqSort Sort Sort
+        | MetaCannotDependOn MetaId [Nat] Nat
+            -- ^ The arguments are the meta variable, the parameters it can
+            --   depend on and the paratemeter that it wants to depend on.
+        | MetaOccursInItself MetaId
+        | GenericError String
+        | GenericDocError Doc
         | BuiltinMustBeConstructor String A.Expr
-	| NoSuchBuiltinName String
-	| DuplicateBuiltinBinding String Term Term
-	| NoBindingForBuiltin String
-	| NoSuchPrimitiveFunction String
+        | NoSuchBuiltinName String
+        | DuplicateBuiltinBinding String Term Term
+        | NoBindingForBuiltin String
+        | NoSuchPrimitiveFunction String
         | ShadowedModule C.Name [A.ModuleName]
-	| BuiltinInParameterisedModule String
+        | BuiltinInParameterisedModule String
         | IllegalLetInTelescope C.TypedBinding
-	| NoRHSRequiresAbsurdPattern [NamedArg A.Pattern]
-	| AbsurdPatternRequiresNoRHS [NamedArg A.Pattern]
-	| TooFewFields QName [C.Name]
-	| TooManyFields QName [C.Name]
-	| DuplicateFields [C.Name]
-	| DuplicateConstructors [C.Name]
-	| UnexpectedWithPatterns [A.Pattern]
-	| WithClausePatternMismatch A.Pattern Pattern
+        | NoRHSRequiresAbsurdPattern [NamedArg A.Pattern]
+        | AbsurdPatternRequiresNoRHS [NamedArg A.Pattern]
+        | TooFewFields QName [C.Name]
+        | TooManyFields QName [C.Name]
+        | DuplicateFields [C.Name]
+        | DuplicateConstructors [C.Name]
+        | WithOnFreeVariable A.Expr
+        | UnexpectedWithPatterns [A.Pattern]
+        | WithClausePatternMismatch A.Pattern Pattern
         | FieldOutsideRecord
         | ModuleArityMismatch A.ModuleName Telescope [NamedArg A.Expr]
     -- Coverage errors
     -- TODO: Remove some of the constructors in this section, now that
     -- the SplitError constructor has been added?
-	| IncompletePatternMatching Term [Elim] -- can only happen if coverage checking is switched off
+        | IncompletePatternMatching Term [Elim] -- can only happen if coverage checking is switched off
         | CoverageFailure QName [[Arg Pattern]]
         | UnreachableClauses QName [[Arg Pattern]]
         | CoverageCantSplitOn QName Telescope Args Args
@@ -1560,62 +1820,73 @@ data TypeError
         | WithoutKError Type Term Term
         | SplitError SplitError
     -- Positivity errors
-	| NotStrictlyPositive QName [Occ]
+        | NotStrictlyPositive QName [Occ]
     -- Import errors
-	| LocalVsImportedModuleClash ModuleName
-	| UnsolvedMetas [Range]
-	| UnsolvedConstraints Constraints
-	| CyclicModuleDependency [C.TopLevelModuleName]
-	| FileNotFound C.TopLevelModuleName [AbsolutePath]
+        | LocalVsImportedModuleClash ModuleName
+        | UnsolvedMetas [Range]
+        | UnsolvedConstraints Constraints
+        | SolvedButOpenHoles
+          -- ^ Some interaction points (holes) have not be filled by user.
+          --   There are not 'UnsolvedMetas' since unification solved them.
+          --   This is an error, since interaction points are never filled
+          --   without user interaction.
+        | CyclicModuleDependency [C.TopLevelModuleName]
+        | FileNotFound C.TopLevelModuleName [AbsolutePath]
         | OverlappingProjects AbsolutePath C.TopLevelModuleName C.TopLevelModuleName
         | AmbiguousTopLevelModuleName C.TopLevelModuleName [AbsolutePath]
-	| ModuleNameDoesntMatchFileName C.TopLevelModuleName [AbsolutePath]
-	| ClashingFileNamesFor ModuleName [AbsolutePath]
+        | ModuleNameDoesntMatchFileName C.TopLevelModuleName [AbsolutePath]
+        | ClashingFileNamesFor ModuleName [AbsolutePath]
         | ModuleDefinedInOtherFile C.TopLevelModuleName AbsolutePath AbsolutePath
           -- ^ Module name, file from which it was loaded, file which
           -- the include path says contains the module.
     -- Scope errors
-	| BothWithAndRHS
-	| NotInScope [C.QName]
-	| NoSuchModule C.QName
-	| AmbiguousName C.QName [A.QName]
-	| AmbiguousModule C.QName [A.ModuleName]
-	| UninstantiatedModule C.QName
-	| ClashingDefinition C.QName A.QName
-	| ClashingModule A.ModuleName A.ModuleName
-	| ClashingImport C.Name A.QName
-	| ClashingModuleImport C.Name A.ModuleName
-	| PatternShadowsConstructor A.Name A.QName
-	| ModuleDoesntExport C.QName [C.ImportedName]
+        | BothWithAndRHS
+        | NotInScope [C.QName]
+        | NoSuchModule C.QName
+        | AmbiguousName C.QName [A.QName]
+        | AmbiguousModule C.QName [A.ModuleName]
+        | UninstantiatedModule C.QName
+        | ClashingDefinition C.QName A.QName
+        | ClashingModule A.ModuleName A.ModuleName
+        | ClashingImport C.Name A.QName
+        | ClashingModuleImport C.Name A.ModuleName
+        | PatternShadowsConstructor A.Name A.QName
+        | ModuleDoesntExport C.QName [C.ImportedName]
         | DuplicateImports C.QName [C.ImportedName]
-	| InvalidPattern C.Pattern
-	| RepeatedVariablesInPattern [C.Name]
+        | InvalidPattern C.Pattern
+        | RepeatedVariablesInPattern [C.Name]
     -- Concrete to Abstract errors
-	| NotAModuleExpr C.Expr
-	    -- ^ The expr was used in the right hand side of an implicit module
-	    --	 definition, but it wasn't of the form @m Delta at .
-	| NotAnExpression C.Expr
-	| NotAValidLetBinding D.NiceDeclaration
-	| NothingAppliedToHiddenArg C.Expr
-	| NothingAppliedToInstanceArg C.Expr
+        | NotAModuleExpr C.Expr
+            -- ^ The expr was used in the right hand side of an implicit module
+            --   definition, but it wasn't of the form @m Delta at .
+        | NotAnExpression C.Expr
+        | NotAValidLetBinding D.NiceDeclaration
+        | NothingAppliedToHiddenArg C.Expr
+        | NothingAppliedToInstanceArg C.Expr
+    -- Pattern synonym errors
+        | BadArgumentsToPatternSynonym A.QName
+        | TooFewArgumentsToPatternSynonym A.QName
         | UnusedVariableInPatternSynonym
-        | PatternSynonymArityMismatch A.QName
     -- Operator errors
-	| NoParseForApplication [C.Expr]
-	| AmbiguousParseForApplication [C.Expr] [C.Expr]
-	| NoParseForLHS LHSOrPatSyn C.Pattern
-	| AmbiguousParseForLHS LHSOrPatSyn C.Pattern [C.Pattern]
+        | NoParseForApplication [C.Expr]
+        | AmbiguousParseForApplication [C.Expr] [C.Expr]
+        | NoParseForLHS LHSOrPatSyn C.Pattern
+        | AmbiguousParseForLHS LHSOrPatSyn C.Pattern [C.Pattern]
 {- UNUSED
-	| NoParseForPatternSynonym C.Pattern
-	| AmbiguousParseForPatternSynonym C.Pattern [C.Pattern]
+        | NoParseForPatternSynonym C.Pattern
+        | AmbiguousParseForPatternSynonym C.Pattern [C.Pattern]
 -}
     -- Usage errors
     -- Implicit From Scope errors
         | IFSNoCandidateInScope Type
+    -- Reflection errors
+        | UnquoteFailed UnquoteError
     -- Safe flag errors
         | SafeFlagPostulate C.Name
         | SafeFlagPragma [String]
         | SafeFlagNoTerminationCheck
+        | SafeFlagNonTerminating
+        | SafeFlagTerminating
         | SafeFlagPrimTrustMe
     -- Language option errors
         | NeedOptionCopatterns
@@ -1634,10 +1905,10 @@ instance Error TypeError where
 -- | Type-checking errors.
 
 data TCErr = TypeError TCState (Closure TypeError)
-	   | Exception Range String
+           | Exception Range String
            | IOException Range E.IOException
-	   | PatternErr  TCState -- ^ for pattern violations
-	   {- AbortAssign TCState -- ^ used to abort assignment to meta when there are instantiations -- UNUSED -}
+           | PatternErr  -- TCState -- ^ for pattern violations
+           {- AbortAssign TCState -- ^ used to abort assignment to meta when there are instantiations -- UNUSED -}
   deriving (Typeable)
 
 instance Error TCErr where
@@ -1648,14 +1919,14 @@ instance Show TCErr where
     show (TypeError _ e) = show (envRange $ clEnv e) ++ ": " ++ show (clValue e)
     show (Exception r s) = show r ++ ": " ++ s
     show (IOException r e) = show r ++ ": " ++ show e
-    show (PatternErr _)  = "Pattern violation (you shouldn't see this)"
+    show PatternErr{}  = "Pattern violation (you shouldn't see this)"
     {- show (AbortAssign _) = "Abort assignment (you shouldn't see this)" -- UNUSED -}
 
 instance HasRange TCErr where
     getRange (TypeError _ cl)  = envRange $ clEnv cl
     getRange (Exception r _)   = r
     getRange (IOException r _) = r
-    getRange (PatternErr s)    = noRange
+    getRange PatternErr{}      = noRange
     {- getRange (AbortAssign s)   = noRange -- UNUSED -}
 
 instance Exception TCErr
@@ -1729,10 +2000,13 @@ instance MonadError TCErr (TCMT IO) where
     oldState <- liftIO (readIORef r)
     unTCM m r e `E.catch` \err -> do
       -- Reset the state, but do not forget changes to the persistent
-      -- component.
-      liftIO $ do
-        newState <- readIORef r
-        writeIORef r $ oldState { stPersistent = stPersistent newState }
+      -- component. Not for pattern violations.
+      case err of
+        PatternErr -> return ()
+        _          ->
+          liftIO $ do
+            newState <- readIORef r
+            writeIORef r $ oldState { stPersistentState = stPersistentState newState }
       unTCM (h err) r e
 
 -- | Preserve the state of the failing computation.
@@ -1757,7 +2031,7 @@ instance MonadIO m => MonadTCM (TCMT m) where
 instance MonadTCM tcm => MonadTCM (MaybeT tcm) where
   liftTCM = lift . liftTCM
 
-instance (Error err, MonadTCM tcm) => MonadTCM (ErrorT err tcm) where
+instance (Error err, MonadTCM tcm) => MonadTCM (ExceptT err tcm) where
   liftTCM = lift . liftTCM
 
 instance (Monoid w, MonadTCM tcm) => MonadTCM (WriterT w tcm) where
@@ -1834,9 +2108,7 @@ instance MonadIO m => MonadIO (TCMT m) where
       handleException   r s = throwIO $ Exception r s
 
 patternViolation :: TCM a
-patternViolation = do
-    s <- get
-    throwError $ PatternErr s
+patternViolation = throwError PatternErr
 
 internalError :: MonadTCM tcm => String -> tcm a
 internalError s = typeError $ InternalError s
@@ -1901,12 +2173,13 @@ forkTCM m = do
 
 
 -- | Base name for extended lambda patterns
-extendlambdaname = ".extendedlambda"
+extendedLambdaName :: String
+extendedLambdaName = ".extendedlambda"
 
 -- | Name of absurdLambda definitions.
+absurdLambdaName :: String
 absurdLambdaName = ".absurdlambda"
 
 -- | Check whether we have an definition from an absurd lambda.
 isAbsurdLambdaName :: QName -> Bool
-isAbsurdLambdaName (QName _ x) | show x == absurdLambdaName = True
-isAbsurdLambdaName _ = False
+isAbsurdLambdaName = (absurdLambdaName ==) . prettyShow . qnameName
diff --git a/src/full/Agda/TypeChecking/Monad/Base/Benchmark.hs b/src/full/Agda/TypeChecking/Monad/Base/Benchmark.hs
index ce38919..b3df15a 100644
--- a/src/full/Agda/TypeChecking/Monad/Base/Benchmark.hs
+++ b/src/full/Agda/TypeChecking/Monad/Base/Benchmark.hs
@@ -3,6 +3,7 @@
 module Agda.TypeChecking.Monad.Base.Benchmark where
 
 import Agda.Utils.Trie as Trie
+import Agda.Utils.Time (CPUTime)
 
 -- | Phases to allocate CPU time to.
 data Phase
@@ -46,6 +47,10 @@ data Phase
     -- ^ Subphase for 'Import'.
   | Sort
     -- ^ Subphase for 'Serialize'.
+  | BinaryEncode
+    -- ^ Subphase for 'Serialize'.
+  | Compress
+    -- ^ Subphase for 'Serialize'.
   | Operators
     -- ^ Subphase for 'Parsing'.
   | BuildParser
@@ -53,12 +58,10 @@ data Phase
   deriving (Eq, Ord, Show, Enum, Bounded)
 
 -- | Account we can bill computation time to.
+--   A word of 'Phase's.
 type Account = [Phase]
 
--- | We measure CPU time spent on certain tasks.
-type CPUTime = Integer
-
--- | Benchmark structure is a trie, mapping phases (and subphases)
+-- | Benchmark structure is a trie, mapping accounts (phases and subphases)
 --   to CPU time spent on their performance.
 type Benchmark = Trie Phase CPUTime
 
diff --git a/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs b/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
index d7707c1..0819b0d 100644
--- a/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
+++ b/src/full/Agda/TypeChecking/Monad/Base/KillRange.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 -- | 'KillRange' instances for data structures from 'Agda.TypeChecking.Monad.Base'.
 
@@ -44,8 +46,8 @@ instance KillRange Defn where
   killRange def =
     case def of
       Axiom -> Axiom
-      Function cls comp inv mut isAbs delayed proj static copy term extlam with ->
-        killRange12 Function cls comp inv mut isAbs delayed proj static copy term extlam with
+      Function cls comp inv mut isAbs delayed proj static copy term extlam with cop ->
+        killRange13 Function cls comp inv mut isAbs delayed proj static copy term extlam with cop
       Datatype a b c d e f g h i j   -> killRange10 Datatype a b c d e f g h i j
       Record a b c d e f g h i j k l -> killRange12 Record a b c d e f g h i j k l
       Constructor a b c d e          -> killRange5 Constructor a b c d e
diff --git a/src/full/Agda/TypeChecking/Monad/Benchmark.hs b/src/full/Agda/TypeChecking/Monad/Benchmark.hs
index 9b66629..3c93221 100644
--- a/src/full/Agda/TypeChecking/Monad/Benchmark.hs
+++ b/src/full/Agda/TypeChecking/Monad/Benchmark.hs
@@ -22,7 +22,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Pretty (Doc)
 import Agda.Utils.Time
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Check whether benchmarking is activated.
diff --git a/src/full/Agda/TypeChecking/Monad/Builtin.hs b/src/full/Agda/TypeChecking/Monad/Builtin.hs
index 2f3e7a7..6dc09d0 100644
--- a/src/full/Agda/TypeChecking/Monad/Builtin.hs
+++ b/src/full/Agda/TypeChecking/Monad/Builtin.hs
@@ -3,7 +3,6 @@
 module Agda.TypeChecking.Monad.Builtin where
 
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.State
 
 import Data.Functor
@@ -16,11 +15,13 @@ import Agda.Syntax.Internal
 import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Substitute
 
+import Agda.Utils.Except ( Error, MonadError(catchError) )
+import Agda.Utils.Lens
 import Agda.Utils.Monad (when_)
 import Agda.Utils.Maybe
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 class (Functor m, Applicative m, Monad m) => HasBuiltins m where
@@ -28,7 +29,7 @@ class (Functor m, Applicative m, Monad m) => HasBuiltins m where
 
 litType :: Literal -> TCM Type
 litType l = case l of
-    LitInt _ n	  -> do
+    LitInt _ n    -> do
       primZero
       when_ (n > 0) $ primSuc
       el <$> primNat
@@ -40,26 +41,23 @@ litType l = case l of
     el t = El (mkType 0) t
 
 instance MonadIO m => HasBuiltins (TCMT m) where
-  getBuiltinThing b = liftM2 mplus (Map.lookup b <$> gets stLocalBuiltins)
-                      (Map.lookup b <$> gets stImportedBuiltins)
+  getBuiltinThing b = liftM2 mplus (Map.lookup b <$> use stLocalBuiltins)
+                      (Map.lookup b <$> use stImportedBuiltins)
 
 setBuiltinThings :: BuiltinThings PrimFun -> TCM ()
-setBuiltinThings b = modify $ \s -> s { stLocalBuiltins = b }
+setBuiltinThings b = stLocalBuiltins .= b
 
 bindBuiltinName :: String -> Term -> TCM ()
 bindBuiltinName b x = do
-	builtin <- getBuiltinThing b
-	case builtin of
-	    Just (Builtin y) -> typeError $ DuplicateBuiltinBinding b y x
-	    Just (Prim _)    -> typeError $ NoSuchBuiltinName b
-	    Nothing	     -> modify $ \st ->
-              st { stLocalBuiltins =
-                    Map.insert b (Builtin x) $ stLocalBuiltins st
-                 }
+        builtin <- getBuiltinThing b
+        case builtin of
+            Just (Builtin y) -> typeError $ DuplicateBuiltinBinding b y x
+            Just (Prim _)    -> typeError $ NoSuchBuiltinName b
+            Nothing          -> stLocalBuiltins %= Map.insert b (Builtin x)
 
 bindPrimitive :: String -> PrimFun -> TCM ()
 bindPrimitive b pf = do
-  builtin <- gets stLocalBuiltins
+  builtin <- use stLocalBuiltins
   setBuiltinThings $ Map.insert b (Prim pf) builtin
 
 getBuiltin :: String -> TCM Term
@@ -70,8 +68,8 @@ getBuiltin' :: HasBuiltins m => String -> m (Maybe Term)
 getBuiltin' x = do
     builtin <- getBuiltinThing x
     case builtin of
-	Just (Builtin t) -> return $ Just (killRange t)
-	_		 -> return Nothing
+        Just (Builtin t) -> return $ Just (killRange t)
+        _                -> return Nothing
 
 getPrimitive' :: HasBuiltins m => String -> m (Maybe PrimFun)
 getPrimitive' x = (getPrim =<<) <$> getBuiltinThing x
@@ -130,8 +128,10 @@ primInteger, primFloat, primChar, primString, primBool, primTrue, primFalse,
     primAgdaDefinitionPostulate, primAgdaDefinitionPrimitive, primAgdaDefinitionDataConstructor,
     primAgdaFunDef, primAgdaFunDefCon, primAgdaClause, primAgdaClauseClause, primAgdaClauseAbsurd,
     primAgdaPattern, primAgdaPatCon, primAgdaPatVar, primAgdaPatDot,
-    primAgdaDataDef, primAgdaRecordDef
+    primAgdaDataDef, primAgdaRecordDef, primAgdaPatLit, primAgdaPatProj,
+    primAgdaPatAbsurd
     :: TCM Term
+
 primInteger      = getBuiltin builtinInteger
 primFloat        = getBuiltin builtinFloat
 primChar         = getBuiltin builtinChar
@@ -225,77 +225,105 @@ primAgdaDefinitionPostulate       = getBuiltin builtinAgdaDefinitionPostulate
 primAgdaDefinitionPrimitive       = getBuiltin builtinAgdaDefinitionPrimitive
 primAgdaDefinition                = getBuiltin builtinAgdaDefinition
 
-builtinNat          = "NATURAL"
-builtinSuc          = "SUC"
-builtinZero         = "ZERO"
-builtinNatPlus      = "NATPLUS"
-builtinNatMinus     = "NATMINUS"
-builtinNatTimes     = "NATTIMES"
-builtinNatDivSucAux = "NATDIVSUCAUX"
-builtinNatModSucAux = "NATMODSUCAUX"
-builtinNatEquals    = "NATEQUALS"
-builtinNatLess      = "NATLESS"
-builtinInteger      = "INTEGER"
-builtinFloat        = "FLOAT"
-builtinChar         = "CHAR"
-builtinString       = "STRING"
-builtinBool         = "BOOL"
-builtinTrue         = "TRUE"
-builtinFalse        = "FALSE"
-builtinList         = "LIST"
-builtinNil          = "NIL"
-builtinCons         = "CONS"
-builtinIO           = "IO"
-builtinSize         = "SIZE"
-builtinSizeLt       = "SIZELT"
-builtinSizeSuc      = "SIZESUC"
-builtinSizeInf      = "SIZEINF"
-builtinSizeMax      = "SIZEMAX"
-builtinInf          = "INFINITY"
-builtinSharp        = "SHARP"
-builtinFlat         = "FLAT"
-builtinEquality     = "EQUALITY"
-builtinRefl         = "REFL"
-builtinRewrite      = "REWRITE"
-builtinLevelMax     = "LEVELMAX"
-builtinLevel        = "LEVEL"
-builtinLevelZero    = "LEVELZERO"
-builtinLevelSuc     = "LEVELSUC"
-builtinIrrAxiom     = "IRRAXIOM"
-builtinQName        = "QNAME"
-builtinAgdaSort     = "AGDASORT"
-builtinAgdaSortSet  = "AGDASORTSET"
-builtinAgdaSortLit  = "AGDASORTLIT"
-builtinAgdaSortUnsupported = "AGDASORTUNSUPPORTED"
-builtinAgdaType     = "AGDATYPE"
-builtinAgdaTypeEl   = "AGDATYPEEL"
-builtinHiding       = "HIDING"
-builtinHidden       = "HIDDEN"
-builtinInstance     = "INSTANCE"
-builtinVisible      = "VISIBLE"
-builtinRelevance    = "RELEVANCE"
-builtinRelevant     = "RELEVANT"
-builtinIrrelevant   = "IRRELEVANT"
-builtinArg          = "ARG"
-builtinArgInfo      = "ARGINFO"
-builtinArgArgInfo   = "ARGARGINFO"
-builtinArgArg       = "ARGARG"
-builtinAgdaTerm         = "AGDATERM"
-builtinAgdaTermVar      = "AGDATERMVAR"
-builtinAgdaTermLam      = "AGDATERMLAM"
-builtinAgdaTermExtLam   = "AGDATERMEXTLAM"
-builtinAgdaTermDef      = "AGDATERMDEF"
-builtinAgdaTermCon      = "AGDATERMCON"
-builtinAgdaTermPi       = "AGDATERMPI"
-builtinAgdaTermSort     = "AGDATERMSORT"
-builtinAgdaTermLit      = "AGDATERMLIT"
-builtinAgdaTermUnsupported = "AGDATERMUNSUPPORTED"
-builtinAgdaLiteral   = "AGDALITERAL"
-builtinAgdaLitNat    = "AGDALITNAT"
-builtinAgdaLitFloat  = "AGDALITFLOAT"
-builtinAgdaLitChar   = "AGDALITCHAR"
-builtinAgdaLitString = "AGDALITSTRING"
-builtinAgdaLitQName  = "AGDALITQNAME"
+builtinNat, builtinSuc, builtinZero, builtinNatPlus, builtinNatMinus,
+  builtinNatTimes, builtinNatDivSucAux, builtinNatModSucAux, builtinNatEquals,
+  builtinNatLess, builtinInteger, builtinFloat, builtinChar, builtinString,
+  builtinBool, builtinTrue, builtinFalse, builtinList, builtinNil,
+  builtinCons, builtinIO, builtinSize, builtinSizeLt, builtinSizeSuc,
+  builtinSizeInf, builtinSizeMax, builtinInf, builtinSharp, builtinFlat,
+  builtinEquality, builtinRefl, builtinRewrite, builtinLevelMax,
+  builtinLevel, builtinLevelZero, builtinLevelSuc, builtinIrrAxiom,
+  builtinQName, builtinAgdaSort, builtinAgdaSortSet, builtinAgdaSortLit,
+  builtinAgdaSortUnsupported, builtinAgdaType, builtinAgdaTypeEl,
+  builtinHiding, builtinHidden, builtinInstance, builtinVisible,
+  builtinRelevance, builtinRelevant, builtinIrrelevant, builtinArg,
+  builtinArgInfo, builtinArgArgInfo, builtinArgArg, builtinAgdaTerm,
+  builtinAgdaTermVar, builtinAgdaTermLam, builtinAgdaTermExtLam,
+  builtinAgdaTermDef, builtinAgdaTermCon, builtinAgdaTermPi,
+  builtinAgdaTermSort, builtinAgdaTermLit, builtinAgdaTermUnsupported,
+  builtinAgdaLiteral, builtinAgdaLitNat, builtinAgdaLitFloat,
+  builtinAgdaLitChar, builtinAgdaLitString, builtinAgdaLitQName,
+  builtinAgdaFunDef, builtinAgdaFunDefCon, builtinAgdaClause,
+  builtinAgdaClauseClause, builtinAgdaClauseAbsurd, builtinAgdaPattern,
+  builtinAgdaPatVar, builtinAgdaPatCon, builtinAgdaPatDot, builtinAgdaPatLit,
+  builtinAgdaPatProj, builtinAgdaPatAbsurd, builtinAgdaDataDef,
+  builtinAgdaRecordDef, builtinAgdaDefinitionFunDef,
+  builtinAgdaDefinitionDataDef, builtinAgdaDefinitionRecordDef,
+  builtinAgdaDefinitionDataConstructor, builtinAgdaDefinitionPostulate,
+  builtinAgdaDefinitionPrimitive, builtinAgdaDefinition
+  :: String
+
+builtinNat                           = "NATURAL"
+builtinSuc                           = "SUC"
+builtinZero                          = "ZERO"
+builtinNatPlus                       = "NATPLUS"
+builtinNatMinus                      = "NATMINUS"
+builtinNatTimes                      = "NATTIMES"
+builtinNatDivSucAux                  = "NATDIVSUCAUX"
+builtinNatModSucAux                  = "NATMODSUCAUX"
+builtinNatEquals                     = "NATEQUALS"
+builtinNatLess                       = "NATLESS"
+builtinInteger                       = "INTEGER"
+builtinFloat                         = "FLOAT"
+builtinChar                          = "CHAR"
+builtinString                        = "STRING"
+builtinBool                          = "BOOL"
+builtinTrue                          = "TRUE"
+builtinFalse                         = "FALSE"
+builtinList                          = "LIST"
+builtinNil                           = "NIL"
+builtinCons                          = "CONS"
+builtinIO                            = "IO"
+builtinSize                          = "SIZE"
+builtinSizeLt                        = "SIZELT"
+builtinSizeSuc                       = "SIZESUC"
+builtinSizeInf                       = "SIZEINF"
+builtinSizeMax                       = "SIZEMAX"
+builtinInf                           = "INFINITY"
+builtinSharp                         = "SHARP"
+builtinFlat                          = "FLAT"
+builtinEquality                      = "EQUALITY"
+builtinRefl                          = "REFL"
+builtinRewrite                       = "REWRITE"
+builtinLevelMax                      = "LEVELMAX"
+builtinLevel                         = "LEVEL"
+builtinLevelZero                     = "LEVELZERO"
+builtinLevelSuc                      = "LEVELSUC"
+builtinIrrAxiom                      = "IRRAXIOM"
+builtinQName                         = "QNAME"
+builtinAgdaSort                      = "AGDASORT"
+builtinAgdaSortSet                   = "AGDASORTSET"
+builtinAgdaSortLit                   = "AGDASORTLIT"
+builtinAgdaSortUnsupported           = "AGDASORTUNSUPPORTED"
+builtinAgdaType                      = "AGDATYPE"
+builtinAgdaTypeEl                    = "AGDATYPEEL"
+builtinHiding                        = "HIDING"
+builtinHidden                        = "HIDDEN"
+builtinInstance                      = "INSTANCE"
+builtinVisible                       = "VISIBLE"
+builtinRelevance                     = "RELEVANCE"
+builtinRelevant                      = "RELEVANT"
+builtinIrrelevant                    = "IRRELEVANT"
+builtinArg                           = "ARG"
+builtinArgInfo                       = "ARGINFO"
+builtinArgArgInfo                    = "ARGARGINFO"
+builtinArgArg                        = "ARGARG"
+builtinAgdaTerm                      = "AGDATERM"
+builtinAgdaTermVar                   = "AGDATERMVAR"
+builtinAgdaTermLam                   = "AGDATERMLAM"
+builtinAgdaTermExtLam                = "AGDATERMEXTLAM"
+builtinAgdaTermDef                   = "AGDATERMDEF"
+builtinAgdaTermCon                   = "AGDATERMCON"
+builtinAgdaTermPi                    = "AGDATERMPI"
+builtinAgdaTermSort                  = "AGDATERMSORT"
+builtinAgdaTermLit                   = "AGDATERMLIT"
+builtinAgdaTermUnsupported           = "AGDATERMUNSUPPORTED"
+builtinAgdaLiteral                   = "AGDALITERAL"
+builtinAgdaLitNat                    = "AGDALITNAT"
+builtinAgdaLitFloat                  = "AGDALITFLOAT"
+builtinAgdaLitChar                   = "AGDALITCHAR"
+builtinAgdaLitString                 = "AGDALITSTRING"
+builtinAgdaLitQName                  = "AGDALITQNAME"
 builtinAgdaFunDef                    = "AGDAFUNDEF"
 builtinAgdaFunDefCon                 = "AGDAFUNDEFCON"
 builtinAgdaClause                    = "AGDACLAUSE"
diff --git a/src/full/Agda/TypeChecking/Monad/Closure.hs b/src/full/Agda/TypeChecking/Monad/Closure.hs
index f8e2b70..1e988bc 100644
--- a/src/full/Agda/TypeChecking/Monad/Closure.hs
+++ b/src/full/Agda/TypeChecking/Monad/Closure.hs
@@ -1,4 +1,3 @@
-
 module Agda.TypeChecking.Monad.Closure where
 
 import Agda.TypeChecking.Monad.Base
diff --git a/src/full/Agda/TypeChecking/Monad/Constraints.hs b/src/full/Agda/TypeChecking/Monad/Constraints.hs
index 7ecefff..1eac04a 100644
--- a/src/full/Agda/TypeChecking/Monad/Constraints.hs
+++ b/src/full/Agda/TypeChecking/Monad/Constraints.hs
@@ -14,15 +14,16 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Monad.Closure
 import Agda.TypeChecking.Monad.Options
 
+import Agda.Utils.Lens
 import Agda.Utils.List
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Get the current problem
 currentProblem :: TCM ProblemId
-currentProblem = fromMaybe __IMPOSSIBLE__ . mhead <$> asks envActiveProblems
+currentProblem = headWithDefault __IMPOSSIBLE__ <$> asks envActiveProblems
 
 -- | Steal all constraints belonging to the given problem and add them to the current problem.
 stealConstraints :: ProblemId -> TCM ()
@@ -60,11 +61,11 @@ getConstraintsForProblem pid = List.filter ((== pid) . constraintProblem) <$> ge
 
 -- | Get the awake constraints
 getAwakeConstraints :: TCM Constraints
-getAwakeConstraints = gets stAwakeConstraints
+getAwakeConstraints = use stAwakeConstraints
 
 wakeConstraints :: (ProblemConstraint-> Bool) -> TCM ()
 wakeConstraints wake = do
-  (wakeup, sleepin) <- List.partition wake <$> gets stSleepingConstraints
+  (wakeup, sleepin) <- List.partition wake <$> use stSleepingConstraints
   reportSLn "tc.constr.wake" 50 $
     "waking up         " ++ show (List.map constraintProblem wakeup) ++ "\n" ++
     "  still sleeping: " ++ show (List.map constraintProblem sleepin)
@@ -80,7 +81,7 @@ dropConstraints crit = do
 
 putAllConstraintsToSleep :: TCM ()
 putAllConstraintsToSleep = do
-  awakeOnes <- gets stAwakeConstraints
+  awakeOnes <- use stAwakeConstraints
   modifySleepingConstraints $ (++ awakeOnes)
   modifyAwakeConstraints    $ const []
 
@@ -94,7 +95,7 @@ takeAwakeConstraint = do
       return $ Just c
 
 getAllConstraints :: TCM Constraints
-getAllConstraints = gets $ \s -> stAwakeConstraints s ++ stSleepingConstraints s
+getAllConstraints = gets $ \s -> s^.stAwakeConstraints ++ s^.stSleepingConstraints
 
 withConstraint :: (Constraint -> TCM a) -> ProblemConstraint -> TCM a
 withConstraint f (PConstr pid c) = do
@@ -114,7 +115,8 @@ buildConstraint c = flip buildProblemConstraint c =<< currentProblem
 addConstraint' :: Constraint -> TCM ()
 addConstraint' c = do
     pc <- build
-    modify $ \s -> s { stDirty = True, stSleepingConstraints = pc : stSleepingConstraints s }
+    stDirty .= True
+    stSleepingConstraints %= (pc :)
   where
     build | isBlocking c = buildConstraint c
           | otherwise    = buildProblemConstraint 0 c
@@ -145,10 +147,10 @@ isSolvingConstraints = asks envSolvingConstraints
 ---------------------------------------------------------------------------
 
 mapAwakeConstraints :: (Constraints -> Constraints) -> TCState -> TCState
-mapAwakeConstraints f s = s { stAwakeConstraints = f (stAwakeConstraints s) }
+mapAwakeConstraints = over stAwakeConstraints
 
 mapSleepingConstraints :: (Constraints -> Constraints) -> TCState -> TCState
-mapSleepingConstraints f s = s { stSleepingConstraints = f (stSleepingConstraints s) }
+mapSleepingConstraints = over stSleepingConstraints
 
 modifyAwakeConstraints  :: (Constraints -> Constraints) -> TCM ()
 modifyAwakeConstraints = modify . mapAwakeConstraints
diff --git a/src/full/Agda/TypeChecking/Monad/Context.hs b/src/full/Agda/TypeChecking/Monad/Context.hs
index 5a7fdd5..54c6671 100644
--- a/src/full/Agda/TypeChecking/Monad/Context.hs
+++ b/src/full/Agda/TypeChecking/Monad/Context.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE TupleSections,
-      FlexibleInstances, TypeSynonymInstances, OverlappingInstances #-}
+{-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
 
 module Agda.TypeChecking.Monad.Context where
 
@@ -18,7 +20,6 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Monad.Open
 
-import Agda.Utils.Fresh
 import Agda.Utils.Functor
 import Agda.Utils.List ((!!!), downFrom)
 import Agda.Utils.Monad
@@ -203,6 +204,7 @@ getContextArgs :: MonadTCM tcm => tcm Args
 getContextArgs = reverse . zipWith mkArg [0..] <$> getContext
   where mkArg i (Common.Dom info _) = Common.Arg info $ var i
 
+-- | Generate @[var (n - 1), ..., var 0]@ for all declarations in the context.
 {-# SPECIALIZE getContextTerms :: TCM [Term] #-}
 getContextTerms :: MonadTCM tcm => tcm [Term]
 getContextTerms = map var . downFrom <$> getContextSize
@@ -245,13 +247,13 @@ nameOfBV n = fst . unDom <$> lookupBV n
 {-# SPECIALIZE getVarInfo :: Name -> TCM (Term, Dom Type) #-}
 getVarInfo :: MonadTCM tcm => Name -> tcm (Term, Dom Type)
 getVarInfo x =
-    do	ctx <- getContext
-	def <- asks envLetBindings
-	case findIndex ((==x) . fst . unDom) ctx of
-	    Just n -> do
+    do  ctx <- getContext
+        def <- asks envLetBindings
+        case findIndex ((==x) . fst . unDom) ctx of
+            Just n -> do
                 t <- typeOfBV' n
                 return (var n, t)
-	    _	    ->
-		case Map.lookup x def of
-		    Just vt -> liftTCM $ getOpen vt
-		    _	    -> fail $ "unbound variable " ++ show x
+            _       ->
+                case Map.lookup x def of
+                    Just vt -> liftTCM $ getOpen vt
+                    _       -> fail $ "unbound variable " ++ show (nameConcrete x)
diff --git a/src/full/Agda/TypeChecking/Monad/Debug.hs b/src/full/Agda/TypeChecking/Monad/Debug.hs
index 7771a1a..fc4a83d 100644
--- a/src/full/Agda/TypeChecking/Monad/Debug.hs
+++ b/src/full/Agda/TypeChecking/Monad/Debug.hs
@@ -1,4 +1,3 @@
-
 module Agda.TypeChecking.Monad.Debug where
 
 import Control.Monad.Trans ( MonadIO(liftIO) )
diff --git a/src/full/Agda/TypeChecking/Monad/Env.hs b/src/full/Agda/TypeChecking/Monad/Env.hs
index fcf0fcb..f180423 100644
--- a/src/full/Agda/TypeChecking/Monad/Env.hs
+++ b/src/full/Agda/TypeChecking/Monad/Env.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+
 module Agda.TypeChecking.Monad.Env where
 
 import Control.Monad.Reader
@@ -70,21 +71,29 @@ performedSimplification' simpl = local $ \ e -> e { envSimplification = simpl `m
 getSimplification :: MonadReader TCEnv m => m Simplification
 getSimplification = asks envSimplification
 
--- | Reduce @Def f vs@ only if @f@ is a projection.
-onlyReduceProjections :: TCM a -> TCM a
-onlyReduceProjections = local $ \ e -> e { envAllowedReductions = [ProjectionReductions] }
+-- * Controlling reduction.
+
+-- | Lens for 'AllowedReductions'.
+updateAllowedReductions :: (AllowedReductions -> AllowedReductions) -> TCEnv -> TCEnv
+updateAllowedReductions f e = e { envAllowedReductions = f (envAllowedReductions e) }
 
-dontReduceProjections :: TCM a -> TCM a
-dontReduceProjections = local $ \ e -> e { envAllowedReductions = allReductions \\ [ProjectionReductions] }
+modifyAllowedReductions :: (AllowedReductions -> AllowedReductions) -> TCM a -> TCM a
+modifyAllowedReductions = local . updateAllowedReductions
 
-dontReduceLevels :: TCM a -> TCM a
-dontReduceLevels = local $ \ e -> e { envAllowedReductions = allReductions \\ [LevelReductions] }
+putAllowedReductions :: AllowedReductions -> TCM a -> TCM a
+putAllowedReductions = modifyAllowedReductions . const
+
+-- | Reduce @Def f vs@ only if @f@ is a projection.
+onlyReduceProjections :: TCM a -> TCM a
+onlyReduceProjections = putAllowedReductions [ProjectionReductions]
 
+-- | Allow all reductions except for non-terminating functions (default).
 allowAllReductions :: TCM a -> TCM a
-allowAllReductions = local $ \ e -> e { envAllowedReductions = allReductions }
+allowAllReductions = putAllowedReductions allReductions
 
+-- | Allow all reductions including non-terminating functions.
 allowNonTerminatingReductions :: TCM a -> TCM a
-allowNonTerminatingReductions = local $ \ e -> e { envAllowedReductions = allReductions ++ [NonTerminatingReductions] }
+allowNonTerminatingReductions = putAllowedReductions $ [NonTerminatingReductions] ++ allReductions
 
 insideDotPattern :: TCM a -> TCM a
 insideDotPattern = local $ \e -> e { envInsideDotPattern = True }
diff --git a/src/full/Agda/TypeChecking/Monad/Exception.hs b/src/full/Agda/TypeChecking/Monad/Exception.hs
index 516bb5c..dc9f33b 100644
--- a/src/full/Agda/TypeChecking/Monad/Exception.hs
+++ b/src/full/Agda/TypeChecking/Monad/Exception.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE UndecidableInstances   #-}
 
 -- | Basically a copy of the ErrorT monad transformer. It's handy to slap
 --   onto TCM and still be a MonadTCM (which isn't possible with ErrorT).
@@ -13,11 +13,12 @@
 module Agda.TypeChecking.Monad.Exception where
 
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.State
 import Control.Monad.Reader
 import Control.Monad.Writer
+
 import Agda.TypeChecking.Monad.Base
+import Agda.Utils.Except ( Error(strMsg), MonadError(catchError, throwError) )
 
 newtype ExceptionT err m a = ExceptionT { runExceptionT :: m (Either err a) }
 
diff --git a/src/full/Agda/TypeChecking/Monad/Imports.hs b/src/full/Agda/TypeChecking/Monad/Imports.hs
index c9e4d92..f1095f8 100644
--- a/src/full/Agda/TypeChecking/Monad/Imports.hs
+++ b/src/full/Agda/TypeChecking/Monad/Imports.hs
@@ -1,4 +1,3 @@
-
 module Agda.TypeChecking.Monad.Imports where
 
 import Control.Monad.State
@@ -11,20 +10,21 @@ import qualified Data.Set as Set
 import Agda.Syntax.Abstract.Name
 import qualified Agda.Syntax.Concrete.Name as C
 import Agda.TypeChecking.Monad.Base
+import Agda.Utils.Lens
 import Agda.Utils.Monad
 import Agda.Utils.Time
 import Agda.Utils.Hash
 
 addImport :: ModuleName -> TCM ()
 addImport m =
-    modify $ \s -> s { stImportedModules = Set.insert m $ stImportedModules s }
+    stImportedModules %= Set.insert m
 
 addImportCycleCheck :: C.TopLevelModuleName -> TCM a -> TCM a
 addImportCycleCheck m =
     local $ \e -> e { envImportPath = m : envImportPath e }
 
 getImports :: TCM (Set ModuleName)
-getImports = gets stImportedModules
+getImports = use stImportedModules
 
 isImported :: ModuleName -> TCM Bool
 isImported m = Set.member m <$> getImports
@@ -33,49 +33,48 @@ getImportPath :: TCM [C.TopLevelModuleName]
 getImportPath = asks envImportPath
 
 visitModule :: ModuleInfo -> TCM ()
-visitModule mi = modify $ \s ->
-  s { stVisitedModules =
-        Map.insert (toTopLevelModuleName $ iModuleName $ miInterface mi)
-                   mi $
-          stVisitedModules s }
+visitModule mi =
+  stVisitedModules %=
+    Map.insert (toTopLevelModuleName $ iModuleName $ miInterface mi) mi
 
 setVisitedModules :: VisitedModules -> TCM ()
-setVisitedModules ms = modify $ \s -> s { stVisitedModules = ms }
+setVisitedModules ms = stVisitedModules .= ms
 
 getVisitedModules :: TCM VisitedModules
-getVisitedModules = gets stVisitedModules
+getVisitedModules = use stVisitedModules
 
 isVisited :: C.TopLevelModuleName -> TCM Bool
-isVisited x = gets $ Map.member x . stVisitedModules
+isVisited x = Map.member x <$> use stVisitedModules
 
 getVisitedModule :: C.TopLevelModuleName
                  -> TCM (Maybe ModuleInfo)
-getVisitedModule x = gets $ Map.lookup x . stVisitedModules
+getVisitedModule x = Map.lookup x <$> use stVisitedModules
 
 getDecodedModules :: TCM DecodedModules
-getDecodedModules = stDecodedModules . stPersistent <$> get
+getDecodedModules = stDecodedModules . stPersistentState <$> get
 
 setDecodedModules :: DecodedModules -> TCM ()
 setDecodedModules ms = modify $ \s ->
-  s { stPersistent = (stPersistent s) { stDecodedModules = ms } }
+  s { stPersistentState = (stPersistentState s) { stDecodedModules = ms } }
 
 getDecodedModule :: C.TopLevelModuleName -> TCM (Maybe Interface)
-getDecodedModule x = Map.lookup x . stDecodedModules . stPersistent <$> get
+getDecodedModule x = Map.lookup x . stDecodedModules . stPersistentState <$> get
 
 storeDecodedModule :: Interface -> TCM ()
 storeDecodedModule i = modify $ \s ->
-  s { stPersistent =
-        (stPersistent s) { stDecodedModules =
+  s { stPersistentState =
+        (stPersistentState s) { stDecodedModules =
           Map.insert (toTopLevelModuleName $ iModuleName i) i $
-            (stDecodedModules $ stPersistent s)
+            (stDecodedModules $ stPersistentState s)
         }
   }
 
 dropDecodedModule :: C.TopLevelModuleName -> TCM ()
 dropDecodedModule x = modify $ \s ->
-  s { stPersistent = (stPersistent s) { stDecodedModules =
-                       Map.delete x $ stDecodedModules $ stPersistent s
-                     }
+  s { stPersistentState =
+        (stPersistentState s) { stDecodedModules =
+                                  Map.delete x $ stDecodedModules $ stPersistentState s
+                              }
   }
 
 withImportPath :: [C.TopLevelModuleName] -> TCM a -> TCM a
@@ -87,4 +86,4 @@ checkForImportCycle :: TCM ()
 checkForImportCycle = do
     m:ms <- getImportPath
     when (m `elem` ms) $ typeError $ CyclicModuleDependency
-				   $ dropWhile (/= m) $ reverse (m:ms)
+                                   $ dropWhile (/= m) $ reverse (m:ms)
diff --git a/src/full/Agda/TypeChecking/Monad/MetaVars.hs b/src/full/Agda/TypeChecking/Monad/MetaVars.hs
index bac9153..f4a173a 100644
--- a/src/full/Agda/TypeChecking/Monad/MetaVars.hs
+++ b/src/full/Agda/TypeChecking/Monad/MetaVars.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.Monad.MetaVars where
@@ -27,14 +27,14 @@ import Agda.TypeChecking.Monad.Context
 import Agda.TypeChecking.Substitute
 
 import Agda.Utils.Functor ((<.>))
-import Agda.Utils.Fresh
+import Agda.Utils.Lens
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Tuple
 import Agda.Utils.Size
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Switch off assignment of metas.
@@ -43,10 +43,10 @@ dontAssignMetas = local $ \ env -> env { envAssignMetas = False }
 
 -- | Get the meta store.
 getMetaStore :: TCM MetaStore
-getMetaStore = gets stMetaStore
+getMetaStore = use stMetaStore
 
 modifyMetaStore :: (MetaStore -> MetaStore) -> TCM ()
-modifyMetaStore f = modify $ \ st -> st { stMetaStore = f (stMetaStore st) }
+modifyMetaStore f = stMetaStore %= f
 
 -- | Lookup a meta variable
 lookupMeta :: MetaId -> TCM MetaVariable
@@ -136,9 +136,9 @@ isInstantiatedMeta' :: MetaId -> TCM (Maybe Term)
 isInstantiatedMeta' m = do
   mv <- lookupMeta m
   return $ case mvInstantiation mv of
-    InstV v -> Just v
-    InstS v -> Just v
-    _       -> Nothing
+    InstV tel v -> Just $ foldr mkLam v tel
+    InstS v     -> Just v
+    _           -> Nothing
 
 -- | Create 'MetaInfo' in the current environment.
 createMetaInfo :: TCM MetaInfo
@@ -180,7 +180,7 @@ updateMetaVarRange mi r = updateMetaVar mi (setRange r)
 
 modifyInteractionPoints :: (InteractionPoints -> InteractionPoints) -> TCM ()
 modifyInteractionPoints f =
-  modify $ \ s -> s { stInteractionPoints = f (stInteractionPoints s) }
+  stInteractionPoints %= f
 
 -- | Register an interaction point during scope checking.
 --   If there is no interaction id yet, create one.
@@ -189,7 +189,7 @@ registerInteractionPoint r maybeId = do
   ii <- case maybeId of
     Just i  -> return $ InteractionId i
     Nothing -> fresh
-  m <- gets stInteractionPoints
+  m <- use stInteractionPoints
   let ip = InteractionPoint { ipRange = r, ipMeta = Nothing }
   case Map.insertLookupWithKey (\ key new old -> old) ii ip m of
     -- If the interaction point is already present, we keep the old ip.
@@ -204,7 +204,7 @@ registerInteractionPoint r maybeId = do
 -- | Hook up meta variable to interaction point.
 connectInteractionPoint :: InteractionId -> MetaId -> TCM ()
 connectInteractionPoint ii mi = do
-  m <- gets stInteractionPoints
+  m <- use stInteractionPoints
   let ip = InteractionPoint { ipRange = __IMPOSSIBLE__, ipMeta = Just mi }
   -- The interaction point needs to be present already, we just set the meta.
   case Map.insertLookupWithKey (\ key new old -> new { ipRange = ipRange old }) ii ip m of
@@ -219,15 +219,15 @@ removeInteractionPoint ii = do
 
 -- | Get a list of interaction ids.
 getInteractionPoints :: TCM [InteractionId]
-getInteractionPoints = Map.keys <$> gets stInteractionPoints
+getInteractionPoints = Map.keys <$> use stInteractionPoints
 
 -- | Get all metas that correspond to interaction ids.
 getInteractionMetas :: TCM [MetaId]
-getInteractionMetas = mapMaybe ipMeta . Map.elems <$> gets stInteractionPoints
+getInteractionMetas = mapMaybe ipMeta . Map.elems <$> use stInteractionPoints
 
 -- | Get all metas that correspond to interaction ids.
 getInteractionIdsAndMetas :: TCM [(InteractionId,MetaId)]
-getInteractionIdsAndMetas = mapMaybe f . Map.toList <$> gets stInteractionPoints
+getInteractionIdsAndMetas = mapMaybe f . Map.toList <$> use stInteractionPoints
   where f (ii, ip) = (ii,) <$> ipMeta ip
 
 -- | Does the meta variable correspond to an interaction point?
@@ -239,7 +239,7 @@ isInteractionMeta x = lookup x . map swap <$> getInteractionIdsAndMetas
 -- | Get the information associated to an interaction point.
 lookupInteractionPoint :: InteractionId -> TCM InteractionPoint
 lookupInteractionPoint ii =
-  fromMaybeM err $ Map.lookup ii <$> gets stInteractionPoints
+  fromMaybeM err $ Map.lookup ii <$> use stInteractionPoints
   where
     err  = fail $ "no such interaction point: " ++ show ii
 
@@ -264,7 +264,7 @@ newMeta' inst mi p perm j = do
       mv = MetaVar mi p perm j' inst Set.empty Instantiable
   -- printing not available (import cycle)
   -- reportSDoc "tc.meta.new" 50 $ text "new meta" <+> prettyTCM j'
-  modify $ \st -> st { stMetaStore = Map.insert x mv $ stMetaStore st }
+  stMetaStore %= Map.insert x mv
   return x
 
 -- | Get the 'Range' for an interaction point.
@@ -290,24 +290,24 @@ getInstantiatedMetas = do
     store <- getMetaStore
     return [ i | (i, MetaVar{ mvInstantiation = mi }) <- Map.assocs store, isInst mi ]
     where
-	isInst Open                               = False
-	isInst OpenIFS                            = False
-	isInst (BlockedConst _)                   = False
-        isInst (PostponedTypeCheckingProblem _ _) = False
-	isInst (InstV _)                          = True
-	isInst (InstS _)                          = True
+        isInst Open                           = False
+        isInst OpenIFS                        = False
+        isInst BlockedConst{}                 = False
+        isInst PostponedTypeCheckingProblem{} = False
+        isInst InstV{}                        = True
+        isInst InstS{}                        = True
 
 getOpenMetas :: TCM [MetaId]
 getOpenMetas = do
     store <- getMetaStore
     return [ i | (i, MetaVar{ mvInstantiation = mi }) <- Map.assocs store, isOpen mi ]
     where
-	isOpen Open                               = True
-	isOpen OpenIFS                            = True
-	isOpen (BlockedConst _)                   = True
-        isOpen (PostponedTypeCheckingProblem _ _) = True
-	isOpen (InstV _)                          = False
-	isOpen (InstS _)                          = False
+        isOpen Open                           = True
+        isOpen OpenIFS                        = True
+        isOpen BlockedConst{}                 = True
+        isOpen PostponedTypeCheckingProblem{} = True
+        isOpen InstV{}                        = False
+        isOpen InstS{}                        = False
 
 -- | @listenToMeta l m@: register @l@ as a listener to @m at . This is done
 --   when the type of l is blocked by @m at .
diff --git a/src/full/Agda/TypeChecking/Monad/Mutual.hs b/src/full/Agda/TypeChecking/Monad/Mutual.hs
index f047d1e..ecd1113 100644
--- a/src/full/Agda/TypeChecking/Monad/Mutual.hs
+++ b/src/full/Agda/TypeChecking/Monad/Mutual.hs
@@ -6,12 +6,13 @@ import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.Map as Map
 import Data.Set (Set)
+import Data.Functor ((<$>))
 import qualified Data.Set as Set
 import qualified Agda.Utils.HashMap as HMap
 
 import Agda.Syntax.Internal
 import Agda.TypeChecking.Monad.Base
-import Agda.Utils.Fresh
+import Agda.Utils.Lens
 
 noMutualBlock :: TCM a -> TCM a
 noMutualBlock = local $ \e -> e { envMutualBlock = Nothing }
@@ -29,17 +30,14 @@ inMutualBlock m = do
 -- | Set the mutual block for a definition
 setMutualBlock :: MutualId -> QName -> TCM ()
 setMutualBlock i x = do
-  modify $ \s -> s { stMutualBlocks = Map.insertWith Set.union i (Set.singleton x) $ stMutualBlocks s
-		   , stSignature    = (stSignature s)
-				      { sigDefinitions = setMutId x i $ sigDefinitions $ stSignature s
-				      }
-		   }
+  stMutualBlocks %= Map.insertWith Set.union i (Set.singleton x)
+  stSignature    %= \sig -> sig { sigDefinitions = setMutId x i $ sigDefinitions sig }
   where
     setMutId x i = flip HMap.adjust x $ \defn -> defn { defMutual = i }
 
 -- | Get all mutual blocks
 getMutualBlocks :: TCM [Set QName]
-getMutualBlocks = gets $ Map.elems . stMutualBlocks
+getMutualBlocks = Map.elems <$> use stMutualBlocks
 
 -- | Get the current mutual block, if any, otherwise a fresh mutual
 -- block is returned.
@@ -48,7 +46,7 @@ currentOrFreshMutualBlock = maybe fresh return =<< asks envMutualBlock
 
 lookupMutualBlock :: MutualId -> TCM (Set QName)
 lookupMutualBlock mi = do
-  mb <- gets stMutualBlocks
+  mb <- use stMutualBlocks
   case Map.lookup mi mb of
     Just qs -> return qs
     Nothing -> return Set.empty -- can end up here if we ask for the current mutual block and there is none
diff --git a/src/full/Agda/TypeChecking/Monad/Open.hs b/src/full/Agda/TypeChecking/Monad/Open.hs
index 74b8ada..8748444 100644
--- a/src/full/Agda/TypeChecking/Monad/Open.hs
+++ b/src/full/Agda/TypeChecking/Monad/Open.hs
@@ -1,15 +1,14 @@
 -- {-# LANGUAGE CPP #-}
 
 module Agda.TypeChecking.Monad.Open
-	( makeOpen
-	, makeClosed
-	, getOpen
-	, tryOpen
-	) where
+        ( makeOpen
+        , makeClosed
+        , getOpen
+        , tryOpen
+        ) where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error
 import Data.List
 
 import Agda.TypeChecking.Substitute
@@ -17,6 +16,8 @@ import Agda.TypeChecking.Monad.Base
 
 import {-# SOURCE #-} Agda.TypeChecking.Monad.Context
 
+import Agda.Utils.Except ( MonadError(catchError) )
+
 -- | Create an open term in the current context.
 makeOpen :: a -> TCM (Open a)
 makeOpen x = do
diff --git a/src/full/Agda/TypeChecking/Monad/Options.hs b/src/full/Agda/TypeChecking/Monad/Options.hs
index 1027c21..c7821d5 100644
--- a/src/full/Agda/TypeChecking/Monad/Options.hs
+++ b/src/full/Agda/TypeChecking/Monad/Options.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
 
 module Agda.TypeChecking.Monad.Options where
 
 import Control.Applicative
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Maybe
@@ -24,13 +23,15 @@ import Agda.Interaction.Options
 import qualified Agda.Interaction.Options.Lenses as Lens
 import Agda.Interaction.Response
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.FileName
 import Agda.Utils.Monad
+import Agda.Utils.Lens
 import Agda.Utils.List
 import Agda.Utils.Trie (Trie)
 import qualified Agda.Utils.Trie as Trie
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Sets the pragma options.
@@ -43,7 +44,7 @@ setPragmaOptions opts = do
   case checkOpts (clo { optPragmaOptions = opts }) of
     Left err   -> __IMPOSSIBLE__
     Right opts -> do
-      modify $ \s -> s { stPragmaOptions = (optPragmaOptions opts) }
+      stPragmaOptions .= optPragmaOptions opts
 
 -- | Sets the command line options (both persistent and pragma options
 -- are updated).
@@ -78,19 +79,19 @@ class (Functor m, Applicative m, Monad m) => HasOptions m where
   commandLineOptions :: m CommandLineOptions
 
 instance MonadIO m => HasOptions (TCMT m) where
-  pragmaOptions = gets stPragmaOptions
+  pragmaOptions = use stPragmaOptions
 
   commandLineOptions = do
-    p  <- stPragmaOptions <$> get
-    cl <- stPersistentOptions . stPersistent <$> get
+    p  <- use stPragmaOptions
+    cl <- stPersistentOptions . stPersistentState <$> get
     return $ cl { optPragmaOptions = p }
 
 setOptionsFromPragma :: OptionsPragma -> TCM ()
 setOptionsFromPragma ps = do
     opts <- commandLineOptions
     case parsePragmaOptions ps opts of
-	Left err    -> typeError $ GenericError err
-	Right opts' -> setPragmaOptions opts'
+        Left err    -> typeError $ GenericError err
+        Right opts' -> setPragmaOptions opts'
 
 -- | Disable display forms.
 enableDisplayForms :: TCM a -> TCM a
@@ -209,17 +210,17 @@ setIncludeDirs incs relativeTo = do
 
 setInputFile :: FilePath -> TCM ()
 setInputFile file =
-    do	opts <- commandLineOptions
-	setCommandLineOptions $
+    do  opts <- commandLineOptions
+        setCommandLineOptions $
           opts { optInputFile = Just file }
 
 -- | Should only be run if 'hasInputFile'.
 getInputFile :: TCM AbsolutePath
 getInputFile =
-    do	mf <- optInputFile <$> commandLineOptions
-	case mf of
-	    Just file -> liftIO $ absolute file
-	    Nothing   -> __IMPOSSIBLE__
+    do  mf <- optInputFile <$> commandLineOptions
+        case mf of
+            Just file -> liftIO $ absolute file
+            Nothing   -> __IMPOSSIBLE__
 
 hasInputFile :: TCM Bool
 hasInputFile = isJust <$> optInputFile <$> commandLineOptions
@@ -297,7 +298,7 @@ hasVerbosity k n | n < 0     = __IMPOSSIBLE__
                  | otherwise = do
     t <- getVerbosity
     let ks = wordsBy (`elem` ".:") k
-	m  = maximum $ 0 : Trie.lookupPath ks t
+        m  = maximum $ 0 : Trie.lookupPath ks t
     return (n <= m)
 
 -- | Displays a debug message in a suitable way.
diff --git a/src/full/Agda/TypeChecking/Monad/Sharing.hs b/src/full/Agda/TypeChecking/Monad/Sharing.hs
index c586db6..fba14f1 100644
--- a/src/full/Agda/TypeChecking/Monad/Sharing.hs
+++ b/src/full/Agda/TypeChecking/Monad/Sharing.hs
@@ -12,7 +12,7 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Monad.Options
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 updateSharedTerm :: MonadTCM tcm => (Term -> tcm Term) -> Term -> tcm Term
diff --git a/src/full/Agda/TypeChecking/Monad/Signature.hs b/src/full/Agda/TypeChecking/Monad/Signature.hs
index eb5a1f7..08e0a39 100644
--- a/src/full/Agda/TypeChecking/Monad/Signature.hs
+++ b/src/full/Agda/TypeChecking/Monad/Signature.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards     #-}
 
 module Agda.TypeChecking.Monad.Signature where
 
@@ -26,6 +26,7 @@ import Agda.TypeChecking.Monad.Base
 import Agda.TypeChecking.Monad.Context
 import Agda.TypeChecking.Monad.Options
 import Agda.TypeChecking.Monad.Env
+import Agda.TypeChecking.Monad.Exception ( ExceptionT )
 import Agda.TypeChecking.Monad.Mutual
 import Agda.TypeChecking.Monad.Open
 import Agda.TypeChecking.Monad.State
@@ -40,10 +41,12 @@ import Agda.Utils.Monad
 import Agda.Utils.Size
 import Agda.Utils.Permutation
 import Agda.Utils.Pretty
+import Agda.Utils.Lens
 import Agda.Utils.List
+import Agda.Utils.Except ( Error )
 import qualified Agda.Utils.HashMap as HMap
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Add a constant to the signature. Lifts the definition to top level.
@@ -52,8 +55,8 @@ addConstant q d = do
   reportSLn "tc.signature" 20 $ "adding constant " ++ show q ++ " to signature"
   tel <- getContextTelescope
   let tel' = replaceEmptyName "r" $ killRange $ case theDef d of
-	      Constructor{} -> fmap (setHiding Hidden) tel
-	      _		    -> tel
+              Constructor{} -> fmap (setHiding Hidden) tel
+              _             -> tel
   let d' = abstract tel' $ d { defName = q }
   reportSLn "tc.signature" 30 $ "lambda-lifted definition = " ++ show d'
   modifySignature $ \sig -> sig
@@ -161,29 +164,29 @@ addDisplayForms x = do
       def <- getConstInfo x
       let cs = defClauses def
       case cs of
-	[ Clause{ namedClausePats = pats, clauseBody = b } ]
-	  | all (isVar . namedArg) pats
+        [ Clause{ namedClausePats = pats, clauseBody = b } ]
+          | all (isVar . namedArg) pats
           , Just (m, Def y es) <- strip (b `apply` vs0)
           , Just vs <- mapM isApplyElim es -> do
-	      let ps = raise 1 $ map unArg vs
+              let ps = raise 1 $ map unArg vs
                   df = Display 0 ps $ DTerm $ Def top $ map Apply args
-	      reportSLn "tc.display.section" 20 $ "adding display form " ++ show y ++ " --> " ++ show top
+              reportSLn "tc.display.section" 20 $ "adding display form " ++ show y ++ " --> " ++ show top
                                                 ++ "\n  " ++ show df
-	      addDisplayForm y df
-	      add args top y vs
-	_ -> do
-	      let reason = case cs of
-		    []    -> "no clauses"
-		    _:_:_ -> "many clauses"
-		    [ Clause{ clauseBody = b } ] -> case strip b of
-		      Nothing -> "bad body"
-		      Just (m, Def y es)
-			| m < length args -> "too few args"
-			| m > length args -> "too many args"
-			| otherwise	  -> "args=" ++ show args ++ " es=" ++ show es
-		      Just (m, v) -> "not a def body"
-	      reportSLn "tc.display.section" 30 $ "no display form from " ++ show x ++ " because " ++ reason
-	      return ()
+              addDisplayForm y df
+              add args top y vs
+        _ -> do
+              let reason = case cs of
+                    []    -> "no clauses"
+                    _:_:_ -> "many clauses"
+                    [ Clause{ clauseBody = b } ] -> case strip b of
+                      Nothing -> "bad body"
+                      Just (m, Def y es)
+                        | m < length args -> "too few args"
+                        | m > length args -> "too many args"
+                        | otherwise       -> "args=" ++ show args ++ " es=" ++ show es
+                      Just (m, v) -> "not a def body"
+              reportSLn "tc.display.section" 30 $ "no display form from " ++ show x ++ " because " ++ reason
+              return ()
     strip (Body v)   = return (0, unSpine v)
     strip  NoBody    = Nothing
     strip (Bind b)   = do
@@ -227,8 +230,8 @@ applySection new ptel old ts rd rm = do
     -- produce out-of-scope constructors.
     copyName x = Map.findWithDefault x x rd
 
-    argsToUse x = do
-      let m = mnameFromList $ commonPrefix (mnameToList old) (mnameToList $ qnameModule x)
+    argsToUse new = do
+      let m = mnameFromList $ commonPrefix (mnameToList old) (mnameToList new)
       reportSLn "tc.mod.apply" 80 $ "Common prefix: " ++ show m
       let ms = tail . map mnameFromList . inits . mnameToList $ m
       ps <- sequence [ maybe 0 secFreeVars <$> getSection m | m <- ms ]
@@ -238,7 +241,7 @@ applySection new ptel old ts rd rm = do
     copyDef :: Args -> (QName, QName) -> TCM ()
     copyDef ts (x, y) = do
       def <- getConstInfo x
-      np  <- argsToUse x
+      np  <- argsToUse (qnameModule x)
       copyDef' np def
       where
         copyDef' np d = do
@@ -246,20 +249,20 @@ applySection new ptel old ts rd rm = do
           reportSLn "tc.mod.apply" 80 $ "args = " ++ show ts' ++ "\n" ++
                                         "old type = " ++ showTerm (unEl $ defType d) ++ "\n" ++
                                         "new type = " ++ showTerm (unEl t)
-	  addConstant y =<< nd y
+          addConstant y =<< nd y
           makeProjection y
-	  -- Set display form for the old name if it's not a constructor.
+          -- Set display form for the old name if it's not a constructor.
 {- BREAKS fail/Issue478
           -- Andreas, 2012-10-20 and if we are not an anonymous module
-	  -- unless (isAnonymousModuleName new || isCon || size ptel > 0) $ do
+          -- unless (isAnonymousModuleName new || isCon || size ptel > 0) $ do
 -}
           -- Issue1238: the copied def should be an 'instance' if the original
           -- def is one. Skip constructors since the original constructor will
           -- still work as an instance.
           unless isCon $ flip (maybe (return ())) inst $ \c -> addNamedInstance y c
 
-	  unless (isCon || size ptel > 0) $ do
-	    addDisplayForms y
+          unless (isCon || size ptel > 0) $ do
+            addDisplayForms y
           where
             ts' = take np ts
             t   = defType d `apply` ts'
@@ -328,6 +331,7 @@ applySection new ptel old ts rd rm = do
                         , funTerminates     = Just True
                         , funExtLam         = extlam
                         , funWith           = with
+                        , funCopatternLHS   = isCopatternLHS [cl]
                         }
                   reportSLn "tc.mod.apply" 80 $ "new def for " ++ show x ++ "\n  " ++ show newDef
                   return newDef
@@ -346,11 +350,15 @@ applySection new ptel old ts rd rm = do
 
     copySec :: Args -> (ModuleName, ModuleName) -> TCM ()
     copySec ts (x, y) = do
+      np  <- argsToUse x
       tel <- lookupSection x
-      let fv = size tel - size ts
+      let fv = size tel - np
       reportSLn "tc.mod.apply" 80 $ "Copying section " ++ show x ++ " to " ++ show y
       reportSLn "tc.mod.apply" 80 $ "  free variables: " ++ show fv
-      addCtxTel (apply tel ts) $ addSection y fv
+      reportSLn "tc.mod.apply" 80 $ "  ts  = " ++ show ts
+      reportSLn "tc.mod.apply" 80 $ "  tel = " ++ show tel
+      reportSLn "tc.mod.apply" 80 $ "  np  = " ++ show np
+      addCtxTel (apply tel $ take np ts) $ addSection y fv
 
 addDisplayForm :: QName -> DisplayForm -> TCM ()
 addDisplayForm x df = do
@@ -360,8 +368,8 @@ addDisplayForm x df = do
   where
     add df sig = sig { sigDefinitions = HMap.adjust addDf x defs }
       where
-	addDf def = def { defDisplay = df : defDisplay def }
-	defs	  = sigDefinitions sig
+        addDf def = def { defDisplay = df : defDisplay def }
+        defs      = sigDefinitions sig
 
 canonicalName :: QName -> TCM QName
 canonicalName x = do
@@ -421,8 +429,8 @@ class (Functor m, Applicative m, Monad m) => HasConstInfo m where
 
 instance HasConstInfo (TCMT IO) where
   getConstInfo q = join $ pureTCM $ \st env ->
-    let defs  = sigDefinitions $ stSignature st
-        idefs = sigDefinitions $ stImports st
+    let defs  = sigDefinitions $ st^.stSignature
+        idefs = sigDefinitions $ st^.stImports
     in case catMaybes [HMap.lookup q defs, HMap.lookup q idefs] of
         []  -> fail $ "Unbound name: " ++ show q ++ " " ++ showQNameId q
         [d] -> mkAbs env d
@@ -431,8 +439,8 @@ instance HasConstInfo (TCMT IO) where
       mkAbs env d
         | treatAbstractly' q' env =
           case makeAbstract d of
-            Just d	-> return d
-            Nothing	-> notInScope $ qnameToConcrete q
+            Just d      -> return d
+            Nothing     -> notInScope $ qnameToConcrete q
               -- the above can happen since the scope checker is a bit sloppy with 'abstract'
         | otherwise = return d
         where
@@ -449,6 +457,9 @@ instance HasConstInfo (TCMT IO) where
           init' [] = {-'-} __IMPOSSIBLE__
           init' xs = init xs
 
+instance (HasConstInfo m, Error err) => HasConstInfo (ExceptionT err m) where
+  getConstInfo = lift . getConstInfo
+
 {-# INLINE getConInfo #-}
 {-# SPECIALIZE getConstInfo :: QName -> TCM Definition #-}
 getConInfo :: MonadTCM tcm => ConHead -> tcm Definition
@@ -629,12 +640,12 @@ treatAbstractly q = asks $ treatAbstractly' q
 
 treatAbstractly' :: QName -> TCEnv -> Bool
 treatAbstractly' q env = case envAbstractMode env of
-  ConcreteMode	     -> True
+  ConcreteMode       -> True
   IgnoreAbstractMode -> False
-  AbstractMode	     -> not $ current == m || current `isSubModuleOf` m
+  AbstractMode       -> not $ current == m || current `isSubModuleOf` m
   where
     current = envCurrentModule env
-    m	    = qnameModule q
+    m       = qnameModule q
 
 -- | Get type of a constant, instantiated to the current context.
 typeOfConst :: QName -> TCM Type
@@ -651,10 +662,10 @@ colOfConst q = defColors <$> getConstInfo q
 -- | The name must be a datatype.
 sortOfConst :: QName -> TCM Sort
 sortOfConst q =
-    do	d <- theDef <$> getConstInfo q
-	case d of
-	    Datatype{dataSort = s} -> return s
-	    _			   -> fail $ "Expected " ++ show q ++ " to be a datatype."
+    do  d <- theDef <$> getConstInfo q
+        case d of
+            Datatype{dataSort = s} -> return s
+            _                      -> fail $ "Expected " ++ show q ++ " to be a datatype."
 
 -- | Is it the name of a record projection?
 isProjection :: QName -> TCM (Maybe Projection)
diff --git a/src/full/Agda/TypeChecking/Monad/SizedTypes.hs b/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
index 6a3a3b0..80c4750 100644
--- a/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
+++ b/src/full/Agda/TypeChecking/Monad/SizedTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -9,7 +9,6 @@
 module Agda.TypeChecking.Monad.SizedTypes where
 
 import Control.Applicative
-import Control.Monad.Error
 
 import Agda.Interaction.Options
 
@@ -23,9 +22,10 @@ import Agda.TypeChecking.Monad.Signature
 import Agda.TypeChecking.Monad.State
 import Agda.TypeChecking.Substitute ()
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -106,12 +106,23 @@ builtinSizeHook s q e' t = do
 -- * Constructors
 ------------------------------------------------------------------------
 
+-- | The sort of built-in types @SIZE@ and @SIZELT at .
+sizeSort :: Sort
+sizeSort = mkType 0
+
+-- | The type of built-in types @SIZE@ and @SIZELT at .
+sizeUniv :: Type
+sizeUniv = sort $ sizeSort
+
+-- | The built-in type @SIZE@ with user-given name.
 sizeType_ :: QName -> Type
-sizeType_ size = El (mkType 0) $ Def size []
+sizeType_ size = El sizeSort $ Def size []
 
+-- | The built-in type @SIZE at .
 sizeType :: TCM Type
-sizeType = El (mkType 0) <$> primSize
+sizeType = El sizeSort <$> primSize
 
+-- | The name of @SIZESUC at .
 sizeSucName :: TCM (Maybe QName)
 sizeSucName = liftTCM $
   ifM (not . optSizedTypes <$> pragmaOptions) (return Nothing) $ do
diff --git a/src/full/Agda/TypeChecking/Monad/State.hs b/src/full/Agda/TypeChecking/Monad/State.hs
index b3f80f0..9a6684e 100644
--- a/src/full/Agda/TypeChecking/Monad/State.hs
+++ b/src/full/Agda/TypeChecking/Monad/State.hs
@@ -29,19 +29,20 @@ import {-# SOURCE #-} Agda.TypeChecking.Monad.Options
 
 import Agda.Utils.Hash
 import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.Lens
 import Agda.Utils.Monad (bracket_)
 import Agda.Utils.Pretty
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Resets the non-persistent part of the type checking state.
 
 resetState :: TCM ()
 resetState = do
-    pers <- gets stPersistent
-    put $ initState { stPersistent = pers }
+    pers <- gets stPersistentState
+    put $ initState { stPersistentState = pers }
 
 -- | Resets all of the type checking state.
 --
@@ -63,23 +64,51 @@ localTCState = bracket_ get $ \ s -> do
    put s
    modifyBenchmark $ const b
 
+-- | Same as 'localTCState' but also returns the state in which we were just
+--   before reverting it.
+localTCStateSaving :: TCM a -> TCM (a, TCState)
+localTCStateSaving compute = do
+  state <- get
+  result <- compute
+  newState <- get
+  do
+    b <- getBenchmark
+    put state
+    modifyBenchmark $ const b
+  return (result, newState)
+
+
 ---------------------------------------------------------------------------
--- * Lens for persistent state
+-- * Lens for persistent states and its fields
 ---------------------------------------------------------------------------
 
-updatePersistentState :: (PersistentTCState -> PersistentTCState) -> (TCState -> TCState)
-updatePersistentState f s = s { stPersistent = f (stPersistent s) }
+lensPersistentState :: Lens' PersistentTCState TCState
+lensPersistentState f s =
+  f (stPersistentState s) <&> \ p -> s { stPersistentState = p }
+
+updatePersistentState
+  :: (PersistentTCState -> PersistentTCState) -> (TCState -> TCState)
+updatePersistentState f s = s { stPersistentState = f (stPersistentState s) }
 
 modifyPersistentState :: (PersistentTCState -> PersistentTCState) -> TCM ()
 modifyPersistentState = modify . updatePersistentState
 
+-- | Lens for 'stAccumStatistics'.
+
+lensAccumStatisticsP :: Lens' Statistics PersistentTCState
+lensAccumStatisticsP f s = f (stAccumStatistics s) <&> \ a ->
+  s { stAccumStatistics = a }
+
+lensAccumStatistics :: Lens' Statistics TCState
+lensAccumStatistics =  lensPersistentState . lensAccumStatisticsP
+
 ---------------------------------------------------------------------------
 -- * Scope
 ---------------------------------------------------------------------------
 
 -- | Get the current scope.
 getScope :: TCM ScopeInfo
-getScope = gets stScope
+getScope = use stScope
 
 -- | Set the current scope.
 setScope :: ScopeInfo -> TCM ()
@@ -87,7 +116,7 @@ setScope scope = modifyScope (const scope)
 
 -- | Modify the current scope.
 modifyScope :: (ScopeInfo -> ScopeInfo) -> TCM ()
-modifyScope f = modify $ \ s -> s { stScope = f (stScope s) }
+modifyScope f = stScope %= f
 
 -- | Run a computation in a local scope.
 withScope :: ScopeInfo -> TCM a -> TCM (a, ScopeInfo)
@@ -130,22 +159,22 @@ printScope tag v s = verboseS ("scope." ++ tag) v $ do
 -- ** Lens for 'stSignature' and 'stImports'
 
 modifySignature :: (Signature -> Signature) -> TCM ()
-modifySignature f = modify $ \s -> s { stSignature = f $ stSignature s }
+modifySignature f = stSignature %= f
 
 modifyImportedSignature :: (Signature -> Signature) -> TCM ()
-modifyImportedSignature f = modify $ \s -> s { stImports = f $ stImports s }
+modifyImportedSignature f = stImports %= f
 
 getSignature :: TCM Signature
-getSignature = gets stSignature
+getSignature = use stSignature
 
 getImportedSignature :: TCM Signature
-getImportedSignature = gets stImports
+getImportedSignature = use stImports
 
 setSignature :: Signature -> TCM ()
 setSignature sig = modifySignature $ const sig
 
 setImportedSignature :: Signature -> TCM ()
-setImportedSignature sig = modify $ \s -> s { stImports = sig }
+setImportedSignature sig = stImports .= sig
 
 -- | Run some computation in a different signature, restore original signature.
 withSignature :: Signature -> TCM a -> TCM a
@@ -194,21 +223,16 @@ updateFunClauses f _                              = __IMPOSSIBLE__
 -- implementation of 'setTopLevelModule' should be changed.
 
 setTopLevelModule :: C.QName -> TCM ()
-setTopLevelModule x =
-  modify $ \s -> s
-    { stFreshThings = (stFreshThings s)
-      { fName = NameId 0 $ hashString (show x)
-      }
-    }
+setTopLevelModule x = stFreshNameId .= NameId 0 (hashString (show x))
 
 -- | Use a different top-level module for a computation. Used when generating
 --   names for imported modules.
 withTopLevelModule :: C.QName -> TCM a -> TCM a
 withTopLevelModule x m = do
-  next <- gets $ fName . stFreshThings
+  next <- use stFreshNameId
   setTopLevelModule x
   y <- m
-  modify $ \s -> s { stFreshThings = (stFreshThings s) { fName = next } }
+  stFreshNameId .= next
   return y
 
 ---------------------------------------------------------------------------
@@ -217,12 +241,11 @@ withTopLevelModule x m = do
 
 -- | Tell the compiler to import the given Haskell module.
 addHaskellImport :: String -> TCM ()
-addHaskellImport i =
-  modify $ \s -> s { stHaskellImports = Set.insert i $ stHaskellImports s }
+addHaskellImport i = stHaskellImports %= Set.insert i
 
 -- | Get the Haskell imports.
 getHaskellImports :: TCM (Set String)
-getHaskellImports = gets stHaskellImports
+getHaskellImports = use stHaskellImports
 
 ---------------------------------------------------------------------------
 -- * Interaction output callback
@@ -230,7 +253,7 @@ getHaskellImports = gets stHaskellImports
 
 getInteractionOutputCallback :: TCM InteractionOutputCallback
 getInteractionOutputCallback
-  = gets $ stInteractionOutputCallback . stPersistent
+  = gets $ stInteractionOutputCallback . stPersistentState
 
 appInteractionOutputCallback :: Response -> TCM ()
 appInteractionOutputCallback r
@@ -245,17 +268,17 @@ setInteractionOutputCallback cb
 ---------------------------------------------------------------------------
 
 getPatternSyns :: TCM PatternSynDefns
-getPatternSyns = gets stPatternSyns
+getPatternSyns = use stPatternSyns
 
 setPatternSyns :: PatternSynDefns -> TCM ()
 setPatternSyns m = modifyPatternSyns (const m)
 
 -- | Lens for 'stPatternSyns'.
 modifyPatternSyns :: (PatternSynDefns -> PatternSynDefns) -> TCM ()
-modifyPatternSyns f = modify $ \s -> s { stPatternSyns = f (stPatternSyns s) }
+modifyPatternSyns f = stPatternSyns %= f
 
 getPatternSynImports :: TCM PatternSynDefns
-getPatternSynImports = gets stPatternSynImports
+getPatternSynImports = use stPatternSynImports
 
 lookupPatternSyn :: QName -> TCM PatternSynDefn
 lookupPatternSyn x = do
@@ -274,7 +297,7 @@ lookupPatternSyn x = do
 
 -- | Lens getter for 'Benchmark' from 'TCState'.
 theBenchmark :: TCState -> Benchmark
-theBenchmark = stBenchmark . stPersistent
+theBenchmark = stBenchmark . stPersistentState
 
 -- | Lens map for 'Benchmark'.
 updateBenchmark :: (Benchmark -> Benchmark) -> TCState -> TCState
@@ -294,7 +317,10 @@ freshTCM :: TCM a -> TCM (Either TCErr a)
 freshTCM m = do
   -- Prepare an initial state with current benchmark info.
   b <- getBenchmark
-  let s = updateBenchmark (const b) initState
+  a <- use lensAccumStatistics
+  let s = updateBenchmark (const b)
+        . set lensAccumStatistics a
+        $ initState
   -- Run subcomputation in initial state.
   -- If we encounter an exception, we lose the state and the
   -- benchmark info.
@@ -306,6 +332,7 @@ freshTCM m = do
     Right (a, s) -> do
       -- Keep only the benchmark info from the final state of the subcomp.
       modifyBenchmark $ const $ theBenchmark s
+      lensAccumStatistics .= (s^.lensAccumStatistics)
       return $ Right a
 
 ---------------------------------------------------------------------------
@@ -321,13 +348,13 @@ addSignatureInstances sig = do
 
 -- | Lens for 'stInstanceDefs'.
 updateInstanceDefs :: (TempInstanceTable -> TempInstanceTable) -> (TCState -> TCState)
-updateInstanceDefs f s = s { stInstanceDefs = f $ stInstanceDefs s }
+updateInstanceDefs = over stInstanceDefs
 
 modifyInstanceDefs :: (TempInstanceTable -> TempInstanceTable) -> TCM ()
 modifyInstanceDefs = modify . updateInstanceDefs
 
 getAllInstanceDefs :: TCM TempInstanceTable
-getAllInstanceDefs = gets stInstanceDefs
+getAllInstanceDefs = use stInstanceDefs
 
 getAnonInstanceDefs :: TCM [QName]
 getAnonInstanceDefs = snd <$> getAllInstanceDefs
diff --git a/src/full/Agda/TypeChecking/Monad/Statistics.hs b/src/full/Agda/TypeChecking/Monad/Statistics.hs
index 0ae9d2c..e273e40 100644
--- a/src/full/Agda/TypeChecking/Monad/Statistics.hs
+++ b/src/full/Agda/TypeChecking/Monad/Statistics.hs
@@ -1,21 +1,34 @@
 -- | Collect statistics.
 
 module Agda.TypeChecking.Monad.Statistics
-    ( tick, tickN, tickMax, getStatistics
+    ( tick, tickN, tickMax, getStatistics, modifyStatistics, printStatistics
     ) where
 
 import Control.Monad.State
-import Data.Map as Map
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import qualified Text.PrettyPrint.Boxes as Boxes
+
+import Agda.Syntax.Concrete.Name as C
 
 import Agda.TypeChecking.Monad.Base
+import Agda.TypeChecking.Monad.Options
+import Agda.TypeChecking.Monad.State
+
+import Agda.Utils.Lens
+import Agda.Utils.Maybe
+import Agda.Utils.Null
+import Agda.Utils.Pretty
+import Agda.Utils.String
 
 -- | Get the statistics.
 getStatistics :: TCM Statistics
-getStatistics = gets stStatistics
+getStatistics = use stStatistics
 
 -- | Modify the statistics via given function.
 modifyStatistics :: (Statistics -> Statistics) -> TCM ()
-modifyStatistics f = modify $ \ s -> s { stStatistics = f (stStatistics s) }
+modifyStatistics f = stStatistics %= f
 
 -- | Increase specified counter by @1 at .
 tick :: String -> TCM ()
@@ -44,3 +57,15 @@ modifyCounter x f = modifyStatistics $ force . update
     update  = Map.insertWith (\ new old -> f old) x dummy
     dummy   = f 0
 
+-- | Print the given statistics if verbosity "profile" is given.
+printStatistics :: Int -> Maybe C.TopLevelModuleName -> Statistics -> TCM ()
+printStatistics vl mmname stats = verboseS "profile" vl $ do
+  unlessNull (Map.toList stats) $ \ stats -> do
+  let -- First column (left aligned) is accounts.
+      col1 = Boxes.vcat Boxes.left  $ map (Boxes.text . fst) stats
+      -- Second column (right aligned) is numbers.
+      col2 = Boxes.vcat Boxes.right $ map (Boxes.text . showThousandSep . snd) stats
+      table = Boxes.hsep 1 Boxes.left [col1, col2]
+  reportSLn "profile" 1 $ caseMaybe mmname "Accumlated statistics" $ \ mname ->
+    "Statistics for " ++ prettyShow mname
+  reportSLn "profile" 1 $ Boxes.render table
diff --git a/src/full/Agda/TypeChecking/Monad/Trace.hs b/src/full/Agda/TypeChecking/Monad/Trace.hs
index c6d1436..a1f7977 100644
--- a/src/full/Agda/TypeChecking/Monad/Trace.hs
+++ b/src/full/Agda/TypeChecking/Monad/Trace.hs
@@ -1,4 +1,3 @@
-
 module Agda.TypeChecking.Monad.Trace where
 
 import Prelude hiding (null)
@@ -21,12 +20,12 @@ import Agda.Utils.Null
 
 interestingCall :: Closure Call -> Bool
 interestingCall cl = case clValue cl of
-    InferVar _ _	      -> False
-    InferDef _ _ _	      -> False
+    InferVar _ _              -> False
+    InferDef _ _ _            -> False
     CheckArguments _ [] _ _ _ -> False
-    SetRange _ _	      -> False
+    SetRange _ _              -> False
     NoHighlighting {}         -> False
-    _			      -> True
+    _                         -> True
 
 traceCallM :: MonadTCM tcm => tcm (Maybe r -> Call) -> tcm a -> tcm a
 traceCallM mkCall m = flip traceCall m =<< mkCall
diff --git a/src/full/Agda/TypeChecking/Patterns/Abstract.hs b/src/full/Agda/TypeChecking/Patterns/Abstract.hs
index 3524913..1abc9bb 100644
--- a/src/full/Agda/TypeChecking/Patterns/Abstract.hs
+++ b/src/full/Agda/TypeChecking/Patterns/Abstract.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Tools to manipulate patterns in abstract syntax
@@ -8,49 +8,23 @@
 
 module Agda.TypeChecking.Patterns.Abstract where
 
--- import Control.Applicative
--- import Control.Monad.Error
-
--- import Data.Maybe (fromMaybe)
--- import Data.Monoid (mempty, mappend)
 import Data.List
 import Data.Traversable hiding (mapM, sequence)
 
--- import Agda.Interaction.Options
-
-import Agda.Syntax.Common as Common
-import Agda.Syntax.Literal
-import Agda.Syntax.Position
-import Agda.Syntax.Internal as I
--- import Agda.Syntax.Internal.Pattern
--- import Agda.Syntax.Abstract (IsProjP(..))
 import qualified Agda.Syntax.Abstract as A
 import Agda.Syntax.Abstract.Views
+import Agda.Syntax.Common as Common
 import Agda.Syntax.Info as A
+import Agda.Syntax.Internal as I
+import Agda.Syntax.Literal
+import Agda.Syntax.Position
 
 import Agda.TypeChecking.Monad
--- import Agda.TypeChecking.Pretty
--- import Agda.TypeChecking.Reduce
--- import Agda.TypeChecking.Substitute
--- import Agda.TypeChecking.Constraints
--- import Agda.TypeChecking.Conversion
--- import Agda.TypeChecking.Datatypes
--- import Agda.TypeChecking.Records
--- import Agda.TypeChecking.Rules.LHS.Problem
 import Agda.TypeChecking.Monad.Builtin
--- import Agda.TypeChecking.Free
--- import Agda.TypeChecking.Irrelevance
--- import Agda.TypeChecking.MetaVars
 
 import Agda.Utils.Functor
--- import Agda.Utils.List
--- import Agda.Utils.Maybe
--- import Agda.Utils.Monad
--- import Agda.Utils.Permutation
--- import Agda.Utils.Tuple
--- import qualified Agda.Utils.Pretty as P
-
-#include "../../undefined.h"
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Expand literal integer pattern into suc/zero constructor patterns.
@@ -117,6 +91,6 @@ instance ExpandPatternSynonyms A.Pattern where
         instPatternSyn (ns, p) as = do
           p <- expandPatternSynonyms p
           case A.insertImplicitPatSynArgs (A.ImplicitP . PatRange) (getRange x) ns as of
-            Nothing       -> typeError $ GenericError $ "Bad arguments to pattern synonym " ++ show x
-            Just (_, _:_) -> typeError $ GenericError $ "Too few arguments to pattern synonym " ++ show x
+            Nothing       -> typeError $ BadArgumentsToPatternSynonym x
+            Just (_, _:_) -> typeError $ TooFewArgumentsToPatternSynonym x
             Just (s, [])  -> return $ setRange (getRange i) $ A.substPattern s p
diff --git a/src/full/Agda/TypeChecking/Patterns/Match.hs b/src/full/Agda/TypeChecking/Patterns/Match.hs
index f9ca052..0a8f5f1 100644
--- a/src/full/Agda/TypeChecking/Patterns/Match.hs
+++ b/src/full/Agda/TypeChecking/Patterns/Match.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Agda.TypeChecking.Patterns.Match where
@@ -21,13 +21,15 @@ import Agda.Utils.Monad
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | If matching is inconclusive (@DontKnow@) we want to know whether
 --   it is due to a particular meta variable.
-data Match a = Yes Simplification [a] | No | DontKnow (Maybe MetaId)
-  deriving (Functor)
+data Match a = Yes Simplification [a]
+             | No
+             | DontKnow (Maybe MetaId)
+  deriving Functor
 
 instance Monoid (Match a) where
     mempty = Yes mempty []
@@ -35,7 +37,7 @@ instance Monoid (Match a) where
     Yes s us   `mappend` Yes s' vs        = Yes (s `mappend` s') (us ++ vs)
     Yes _ _    `mappend` No               = No
     Yes _ _    `mappend` DontKnow m       = DontKnow m
-    No	       `mappend` _                = No
+    No         `mappend` _                = No
 
     -- Nothing means blocked by a variable.  In this case no instantiation of
     -- meta-variables will make progress.
@@ -43,7 +45,7 @@ instance Monoid (Match a) where
 
     -- One could imagine DontKnow _ `mappend` No = No, but would break the
     -- equivalence to case-trees.
-    DontKnow m `mappend` _		  = DontKnow m
+    DontKnow m `mappend` _                = DontKnow m
 
 -- | Instead of 'zipWithM', we need to use this lazy version
 --   of combining pattern matching computations.
@@ -141,27 +143,27 @@ matchPattern p u = case (p, u) of
     w <- reduceB' v
     let arg' = arg $> ignoreBlocking w
     case ignoreSharing <$> w of
-	NotBlocked (Lit l')
-	    | l == l'          -> return (Yes YesSimplification [] , arg')
-	    | otherwise        -> return (No                       , arg')
-	NotBlocked (MetaV x _) -> return (DontKnow $ Just x        , arg')
-	Blocked x _            -> return (DontKnow $ Just x        , arg')
-	_                      -> return (DontKnow Nothing         , arg')
+        NotBlocked (Lit l')
+            | l == l'          -> return (Yes YesSimplification [] , arg')
+            | otherwise        -> return (No                       , arg')
+        NotBlocked (MetaV x _) -> return (DontKnow $ Just x        , arg')
+        Blocked x _            -> return (DontKnow $ Just x        , arg')
+        _                      -> return (DontKnow Nothing         , arg')
 
 {- Andreas, 2012-04-02 NO LONGER UP-TO-DATE
 matchPattern (Arg h' r' (ConP c _ ps))     (Arg h Irrelevant v) = do
           -- Andreas, 2010-09-07 matching a record constructor against
           -- something irrelevant will just continue matching against
           -- irrelevant stuff
-		(m, vs) <- matchPatterns ps $
+                (m, vs) <- matchPatterns ps $
                   repeat $ Arg NotHidden Irrelevant $ DontCare __IMPOSSIBLE__
-		return (m, Arg h Irrelevant $ Con c vs)
+                return (m, Arg h Irrelevant $ Con c vs)
 -}
 
   -- Case record pattern: always succeed!
   -- This case is necessary if we want to use the clauses before
   -- record pattern translation (e.g., in type-checking definitions by copatterns).
-  (ConP con@(ConHead c ds) Just{} ps, arg@(Arg info v))
+  (ConP con@(ConHead c _ ds) Just{} ps, arg@(Arg info v))
      -- precondition: con actually comes with the record fields
      | size ds == size ps -> mapSnd (Arg info . Con con) <$> do
          matchPatterns ps $ for ds $ \ d -> Arg info $ v `applyE` [Proj d]
@@ -170,7 +172,7 @@ matchPattern (Arg h' r' (ConP c _ ps))     (Arg h Irrelevant v) = do
 
   -- Case data constructor pattern.
   (ConP c _ ps, Arg info v) ->
-    do	w <- traverse constructorForm =<< reduceB' v
+    do  w <- traverse constructorForm =<< reduceB' v
         -- Unfold delayed (corecursive) definitions one step. This is
         -- only necessary if c is a coinductive constructor, but
         -- 1) it does not hurt to do it all the time, and
@@ -185,7 +187,7 @@ matchPattern (Arg h' r' (ConP c _ ps))     (Arg h Irrelevant v) = do
                    -- unfolded (due to open public).
                _ -> return w
         let v = ignoreBlocking w
-	case ignoreSharing <$> w of
+        case ignoreSharing <$> w of
 
 {- Andreas, 2013-10-27 the following considered HARMFUL:
           -- Andreas, 2010-09-07 matching a record constructor against
@@ -193,19 +195,23 @@ matchPattern (Arg h' r' (ConP c _ ps))     (Arg h Irrelevant v) = do
           -- irrelevant stuff
           -- NotBlocked (Sort Prop)
           _  | isIrrelevant info -> do
-		(m, vs) <- matchPatterns ps $
+                (m, vs) <- matchPatterns ps $
                   repeat $ setRelevance Irrelevant $ defaultArg $ Sort Prop
                     -- repeat looks very bad here (non-termination!)
-		return (m, Arg info $ Con c vs)
+                return (m, Arg info $ Con c vs)
 -}
-	  NotBlocked (Con c' vs)
-	    | c == c'            -> do
-		(m, vs) <- yesSimplification <$> matchPatterns ps vs
-		return (m, Arg info $ Con c' vs)
-	    | otherwise           -> return (No, Arg info v) -- NOTE: v the reduced thing(shadowing!). Andreas, 2013-07-03
-	  NotBlocked (MetaV x vs) -> return (DontKnow $ Just x, Arg info v)
-	  Blocked x _             -> return (DontKnow $ Just x, Arg info v)
+          NotBlocked (Con c' vs)
+            | c == c'            -> do
+                (m, vs) <- yesSimplification <$> matchPatterns ps vs
+                return (m, Arg info $ Con c' vs)
+            | otherwise           -> return (No, Arg info v) -- NOTE: v the reduced thing(shadowing!). Andreas, 2013-07-03
+          NotBlocked (MetaV x vs) -> return (DontKnow $ Just x, Arg info v)
+          Blocked x _             -> return (DontKnow $ Just x, Arg info v)
           _                       -> return (DontKnow Nothing, Arg info v)
 
+-- ASR (08 November 2014). The type of the function could be
+--
+-- @(Match Term, [I.Arg Term]) -> (Match Term, [I.Arg Term])@.
+yesSimplification :: (Match a, b) -> (Match a, b)
 yesSimplification (Yes _ vs, us) = (Yes YesSimplification vs, us)
 yesSimplification r              = r
diff --git a/src/full/Agda/TypeChecking/Polarity.hs b/src/full/Agda/TypeChecking/Polarity.hs
index 74db82b..0578320 100644
--- a/src/full/Agda/TypeChecking/Polarity.hs
+++ b/src/full/Agda/TypeChecking/Polarity.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.Polarity where
@@ -29,7 +29,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -205,7 +205,7 @@ relevantInIgnoringNonvariant i t (p:ps) = do
 
 -- | Record information that an argument is unused in 'Relevance'.
 mkUnused :: Relevance -> Relevance
-mkUnused Relevant = UnusedArg   -- commenting out this line switches of 'UnusedArg' polarity machinery
+mkUnused Relevant = UnusedArg   -- commenting out this line switches off 'UnusedArg' polarity machinery
 mkUnused r        = r  -- 'Irrelevant' is more informative than 'UnusedArg'.
 
 -- | Improve 'Relevance' information in a type by polarity information.
diff --git a/src/full/Agda/TypeChecking/Positivity.hs b/src/full/Agda/TypeChecking/Positivity.hs
index ef09a85..c8d02e3 100644
--- a/src/full/Agda/TypeChecking/Positivity.hs
+++ b/src/full/Agda/TypeChecking/Positivity.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -38,7 +38,7 @@ import Agda.Utils.SemiRing
 import qualified Agda.Utils.Graph.AdjacencyMap as Graph
 import Agda.Utils.Graph.AdjacencyMap (Graph)
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Check that the datatypes in the mutual block containing the given
@@ -73,8 +73,7 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
   let sccs = Graph.sccs gstar
   reportSDoc "tc.pos.graph.sccs" 15 $ text $ "  sccs = " ++ show sccs
   forM_ sccs $ \ scc -> setMut [ q | DefNode q <- scc ]
-  whenM positivityCheckEnabled $
-    mapM_ (checkPos g) $ Set.toList qs
+  mapM_ (checkPos g) $ Set.toList qs
   reportSDoc "tc.pos.tick" 100 $ text "checked positivity"
 
   where
@@ -89,14 +88,16 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
           loops      = filter (critical dr) $ Graph.allPaths (critical dr) (DefNode q) (DefNode q) g
 
       -- if we have a negative loop, raise error
-      forM_ [ how | Edge o how <- loops, o <= JustPos ] $ \ how -> do
+      whenM positivityCheckEnabled $ do
+        forM_ [ how | Edge o how <- loops, o <= JustPos ] $ \ how -> do
           err <- fsep $
             [prettyTCM q] ++ pwords "is not strictly positive, because it occurs" ++
             [prettyTCM how]
-          setCurrentRange (getRange q) $ typeError $ GenericError (show err)
+          setCurrentRange (getRange q) $ typeError $ GenericDocError err
 
       -- if we find an unguarded record, mark it as such
-      case mhead [ how | Edge o how <- loops, o <= StrictPos ] of
+      when (dr == IsRecord) $ do
+       case headMaybe [ how | Edge o how <- loops, o <= StrictPos ] of
         Just how -> do
           reportSDoc "tc.pos.record" 5 $ sep
             [ prettyTCM q <+> text "is not guarded, because it occurs"
@@ -113,7 +114,7 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
           recursiveRecord q
           checkInduction q
 
-    checkInduction q = do
+    checkInduction q = whenM positivityCheckEnabled $ do
       -- Check whether the recursive record has been declared as
       -- 'Inductive' or 'Coinductive'.  Otherwise, error.
       unlessM (isJust . recInduction . theDef <$> getConstInfo q) $ do
@@ -154,6 +155,7 @@ checkStrictlyPositive qs = disableDestructiveUpdate $ do
       -- it is computed deep-strictly.
       setArgOccurrences q $!! args
 
+getDefArity :: Definition -> TCM Int
 getDefArity def = case theDef def of
   Function{ funClauses = cs, funProjection = proj } -> do
     let dropped = maybe 0 (subtract 1 . projIndex) proj
diff --git a/src/full/Agda/TypeChecking/Pretty.hs b/src/full/Agda/TypeChecking/Pretty.hs
index 3a938a0..0fda40d 100644
--- a/src/full/Agda/TypeChecking/Pretty.hs
+++ b/src/full/Agda/TypeChecking/Pretty.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -25,7 +25,7 @@ import Agda.TypeChecking.Monad
 import qualified Agda.Utils.Pretty as P
 import Agda.Utils.Permutation (Permutation)
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -35,41 +35,59 @@ import Agda.Utils.Impossible
 type Doc = P.Doc
 
 empty, comma, colon, equals :: TCM Doc
+empty  = return P.empty
+comma  = return P.comma
+colon  = return P.colon
+equals = return P.equals
 
-empty	   = return P.empty
-comma	   = return P.comma
-colon      = return P.colon
-equals     = return P.equals
-pretty x   = return $ P.pretty x
-prettyA x  = P.prettyA x
+pretty :: P.Pretty a => a -> TCM P.Doc
+pretty x = return $ P.pretty x
+
+prettyA :: (P.Pretty c, ToConcrete a c) => a -> TCM Doc
+prettyA x = P.prettyA x
+
+prettyAs :: (P.Pretty c, ToConcrete a [c]) => a -> TCM Doc
 prettyAs x = P.prettyAs x
+
 text :: String -> TCM Doc
-text s	   = return $ P.text s
-pwords s   = map return $ P.pwords s
-fwords s   = return $ P.fwords s
-sep, fsep, hsep, vcat :: [TCM Doc] -> TCM Doc
-sep ds	   = P.sep <$> sequence ds
-fsep ds    = P.fsep <$> sequence ds
-hsep ds    = P.hsep <$> sequence ds
-hcat ds    = P.hcat <$> sequence ds
-vcat ds    = P.vcat <$> sequence ds
+text s = return $ P.text s
+
+pwords :: String ->  [TCM Doc]
+pwords s = map return $ P.pwords s
+
+fwords :: String -> TCM Doc
+fwords s  = return $ P.fwords s
+
+sep, fsep, hsep, hcat, vcat :: [TCM Doc] -> TCM Doc
+sep ds  = P.sep <$> sequence ds
+fsep ds = P.fsep <$> sequence ds
+hsep ds = P.hsep <$> sequence ds
+hcat ds = P.hcat <$> sequence ds
+vcat ds = P.vcat <$> sequence ds
+
 ($$), ($+$), (<>), (<+>) :: TCM Doc -> TCM Doc -> TCM Doc
-d1 $$ d2   = (P.$$) <$> d1 <*> d2
-d1 $+$ d2  = (P.$+$) <$> d1 <*> d2
-d1 <> d2   = (P.<>) <$> d1 <*> d2
-d1 <+> d2  = (P.<+>) <$> d1 <*> d2
+d1 $$ d2  = (P.$$) <$> d1 <*> d2
+d1 $+$ d2 = (P.$+$) <$> d1 <*> d2
+d1 <> d2  = (P.<>) <$> d1 <*> d2
+d1 <+> d2 = (P.<+>) <$> d1 <*> d2
+
+nest :: Int -> TCM Doc -> TCM Doc
 nest n d   = P.nest n <$> d
+
+braces, dbraces, brackets, parens :: TCM Doc -> TCM Doc
 braces d   = P.braces <$> d
 dbraces d  = P.dbraces <$> d
 brackets d = P.brackets <$> d
 parens d   = P.parens <$> d
 
+prettyList :: [TCM Doc] -> TCM Doc
 prettyList ds = brackets $ fsep $ punctuate comma ds
 
+punctuate :: TCM Doc -> [TCM Doc] -> [TCM Doc]
 punctuate _ [] = []
 punctuate d ds = zipWith (<>) ds (replicate n d ++ [empty])
-    where
-	n = length ds - 1
+  where
+    n = length ds - 1
 
 ---------------------------------------------------------------------------
 -- * The PrettyTCM class
@@ -172,40 +190,40 @@ instance PrettyTCM ProblemConstraint where
 
 instance PrettyTCM Constraint where
     prettyTCM c = case c of
-	ValueCmp cmp ty s t ->
-	    sep [ sep [ prettyTCM s
-		      , prettyTCM cmp <+> prettyTCM t
-		      ]
-		, nest 2 $ text ":" <+> prettyTCM ty
-		]
+        ValueCmp cmp ty s t ->
+            sep [ sep [ prettyTCM s
+                      , prettyTCM cmp <+> prettyTCM t
+                      ]
+                , nest 2 $ text ":" <+> prettyTCM ty
+                ]
         ElimCmp cmps t v us vs ->
           sep [ sep [ prettyTCM us
                     , nest 2 $ text "~~" <+> prettyTCM vs
                     ]
               , text ":" <+> prettyTCM t ]
-	LevelCmp cmp a b ->
-	    sep [ prettyTCM a
-		, prettyTCM cmp <+> prettyTCM b
-		]
-	TypeCmp cmp a b ->
-	    sep [ prettyTCM a
-		, prettyTCM cmp <+> prettyTCM b
-		]
-	TelCmp a b cmp tela telb ->
-	    sep [ prettyTCM tela
-		, prettyTCM cmp <+> prettyTCM telb
-		]
-	SortCmp cmp s1 s2 ->
-	    sep [ prettyTCM s1
-		, prettyTCM cmp <+> prettyTCM s2
-		]
-	Guarded c pid ->
-	    sep [ prettyTCM c
-		, nest 2 $ brackets $ text "blocked on problem" <+> text (show pid)
-		]
-	UnBlock m   -> do
-	    -- BlockedConst t <- mvInstantiation <$> lookupMeta m
-	    mi <- mvInstantiation <$> lookupMeta m
+        LevelCmp cmp a b ->
+            sep [ prettyTCM a
+                , prettyTCM cmp <+> prettyTCM b
+                ]
+        TypeCmp cmp a b ->
+            sep [ prettyTCM a
+                , prettyTCM cmp <+> prettyTCM b
+                ]
+        TelCmp a b cmp tela telb ->
+            sep [ prettyTCM tela
+                , prettyTCM cmp <+> prettyTCM telb
+                ]
+        SortCmp cmp s1 s2 ->
+            sep [ prettyTCM s1
+                , prettyTCM cmp <+> prettyTCM s2
+                ]
+        Guarded c pid ->
+            sep [ prettyTCM c
+                , nest 2 $ brackets $ text "blocked on problem" <+> text (show pid)
+                ]
+        UnBlock m   -> do
+            -- BlockedConst t <- mvInstantiation <$> lookupMeta m
+            mi <- mvInstantiation <$> lookupMeta m
             case mi of
               BlockedConst t ->
                 sep [ text (show m) <+> text ":="
@@ -218,11 +236,11 @@ instance PrettyTCM Constraint where
               OpenIFS{}  -> __IMPOSSIBLE__
               InstS{} -> __IMPOSSIBLE__
               InstV{} -> __IMPOSSIBLE__
-	FindInScope m Nothing -> do
+        FindInScope m Nothing -> do
             t <- getMetaType m
             sep [ text $ "Find in scope " ++ (show m) ++ " :" ++ (show t) ++ " (no candidate for now)"
                 ]
-	FindInScope m (Just cands) -> do
+        FindInScope m (Just cands) -> do
             t <- getMetaType m
             sep [ text $ "Find in scope " ++ (show m) ++ " :"
                 , nest 2 $ prettyTCM t
@@ -267,7 +285,7 @@ instance PrettyTCM PrettyContext where
   prettyTCM (PrettyContext ctx) = P.fsep . reverse <$> pr (map ctxEntry ctx)
       where
           pr :: [Dom (Name, Type)] -> TCM [P.Doc]
-          pr []		   = return []
+          pr []            = return []
           pr (Common.Dom info (x,t) : ctx) = escapeContext 1 $ do
               d    <- prettyTCM t
               x    <- prettyTCM x
diff --git a/src/full/Agda/TypeChecking/Pretty.hs-boot b/src/full/Agda/TypeChecking/Pretty.hs-boot
index cb9b908..4d383ce 100644
--- a/src/full/Agda/TypeChecking/Pretty.hs-boot
+++ b/src/full/Agda/TypeChecking/Pretty.hs-boot
@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 module Agda.TypeChecking.Pretty where
 
 -- import Agda.Syntax.Common
diff --git a/src/full/Agda/TypeChecking/Primitive.hs b/src/full/Agda/TypeChecking/Primitive.hs
index 83669f7..acd71b1 100644
--- a/src/full/Agda/TypeChecking/Primitive.hs
+++ b/src/full/Agda/TypeChecking/Primitive.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 {-| Primitive functions, such as addition on builtin integers.
 -}
@@ -15,6 +15,7 @@ import Control.Applicative
 import Data.Char
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Maybe
 
 import Agda.Interaction.Options
 
@@ -32,14 +33,14 @@ import Agda.TypeChecking.Reduce.Monad
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Errors
 import Agda.TypeChecking.Level
-import Agda.TypeChecking.Quote (quotingKit)
+import Agda.TypeChecking.Quote (QuotingKit, quoteTermWithKit, quoteTypeWithKit, quoteClauseWithKit, quotingKit)
 import Agda.TypeChecking.Pretty ()  -- instances only
 
 import Agda.Utils.Monad
 import Agda.Utils.Pretty (pretty)
-import Agda.Utils.Maybe
+import Agda.Utils.String ( Str(Str), unStr )
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 import Debug.Trace
 
@@ -51,9 +52,6 @@ data PrimitiveImpl = PrimImpl Type PrimFun
 
 -- Haskell type to Agda type
 
-newtype Str = Str { unStr :: String }
-    deriving (Eq, Ord)
-
 newtype Nat = Nat { unNat :: Integer }
     deriving (Eq, Ord, Num, Enum, Real)
 
@@ -82,13 +80,13 @@ instance (PrimType a, PrimType b) => PrimTerm (a -> b) where
 instance PrimTerm a => PrimType a where
     primType _ = el $ primTerm (undefined :: a)
 
-class	 PrimTerm a	  where primTerm :: a -> TCM Term
+class    PrimTerm a       where primTerm :: a -> TCM Term
 instance PrimTerm Integer where primTerm _ = primInteger
-instance PrimTerm Bool	  where primTerm _ = primBool
-instance PrimTerm Char	  where primTerm _ = primChar
+instance PrimTerm Bool    where primTerm _ = primBool
+instance PrimTerm Char    where primTerm _ = primChar
 instance PrimTerm Double  where primTerm _ = primFloat
-instance PrimTerm Str	  where primTerm _ = primString
-instance PrimTerm Nat	  where primTerm _ = primNat
+instance PrimTerm Str     where primTerm _ = primString
+instance PrimTerm Nat     where primTerm _ = primNat
 instance PrimTerm Lvl     where primTerm _ = primLevel
 instance PrimTerm QName   where primTerm _ = primQName
 instance PrimTerm Type    where primTerm _ = primAgdaType
@@ -108,26 +106,26 @@ class ToTerm a where
     toTermR = (pure .) <$> toTerm
 
 instance ToTerm Integer where toTerm = return $ Lit . LitInt noRange
-instance ToTerm Nat	where toTerm = return $ Lit . LitInt noRange . unNat
-instance ToTerm Lvl	where toTerm = return $ Level . Max . (:[]) . ClosedLevel . unLvl
+instance ToTerm Nat     where toTerm = return $ Lit . LitInt noRange . unNat
+instance ToTerm Lvl     where toTerm = return $ Level . Max . (:[]) . ClosedLevel . unLvl
 instance ToTerm Double  where toTerm = return $ Lit . LitFloat noRange
-instance ToTerm Char	where toTerm = return $ Lit . LitChar noRange
-instance ToTerm Str	where toTerm = return $ Lit . LitString noRange . unStr
-instance ToTerm QName	where toTerm = return $ Lit . LitQName noRange
+instance ToTerm Char    where toTerm = return $ Lit . LitChar noRange
+instance ToTerm Str     where toTerm = return $ Lit . LitString noRange . unStr
+instance ToTerm QName   where toTerm = return $ Lit . LitQName noRange
 
 instance ToTerm Bool where
     toTerm = do
-	true  <- primTrue
-	false <- primFalse
-	return $ \b -> if b then true else false
+        true  <- primTrue
+        false <- primFalse
+        return $ \b -> if b then true else false
 
 instance ToTerm Term where
-    toTerm  = do (f, _, _) <- quotingKit; runReduceF f
-    toTermR = do (f, _, _) <- quotingKit; return f
+    toTerm  = do kit <- quotingKit; runReduceF (quoteTermWithKit kit)
+    toTermR = do kit <- quotingKit; return (quoteTermWithKit kit)
 
 instance ToTerm Type where
-    toTerm  = do (_, f, _) <- quotingKit; runReduceF f
-    toTermR = do (_, f, _) <- quotingKit; return f
+    toTerm  = do kit <- quotingKit; runReduceF (quoteTypeWithKit kit)
+    toTermR = do kit <- quotingKit; return (quoteTypeWithKit kit)
 
 instance ToTerm I.ArgInfo where
   toTerm = do
@@ -158,14 +156,14 @@ buildList = do
     nil'  <- primNil
     cons' <- primCons
     let nil       = nil'
-	cons x xs = cons' `apply` [defaultArg x, defaultArg xs]
+        cons x xs = cons' `apply` [defaultArg x, defaultArg xs]
     return $ foldr cons nil
 
 instance (PrimTerm a, ToTerm a) => ToTerm [a] where
     toTerm = do
-	mkList <- buildList
-	fromA  <- toTerm
-	return $ mkList . map fromA
+        mkList <- buildList
+        fromA  <- toTerm
+        return $ mkList . map fromA
 
 -- From Haskell value to Agda term
 
@@ -176,52 +174,52 @@ class FromTerm a where
 
 instance FromTerm Integer where
     fromTerm = fromLiteral $ \l -> case l of
-	LitInt _ n -> Just n
-	_	   -> Nothing
+        LitInt _ n -> Just n
+        _          -> Nothing
 
 instance FromTerm Nat where
     fromTerm = fromLiteral $ \l -> case l of
-	LitInt _ n -> Just $ Nat n
-	_	   -> Nothing
+        LitInt _ n -> Just $ Nat n
+        _          -> Nothing
 
 instance FromTerm Lvl where
     fromTerm = fromReducedTerm $ \l -> case l of
-	Level (Max [ClosedLevel n]) -> Just $ Lvl n
-	_                           -> Nothing
+        Level (Max [ClosedLevel n]) -> Just $ Lvl n
+        _                           -> Nothing
 
 instance FromTerm Double where
     fromTerm = fromLiteral $ \l -> case l of
-	LitFloat _ x -> Just x
-	_	     -> Nothing
+        LitFloat _ x -> Just x
+        _            -> Nothing
 
 instance FromTerm Char where
     fromTerm = fromLiteral $ \l -> case l of
-	LitChar _ c -> Just c
-	_	    -> Nothing
+        LitChar _ c -> Just c
+        _           -> Nothing
 
 instance FromTerm Str where
     fromTerm = fromLiteral $ \l -> case l of
-	LitString _ s -> Just $ Str s
-	_	      -> Nothing
+        LitString _ s -> Just $ Str s
+        _             -> Nothing
 
 instance FromTerm QName where
     fromTerm = fromLiteral $ \l -> case l of
-	LitQName _ x -> Just x
-	_	      -> Nothing
+        LitQName _ x -> Just x
+        _             -> Nothing
 
 instance FromTerm Bool where
     fromTerm = do
-	true  <- primTrue
-	false <- primFalse
-	fromReducedTerm $ \t -> case t of
-	    _	| t === true  -> Just True
-		| t === false -> Just False
-		| otherwise   -> Nothing
-	where
-	    Def x [] === Def y []   = x == y
-	    Con x [] === Con y []   = x == y
-	    Var n [] === Var m []   = n == m
-	    _	     === _	    = False
+        true  <- primTrue
+        false <- primFalse
+        fromReducedTerm $ \t -> case t of
+            _   | t === true  -> Just True
+                | t === false -> Just False
+                | otherwise   -> Nothing
+        where
+            Def x [] === Def y []   = x == y
+            Con x [] === Con y []   = x == y
+            Var n [] === Var m []   = n == m
+            _        === _          = False
 
 instance (ToTerm a, FromTerm a) => FromTerm [a] where
   fromTerm = do
@@ -260,12 +258,12 @@ instance (ToTerm a, FromTerm a) => FromTerm [a] where
 
 -- | Conceptually: @redBind m f k = either (return . Left . f) k =<< m@
 redBind :: ReduceM (Reduced a a') -> (a -> b) ->
-	     (a' -> ReduceM (Reduced b b')) -> ReduceM (Reduced b b')
+             (a' -> ReduceM (Reduced b b')) -> ReduceM (Reduced b b')
 redBind ma f k = do
     r <- ma
     case r of
-	NoReduction x    -> return $ NoReduction $ f x
-	YesReduction _ y -> k y
+        NoReduction x    -> return $ NoReduction $ f x
+        YesReduction _ y -> k y
 
 redReturn :: a -> ReduceM (Reduced a' a)
 redReturn = return . YesReduction YesSimplification
@@ -274,13 +272,13 @@ fromReducedTerm :: (Term -> Maybe a) -> TCM (FromTermFunction a)
 fromReducedTerm f = return $ \t -> do
     b <- reduceB' t
     case f $ ignoreSharing $ unArg (ignoreBlocking b) of
-	Just x	-> return $ YesReduction NoSimplification x
-	Nothing	-> return $ NoReduction (reduced b)
+        Just x  -> return $ YesReduction NoSimplification x
+        Nothing -> return $ NoReduction (reduced b)
 
 fromLiteral :: (Literal -> Maybe a) -> TCM (FromTermFunction a)
 fromLiteral f = fromReducedTerm $ \t -> case t of
     Lit lit -> f lit
-    _	    -> Nothing
+    _       -> Nothing
 
 -- trustMe : {a : Level} {A : Set a} {x y : A} -> x ≡ y
 primTrustMe :: TCM PrimitiveImpl
@@ -309,7 +307,7 @@ primTrustMe = do
             -- like this.
             -- We can only do untyped equality, e.g., by normalisation.
             (u', v') <- normalise' (u, v)
-            if (u' == v') then redReturn (refl $ unArg u) else
+            if u' == v' then redReturn (refl $ unArg u) else
               return (NoReduction $ map notReduced [a, t, u, v])
 {- OLD:
 
@@ -323,12 +321,12 @@ primTrustMe = do
 
 primQNameType :: TCM PrimitiveImpl
 primQNameType = mkPrimFun1TCM (el primQName --> el primAgdaType)
-                              (\q -> defType <$> getConstInfo q)
+                              (\q -> normalise' . defType =<< getConstInfo q)
   -- Note: gets the top-level type! All bounds variables have been lifted.
 
 primQNameDefinition :: TCM PrimitiveImpl
 primQNameDefinition = do
-  (_, qType, qClause) <- quotingKit
+  kit                           <- quotingKit
   agdaFunDef                    <- primAgdaFunDef
   agdaFunDefCon                 <- primAgdaFunDefCon
   agdaDefinitionFunDef          <- primAgdaDefinitionFunDef
@@ -339,7 +337,9 @@ primQNameDefinition = do
   agdaDefinitionDataConstructor <- primAgdaDefinitionDataConstructor
   list        <- buildList
 
-  let defapp f xs  = apply f . map defaultArg <$> sequence xs
+  let qType        = quoteTypeWithKit kit
+      qClause      = quoteClauseWithKit kit
+      defapp f xs  = apply f . map defaultArg <$> sequence xs
       qFunDef t cs = defapp agdaFunDefCon [qType t, list <$> mapM qClause cs]
       qQName       = Lit . LitQName noRange
       con qn = do
@@ -403,11 +403,11 @@ mkPrimFun1TCM mt f = do
 
 -- Tying the knot
 mkPrimFun1 :: (PrimType a, PrimType b, FromTerm a, ToTerm b) =>
-	      (a -> b) -> TCM PrimitiveImpl
+              (a -> b) -> TCM PrimitiveImpl
 mkPrimFun1 f = do
     toA   <- fromTerm
     fromB <- toTerm
-    t	  <- primType f
+    t     <- primType f
     return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 1 $ \ts ->
       case ts of
         [v] ->
@@ -417,13 +417,13 @@ mkPrimFun1 f = do
         _ -> __IMPOSSIBLE__
 
 mkPrimFun2 :: (PrimType a, PrimType b, PrimType c, FromTerm a, ToTerm a, FromTerm b, ToTerm c) =>
-	      (a -> b -> c) -> TCM PrimitiveImpl
+              (a -> b -> c) -> TCM PrimitiveImpl
 mkPrimFun2 f = do
     toA   <- fromTerm
     fromA <- toTerm
-    toB	  <- fromTerm
+    toB   <- fromTerm
     fromC <- toTerm
-    t	  <- primType f
+    t     <- primType f
     return $ PrimImpl t $ PrimFun __IMPOSSIBLE__ 2 $ \ts ->
       case ts of
         [v,w] ->
@@ -440,7 +440,7 @@ mkPrimFun4 :: ( PrimType a, FromTerm a, ToTerm a
               , PrimType c, FromTerm c, ToTerm c
               , PrimType d, FromTerm d
               , PrimType e, ToTerm e) =>
-	      (a -> b -> c -> d -> e) -> TCM PrimitiveImpl
+              (a -> b -> c -> d -> e) -> TCM PrimitiveImpl
 mkPrimFun4 f = do
     (toA, fromA) <- (,) <$> fromTerm <*> toTerm
     (toB, fromB) <- (,) <$> fromTerm <*> toTerm
@@ -497,7 +497,7 @@ gpi info name a b = do
               (Pi (Dom info a) (Abs y b))
 
 hPi, nPi :: String -> TCM Type -> TCM Type -> TCM Type
-hPi = gpi $ setHiding Hidden $ defaultArgInfo
+hPi = gpi $ setHiding Hidden defaultArgInfo
 nPi = gpi defaultArgInfo
 
 varM :: Int -> TCM Term
@@ -528,13 +528,17 @@ tset :: TCM Type
 tset = return $ sort (mkType 0)
 
 -- | Abbreviation: @argN = 'Arg' 'defaultArgInfo'@.
-
+argN :: e -> I.Arg e
 argN = Arg defaultArgInfo
+
+domN :: e -> I.Dom e
 domN = Dom defaultArgInfo
 
 -- | Abbreviation: @argH = 'hide' 'Arg' 'defaultArgInfo'@.
-
+argH :: e -> I.Arg e
 argH = Arg $ setHiding Hidden defaultArgInfo
+
+domH :: e -> I.Dom e
 domH = Dom $ setHiding Hidden defaultArgInfo
 
 ---------------------------------------------------------------------------
@@ -550,71 +554,71 @@ primitiveFunctions :: Map String (TCM PrimitiveImpl)
 primitiveFunctions = Map.fromList
 
     -- Integer functions
-    [ "primIntegerPlus"	    |-> mkPrimFun2 ((+)	       :: Op Integer)
-    , "primIntegerMinus"    |-> mkPrimFun2 ((-)	       :: Op Integer)
-    , "primIntegerTimes"    |-> mkPrimFun2 ((*)	       :: Op Integer)
-    , "primIntegerDiv"	    |-> mkPrimFun2 (div	       :: Op Integer)    -- partial
-    , "primIntegerMod"	    |-> mkPrimFun2 (mod	       :: Op Integer)    -- partial
+    [ "primIntegerPlus"     |-> mkPrimFun2 ((+)        :: Op Integer)
+    , "primIntegerMinus"    |-> mkPrimFun2 ((-)        :: Op Integer)
+    , "primIntegerTimes"    |-> mkPrimFun2 ((*)        :: Op Integer)
+    , "primIntegerDiv"      |-> mkPrimFun2 (div        :: Op Integer)    -- partial
+    , "primIntegerMod"      |-> mkPrimFun2 (mod        :: Op Integer)    -- partial
     , "primIntegerEquality" |-> mkPrimFun2 ((==)       :: Rel Integer)
-    , "primIntegerLess"	    |-> mkPrimFun2 ((<)	       :: Rel Integer)
+    , "primIntegerLess"     |-> mkPrimFun2 ((<)        :: Rel Integer)
     , "primIntegerAbs"      |-> mkPrimFun1 (Nat . abs  :: Integer -> Nat)
     , "primNatToInteger"    |-> mkPrimFun1 (unNat      :: Nat -> Integer)
-    , "primShowInteger"	    |-> mkPrimFun1 (Str . show :: Integer -> Str)
+    , "primShowInteger"     |-> mkPrimFun1 (Str . show :: Integer -> Str)
 
     -- Natural number functions
-    , "primNatPlus"	    |-> mkPrimFun2 ((+)			    :: Op Nat)
-    , "primNatMinus"	    |-> mkPrimFun2 ((\x y -> max 0 (x - y)) :: Op Nat)
-    , "primNatTimes"	    |-> mkPrimFun2 ((*)			    :: Op Nat)
+    , "primNatPlus"         |-> mkPrimFun2 ((+)                     :: Op Nat)
+    , "primNatMinus"        |-> mkPrimFun2 ((\x y -> max 0 (x - y)) :: Op Nat)
+    , "primNatTimes"        |-> mkPrimFun2 ((*)                     :: Op Nat)
     , "primNatDivSucAux"    |-> mkPrimFun4 ((\k m n j -> k + div (max 0 $ n + m - j) (m + 1)) :: Nat -> Nat -> Nat -> Nat -> Nat)
     , "primNatModSucAux"    |->
         let aux :: Nat -> Nat -> Nat -> Nat -> Nat
             aux k m n j | n > j     = mod (n - j - 1) (m + 1)
                         | otherwise = k + n
         in mkPrimFun4 aux
-    , "primNatEquality"	    |-> mkPrimFun2 ((==)		    :: Rel Nat)
-    , "primNatLess"	    |-> mkPrimFun2 ((<)			    :: Rel Nat)
-    , "primLevelZero"	    |-> mkPrimLevelZero
-    , "primLevelSuc"	    |-> mkPrimLevelSuc
-    , "primLevelMax"	    |-> mkPrimLevelMax
+    , "primNatEquality"     |-> mkPrimFun2 ((==)                    :: Rel Nat)
+    , "primNatLess"         |-> mkPrimFun2 ((<)                     :: Rel Nat)
+    , "primLevelZero"       |-> mkPrimLevelZero
+    , "primLevelSuc"        |-> mkPrimLevelSuc
+    , "primLevelMax"        |-> mkPrimLevelMax
 
     -- Floating point functions
     , "primIntegerToFloat"  |-> mkPrimFun1 (fromIntegral :: Integer -> Double)
-    , "primFloatPlus"	    |-> mkPrimFun2 ((+)		 :: Op Double)
-    , "primFloatMinus"	    |-> mkPrimFun2 ((-)		 :: Op Double)
-    , "primFloatTimes"	    |-> mkPrimFun2 ((*)		 :: Op Double)
-    , "primFloatDiv"	    |-> mkPrimFun2 ((/)		 :: Op Double)
-    , "primFloatEquality"   |-> mkPrimFun2 ((==)	 :: Rel Double)
-    , "primFloatLess"	    |-> mkPrimFun2 ((<)		 :: Rel Double)
-    , "primRound"	    |-> mkPrimFun1 (round	 :: Double -> Integer)
-    , "primFloor"	    |-> mkPrimFun1 (floor	 :: Double -> Integer)
-    , "primCeiling"	    |-> mkPrimFun1 (ceiling	 :: Double -> Integer)
-    , "primExp"		    |-> mkPrimFun1 (exp		 :: Fun Double)
-    , "primLog"		    |-> mkPrimFun1 (log		 :: Fun Double)    -- partial
-    , "primSin"		    |-> mkPrimFun1 (sin		 :: Fun Double)
-    , "primShowFloat"	    |-> mkPrimFun1 (Str . show	 :: Double -> Str)
+    , "primFloatPlus"       |-> mkPrimFun2 ((+)          :: Op Double)
+    , "primFloatMinus"      |-> mkPrimFun2 ((-)          :: Op Double)
+    , "primFloatTimes"      |-> mkPrimFun2 ((*)          :: Op Double)
+    , "primFloatDiv"        |-> mkPrimFun2 ((/)          :: Op Double)
+    , "primFloatEquality"   |-> mkPrimFun2 ((==)         :: Rel Double)
+    , "primFloatLess"       |-> mkPrimFun2 ((<)          :: Rel Double)
+    , "primRound"           |-> mkPrimFun1 (round        :: Double -> Integer)
+    , "primFloor"           |-> mkPrimFun1 (floor        :: Double -> Integer)
+    , "primCeiling"         |-> mkPrimFun1 (ceiling      :: Double -> Integer)
+    , "primExp"             |-> mkPrimFun1 (exp          :: Fun Double)
+    , "primLog"             |-> mkPrimFun1 (log          :: Fun Double)    -- partial
+    , "primSin"             |-> mkPrimFun1 (sin          :: Fun Double)
+    , "primShowFloat"       |-> mkPrimFun1 (Str . show   :: Double -> Str)
 
     -- Character functions
     , "primCharEquality"    |-> mkPrimFun2 ((==) :: Rel Char)
-    , "primIsLower"	    |-> mkPrimFun1 isLower
-    , "primIsDigit"	    |-> mkPrimFun1 isDigit
-    , "primIsAlpha"	    |-> mkPrimFun1 isAlpha
-    , "primIsSpace"	    |-> mkPrimFun1 isSpace
-    , "primIsAscii"	    |-> mkPrimFun1 isAscii
-    , "primIsLatin1"	    |-> mkPrimFun1 isLatin1
-    , "primIsPrint"	    |-> mkPrimFun1 isPrint
-    , "primIsHexDigit"	    |-> mkPrimFun1 isHexDigit
-    , "primToUpper"	    |-> mkPrimFun1 toUpper
-    , "primToLower"	    |-> mkPrimFun1 toLower
+    , "primIsLower"         |-> mkPrimFun1 isLower
+    , "primIsDigit"         |-> mkPrimFun1 isDigit
+    , "primIsAlpha"         |-> mkPrimFun1 isAlpha
+    , "primIsSpace"         |-> mkPrimFun1 isSpace
+    , "primIsAscii"         |-> mkPrimFun1 isAscii
+    , "primIsLatin1"        |-> mkPrimFun1 isLatin1
+    , "primIsPrint"         |-> mkPrimFun1 isPrint
+    , "primIsHexDigit"      |-> mkPrimFun1 isHexDigit
+    , "primToUpper"         |-> mkPrimFun1 toUpper
+    , "primToLower"         |-> mkPrimFun1 toLower
     , "primCharToNat"       |-> mkPrimFun1 (fromIntegral . fromEnum :: Char -> Nat)
     , "primNatToChar"       |-> mkPrimFun1 (toEnum . fromIntegral   :: Nat -> Char)
-    , "primShowChar"	    |-> mkPrimFun1 (Str . show . pretty . LitChar noRange)
+    , "primShowChar"        |-> mkPrimFun1 (Str . show . pretty . LitChar noRange)
 
     -- String functions
     , "primStringToList"    |-> mkPrimFun1 unStr
     , "primStringFromList"  |-> mkPrimFun1 Str
     , "primStringAppend"    |-> mkPrimFun2 (\s1 s2 -> Str $ unStr s1 ++ unStr s2)
     , "primStringEquality"  |-> mkPrimFun2 ((==) :: Rel Str)
-    , "primShowString"	    |-> mkPrimFun1 (Str . show . pretty . LitString noRange . unStr)
+    , "primShowString"      |-> mkPrimFun1 (Str . show . pretty . LitString noRange . unStr)
 
     -- Reflection
     , "primQNameType"       |-> primQNameType
@@ -627,13 +631,12 @@ primitiveFunctions = Map.fromList
     , "primShowQName"       |-> mkPrimFun1 (Str . show :: QName -> Str)
     ]
     where
-	(|->) = (,)
+        (|->) = (,)
 
 lookupPrimitiveFunction :: String -> TCM PrimitiveImpl
 lookupPrimitiveFunction x =
-    case Map.lookup x primitiveFunctions of
-	Just p	-> p
-	Nothing	-> typeError $ NoSuchPrimitiveFunction x
+  fromMaybe (typeError $ NoSuchPrimitiveFunction x)
+            (Map.lookup x primitiveFunctions)
 
 lookupPrimitiveFunctionQ :: QName -> TCM (String, PrimitiveImpl)
 lookupPrimitiveFunctionQ q = do
diff --git a/src/full/Agda/TypeChecking/ProjectionLike.hs b/src/full/Agda/TypeChecking/ProjectionLike.hs
index bc8d598..8269586 100644
--- a/src/full/Agda/TypeChecking/ProjectionLike.hs
+++ b/src/full/Agda/TypeChecking/ProjectionLike.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.ProjectionLike where
@@ -27,7 +27,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Size
 import Agda.Utils.Permutation
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | View for a @Def f (Apply a : es)@ where @isProjection f at .
diff --git a/src/full/Agda/TypeChecking/Quote.hs b/src/full/Agda/TypeChecking/Quote.hs
index fa554f5..4078274 100644
--- a/src/full/Agda/TypeChecking/Quote.hs
+++ b/src/full/Agda/TypeChecking/Quote.hs
@@ -1,46 +1,56 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE PatternGuards #-}
 
 module Agda.TypeChecking.Quote where
 
 import Control.Applicative
 import Control.Monad.State (evalState, get, put)
 import Control.Monad.Writer (execWriterT, tell)
-import Control.Monad.Error (catchError)
+import Control.Monad.Trans (lift)
 
+import Data.Char
 import Data.Maybe (fromMaybe)
 import Data.Traversable (traverse)
-import Data.Char
 
-import Agda.Syntax.Position
-import Agda.Syntax.Literal
-import Agda.Syntax.Internal as I
 import Agda.Syntax.Common
+import Agda.Syntax.Internal as I
+import Agda.Syntax.Literal
+import Agda.Syntax.Position
 import Agda.Syntax.Translation.InternalToAbstract
 
-import {-# SOURCE #-} Agda.TypeChecking.Datatypes
+import Agda.TypeChecking.CompiledClause
+import Agda.TypeChecking.Datatypes ( getConHead )
+import Agda.TypeChecking.DropArgs
+import Agda.TypeChecking.Free
+import Agda.TypeChecking.Level
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.Monad.Builtin
+import Agda.TypeChecking.Monad.Exception
+import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Reduce.Monad
-import Agda.TypeChecking.Pretty
 import Agda.TypeChecking.Substitute
-import Agda.TypeChecking.DropArgs
-import Agda.TypeChecking.CompiledClause
-import Agda.TypeChecking.Free
-import Agda.TypeChecking.Level
-
-import Agda.Utils.String
-import Agda.Utils.Permutation
 
-import Agda.Utils.Monad
-
-#include "../undefined.h"
+import Agda.Utils.Except
 import Agda.Utils.Impossible
-
-quotingKit :: TCM (Term -> ReduceM Term, Type -> ReduceM Term, Clause -> ReduceM Term)
+import Agda.Utils.Monad ( ifM )
+import Agda.Utils.Permutation ( Permutation(Perm) )
+import Agda.Utils.String ( Str(Str), unStr )
+import Agda.Utils.VarSet (VarSet)
+import qualified Agda.Utils.VarSet as Set
+
+#include "undefined.h"
+
+data QuotingKit = QuotingKit
+  { quoteTermWithKit   :: Term       -> ReduceM Term
+  , quoteTypeWithKit   :: Type       -> ReduceM Term
+  , quoteClauseWithKit :: Clause     -> ReduceM Term
+  , quoteDomWithKit    :: I.Dom Type -> ReduceM Term
+  }
+
+quotingKit :: TCM QuotingKit
 quotingKit = do
   hidden          <- primHidden
   instanceH       <- primInstance
@@ -87,66 +97,98 @@ quotingKit = do
       t @@ u = apply <$> t <*> ((:[]) . defaultArg <$> u)
 
       (!@) :: Apply a => a -> ReduceM Term -> ReduceM a
-      t !@  u = pure t @@ u
+      t !@ u = pure t @@ u
 
       (!@!) :: Apply a => a -> Term -> ReduceM a
       t !@! u = pure t @@ pure u
 
+      quoteHiding :: Hiding -> ReduceM Term
       quoteHiding Hidden    = pure hidden
       quoteHiding Instance  = pure instanceH
       quoteHiding NotHidden = pure visible
+
+      quoteRelevance :: Relevance -> ReduceM Term
       quoteRelevance Relevant   = pure relevant
       quoteRelevance Irrelevant = pure irrelevant
       quoteRelevance NonStrict  = pure relevant
       quoteRelevance Forced     = pure relevant
       quoteRelevance UnusedArg  = pure relevant
-      quoteColors _ = nil -- TODO guilhem
+
+--      quoteColors _ = nil -- TODO guilhem
+
+      quoteArgInfo :: I.ArgInfo -> ReduceM Term
       quoteArgInfo (ArgInfo h r cs) = arginfo !@ quoteHiding h
                                               @@ quoteRelevance r
                                 --              @@ quoteColors cs
+
+      quoteLit :: Literal -> ReduceM Term
       quoteLit l at LitInt{}    = lit !@ (litNat    !@! Lit l)
       quoteLit l at LitFloat{}  = lit !@ (litFloat  !@! Lit l)
       quoteLit l at LitChar{}   = lit !@ (litChar   !@! Lit l)
       quoteLit l at LitString{} = lit !@ (litString !@! Lit l)
       quoteLit l at LitQName{}  = lit !@ (litQName  !@! Lit l)
+
       -- We keep no ranges in the quoted term, so the equality on terms
       -- is only on the structure.
+      quoteSortLevelTerm :: Level -> ReduceM Term
       quoteSortLevelTerm (Max [])              = setLit !@! Lit (LitInt noRange 0)
       quoteSortLevelTerm (Max [ClosedLevel n]) = setLit !@! Lit (LitInt noRange n)
-      quoteSortLevelTerm l = set !@ quote (unlevelWithKit lkit l)
-      quoteSort (Type t)    = quoteSortLevelTerm t
-      quoteSort Prop        = pure unsupportedSort
-      quoteSort Inf         = pure unsupportedSort
-      quoteSort DLub{}      = pure unsupportedSort
-      quoteType (El s t) = el !@ quoteSort s @@ quote t
+      quoteSortLevelTerm l                     = set !@ quoteTerm (unlevelWithKit lkit l)
+
+      quoteSort :: Sort -> ReduceM Term
+      quoteSort (Type t) = quoteSortLevelTerm t
+      quoteSort Prop     = pure unsupportedSort
+      quoteSort Inf      = pure unsupportedSort
+      quoteSort DLub{}   = pure unsupportedSort
 
+      quoteType :: Type -> ReduceM Term
+      quoteType (El s t) = el !@ quoteSort s @@ quoteTerm t
+
+      quoteQName :: QName -> ReduceM Term
       quoteQName x = pure $ Lit $ LitQName noRange x
+
+      quotePats :: [I.NamedArg Pattern] -> ReduceM Term
       quotePats ps = list $ map (quoteArg quotePat . fmap namedThing) ps
+
+      quotePat :: Pattern -> ReduceM Term
       quotePat (VarP "()")   = pure absurdP
       quotePat (VarP _)      = pure varP
       quotePat (DotP _)      = pure dotP
       quotePat (ConP c _ ps) = conP !@ quoteQName (conName c) @@ quotePats ps
       quotePat (LitP l)      = litP !@! Lit l
       quotePat (ProjP x)     = projP !@ quoteQName x
-      quoteBody (Body a) = Just (quote a)
+
+      quoteBody :: I.ClauseBody -> Maybe (ReduceM Term)
+      quoteBody (Body a) = Just (quoteTerm a)
       quoteBody (Bind b) = quoteBody (absBody b)
       quoteBody NoBody   = Nothing
+
+      quoteClause :: Clause -> ReduceM Term
       quoteClause Clause{namedClausePats = ps, clauseBody = body} =
         case quoteBody body of
           Nothing -> absurdClause !@ quotePats ps
           Just b  -> normalClause !@ quotePats ps @@ b
 
-      list [] = pure nil
+      list :: [ReduceM Term] -> ReduceM Term
+      list []       = pure nil
       list (a : as) = cons !@ a @@ list as
+
+      quoteDom :: (Type -> ReduceM Term) -> I.Dom Type -> ReduceM Term
       quoteDom q (Dom info t) = arg !@ quoteArgInfo info @@ q t
+
+      quoteArg :: (a -> ReduceM Term) -> I.Arg a -> ReduceM Term
       quoteArg q (Arg info t) = arg !@ quoteArgInfo info @@ q t
-      quoteArgs ts = list (map (quoteArg quote) ts)
-      quote v =
+
+      quoteArgs :: I.Args -> ReduceM Term
+      quoteArgs ts = list (map (quoteArg quoteTerm) ts)
+
+      quoteTerm :: Term -> ReduceM Term
+      quoteTerm v =
         case unSpine v of
           Var n es   ->
              let ts = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
              in  var !@! Lit (LitInt noRange $ fromIntegral n) @@ quoteArgs ts
-          Lam info t -> lam !@ quoteHiding (getHiding info) @@ quote (absBody t)
+          Lam info t -> lam !@ quoteHiding (getHiding info) @@ quoteTerm (absBody t)
           Def x es   -> do
             d <- theDef <$> getConstInfo x
             qx d @@ quoteArgs ts
@@ -160,14 +202,15 @@ quotingKit = do
           Con x ts   -> con !@! quoteConName x @@ quoteArgs ts
           Pi t u     -> pi !@ quoteDom quoteType t
                              @@ quoteType (absBody u)
-          Level _    -> pure unsupported
+          Level l    -> quoteTerm (unlevelWithKit lkit l)
           Lit lit    -> quoteLit lit
           Sort s     -> sort !@ quoteSort s
-          Shared p   -> quote $ derefPtr p
+          Shared p   -> quoteTerm $ derefPtr p
           MetaV{}    -> pure unsupported
           DontCare{} -> pure unsupported -- could be exposed at some point but we have to take care
           ExtLam{}   -> __IMPOSSIBLE__
-  return (quote, quoteType, quoteClause)
+
+  return $ QuotingKit quoteTerm quoteType quoteClause (quoteDom quoteType)
 
 quoteName :: QName -> Term
 quoteName x = Lit (LitQName noRange x)
@@ -177,344 +220,10 @@ quoteConName = quoteName . conName
 
 quoteTerm :: Term -> TCM Term
 quoteTerm v = do
-  (f, _, _) <- quotingKit
-  runReduceM (f v)
+  kit <- quotingKit
+  runReduceM (quoteTermWithKit kit v)
 
 quoteType :: Type -> TCM Term
 quoteType v = do
-  (_, f, _) <- quotingKit
-  runReduceM (f v)
-
-agdaTermType :: TCM Type
-agdaTermType = El (mkType 0) <$> primAgdaTerm
-
-qNameType :: TCM Type
-qNameType = El (mkType 0) <$> primQName
-
-isCon :: ConHead -> TCM Term -> TCM Bool
-isCon con tm = do t <- tm
-                  case ignoreSharing t of
-                    Con con' _ -> return (con == con')
-                    _ -> return False
-
-unquoteFailedGeneric :: String -> TCM a
-unquoteFailedGeneric msg = typeError . GenericError $ "Unable to unquote the " ++ msg
-
-unquoteFailed :: String -> String -> Term -> TCM a
-unquoteFailed kind msg t = do doc <- prettyTCM t
-                              unquoteFailedGeneric $ "term (" ++ show doc ++ ") of type " ++ kind ++ ".\nReason: " ++ msg ++ "."
-
-class Unquote a where
-  unquote :: Term -> TCM a
-
-unquoteH :: Unquote a => I.Arg Term -> TCM a
-unquoteH a | isHidden a && isRelevant a =
-    unquote $ unArg a
-unquoteH _ = unquoteFailedGeneric "argument. It should be `hidden'."
-
-unquoteN :: Unquote a => I.Arg Term -> TCM a
-unquoteN a | notHidden a && isRelevant a =
-    unquote $ unArg a
-unquoteN _ = unquoteFailedGeneric "argument. It should be `visible'"
-
-choice :: Monad m => [(m Bool, m a)] -> m a -> m a
-choice [] dflt = dflt
-choice ((mb, mx) : mxs) dflt = ifM mb mx $ choice mxs dflt
-
-ensureDef :: QName -> TCM QName
-ensureDef x = do
-  i <- (theDef <$> getConstInfo x) `catchError` \_ -> return Axiom  -- for recursive unquoteDecl
-  case i of
-    Constructor{} -> do
-      def <- prettyTCM =<< primAgdaTermDef
-      con <- prettyTCM =<< primAgdaTermCon
-      c   <- prettyTCM x
-      setCurrentRange (getRange x) $ typeError $ GenericError $ "Use " ++ show con ++ " instead of " ++ show def ++ " for constructor " ++ show c
-    _ -> return x
-
-ensureCon :: QName -> TCM QName
-ensureCon x = do
-  i <- (theDef <$> getConstInfo x) `catchError` \_ -> return Axiom  -- for recursive unquoteDecl
-  case i of
-    Constructor{} -> return x
-    _ -> do
-      def <- prettyTCM =<< primAgdaTermDef
-      con <- prettyTCM =<< primAgdaTermCon
-      f   <- prettyTCM x
-      setCurrentRange (getRange x) $ typeError $ GenericError $ "Use " ++ show def ++ " instead of " ++ show con ++ " for non-constructor " ++ show f
-
-pickName :: Type -> String
-pickName a =
-  case unEl a of
-    Pi{}   -> "f"
-    Sort{} -> "A"
-    Def d _ | c:_ <- show (qnameName d),
-              isAlpha c -> [toLower c]
-    _    -> "_"
-
-instance Unquote I.ArgInfo where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [h,r] -> do
-        choice
-          [(c `isCon` primArgArgInfo, ArgInfo <$> unquoteN h <*> unquoteN r <*> return [])]
-          (unquoteFailed "ArgInfo" "arity 2 and not the `arginfo' constructor" t)
-      _ -> unquoteFailed "ArgInfo" "not of arity 2" t
-
-instance Unquote a => Unquote (I.Arg a) where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [info,x] -> do
-        choice
-          [(c `isCon` primArgArg, Arg <$> unquoteN info <*> unquoteN x)]
-          (unquoteFailed "Arg" "arity 2 and not the `arg' constructor" t)
-      _ -> unquoteFailed "Arg" "not of arity 2" t
-
--- Andreas, 2013-10-20: currently, post-fix projections are not part of the
--- quoted syntax.
-instance Unquote a => Unquote (Elim' a) where
-  unquote t = Apply <$> unquote t
-
-instance Unquote Integer where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Lit (LitInt _ n) -> return n
-      _ -> unquoteFailed "Integer" "not a literal integer" t
-
-instance Unquote Double where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Lit (LitFloat _ x) -> return x
-      _ -> unquoteFailed "Float" "not a literal float" t
-
-instance Unquote Char where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Lit (LitChar _ x) -> return x
-      _ -> unquoteFailed "Char" "not a literal char" t
-
-instance Unquote Str where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Lit (LitString _ x) -> return (Str x)
-      _ -> unquoteFailed "String" "not a literal string" t
-
-instance Unquote a => Unquote [a] where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [x,xs] -> do
-        choice
-          [(c `isCon` primCons, (:) <$> unquoteN x <*> unquoteN xs)]
-          (unquoteFailed "List" "arity 2 and not the `∷' constructor" t)
-      Con c [] -> do
-        choice
-          [(c `isCon` primNil, return [])]
-          (unquoteFailed "List" "arity 0 and not the `[]' constructor" t)
-      _ -> unquoteFailed "List" "neither `[]' nor `∷'" t
-
-instance Unquote Hiding where
-  unquote t = do
-    t <- reduce t
-    let err = unquoteFailed "Hiding" "neither `hidden' nor `visible'" t
-    case ignoreSharing t of
-      Con c [] -> do
-        choice
-          [(c `isCon` primHidden,  return Hidden)
-          ,(c `isCon` primInstance, return Instance)
-          ,(c `isCon` primVisible, return NotHidden)]
-          err
-      Con c vs -> unquoteFailed "Hiding" "the value is a constructor, but its arity is not 0" t
-      _        -> err
-
-instance Unquote Relevance where
-  unquote t = do
-    t <- reduce t
-    let err = unquoteFailed "Relevance" "neither `relevant' or `irrelevant'" t
-    case ignoreSharing t of
-      Con c [] -> do
-        choice
-          [(c `isCon` primRelevant,   return Relevant)
-          ,(c `isCon` primIrrelevant, return Irrelevant)]
-          err
-      Con c vs -> unquoteFailed "Relevance" "the value is a constructor, but its arity is not 0" t
-      _        -> err
-
-instance Unquote QName where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Lit (LitQName _ x) -> return x
-      _                  -> unquoteFailed "QName" "not a literal qname value" t
-
-instance Unquote ConHead where
-  unquote t = getConHead =<< ensureCon =<< unquote t
-
-instance Unquote a => Unquote (Abs a) where
-  unquote t = Abs "_" <$> unquote t
-
-instance Unquote Sort where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [] -> do
-        choice
-          [(c `isCon` primAgdaSortUnsupported, pure $ Type $ Max [Plus 0 $ UnreducedLevel $ hackReifyToMeta])]
-          __IMPOSSIBLE__
-      Con c [u] -> do
-        choice
-          [(c `isCon` primAgdaSortSet, Type <$> unquoteN u)
-          ,(c `isCon` primAgdaSortLit, Type . levelMax . (:[]) . ClosedLevel <$> unquoteN u)]
-          (unquoteFailed "Sort" "arity 1 and not the `set' or the `lit' constructors" t)
-      _ -> unquoteFailed "Sort" "not of arity 0 nor 1" t
-
-instance Unquote Level where
-  unquote l = Max . (:[]) . Plus 0 . UnreducedLevel <$> unquote l
-
-instance Unquote Type where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [s, u] -> do
-        choice
-          [(c `isCon` primAgdaTypeEl, El <$> unquoteN s <*> unquoteN u)]
-          (unquoteFailed "Type" "arity 2 and not the `el' constructor" t)
-      _ -> unquoteFailed "Type" "not of arity 2" t
-
-instance Unquote Literal where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [x] ->
-        choice
-          [ (c `isCon` primAgdaLitNat,    LitInt    noRange <$> unquoteN x)
-          , (c `isCon` primAgdaLitFloat,  LitFloat  noRange <$> unquoteN x)
-          , (c `isCon` primAgdaLitChar,   LitChar   noRange <$> unquoteN x)
-          , (c `isCon` primAgdaLitString, LitString noRange . getStr <$> unquoteN x)
-          , (c `isCon` primAgdaLitQName,  LitQName  noRange <$> unquoteN x) ]
-          (unquoteFailed "Literal" "not a literal constructor" t)
-      _ -> unquoteFailed "Literal" "not a literal constructor" t
-
-instance Unquote Term where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [] ->
-        choice
-          [(c `isCon` primAgdaTermUnsupported, pure hackReifyToMeta)]
-          (unquoteFailed "Term" "arity 0 and not the `unsupported' constructor" t)
-
-      Con c [x] -> do
-        choice
-          [ (c `isCon` primAgdaTermSort,   Sort <$> unquoteN x)
-          , (c `isCon` primAgdaTermLit,    Lit <$> unquoteN x) ]
-          (unquoteFailed "Term" "bad constructor" t)
-
-      Con c [x, y] ->
-        choice
-          [ (c `isCon` primAgdaTermVar, Var <$> (fromInteger <$> unquoteN x) <*> unquoteN y)
-          , (c `isCon` primAgdaTermCon, Con <$> unquoteN x <*> unquoteN y)
-          , (c `isCon` primAgdaTermDef, Def <$> (ensureDef =<< unquoteN x) <*> unquoteN y)
-          , (c `isCon` primAgdaTermLam, Lam <$> (flip setHiding defaultArgInfo <$> unquoteN x) <*> unquoteN y)
-          , (c `isCon` primAgdaTermPi,  mkPi <$> (domFromArg <$> unquoteN x) <*> unquoteN y)
-          , (c `isCon` primAgdaTermExtLam, mkExtLam <$> unquoteN x <*> unquoteN y) ]
-          (unquoteFailed "Term" "bad term constructor" t)
-        where
-          mkExtLam = ExtLam
-          mkPi a (Abs _ b) = Pi a (Abs x b)
-            where x | 0 `freeIn` b = pickName (unDom a)
-                    | otherwise    = "_"
-          mkPi _ NoAbs{} = __IMPOSSIBLE__
-
-      Con{} -> unquoteFailed "Term" "neither arity 0 nor 1 nor 2" t
-      Lit{} -> unquoteFailed "Term" "unexpected literal" t
-      _ -> unquoteFailed "Term" "not a constructor" t
-
-instance Unquote Pattern where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [] -> do
-        choice
-          [ (c `isCon` primAgdaPatVar,    pure (VarP "x"))
-          , (c `isCon` primAgdaPatAbsurd, pure (VarP "()"))
-          , (c `isCon` primAgdaPatDot,    pure (DotP hackReifyToMeta))
-          ] __IMPOSSIBLE__
-      Con c [x] -> do
-        choice
-          [ (c `isCon` primAgdaPatProj, ProjP <$> unquoteN x)
-          , (c `isCon` primAgdaPatLit,  LitP  <$> unquoteN x) ]
-          __IMPOSSIBLE__
-      Con c [x, y] -> do
-        choice
-          [ (c `isCon` primAgdaPatCon, flip ConP Nothing <$> unquoteN x <*> (map (fmap unnamed) <$> unquoteN y)) ]
-          __IMPOSSIBLE__
-      _ -> unquoteFailed "Pattern" "not a constructor" t
-
-data UnquotedFunDef = UnQFun Type [Clause]
-
-instance Unquote Clause where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [x] -> do
-        choice
-          [ (c `isCon` primAgdaClauseAbsurd, mkClause Nothing <$> unquoteN x) ]
-          __IMPOSSIBLE__
-      Con c [x, y] -> do
-        choice
-          [ (c `isCon` primAgdaClauseClause, mkClause . Just <$> unquoteN y <*> unquoteN x) ]
-          __IMPOSSIBLE__
-      _ -> unquoteFailed "Pattern" "not a constructor" t
-    where
-      mkClause :: Maybe Term -> [I.Arg Pattern] -> I.Clause
-      mkClause b ps0 =
-        Clause { clauseRange     = noRange
-               , clauseTel       = dummyTel n'
-               , clausePerm      = Perm n vs
-               , namedClausePats = ps
-               , clauseBody      = mkBody n b
-               , clauseType      = Nothing }
-        where
-          ps = map (fmap unnamed) ps0
-          n  = vars True ps  -- with dot patterns
-          n' = vars False ps -- without dot patterns
-          dummyTel 0 = EmptyTel
-          dummyTel n = ExtendTel (defaultDom typeDontCare) (Abs "x" $ dummyTel (n - 1))
-          mkBody 0 b = maybe NoBody Body b
-          mkBody n b = Bind $ Abs "x" $ mkBody (n - 1) b
-          vars d ps = sum $ map (vars' d . namedArg) ps
-          vars' d (ConP _ _ ps) = vars d ps
-          vars' d VarP{}      = 1
-          vars' d DotP{}      = if d then 1 else 0
-          vars' d LitP{}      = 0
-          vars' d ProjP{}     = 0
-
-          vs = evalState (execWriterT $ mapM_ (computePerm . namedArg) ps) 0
-          next = do n <- get; put (n + 1); return n
-
-          computePerm (ConP _ _ ps) = mapM_ (computePerm . namedArg) ps
-          computePerm VarP{}        = tell . (:[]) =<< next
-          computePerm DotP{}        = () <$ next
-          computePerm LitP{}        = return ()
-          computePerm ProjP{}       = return ()
-
-instance Unquote UnquotedFunDef where
-  unquote t = do
-    t <- reduce t
-    case ignoreSharing t of
-      Con c [x, y] -> do
-        choice
-          [ (c `isCon` primAgdaFunDefCon, UnQFun <$> unquoteN x <*> unquoteN y) ]
-          __IMPOSSIBLE__
-      _ -> unquoteFailed "Pattern" "not a constructor" t
-
-reifyUnquoted :: Reify a e => a -> TCM e
-reifyUnquoted = nowReifyingUnquoted . disableDisplayForms . withShowAllArguments . reify
-
+  kit <- quotingKit
+  runReduceM (quoteTypeWithKit kit v)
diff --git a/src/full/Agda/TypeChecking/RecordPatterns.hs b/src/full/Agda/TypeChecking/RecordPatterns.hs
index 5a85783..7a5b31b 100644
--- a/src/full/Agda/TypeChecking/RecordPatterns.hs
+++ b/src/full/Agda/TypeChecking/RecordPatterns.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE TupleSections              #-}
 
 -- | Code which replaces pattern matching on record constructors with
 -- uses of projection functions.
@@ -44,7 +44,7 @@ import Agda.Utils.Maybe
 import Agda.Utils.Permutation hiding (dropFrom)
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -456,7 +456,7 @@ translateRecordPatterns clause = do
       -- order (i.e. the type signature for the variable which occurs
       -- first in the list of patterns comes first).
       flattenedOldTel =
-        permute (invertP $ compactP $ clausePerm clause) $
+        permute (invertP __IMPOSSIBLE__ $ compactP $ clausePerm clause) $
         zip (teleNames $ clauseTel clause) $
         flattenTel $
         clauseTel clause
diff --git a/src/full/Agda/TypeChecking/Records.hs b/src/full/Agda/TypeChecking/Records.hs
index 654c279..f6aa95e 100644
--- a/src/full/Agda/TypeChecking/Records.hs
+++ b/src/full/Agda/TypeChecking/Records.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -17,6 +17,7 @@ import qualified Agda.Syntax.Concrete.Name as C
 import Agda.Syntax.Abstract.Name
 import Agda.Syntax.Internal as I
 import Agda.Syntax.Position
+
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Pretty
@@ -30,9 +31,10 @@ import Agda.Utils.Functor (for, ($>))
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.Pretty (prettyShow)
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Order the fields of a record construction.
@@ -297,7 +299,7 @@ etaExpandBoundVar i = do
 
       rev   = foldl (\ l (Dom ai (n, t)) -> Dom ai (nameToArgName n, t) : l) []
       -- Use "f(x)" as variable name for the projection f(x).
-      s     = show x
+      s     = prettyShow x
       tel'  = mapAbsNames (\ f -> stringToArgName $ argNameToString f ++ "(" ++ s ++ ")") tel
       delta = telFromList $ rev gamma1 ++ telToList tel' ++ rev (applySubst tau0 gamma2)
 
diff --git a/src/full/Agda/TypeChecking/Reduce.hs b/src/full/Agda/TypeChecking/Reduce.hs
index fd4026e..f349c2a 100644
--- a/src/full/Agda/TypeChecking/Reduce.hs
+++ b/src/full/Agda/TypeChecking/Reduce.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Agda.TypeChecking.Reduce where
@@ -43,7 +43,7 @@ import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 instantiate :: Instantiate a => a -> TCM a
@@ -75,7 +75,19 @@ instance Instantiate Term where
   instantiate' t@(MetaV x es) = do
     mi <- mvInstantiation <$> lookupMeta x
     case mi of
-      InstV a                          -> instantiate' $ a `applyE` es
+      InstV tel v -> instantiate' inst
+        where
+          -- A slight complication here is that the meta might be underapplied,
+          -- in which case we have to build the lambda abstraction before
+          -- applying the substitution, or overapplied in which case we need to
+          -- fall back to applyE.
+          (es1, es2) = splitAt (length tel) es
+          vs1 = reverse $ map unArg $ fromMaybe __IMPOSSIBLE__ $ allApplyElims es1
+          rho = vs1 ++# wkS (length vs1) idS
+                -- really should be .. ++# emptyS but using wkS makes it reduce to idS
+                -- when applicable
+          -- specification: inst == foldr mkLam v tel `applyE` es
+          inst = applySubst rho (foldr mkLam v $ drop (length es1) tel) `applyE` es2
       Open                             -> return t
       OpenIFS                          -> return t
       BlockedConst _                   -> return t
@@ -109,12 +121,12 @@ instance Instantiate a => Instantiate (Blocked a) where
   instantiate' v@(Blocked x u) = do
     mi <- mvInstantiation <$> lookupMeta x
     case mi of
-      InstV _                          -> notBlocked <$> instantiate' u
-      Open                             -> return v
-      OpenIFS                          -> return v
-      BlockedConst _                   -> return v
-      PostponedTypeCheckingProblem _ _ -> return v
-      InstS _                          -> __IMPOSSIBLE__
+      InstV{}                        -> notBlocked <$> instantiate' u
+      Open                           -> return v
+      OpenIFS                        -> return v
+      BlockedConst{}                 -> return v
+      PostponedTypeCheckingProblem{} -> return v
+      InstS{}                        -> __IMPOSSIBLE__
 
 instance Instantiate Type where
     instantiate' (El s t) = El <$> instantiate' s <*> instantiate' t
@@ -149,8 +161,8 @@ instance (Instantiate a, Instantiate b,Instantiate c) => Instantiate (a,b,c) whe
 
 instance Instantiate a => Instantiate (Closure a) where
     instantiate' cl = do
-	x <- enterClosure cl instantiate'
-	return $ cl { clValue = x }
+        x <- enterClosure cl instantiate'
+        return $ cl { clValue = x }
 
 instance Instantiate Telescope where
   instantiate' tel = return tel
@@ -291,7 +303,6 @@ instance Reduce Term where
       Level l  -> ifM (elem LevelReductions <$> asks envAllowedReductions)
                     {- then -} (fmap levelTm <$> reduceB' l)
                     {- else -} done
-      -- Level l  -> fmap levelTm <$> reduceB' l
       Pi _ _   -> done
       Lit _    -> done
       Var _ _  -> done
@@ -306,12 +317,12 @@ instance Reduce Term where
         mz  <- getBuiltin' builtinZero
         case v of
           _ | Just v == mz  -> return $ Lit $ LitInt (getRange c) 0
-          _		    -> return v
+          _                 -> return v
       reduceNat v@(Con c [a]) | notHidden a && isRelevant a = do
         ms  <- fmap ignoreSharing <$> getBuiltin' builtinSuc
         case v of
           _ | Just (Con c []) == ms -> inc <$> reduce' (unArg a)
-          _	                    -> return v
+          _                         -> return v
           where
             inc w = case ignoreSharing w of
               Lit (LitInt r n) -> Lit (LitInt (fuseRange c r) $ n + 1)
@@ -339,63 +350,36 @@ unfoldDefinition' ::
 unfoldDefinition' unfoldDelayed keepGoing v0 f es =
   {-# SCC "reduceDef" #-} do
   info <- getConstInfo f
+  allowed <- asks envAllowedReductions
   let def = theDef info
       v   = v0 `applyE` es
+      -- Non-terminating functions
+      -- (i.e., those that failed the termination check)
+      -- and delayed definitions
+      -- are not unfolded unless explicitely permitted.
+      dontUnfold =
+        (defNonterminating info && notElem NonTerminatingReductions allowed)
+        || (defDelayed info == Delayed && not unfoldDelayed)
   case def of
     Constructor{conSrcCon = c} ->
       retSimpl $ notBlocked $ Con (c `withRangeOf` f) [] `applyE` es
     Primitive{primAbstr = ConcreteDef, primName = x, primClauses = cls} -> do
       pf <- fromMaybe __IMPOSSIBLE__ <$> getPrimitive' x
-      reducePrimitive x v0 f es pf (defDelayed info) (defNonterminating info)
+      reducePrimitive x v0 f es pf dontUnfold
                       cls (defCompiled info)
     _  -> do
-      allowed <- asks envAllowedReductions
-{-
-      -- case f is projection-like:
-      if isProperProjection def then
-        if ProjectionReductions `elem` allowed then do
-          -- we cannot call elimView right away, since it calls back to reduce'
-          -- get rid of projection if possible
-          (simpl, w) <- onlyReduceProjections $ do
-            reduceNormal (retSimpl <=< reduceB') v0 f (map notReduced args)
-              (defDelayed info) (defNonterminating info)
-              (defClauses info) (defCompiled info)
-          -- Now @w@ should not have any reducible projection in the head.
-          -- By not allowing reentrace (dontReduceProjections),
-          -- we can now call elimView without risk of circularity.
-          case w of
-            Blocked{} -> return (simpl, w)
-            NotBlocked w' -> do
-              ev <- dontReduceProjections $ elimView w'
-              case ev of
-                DefElim f es -> performedSimplification' simpl $ do
-                  reduceDefElim f es
-                _ -> return (simpl, w)
-        else retSimpl $ notBlocked v
-       -- case f is not a projection:
-       else if FunctionReductions `elem` allowed then
-        -- proceed as before, without calling elimView
--}
       if FunctionReductions `elem` allowed ||
          (isJust (isProjection_ def) && ProjectionReductions `elem` allowed)  -- includes projection-like
-       then
-        reduceNormalE keepGoing v0 f (map notReduced es)
-                       (defDelayed info) (notElem NonTerminatingReductions allowed && defNonterminating info)
+        then
+          reduceNormalE keepGoing v0 f (map notReduced es)
+                       dontUnfold
                        (defClauses info) (defCompiled info)
         else retSimpl $ notBlocked v
 
   where
     retSimpl v = (,v) <$> getSimplification
-{-
-    reduceDefElim :: QName -> [Elim] -> ReduceM (Simplification, Blocked Term)
-    reduceDefElim f es = do
-      info <- getConstInfo f
-      reduceNormalE keepGoing (Def f []) f (map notReduced es)
-                       (defDelayed info) (defNonterminating info)
-                       (defClauses info) (defCompiled info)
--}
 
-    reducePrimitive x v0 f es pf delayed nonterminating cls mcc
+    reducePrimitive x v0 f es pf dontUnfold cls mcc
       | genericLength es < ar
                   = retSimpl $ notBlocked $ v0 `applyE` es -- not fully applied
       | otherwise = {-# SCC "reducePrimitive" #-} do
@@ -412,7 +396,7 @@ unfoldDefinition' unfoldDelayed keepGoing v0 f es =
                else
                 reduceNormalE keepGoing v0 f
                              (es1' ++ map notReduced es2)
-                             delayed nonterminating cls mcc
+                             dontUnfold cls mcc
             YesReduction simpl v -> performedSimplification' simpl $
               keepGoing $ v `applyE` es2
       where
@@ -421,27 +405,11 @@ unfoldDefinition' unfoldDelayed keepGoing v0 f es =
           mredToBlocked (MaybeRed NotReduced  x) = notBlocked x
           mredToBlocked (MaybeRed (Reduced b) x) = x <$ b
 
-{-
-    reduceNormal ::  (Term -> ReduceM (Simplification, Blocked Term)) -> Term -> QName -> [MaybeReduced (Arg Term)] -> Delayed -> Bool -> [Clause] -> Maybe CompiledClauses -> ReduceM (Simplification, Blocked Term)
-    reduceNormal keepGoing v0 f args = reduceNormalE keepGoing v0 f $ map (fmap Apply) args
--}
-
-    reduceNormalE :: (Term -> ReduceM (Simplification, Blocked Term)) -> Term -> QName -> [MaybeReduced Elim] -> Delayed -> Bool -> [Clause] -> Maybe CompiledClauses -> ReduceM (Simplification, Blocked Term)
-    reduceNormalE keepGoing v0 f es delayed nonterminating def mcc = {-# SCC "reduceNormal" #-} do
+    reduceNormalE :: (Term -> ReduceM (Simplification, Blocked Term)) -> Term -> QName -> [MaybeReduced Elim] -> Bool -> [Clause] -> Maybe CompiledClauses -> ReduceM (Simplification, Blocked Term)
+    reduceNormalE keepGoing v0 f es dontUnfold def mcc = {-# SCC "reduceNormal" #-} do
       case def of
-        _ | nonterminating -> defaultResult
-        _ | Delayed <- delayed,
-            not unfoldDelayed -> defaultResult
+        _ | dontUnfold -> defaultResult
         [] -> defaultResult -- no definition for head
-{- OBSOLETE
-        -- stop here if we only want to reduce' (proper) projections
-        -- but the symbol @f@ is not one
-        cls -> ifM (asks envOnlyReduceProjections `and2M` do not . maybe False projProper <$> isProjection f) defaultResult $ do
--}
-{-
-        cls -> allowAllReductions $ do
-            -- In subterms, we allow all reductions.
--}
         cls -> do
             ev <- appDefE_ f v0 cls mcc es
             case ev of
@@ -459,33 +427,26 @@ unfoldDefinition' unfoldDelayed keepGoing v0 f es =
                 keepGoing v
       where defaultResult = retSimpl $ notBlocked $ vfull
             vfull         = v0 `applyE` map ignoreReduced es
---      where defaultResult = retSimpl $ notBlocked $ v0 `apply` (map ignoreReduced args)
 
 -- | Reduce a non-primitive definition if it is a copy linking to another def.
 reduceDefCopy :: QName -> Args -> TCM (Reduced () Term)
 reduceDefCopy f vs = do
   info <- TCM.getConstInfo f
   if (defCopy info) then reduceDef_ info f vs else return $ NoReduction ()
-
--- | Reduce a non-primitive definition once unless it is delayed.
-reduceDef :: QName -> Args -> TCM (Reduced () Term)
-reduceDef f vs = do
-  info <- TCM.getConstInfo f
-  reduceDef_ info f vs
-
-reduceDef_ :: Definition -> QName -> Args -> TCM (Reduced () Term)
-reduceDef_ info f vs = do
-  let v0   = Def f []
-      args = map notReduced vs
-      cls  = (defClauses info)
-      mcc  = (defCompiled info)
-  if (defDelayed info == Delayed) || (defNonterminating info)
-   then return $ NoReduction ()
-   else do
-      ev <- runReduceM $ appDef_ f v0 cls mcc args
-      case ev of
-        YesReduction simpl t -> return $ YesReduction simpl t
-        NoReduction args'    -> return $ NoReduction ()
+  where
+    reduceDef_ :: Definition -> QName -> Args -> TCM (Reduced () Term)
+    reduceDef_ info f vs = do
+      let v0   = Def f []
+          args = map notReduced vs
+          cls  = (defClauses info)
+          mcc  = (defCompiled info)
+      if (defDelayed info == Delayed) || (defNonterminating info)
+       then return $ NoReduction ()
+       else do
+          ev <- runReduceM $ appDef_ f v0 cls mcc args
+          case ev of
+            YesReduction simpl t -> return $ YesReduction simpl t
+            NoReduction args'    -> return $ NoReduction ()
 
 -- | Reduce simple (single clause) definitions.
 reduceHead :: Term -> TCM (Blocked Term)
@@ -553,23 +514,6 @@ appDefE v cc es = do
 appDef' :: Term -> [Clause] -> MaybeReducedArgs -> ReduceM (Reduced (Blocked Term) Term)
 appDef' v cls args = appDefE' v cls $ map (fmap Apply) args
 
-{- OLD.  With varying function arity, check for underapplication is UNSOUND.
-appDefE' :: Term -> [Clause] -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
-appDefE' _ [] _ = {- ' -} __IMPOSSIBLE__
-appDefE' v cls@(Clause {clausePats = ps} : _) es
-    -- case underapplied: no reduction
-  | m < n     = return $ NoReduction $ notBlocked $ v `applyE` map ignoreReduced es
-  | otherwise = do
-    let (es0, es1) = splitAt n es
-    r <- goCls cls (map ignoreReduced es0)
-    case r of
-      YesReduction simpl u -> return $ YesReduction simpl $ u `applyE` map ignoreReduced es1
-      NoReduction v        -> return $ NoReduction $ (`applyE` map ignoreReduced es1) <$> v
-  where
-
-    n = genericLength ps
-    m = genericLength es
--}
 appDefE' :: Term -> [Clause] -> MaybeReducedElims -> ReduceM (Reduced (Blocked Term) Term)
 appDefE' v cls es = goCls cls $ map ignoreReduced es
   where
@@ -604,9 +548,8 @@ appDefE' v cls es = goCls cls $ map ignoreReduced es
                     app vs body EmptyS `applyE` es1
                 | otherwise     -> cantReduce es
 
-
-    -- NEW version, building an explicit substitution from arguments
-    -- and executing it using parallel substitution.
+    -- Build an explicit substitution from arguments
+    -- and execute it using parallel substitution.
     -- Calculating the de Bruijn indices: ;-) for the Bind case
     --   Simply-typed version
     --   (we are not interested in types, only in de Bruijn indices here)
@@ -617,27 +560,16 @@ appDefE' v cls es = goCls cls $ map ignoreReduced es
     --   Δ.A ⊢ b : B
     app :: [Term] -> ClauseBody -> Substitution -> Term
     app []       (Body v)           sigma = applySubst sigma v
---    app (v : vs) (Bind b) sigma = app es (absBody b) (v :# sigma) -- CBN
     app (v : vs) (Bind (Abs   _ b)) sigma = app vs b (v :# sigma) -- CBN
     app (v : vs) (Bind (NoAbs _ b)) sigma = app vs b sigma
     app  _        NoBody            sigma = __IMPOSSIBLE__
-    app (_ : _)	 (Body _)           sigma = __IMPOSSIBLE__
+    app (_ : _)  (Body _)           sigma = __IMPOSSIBLE__
     app []       (Bind _)           sigma = __IMPOSSIBLE__
 
-{- OLD version, one substitution after another
-    app :: [Elim] -> ClauseBody -> Term
-    app []           (Body v') = v'
-    app (Proj f : es)    b         = app es b
-    app (Apply arg : es) (Bind b)  = app es $ absApp b $ unArg arg -- CBN
-    app  _            NoBody   = __IMPOSSIBLE__
-    app (_ : _)	     (Body _)  = __IMPOSSIBLE__
-    app []           (Bind _)  = __IMPOSSIBLE__
--}
-
 instance Reduce a => Reduce (Closure a) where
     reduce' cl = do
-	x <- enterClosure cl reduce'
-	return $ cl { clValue = x }
+        x <- enterClosure cl reduce'
+        return $ cl { clValue = x }
 
 instance Reduce Telescope where
   reduce' tel = return tel
@@ -756,13 +688,13 @@ instance (Simplify a, Simplify b) => Simplify (a,b) where
 
 instance (Simplify a, Simplify b, Simplify c) => Simplify (a,b,c) where
     simplify' (x,y,z) =
-	do  (x,(y,z)) <- simplify' (x,(y,z))
-	    return (x,y,z)
+        do  (x,(y,z)) <- simplify' (x,(y,z))
+            return (x,y,z)
 
 instance Simplify a => Simplify (Closure a) where
     simplify' cl = do
-	x <- enterClosure cl simplify'
-	return $ cl { clValue = x }
+        x <- enterClosure cl simplify'
+        return $ cl { clValue = x }
 
 instance (Subst a, Simplify a) => Simplify (Tele a) where
   simplify' EmptyTel        = return EmptyTel
@@ -800,7 +732,7 @@ instance Simplify Pattern where
 instance Simplify ClauseBody where
     simplify' (Body   t) = Body   <$> simplify' t
     simplify' (Bind   b) = Bind   <$> simplify' b
-    simplify'  NoBody	= return NoBody
+    simplify'  NoBody   = return NoBody
 
 instance Simplify DisplayForm where
   simplify' (Display n ps v) = Display n <$> simplify' ps <*> return v
@@ -827,17 +759,17 @@ instance Normalise Type where
 
 instance Normalise Term where
     normalise' v =
-	do  v <- reduce' v
-	    case v of
-		Var n vs    -> Var n <$> normalise' vs
-		Con c vs    -> Con c <$> normalise' vs
-		Def f vs    -> Def f <$> normalise' vs
-		MetaV x vs  -> MetaV x <$> normalise' vs
-		Lit _	    -> return v
+        do  v <- reduce' v
+            case v of
+                Var n vs    -> Var n <$> normalise' vs
+                Con c vs    -> Con c <$> normalise' vs
+                Def f vs    -> Def f <$> normalise' vs
+                MetaV x vs  -> MetaV x <$> normalise' vs
+                Lit _       -> return v
                 Level l     -> levelTm <$> normalise' l
-		Lam h b	    -> Lam h <$> normalise' b
-		Sort s	    -> sortTm <$> normalise' s
-		Pi a b	    -> uncurry Pi <$> normalise' (a,b)
+                Lam h b     -> Lam h <$> normalise' b
+                Sort s      -> sortTm <$> normalise' s
+                Pi a b      -> uncurry Pi <$> normalise' (a,b)
                 Shared{}    -> __IMPOSSIBLE__ -- updateSharedTerm normalise' v
                 ExtLam{}    -> __IMPOSSIBLE__
                 DontCare _  -> return v
@@ -865,7 +797,7 @@ instance Normalise LevelAtom where
 instance Normalise ClauseBody where
     normalise' (Body   t) = Body   <$> normalise' t
     normalise' (Bind   b) = Bind   <$> normalise' b
-    normalise'  NoBody	 = return NoBody
+    normalise'  NoBody   = return NoBody
 
 instance (Subst t, Normalise t) => Normalise (Abs t) where
     normalise' a@(Abs x _) = Abs x <$> underAbstraction_ a normalise'
@@ -889,13 +821,13 @@ instance (Normalise a, Normalise b) => Normalise (a,b) where
 
 instance (Normalise a, Normalise b, Normalise c) => Normalise (a,b,c) where
     normalise' (x,y,z) =
-	do  (x,(y,z)) <- normalise' (x,(y,z))
-	    return (x,y,z)
+        do  (x,(y,z)) <- normalise' (x,(y,z))
+            return (x,y,z)
 
 instance Normalise a => Normalise (Closure a) where
     normalise' cl = do
-	x <- enterClosure cl normalise'
-	return $ cl { clValue = x }
+        x <- enterClosure cl normalise'
+        return $ cl { clValue = x }
 
 instance (Subst a, Normalise a) => Normalise (Tele a) where
   normalise' EmptyTel        = return EmptyTel
@@ -956,11 +888,11 @@ instance InstantiateFull Name where
 
 instance InstantiateFull Sort where
     instantiateFull' s = do
-	s <- instantiate' s
-	case s of
-	    Type n     -> levelSort <$> instantiateFull' n
-	    Prop       -> return s
-	    DLub s1 s2 -> dLub <$> instantiateFull' s1 <*> instantiateFull' s2
+        s <- instantiate' s
+        case s of
+            Type n     -> levelSort <$> instantiateFull' n
+            Prop       -> return s
+            DLub s1 s2 -> dLub <$> instantiateFull' s1 <*> instantiateFull' s2
             Inf        -> return s
 
 instance InstantiateFull Type where
@@ -976,7 +908,7 @@ instance InstantiateFull Term where
           Con c vs    -> Con c <$> instantiateFull' vs
           Def f vs    -> Def f <$> instantiateFull' vs
           MetaV x vs  -> MetaV x <$> instantiateFull' vs
-          Lit _	      -> return v
+          Lit _       -> return v
           Level l     -> levelTm <$> instantiateFull' l
           Lam h b     -> Lam h <$> instantiateFull' b
           Sort s      -> sortTm <$> instantiateFull' s
@@ -1006,6 +938,17 @@ instance InstantiateFull LevelAtom where
           (BlockedLevel m <$> instantiateFull' v)
     UnreducedLevel v -> UnreducedLevel <$> instantiateFull' v
 
+instance InstantiateFull Substitution where
+  instantiateFull' sigma =
+    case sigma of
+      IdS                  -> return IdS
+      EmptyS               -> return EmptyS
+      Wk   n sigma         -> Wk   n         <$> instantiateFull' sigma
+      Lift n sigma         -> Lift n         <$> instantiateFull' sigma
+      Strengthen bot sigma -> Strengthen bot <$> instantiateFull' sigma
+      t :# sigma           -> (:#) <$> instantiateFull' t
+                                   <*> instantiateFull' sigma
+
 instance InstantiateFull Bool where
     instantiateFull' = return
 
@@ -1042,13 +985,13 @@ instance (InstantiateFull a, InstantiateFull b) => InstantiateFull (a,b) where
 
 instance (InstantiateFull a, InstantiateFull b, InstantiateFull c) => InstantiateFull (a,b,c) where
     instantiateFull' (x,y,z) =
-	do  (x,(y,z)) <- instantiateFull' (x,(y,z))
-	    return (x,y,z)
+        do  (x,(y,z)) <- instantiateFull' (x,(y,z))
+            return (x,y,z)
 
 instance InstantiateFull a => InstantiateFull (Closure a) where
     instantiateFull' cl = do
-	x <- enterClosure cl instantiateFull'
-	return $ cl { clValue = x }
+        x <- enterClosure cl instantiateFull'
+        return $ cl { clValue = x }
 
 instance InstantiateFull ProblemConstraint where
   instantiateFull' (PConstr p c) = PConstr p <$> instantiateFull' c
@@ -1118,10 +1061,10 @@ instance InstantiateFull DisplayForm where
   instantiateFull' (Display n ps v) = uncurry (Display n) <$> instantiateFull' (ps, v)
 
 instance InstantiateFull DisplayTerm where
-  instantiateFull' (DTerm v)	   = DTerm <$> instantiateFull' v
-  instantiateFull' (DDot  v)	   = DDot  <$> instantiateFull' v
-  instantiateFull' (DCon c vs)	   = DCon c <$> instantiateFull' vs
-  instantiateFull' (DDef c vs)	   = DDef c <$> instantiateFull' vs
+  instantiateFull' (DTerm v)       = DTerm <$> instantiateFull' v
+  instantiateFull' (DDot  v)       = DDot  <$> instantiateFull' v
+  instantiateFull' (DCon c vs)     = DCon c <$> instantiateFull' vs
+  instantiateFull' (DDef c vs)     = DDef c <$> instantiateFull' vs
   instantiateFull' (DWithApp v vs ws) = uncurry3 DWithApp <$> instantiateFull' (v, vs, ws)
 
 instance InstantiateFull Defn where
@@ -1131,9 +1074,9 @@ instance InstantiateFull Defn where
         (cs, cc, inv) <- instantiateFull' (cs, cc, inv)
         return $ d { funClauses = cs, funCompiled = cc, funInv = inv }
       Datatype{ dataSort = s, dataClause = cl } -> do
-	s  <- instantiateFull' s
-	cl <- instantiateFull' cl
-	return $ d { dataSort = s, dataClause = cl }
+        s  <- instantiateFull' s
+        cl <- instantiateFull' cl
+        return $ d { dataSort = s, dataClause = cl }
       Record{ recConType = t, recClause = cl, recTel = tel } -> do
         t   <- instantiateFull' t
         cl  <- instantiateFull' cl
@@ -1173,9 +1116,9 @@ instance InstantiateFull Clause where
 instance InstantiateFull Interface where
     instantiateFull' (Interface h ms mod scope inside
                                sig b hsImports highlighting pragmas patsyns) =
-	Interface h ms mod scope inside
-	    <$> instantiateFull' sig
-	    <*> instantiateFull' b
+        Interface h ms mod scope inside
+            <$> instantiateFull' sig
+            <*> instantiateFull' b
             <*> return hsImports
             <*> return highlighting
             <*> return pragmas
@@ -1183,7 +1126,7 @@ instance InstantiateFull Interface where
 
 instance InstantiateFull a => InstantiateFull (Builtin a) where
     instantiateFull' (Builtin t) = Builtin <$> instantiateFull' t
-    instantiateFull' (Prim x)	= Prim <$> instantiateFull' x
+    instantiateFull' (Prim x)   = Prim <$> instantiateFull' x
 
 instance InstantiateFull QName where
   instantiateFull' = return
diff --git a/src/full/Agda/TypeChecking/Reduce/Monad.hs b/src/full/Agda/TypeChecking/Reduce/Monad.hs
index 2215677..e985e92 100644
--- a/src/full/Agda/TypeChecking/Reduce/Monad.hs
+++ b/src/full/Agda/TypeChecking/Reduce/Monad.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections    #-}
+{-# LANGUAGE RankNTypes       #-}
 
 module Agda.TypeChecking.Reduce.Monad
   ( constructorForm
@@ -29,22 +30,25 @@ import Agda.Syntax.Position
 import Agda.Syntax.Internal
 import Agda.TypeChecking.Monad hiding
   ( enterClosure, underAbstraction_, underAbstraction, addCtx, mkContextEntry,
-    isInstantiatedMeta, verboseS, reportSDoc, reportSLn, typeOfConst, lookupMeta, instantiateDef )
+    isInstantiatedMeta, verboseS, reportSDoc, reportSLn, typeOfConst, lookupMeta )
 import Agda.TypeChecking.Monad.Builtin hiding ( constructorForm )
 import Agda.TypeChecking.Substitute
 import Agda.Interaction.Options
 
-import Agda.Utils.Fresh
 import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.Lens
 import Agda.Utils.Monad
 import Agda.Utils.Pretty
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 gets :: (TCState -> a) -> ReduceM a
 gets f = f . redSt <$> ReduceM ask
 
+useR :: Lens' a TCState -> ReduceM a
+useR l = gets (^.l)
+
 askR :: ReduceM ReduceEnv
 askR = ReduceM ask
 
@@ -52,15 +56,15 @@ localR :: (ReduceEnv -> ReduceEnv) -> ReduceM a -> ReduceM a
 localR f = ReduceM . local f . unReduceM
 
 instance HasOptions ReduceM where
-  pragmaOptions      = gets stPragmaOptions
+  pragmaOptions      = useR stPragmaOptions
   commandLineOptions = do
-    p  <- gets stPragmaOptions
-    cl <- gets $ stPersistentOptions . stPersistent
+    p  <- useR stPragmaOptions
+    cl <- gets $ stPersistentOptions . stPersistentState
     return $ cl{ optPragmaOptions = p }
 
 instance HasBuiltins ReduceM where
-  getBuiltinThing b = liftM2 mplus (Map.lookup b <$> gets stLocalBuiltins)
-                                   (Map.lookup b <$> gets stImportedBuiltins)
+  getBuiltinThing b = liftM2 mplus (Map.lookup b <$> useR stLocalBuiltins)
+                                   (Map.lookup b <$> useR stImportedBuiltins)
 
 constructorForm :: Term -> ReduceM Term
 constructorForm v = do
@@ -72,9 +76,9 @@ enterClosure :: Closure a -> (a -> ReduceM b) -> ReduceM b
 enterClosure (Closure sig env scope x) f = localR (mapRedEnvSt inEnv inState) (f x)
   where
     inEnv   e = env { envAllowDestructiveUpdate = envAllowDestructiveUpdate e }
-    inState s = s { stScope = scope }   -- TODO: use the signature here? would that fix parts of issue 118?
+    inState s = set stScope scope s   -- TODO: use the signature here? would that fix parts of issue 118?
 
-withFreshR :: HasFresh i FreshThings => (i -> ReduceM a) -> ReduceM a
+withFreshR :: HasFresh i => (i -> ReduceM a) -> ReduceM a
 withFreshR f = do
   s <- gets id
   let (i, s') = nextFresh s
@@ -110,7 +114,7 @@ underAbstraction_ :: Subst a => Abs a -> (a -> ReduceM b) -> ReduceM b
 underAbstraction_ = underAbstraction dummyDom
 
 lookupMeta :: MetaId -> ReduceM MetaVariable
-lookupMeta i = fromMaybe __IMPOSSIBLE__ . Map.lookup i <$> gets stMetaStore
+lookupMeta i = fromMaybe __IMPOSSIBLE__ . Map.lookup i <$> useR stMetaStore
 
 isInstantiatedMeta :: MetaId -> ReduceM Bool
 isInstantiatedMeta i = do
@@ -157,8 +161,8 @@ traceSLn k n s = applyWhenVerboseS k n (trace s)
 
 instance HasConstInfo ReduceM where
   getConstInfo q = ReduceM $ ReaderT $ \(ReduceEnv env st) -> Identity $
-    let defs  = sigDefinitions $ stSignature st
-        idefs = sigDefinitions $ stImports st
+    let defs  = sigDefinitions $ st^.stSignature
+        idefs = sigDefinitions $ st^.stImports
     in case catMaybes [HMap.lookup q defs, HMap.lookup q idefs] of
         []  -> trace ("Unbound name: " ++ show q ++ " " ++ showQNameId q) __IMPOSSIBLE__
         [d] -> mkAbs env d
diff --git a/src/full/Agda/TypeChecking/Rewriting.hs b/src/full/Agda/TypeChecking/Rewriting.hs
index 8fd319a..3a6de48 100644
--- a/src/full/Agda/TypeChecking/Rewriting.hs
+++ b/src/full/Agda/TypeChecking/Rewriting.hs
@@ -61,7 +61,7 @@ import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Check that the name given to the BUILTIN REWRITE is actually
diff --git a/src/full/Agda/TypeChecking/Rules/Builtin.hs b/src/full/Agda/TypeChecking/Rules/Builtin.hs
index 6a8defd..b661445 100644
--- a/src/full/Agda/TypeChecking/Rules/Builtin.hs
+++ b/src/full/Agda/TypeChecking/Rules/Builtin.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -6,7 +6,6 @@ module Agda.TypeChecking.Rules.Builtin (bindBuiltin, bindPostulatedName) where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error
 import Data.List (find)
 
 import qualified Agda.Syntax.Abstract as A
@@ -28,10 +27,11 @@ import Agda.TypeChecking.Rules.Term ( checkExpr , inferExpr )
 import {-# SOURCE #-} Agda.TypeChecking.Rules.Builtin.Coinduction
 import {-# SOURCE #-} Agda.TypeChecking.Rewriting
 
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Maybe
 import Agda.Utils.Size
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -402,8 +402,8 @@ bindBuiltinInfo (BuiltinInfo s d) e = do
         bindBuiltinName s (name e')
 
       BuiltinPrim pfname axioms -> do
-	case e of
-	  A.Def qx -> do
+        case e of
+          A.Def qx -> do
 
             PrimImpl t pf <- lookupPrimitiveFunction pfname
             v <- checkExpr e t
@@ -420,7 +420,7 @@ bindBuiltinInfo (BuiltinInfo s d) e = do
             -- needed? yes, for checking equations for mul
             bindBuiltinName s v
 
-	  _ -> typeError $ GenericError $ "Builtin " ++ s ++ " must be bound to a function"
+          _ -> typeError $ GenericError $ "Builtin " ++ s ++ " must be bound to a function"
 
       BuiltinPostulate rel t -> do
         t' <- t
diff --git a/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs b/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs
index 020276f..3aa1086 100644
--- a/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs
+++ b/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs
@@ -1,9 +1,9 @@
+-- {-# LANGUAGE CPP #-}
+
 ------------------------------------------------------------------------
 -- | Handling of the INFINITY, SHARP and FLAT builtins.
 ------------------------------------------------------------------------
 
--- {-# LANGUAGE CPP #-}
-
 module Agda.TypeChecking.Rules.Builtin.Coinduction where
 
 import Control.Applicative
@@ -93,7 +93,7 @@ bindBuiltinSharp e =
     addConstant sharp $
       sharpDefn { theDef = Constructor
                     { conPars   = 2
-                    , conSrcCon = ConHead sharp [] -- flat is added as field later
+                    , conSrcCon = ConHead sharp CoInductive [] -- flat is added as field later
                     , conData   = defName infDefn
                     , conAbstr  = ConcreteDef
                     , conInd    = CoInductive
@@ -115,7 +115,7 @@ bindBuiltinFlat e =
     Def sharp _ <- ignoreSharing <$> primSharp
     kit         <- requireLevels
     Def inf _   <- ignoreSharing <$> primInf
-    let sharpCon = ConHead sharp [flat]
+    let sharpCon = ConHead sharp CoInductive [flat]
         level    = El (mkType 0) $ Def (typeName kit) []
         tel     :: Telescope
         tel      = ExtendTel (domH $ level)                  $ Abs "a" $
@@ -157,6 +157,7 @@ bindBuiltinFlat e =
                    , funTerminates = Just True
                    , funExtLam     = Nothing
                    , funWith       = Nothing
+                   , funCopatternLHS = isCopatternLHS [clause]
                    }
                 }
 
diff --git a/src/full/Agda/TypeChecking/Rules/Data.hs b/src/full/Agda/TypeChecking/Rules/Data.hs
index 421d97a..b0d0545 100644
--- a/src/full/Agda/TypeChecking/Rules/Data.hs
+++ b/src/full/Agda/TypeChecking/Rules/Data.hs
@@ -36,7 +36,7 @@ import Agda.Utils.Size
 import Agda.Utils.Tuple
 import qualified Agda.Utils.VarSet as VarSet
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -48,7 +48,7 @@ import Agda.Utils.Impossible
 checkDataDef :: Info.DefInfo -> QName -> [A.LamBinding] -> [A.Constructor] -> TCM ()
 checkDataDef i name ps cs =
     traceCall (CheckDataDef (getRange i) (qnameName name) ps cs) $ do -- TODO!! (qnameName)
-	let countPars A.DomainFree{} = 1
+        let countPars A.DomainFree{} = 1
             countPars (A.DomainFull (A.TypedBindings _ (Arg _ b))) = case b of
               A.TLet{}       -> 0
               A.TBind _ xs _ -> size xs
@@ -57,8 +57,8 @@ checkDataDef i name ps cs =
         -- Add the datatype module
         addSection (qnameToMName name) 0
 
-	-- Look up the type of the datatype.
-	t <- instantiateFull =<< typeOfConst name
+        -- Look up the type of the datatype.
+        t <- instantiateFull =<< typeOfConst name
 
         -- Make sure the shape of the type is visible
         let unTelV (TelV tel a) = telePi tel a
@@ -67,15 +67,15 @@ checkDataDef i name ps cs =
         -- Top level free vars
         freeVars <- getContextArgs
 
-	-- The parameters are in scope when checking the constructors.
-	dataDef <- bindParameters ps t $ \tel t0 -> do
+        -- The parameters are in scope when checking the constructors.
+        dataDef <- bindParameters ps t $ \tel t0 -> do
 
-	    -- Parameters are always hidden in constructors
-	    let tel' = hideAndRelParams <$> tel
-	    -- let tel' = hideTel tel
+            -- Parameters are always hidden in constructors
+            let tel' = hideAndRelParams <$> tel
+            -- let tel' = hideTel tel
 
-	    -- The type we get from bindParameters is Θ -> s where Θ is the type of
-	    -- the indices. We count the number of indices and return s.
+            -- The type we get from bindParameters is Θ -> s where Θ is the type of
+            -- the indices. We count the number of indices and return s.
             -- We check that s is a sort.
             (nofIxs, s) <- splitType t0
 
@@ -103,7 +103,7 @@ checkDataDef i name ps cs =
                 ]
               ]
 
-	    -- Change the datatype from an axiom to a datatype with no constructors.
+            -- Change the datatype from an axiom to a datatype with no constructors.
             let dataDef = Datatype
                   { dataPars       = npars
                   , dataSmallPars  = Perm npars smallPars
@@ -117,14 +117,14 @@ checkDataDef i name ps cs =
                   , dataMutual     = []
                   }
 
-	    escapeContext (size tel) $ do
-	      addConstant name $
+            escapeContext (size tel) $ do
+              addConstant name $
                 defaultDefn defaultArgInfo name t dataDef
                 -- polarity and argOcc.s determined by the positivity checker
 
-	    -- Check the types of the constructors
+            -- Check the types of the constructors
             -- collect the non-linear parameters of each constructor
-	    nonLins <- mapM (checkConstructor name tel' nofIxs s) cs
+            nonLins <- mapM (checkConstructor name tel' nofIxs s) cs
             -- compute the ascending list of non-linear parameters of the data type
             let nonLinPars0 = Set.toAscList $ Set.unions $ map Set.fromList nonLins
                 -- The constructors are analyzed in the absolute context,
@@ -134,23 +134,23 @@ checkDataDef i name ps cs =
                 -- is then performed by addConstant, cannot restore the linearity info.
                 nonLinPars  = Drop (size freeVars) $ Perm (npars + size freeVars) nonLinPars0
 
-	    -- Return the data definition
-	    return dataDef{ dataNonLinPars = nonLinPars }
+            -- Return the data definition
+            return dataDef{ dataNonLinPars = nonLinPars }
 
         let s      = dataSort dataDef
             cons   = map A.axiomName cs  -- get constructor names
 
-	-- If proof irrelevance is enabled we have to check that datatypes in
-	-- Prop contain at most one element.
-	do  proofIrr <- proofIrrelevance
-	    case (proofIrr, s, cs) of
-		(True, Prop, _:_:_) -> setCurrentRange (getRange cons) $
+        -- If proof irrelevance is enabled we have to check that datatypes in
+        -- Prop contain at most one element.
+        do  proofIrr <- proofIrrelevance
+            case (proofIrr, s, cs) of
+                (True, Prop, _:_:_) -> setCurrentRange (getRange cons) $
                                          typeError PropMustBeSingleton
-		_		    -> return ()
+                _                   -> return ()
 
-	-- Add the datatype to the signature with its constructors.
+        -- Add the datatype to the signature with its constructors.
         -- It was previously added without them.
-	addConstant name $
+        addConstant name $
           defaultDefn defaultArgInfo name t $
             dataDef{ dataCons = cons }
 
@@ -207,27 +207,27 @@ checkConstructor d tel nofIxs s con@(A.Axiom _ i _ c e) =
 -}
         -- check that the type of the constructor is well-formed
         debugEnter c e
-	t <- isType_ e
+        t <- isType_ e
         -- check that the type of the constructor ends in the data type
-	n <- getContextSize
-	-- OLD: n <- size <$> getContextTelescope
+        n <- getContextSize
+        -- OLD: n <- size <$> getContextTelescope
         debugEndsIn t d n
-	nonLinPars <- constructs n t d
+        nonLinPars <- constructs n t d
         debugNonLinPars nonLinPars
         -- check that the sort (universe level) of the constructor type
         -- is contained in the sort of the data type
         -- (to avoid impredicative existential types)
         debugFitsIn s
-	t `fitsIn` s
+        t `fitsIn` s
         -- check which constructor arguments are determined by the type ('forcing')
         t' <- addForcingAnnotations t
         debugAdd c t'
 
         -- add parameters to constructor type and put into signature
-        let con = ConHead c [] -- data constructors have no projectable fields
+        let con = ConHead c Inductive [] -- data constructors have no projectable fields and are always inductive
         escapeContext (size tel) $
           addConstant c $
-	    defaultDefn defaultArgInfo c (telePi tel t') $
+            defaultDefn defaultArgInfo c (telePi tel t') $
               Constructor (size tel) con d (Info.defAbstract i) Inductive
 
         -- declare the constructor as eligible for instance search
@@ -271,9 +271,9 @@ bindParameters (A.DomainFull (A.TypedBindings _ (Arg info (A.TLet _ lbs))) : bs)
 bindParameters ps0@(A.DomainFree info x : ps) (El _ (Pi arg@(Dom info' a) b)) ret
   -- Andreas, 2011-04-07 ignore relevance information in binding?!
     | argInfoHiding info /= argInfoHiding info' =
-	__IMPOSSIBLE__
+        __IMPOSSIBLE__
     | otherwise = addContext (x, arg) $ bindParameters ps (absBody b) $ \tel s ->
-		    ret (ExtendTel arg $ Abs (nameToArgName x) tel) s
+                    ret (ExtendTel arg $ Abs (nameToArgName x) tel) s
 bindParameters bs (El s (Shared p)) ret = bindParameters bs (El s $ derefPtr p) ret
 bindParameters (b : bs) t _ = __IMPOSSIBLE__
 {- Andreas, 2012-01-17 Concrete.Definitions ensures number and hiding of parameters to be correct
@@ -320,29 +320,29 @@ constructs nofPars t q = constrT 0 t
     where
 {- OLD
         constrT :: Nat -> Type -> TCM ()
-	constrT n (El s v) = constr n s v
+        constrT n (El s v) = constr n s v
 
         constr :: Nat -> Sort -> Term -> TCM ()
-	constr n s v = do
-	    v <- reduce v
-	    case ignoreSharing v of
-		Pi _ (NoAbs _ b) -> constrT n b
-		Pi a b	         -> underAbstraction a b $ constrT (n + 1)
-		Def d vs
-		    | d == q -> checkParams n =<< reduce (take nofPars vs)
-						    -- we only check the parameters
-		_ -> bad $ El s v
-
-	bad t = typeError $ ShouldEndInApplicationOfTheDatatype t
+        constr n s v = do
+            v <- reduce v
+            case ignoreSharing v of
+                Pi _ (NoAbs _ b) -> constrT n b
+                Pi a b           -> underAbstraction a b $ constrT (n + 1)
+                Def d vs
+                    | d == q -> checkParams n =<< reduce (take nofPars vs)
+                                                    -- we only check the parameters
+                _ -> bad $ El s v
+
+        bad t = typeError $ ShouldEndInApplicationOfTheDatatype t
 -}
         constrT :: Nat -> Type -> TCM [Int]
         constrT n t = do
-	    t <- reduce t
-	    case ignoreSharing $ unEl t of
-		Pi _ (NoAbs _ b)  -> constrT n b
-		Pi a b	          -> underAbstraction a b $ constrT (n + 1)
+            t <- reduce t
+            case ignoreSharing $ unEl t of
+                Pi _ (NoAbs _ b)  -> constrT n b
+                Pi a b            -> underAbstraction a b $ constrT (n + 1)
                   -- OR: addCxtString (absName b) a $ constrT (n + 1) (absBody b)
-		Def d es | d == q -> do
+                Def d es | d == q -> do
                   let vs = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
                   (pars, ixs) <- normalise $ splitAt nofPars vs
                   -- check that the constructor parameters are the data parameters
@@ -354,26 +354,26 @@ constructs nofPars t q = constrT 0 t
                   when (any (< 0) nl) __IMPOSSIBLE__
                   when (any (>= nofPars) nl) __IMPOSSIBLE__
                   return nl
-		_ -> typeError $ ShouldEndInApplicationOfTheDatatype t
+                _ -> typeError $ ShouldEndInApplicationOfTheDatatype t
 
-	checkParams n vs = zipWithM_ sameVar vs ps
-	    where
+        checkParams n vs = zipWithM_ sameVar vs ps
+            where
                 nvs = size vs
-		ps = genericTake nvs $ downFrom (n + nvs)
+                ps = genericTake nvs $ downFrom (n + nvs)
 
-		sameVar arg i
+                sameVar arg i
                   -- skip irrelevant parameters
                   | isIrrelevant arg = return ()
-		  | otherwise = do
-		    t <- typeOfBV i
-		    equalTerm t (unArg arg) (var i)
+                  | otherwise = do
+                    t <- typeOfBV i
+                    equalTerm t (unArg arg) (var i)
 
         -- return the parameters (numbered 0,1,...,size pars-1 from left to right)
         -- that occur relevantly in the indices
         nonLinearParams n pars ixs =
           -- compute the free de Bruijn indices in the data indices
           -- ALT: Ignore all sorts?
-          let fv = freeVars' FreeConf{ fcIgnoreSorts = IgnoreInAnnotations } ixs
+          let fv = freeVarsIgnore IgnoreInAnnotations ixs
           -- keep relevant ones, convert to de Bruijn levels
           -- note: xs is descending list
               xs = map ((n-1) -) $ VarSet.toList $ relevantVars fv
@@ -388,15 +388,15 @@ forceData d (El s0 t) = liftTCM $ do
     t' <- reduce t
     d  <- canonicalName d
     case ignoreSharing t' of
-	Def d' _
-	    | d == d'   -> return $ El s0 t'
-	    | otherwise	-> fail $ "wrong datatype " ++ show d ++ " != " ++ show d'
-	MetaV m vs	    -> do
-	    Defn {defType = t, theDef = Datatype{dataSort = s}} <- getConstInfo d
-	    ps <- newArgsMeta t
-	    noConstraints $ leqType (El s0 t') (El s (Def d ps)) -- TODO: need equalType?
-	    reduce $ El s0 t'
-	_ -> typeError $ ShouldBeApplicationOf (El s0 t) d
+        Def d' _
+            | d == d'   -> return $ El s0 t'
+            | otherwise -> fail $ "wrong datatype " ++ show d ++ " != " ++ show d'
+        MetaV m vs          -> do
+            Defn {defType = t, theDef = Datatype{dataSort = s}} <- getConstInfo d
+            ps <- newArgsMeta t
+            noConstraints $ leqType (El s0 t') (El s (Def d ps)) -- TODO: need equalType?
+            reduce $ El s0 t'
+        _ -> typeError $ ShouldBeApplicationOf (El s0 t) d
 -}
 
 -- | Is the type coinductive? Returns 'Nothing' if the answer cannot
diff --git a/src/full/Agda/TypeChecking/Rules/Decl.hs b/src/full/Agda/TypeChecking/Rules/Decl.hs
index 3f9385a..4999b74 100644
--- a/src/full/Agda/TypeChecking/Rules/Decl.hs
+++ b/src/full/Agda/TypeChecking/Rules/Decl.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE TupleSections #-}
 
 module Agda.TypeChecking.Rules.Decl where
@@ -47,21 +47,23 @@ import Agda.TypeChecking.Rewriting
 import Agda.TypeChecking.SizedTypes.Solve
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Telescope
+import Agda.TypeChecking.Unquote
 
 import Agda.TypeChecking.Rules.Term
 import Agda.TypeChecking.Rules.Data    ( checkDataDef )
 import Agda.TypeChecking.Rules.Record  ( checkRecDef )
-import Agda.TypeChecking.Rules.Def     ( checkFunDef )
+import Agda.TypeChecking.Rules.Def     ( checkFunDef, useTerPragma )
 import Agda.TypeChecking.Rules.Builtin ( bindBuiltin )
 
 import Agda.Termination.TermCheck
 
-import Agda.Utils.Size
+import qualified Agda.Utils.HashMap as HMap
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
-import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.Pretty (prettyShow)
+import Agda.Utils.Size
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Type check a sequence of declarations.
@@ -86,8 +88,8 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
     let -- What kind of final checks/computations should be performed
         -- if we're not inside a mutual block?
         none        m = m >> return Nothing
-        meta        m = m >> return (Just (return []))
-        mutual i ds m = m >>= return . Just . mutualChecks i ds
+        meta        m = m >> return (Just (return ()))
+        mutual i ds m = m >>= return . Just . mutualChecks i d ds
         impossible  m = m >> return __IMPOSSIBLE__
                        -- We're definitely inside a mutual block.
 
@@ -124,46 +126,19 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
                                   -- highlighting purposes.
       A.UnquoteDecl mi i x e   -> checkUnquoteDecl mi i x e
 
-    unlessM (isJust . envMutualBlock <$> ask) $ do
-      -- The termination errors are not returned, but used for highlighting.
-      termErrs <- caseMaybe finalChecks (return []) $ \ theMutualChecks -> do
+    unlessM (isJust <$> asks envMutualBlock) $ do
+
+      -- Syntax highlighting.
+      highlight_ d
+
+      -- Post-typing checks.
+      whenJust finalChecks $ \ theMutualChecks -> do
         solveSizeConstraints
-        wakeupConstraints_   -- solve emptyness constraints
+        wakeupConstraints_   -- solve emptiness constraints
         freezeMetas
 
         theMutualChecks
 
-      -- Syntax highlighting.
-      let highlight d = generateAndPrintSyntaxInfo d (Full termErrs)
-      reimburseTop Bench.Typing $ billTop Bench.Highlighting $ case d of
-        A.Axiom{}                -> highlight d
-        A.Field{}                -> __IMPOSSIBLE__
-        A.Primitive{}            -> highlight d
-        A.Mutual{}               -> highlight d
-        A.Apply{}                -> highlight d
-        A.Import{}               -> highlight d
-        A.Pragma{}               -> highlight d
-        A.ScopedDecl{}           -> return ()
-        A.FunDef{}               -> __IMPOSSIBLE__
-        A.DataDef{}              -> __IMPOSSIBLE__
-        A.DataSig{}              -> __IMPOSSIBLE__
-        A.Open{}                 -> highlight d
-        A.PatternSynDef{}        -> highlight d
-        A.UnquoteDecl{}          -> highlight d
-        A.Section i x tel _      -> highlight (A.Section i x tel [])
-          -- Each block in the section has already been highlighted,
-          -- all that remains is the module declaration.
-        A.RecSig{}               -> highlight d
-        A.RecDef i x ind c ps tel cs ->
-          highlight (A.RecDef i x ind c [] tel (fields cs))
-          -- The telescope and all record module declarations except
-          -- for the fields have already been highlighted.
-          where
-          fields (A.ScopedDecl _ ds1 : ds2) = fields ds1 ++ fields ds2
-          fields (d at A.Field{}        : ds)  = d : fields ds
-          fields (_                  : ds)  = fields ds
-          fields []                         = []
-
     where
     unScope (A.ScopedDecl scope ds) = setScope scope >> unScope d
     unScope d = return d
@@ -184,47 +159,54 @@ checkDecl d = traceCall (SetRange (getRange d)) $ do
     abstract ConcreteDef = inConcreteMode
     abstract AbstractDef = inAbstractMode
 
-    -- Some checks that should be run at the end of a mutual
-    -- block (or non-mutual record declaration). The set names
-    -- contains the names defined in the mutual block.
-    mutualChecks i ds names = do
-      -- Andreas, 2014-04-11: instantiate metas in definition types
-      mapM_ instantiateDefinitionType $ Set.toList names
-      -- Andreas, 2013-02-27: check termination before injectivity,
-      -- to avoid making the injectivity checker loop.
-      termErrs <- case d of
-        A.UnquoteDecl{} -> checkTermination_ $ A.Mutual i ds
-        _               -> checkTermination_ d
-      checkPositivity_         names
-      checkCoinductiveRecords  ds
-      -- Andreas, 2012-09-11:  Injectivity check stores clauses
-      -- whose 'Relevance' is affected by polarity computation,
-      -- so do it here.
-      checkInjectivity_        names
-      checkProjectionLikeness_ names
-      return termErrs
-
-    checkUnquoteDecl mi i x e = do
-      reportSDoc "tc.unquote.decl" 20 $ text "Checking unquoteDecl" <+> prettyTCM x
-      fundef <- primAgdaFunDef
-      v      <- checkExpr e $ El (mkType 0) fundef
-      reportSDoc "tc.unquote.decl" 20 $ text "unquoteDecl: Checked term"
-      UnQFun a cs <- unquote v
+-- Some checks that should be run at the end of a mutual
+-- block (or non-mutual record declaration). The set names
+-- contains the names defined in the mutual block.
+mutualChecks :: Info.MutualInfo -> A.Declaration -> [A.Declaration] -> Set QName -> TCM ()
+mutualChecks i d ds names = do
+  -- Andreas, 2014-04-11: instantiate metas in definition types
+  mapM_ instantiateDefinitionType $ Set.toList names
+  -- Andreas, 2013-02-27: check termination before injectivity,
+  -- to avoid making the injectivity checker loop.
+  checkTermination_        d
+  checkPositivity_         names
+  checkCoinductiveRecords  ds
+  -- Andreas, 2012-09-11:  Injectivity check stores clauses
+  -- whose 'Relevance' is affected by polarity computation,
+  -- so do it here.
+  checkInjectivity_        names
+  checkProjectionLikeness_ names
+
+type FinalChecks = Maybe (TCM ())
+
+checkUnquoteDecl :: Info.MutualInfo -> Info.DefInfo -> QName -> A.Expr -> TCM FinalChecks
+checkUnquoteDecl mi i x e = do
+  reportSDoc "tc.unquote.decl" 20 $ text "Checking unquoteDecl" <+> prettyTCM x
+  fundef <- primAgdaFunDef
+  v      <- checkExpr e $ El (mkType 0) fundef
+  reportSDoc "tc.unquote.decl" 20 $ text "unquoteDecl: Checked term"
+  uv <- runUnquoteM $ unquote v
+  case uv of
+    Left err -> typeError $ UnquoteFailed err
+    Right (UnQFun a cs) -> do
       reportSDoc "tc.unquote.decl" 20 $
         vcat $ text "unquoteDecl: Unquoted term"
              : [ nest 2 $ text (show c) | c <- cs ]
       -- Add x to signature, otherwise reification gets unhappy.
-      addConstant x $ defaultDefn defaultArgInfo x a emptyFunction
+      addConstant x =<< do
+        useTerPragma $ defaultDefn defaultArgInfo x a emptyFunction
       a <- reifyUnquoted a
       reportSDoc "tc.unquote.decl" 10 $
         vcat [ text "unquoteDecl" <+> prettyTCM x <+> text "-->"
              , prettyTCM x <+> text ":" <+> prettyA a ]
-      cs <- mapM (reifyUnquoted . QNamed x) cs
+      tel <- getContextTelescope
+      let tel' = replaceEmptyName "r" $ killRange tel
+      cs <- mapM (reifyUnquoted . QNamed x . abstract tel) cs
       reportSDoc "tc.unquote.decl" 10 $ vcat $ map prettyA cs
       let ds = [ A.Axiom A.FunSig i defaultArgInfo x a   -- TODO other than defaultArg
                , A.FunDef i x NotDelayed cs ]
       xs <- checkMutual mi ds
-      return $ Just $ mutualChecks mi ds xs
+      return $ Just $ mutualChecks mi (A.Mutual mi ds) ds xs
 
 -- | Instantiate all metas in 'Definition' associated to 'QName'. --   Makes sense after freezing metas.
 --   Some checks, like free variable analysis, are not in 'TCM', --   so they will be more precise (see issue 1099) after meta instantiation.
@@ -253,20 +235,51 @@ instantiateDefinitionType q = do
 --   def <- instantiateFull def
 --   modifySignature $ updateDefinition q $ const def
 
-
--- | Termination check a declaration and return a list of termination errors.
-checkTermination_ :: A.Declaration -> TCM [TerminationError]
+-- | Highlight a declaration.
+highlight_ :: A.Declaration -> TCM ()
+highlight_ d = do
+  let highlight d = generateAndPrintSyntaxInfo d Full
+  reimburseTop Bench.Typing $ billTop Bench.Highlighting $ case d of
+    A.Axiom{}                -> highlight d
+    A.Field{}                -> __IMPOSSIBLE__
+    A.Primitive{}            -> highlight d
+    A.Mutual{}               -> highlight d
+    A.Apply{}                -> highlight d
+    A.Import{}               -> highlight d
+    A.Pragma{}               -> highlight d
+    A.ScopedDecl{}           -> return ()
+    A.FunDef{}               -> __IMPOSSIBLE__
+    A.DataDef{}              -> __IMPOSSIBLE__
+    A.DataSig{}              -> __IMPOSSIBLE__
+    A.Open{}                 -> highlight d
+    A.PatternSynDef{}        -> highlight d
+    A.UnquoteDecl{}          -> highlight d
+    A.Section i x tel _      -> highlight (A.Section i x tel [])
+      -- Each block in the section has already been highlighted,
+      -- all that remains is the module declaration.
+    A.RecSig{}               -> highlight d
+    A.RecDef i x ind c ps tel cs ->
+      highlight (A.RecDef i x ind c [] tel (fields cs))
+      -- The telescope and all record module declarations except
+      -- for the fields have already been highlighted.
+      where
+      fields (A.ScopedDecl _ ds1 : ds2) = fields ds1 ++ fields ds2
+      fields (d at A.Field{}        : ds)  = d : fields ds
+      fields (_                  : ds)  = fields ds
+      fields []                         = []
+
+-- | Termination check a declaration.
+checkTermination_ :: A.Declaration -> TCM ()
 checkTermination_ d = reimburseTop Bench.Typing $ billTop Bench.Termination $ do
   reportSLn "tc.decl" 20 $ "checkDecl: checking termination..."
-  ifNotM (optTerminationCheck <$> pragmaOptions) (return []) $ {- else -} do
+  whenM (optTerminationCheck <$> pragmaOptions) $ do
     case d of
       -- Record module definitions should not be termination-checked twice.
-      A.RecDef {} -> return []
+      A.RecDef {} -> return ()
       _ -> disableDestructiveUpdate $ do
-        termErrs <- {- nubList <$> -} termDecl d
-        modify $ \st ->
-          st { stTermErrs = Fold.foldl' (|>) (stTermErrs st) termErrs }
-        return termErrs
+        termErrs <- termDecl d
+        unless (null termErrs) $
+          typeError $ TerminationCheckFailed termErrs
 
 -- | Check a set of mutual names for positivity.
 checkPositivity_ :: Set QName -> TCM ()
@@ -353,8 +366,8 @@ checkAxiom funSig i info0 x e = do
     ]
   -- Not safe. See Issue 330
   -- t <- addForcingAnnotations t
-  addConstant x $
-    defaultDefn info x t $
+  addConstant x =<< do
+    useTerPragma $ defaultDefn info x t $
       case funSig of
         A.FunSig   -> emptyFunction
         A.NoFunSig -> Axiom    -- NB: used also for data and record type sigs
@@ -375,21 +388,18 @@ checkPrimitive i x e =
     (_, PrimImpl t' pf) <- lookupPrimitiveFunctionQ x
     t <- isType_ e
     noConstraints $ equalType t t'
-    let s  = show $ nameConcrete $ qnameName x
+    let s  = prettyShow $ qnameName x
     bindPrimitive s pf
     addConstant x $
       defaultDefn defaultArgInfo x t $
         Primitive (Info.defAbstract i) s [] Nothing
-    where
-	nameString (Name _ x _ _) = show x
-
 
 -- | Check a pragma.
 checkPragma :: Range -> A.Pragma -> TCM ()
 checkPragma r p =
     traceCall (CheckPragma r p) $ case p of
-	A.BuiltinPragma x e -> bindBuiltin x e
-	A.RewritePragma q   -> addRewriteRule q
+        A.BuiltinPragma x e -> bindBuiltin x e
+        A.RewritePragma q   -> addRewriteRule q
         A.CompiledTypePragma x hs -> do
           def <- getConstInfo x
           case theDef def of
@@ -481,7 +491,7 @@ checkPragma r p =
           case theDef def of
             Function{} -> markStatic x
             _          -> typeError $ GenericError "STATIC directive only works on functions"
-	A.OptionsPragma{} -> typeError $ GenericError $ "OPTIONS pragma only allowed at beginning of file, before top module declaration"
+        A.OptionsPragma{} -> typeError $ GenericError $ "OPTIONS pragma only allowed at beginning of file, before top module declaration"
         A.EtaPragma r -> do
           unlessM (isJust <$> isRecord r) $
             typeError $ GenericError $ "ETA pragma is only applicable to records"
@@ -504,7 +514,8 @@ checkMutual i ds = inMutualBlock $ do
       (text "Checking mutual block" <+> text (show blockId) <> text ":") :
       map (nest 2 . prettyA) ds
 
-  mapM_ checkDecl ds
+  local (\e -> e { envTerminationCheck = () <$ Info.mutualTermCheck i }) $
+    mapM_ checkDecl ds
 
   lookupMutualBlock =<< currentOrFreshMutualBlock
 
@@ -515,10 +526,10 @@ checkTypeSignature (A.ScopedDecl scope ds) = do
   mapM_ checkTypeSignature ds
 checkTypeSignature (A.Axiom funSig i info x e) =
     case Info.defAccess i of
-	PublicAccess  -> inConcreteMode $ checkAxiom funSig i info x e
-	PrivateAccess -> inAbstractMode $ checkAxiom funSig i info x e
+        PublicAccess  -> inConcreteMode $ checkAxiom funSig i info x e
+        PrivateAccess -> inAbstractMode $ checkAxiom funSig i info x e
         OnlyQualified -> __IMPOSSIBLE__
-checkTypeSignature _ = __IMPOSSIBLE__	-- type signatures are always axioms
+checkTypeSignature _ = __IMPOSSIBLE__   -- type signatures are always axioms
 
 -- | Type check a module.
 checkSection :: Info.ModuleInfo -> ModuleName -> A.Telescope -> [A.Declaration] -> TCM ()
@@ -682,7 +693,7 @@ checkSectionApplication' i m1 (A.RecordModuleIFS x) rd rm = do
     -- , nest 2 $ text "args    =" <+> text (show args)
     ]
   when (tel == EmptyTel) $
-    typeError $ GenericError $ show name ++ " is not a parameterised section"
+    typeError $ GenericError $ show (qnameToConcrete name) ++ " is not a parameterised section"
 
   addCtxTel telInst $ do
     vs <- freeVarsToApply name
diff --git a/src/full/Agda/TypeChecking/Rules/Def.hs b/src/full/Agda/TypeChecking/Rules/Def.hs
index 0007c76..4ddfd50 100644
--- a/src/full/Agda/TypeChecking/Rules/Def.hs
+++ b/src/full/Agda/TypeChecking/Rules/Def.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 module Agda.TypeChecking.Rules.Def where
@@ -7,7 +7,7 @@ import Prelude hiding (mapM)
 import Control.Arrow ((***))
 import Control.Applicative
 import Control.Monad.State hiding (forM, mapM)
-import Control.Monad.Error hiding (forM, mapM)
+import Control.Monad.Reader hiding (forM, mapM)
 
 import Data.Function
 import Data.List hiding (sort)
@@ -49,11 +49,13 @@ import Agda.TypeChecking.Rules.Term                ( checkExpr, inferExpr, infer
 import Agda.TypeChecking.Rules.LHS                 ( checkLeftHandSide, LHSResult(..) )
 import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl ( checkDecls )
 
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
+import Agda.Utils.Lens
 import Agda.Utils.Size
 import Agda.Utils.Permutation
 import Agda.Utils.Monad
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -140,6 +142,7 @@ checkAlias t' ai delayed i name e = do
                       , funTerminates     = Nothing
                       , funExtLam         = Nothing
                       , funWith           = Nothing
+                      , funCopatternLHS   = False
                       }
   reportSDoc "tc.def.alias" 20 $ text "checkAlias: leaving"
 
@@ -238,8 +241,10 @@ checkFunDef' t ai delayed extlam with i name cs =
               ]
 
         -- Add the definition
-        addConstant name $
-          defaultDefn ai name t $
+        addConstant name =<< do
+          -- If there was a pragma for this definition, we can set the
+          -- funTerminates field directly.
+          useTerPragma $ defaultDefn ai name t $
              Function
              { funClauses        = cs
              , funCompiled       = Just cc
@@ -253,6 +258,7 @@ checkFunDef' t ai delayed extlam with i name cs =
              , funTerminates     = Nothing
              , funExtLam         = extlam
              , funWith           = with
+             , funCopatternLHS   = isCopatternLHS cs
              }
 
         -- Andreas 2012-02-13: postpone polarity computation until after positivity check
@@ -265,93 +271,27 @@ checkFunDef' t ai delayed extlam with i name cs =
     where
         npats = size . clausePats
 
-{- BEGIN RETIRING implicit argument insertion
-
-{- | Ensure that all clauses have the same number of trailing implicits.
-Example:
-
-@
-  test : Bool → {A B : Set} → Set
-  test true  {A}     = A
-  test false {B = B} = B
-@
-
- at trailingImplicits@ patches these clauses to
-
-@
-  test : Bool → {A B : Set} → Set
-  test true  {A} {_}     = A
-  test false {_} {B = B} = B
-@
+-- | Set 'funTerminates' according to termination info in 'TCEnv',
+--   which comes from a possible termination pragma.
+useTerPragma :: Definition -> TCM Definition
+useTerPragma def at Defn{ defName = name, theDef = fun at Function{}} = do
+  tc <- asks envTerminationCheck
+  let terminates = case tc of
+        NonTerminating -> Just False
+        Terminating    -> Just True
+        _              -> Nothing
+  reportSLn "tc.fundef" 30 $ unlines $
+    [ "funTerminates of " ++ show name ++ " set to " ++ show terminates
+    , "  tc = " ++ show tc
+    ]
+  return $ def { theDef = fun { funTerminates = terminates }}
+useTerPragma def = return def
 
-such that the arity of the clauses of @test@ is uniform.
--}
--- TODO: how does this work with copatterns/flex arity?
-trailingImplicits :: Type -> [A.SpineClause] -> TCM [A.SpineClause]
-trailingImplicits t []       = __IMPOSSIBLE__
--- Andreas, 2013-10-01: don't do anything if there are projection copatterns
-trailingImplicits t cs | hasProjP cs = return cs
-  where
-    hasProjP = any (any (isJust . A.isProjP) . A.spLhsPats . A.clauseLHS)
-trailingImplicits t cs@(c:_) = do
-  pps@((ps,ips):_) <- mapM splitTrailingImplicits cs
-  -- compute the trailing implicits from type t
-  TelV tel t0 <- telView t
-  let -- number of non-hidden patterns
-      nh  = genericLength $ filter ((NotHidden ==) . getHiding) ps
-      -- drop nh non-hidden domains from t
-      l   = dropNonHidden nh $ telToList tel
-      -- take the hidden domains immediately after the dropped stuff
-      is   = takeWhile ((NotHidden /=) . getHiding) l
-      itel = telFromList is
-      -- get the trailing implicit patterns
-      ipss = map snd pps
-  -- complete the implicit pattern lists
-  ipss <- mapM (\ ps -> insertImplicitPatterns DontExpandLast ps itel) ipss
-  let longest = head $ sortBy (compare `on` ((0-) . length)) ipss
-      pps' = zip (map fst pps) ipss
-  return $ zipWith (patchUpTrailingImplicits longest) pps' cs
-
--- | @dropNonHidden n tel@ drops @n@ non-hidden domains from @tel@,
---   including all hidden domains that come before the @n at th non-hidden one.
-dropNonHidden :: Nat -> [I.Dom (String, Type)] -> [I.Dom (String, Type)]
-dropNonHidden 0 l = l
-dropNonHidden n l = case dropWhile ((NotHidden /=) . getHiding) l of
-  []    -> [] -- or raise a type checking error "too many arguments in lhs"
-  (_:l) -> dropNonHidden (n-1) l
-
--- | @splitTrailingImplicits c@ returns the patterns of clause @c@
---   as pair @(ps, ips)@ where @ips@ are the trailing implicit patterns
---   and @ps@ is the rest.
-splitTrailingImplicits :: A.SpineClause -> TCM (A.Patterns, A.Patterns)
-splitTrailingImplicits (A.Clause (A.SpineLHS _ _ _ wps@(_ : _)) _ _) =
-  typeError $ UnexpectedWithPatterns wps
-splitTrailingImplicits (A.Clause (A.SpineLHS _ _ aps []) _ _) = do
-  let (ips, ps) = span isHidden $ reverse aps
-  return (reverse ps, reverse ips)
-
--- | @patchUpTrailingImplicits should (ps, is) c@ takes a clause @c@ whose
---   patterns are split into @(ps, is)@ where @is@ are the trailing
---   implicit patterns and @ps@ the rest.  @is@ has already been patched
---   with omitted implicit patterns (which can occur if named implicit patterns
---   are there originally).  @should@ is an extension of @is at .
---   The returned clause contains an extension of @is@ by new wildcards
---   to match @should at .
-patchUpTrailingImplicits :: A.Patterns -> (A.Patterns, A.Patterns) -> A.SpineClause -> A.SpineClause
-patchUpTrailingImplicits should (ps, is) c | length is >= length should = c
-patchUpTrailingImplicits should (ps, is) (A.Clause (A.SpineLHS i x aps []) rhs0 wh) =
-  let imp  = hide $ defaultArg $ Named Nothing $ A.ImplicitP $ Info.patNoRange
-      imps = replicate (length should - length is) imp
-  in  A.Clause (A.SpineLHS i x (ps ++ is ++ imps) []) rhs0 wh
-patchUpTrailingImplicits _ _ _ = __IMPOSSIBLE__
-
--- END RETIRING implicit argument insertion -}
 
 -- | Insert some patterns in the in with-clauses LHS of the given RHS
 insertPatterns :: [A.Pattern] -> A.RHS -> A.RHS
 insertPatterns pats (A.WithRHS aux es cs) = A.WithRHS aux es (map insertToClause cs)
     where insertToClause (A.Clause (A.LHS i lhscore ps) rhs ds)
---              = A.Clause (A.LHS i x (aps ++ map (Arg NotHidden . unnamed) pats) (ps)) (insertPatterns pats rhs) ds
               = A.Clause (A.LHS i lhscore (pats ++ ps)) (insertPatterns pats rhs) ds
 insertPatterns pats (A.RewriteRHS qs eqs rhs wh) = A.RewriteRHS qs eqs (insertPatterns pats rhs) wh
 insertPatterns pats rhs = rhs
@@ -376,17 +316,7 @@ data WithFunctionProblem
     }
 
 -- | Type check a function clause.
-{-
-checkClause :: Type -> A.Clause -> TCM Clause
-checkClause t c@(A.Clause (A.LHS i (A.LHSProj{}) []) rhs0 wh) =
-  typeError $ NotImplemented "type checking definitions by copatterns"
-checkClause t c@(A.Clause (A.LHS i (A.LHSHead x aps) []) rhs0 wh) =
--}
 checkClause :: Type -> A.SpineClause -> TCM Clause
-{-
-checkClause t c@(A.Clause lhs rhs0 wh) = do
-    let A.SpineLHS i x aps withPats = A.lhsToSpine lhs
--}
 checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
     unless (null withPats) $
       typeError $ UnexpectedWithPatterns withPats
@@ -433,7 +363,7 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                           -- 1. rewriting with a reflexive equality to happen rarely,
                           -- 2. especially with ?-holes in the rewrite expression
                           -- 3. and a large overall number of ?s.
-                          let sameIP = (==) `on` stInteractionPoints
+                          let sameIP = (==) `on` (^.stInteractionPoints)
                           when (sameIP st st') $ put st
                           handleRHS $ A.RewriteRHS names eqs rhs wh
 
@@ -446,21 +376,6 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                      equality <- primEqualityName
                      Con reflCon [] <- ignoreSharing <$> primRefl
 
-                     -- Andreas, 2014-05-17  Issue 1110:
-                     -- Rewriting with REFL has no effect, but gives an
-                     -- incomprehensible error message about the generated
-                     -- with clause. Thus, we rather do simply nothing if
-                     -- rewriting with REFL is attempted.
-
-                     -- OBSOLETE:
-                     -- let isRefl v = isRefl' . ignoreSharing =<< reduce v
-                     --     isRefl' (Con c _) | c == reflCon = return True
-                     --     isRefl' (Lam h t)                = isRefl $ unAbs t
-                     --     isRefl' (DontCare t)             = isRefl t
-                     --     isRefl' _                        = return False
-
-                     -- ifM (isRefl proof) recurse $ {- else -} do
-
                      -- Check that the type is actually an equality (lhs ≡ rhs)
                      -- and extract lhs, rhs, and their type.
 
@@ -509,8 +424,8 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                                     -- is defined by induction on eqs.
                                     (A.RewriteRHS names eqs (insertPatterns pats rhs) inner)
                                     outer]
-                         pats = [A.DotP patNoRange underscore, -- rewriteToExpr,
-                                 A.ConP cinfo (AmbQ [conName reflCon]) []]
+                         pats = [ A.DotP patNoRange underscore
+                                , A.ConP cinfo (AmbQ [conName reflCon]) []]
                      reportSDoc "tc.rewrite.top" 25 $ vcat
                                          [ text "rewrite"
                                          , text "  from  = " <+> prettyTCM rewriteFromExpr
@@ -528,15 +443,18 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                     ]
                   reportSDoc "tc.with.top" 30 $
                     prettyA c
+                  reportSDoc "tc.with.top" 20 $ do
+                    m  <- currentModule
+                    nfv <- getModuleFreeVars m
+                    sep [ text "with function module:" <+>
+                          prettyList (map prettyTCM $ mnameToList m)
+                        ,  text $ "free variables: " ++ show nfv
+                        ]
+
                   -- Infer the types of the with expressions
-                  vas <- mapM inferExprForWith es
-                  (vs0, as) <- instantiateFull (unzip vas)
+                  (vs0, as) <- unzip <$> mapM inferExprForWith es
                   (vs, as)  <- normalise (vs0, as)
 
-                  -- Invent a clever name for the with function
-                  m <- currentModule
-                  reportSDoc "tc.with.top" 20 $ text "with function module:" <+> prettyList (map prettyTCM $ mnameToList m)
-
                   -- Split the telescope into the part needed to type the with arguments
                   -- and all the other stuff
                   let fv = allVars $ freeVars (vs, as)
@@ -561,17 +479,11 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                     ]
 
                   -- Create the body of the original function
-{- OLD
-                  ctx <- getContextTelescope
-                  let n    = size ctx
-                      m    = size delta
-                      -- All the context variables
-                      us   = [ Arg h r (var i) | (i, Arg h r _) <- zip [n - 1,n - 2..0] $ telToList ctx ]
--}
+
                   -- All the context variables
                   us <- getContextArgs
-                  let n    = size us
-                      m    = size delta
+                  let n = size us
+                      m = size delta
                       -- First the variables bound outside this definition
                       (us0, us1') = genericSplitAt (n - m) us
                       -- Then permute the rest and grab those needed to for the with arguments
@@ -584,12 +496,13 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                   -- and Δ₁ ⊢ vs : as
                   (vs, as) <- do
                     let -- We know that as does not depend on Δ₂
-                        rho = parallelS (replicate (size delta2) __IMPOSSIBLE__)
+                        rho = compactS __IMPOSSIBLE__ (replicate (size delta2) Nothing)
                     return $ applySubst rho $ renameP (reverseP perm') (vs, as)
 
 
                   -- Andreas, 2013-02-26 add with-name to signature for printing purposes
-                  addConstant aux (Defn defaultArgInfo aux typeDontCare [] [] [] 0 noCompiledRep [] Nothing emptyFunction)
+                  addConstant aux =<< do
+                    useTerPragma $ Defn defaultArgInfo aux typeDontCare [] [] [] 0 noCompiledRep [] Nothing emptyFunction
 
                   -- Andreas, 2013-02-26 separate msgs to see which goes wrong
                   reportSDoc "tc.with.top" 20 $
@@ -607,17 +520,6 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                   reportSDoc "tc.with.top" 20 $
                     text "              body" <+> (addCtxTel delta $ prettyTCM $ mkBody v)
 
-{-
-                  reportSDoc "tc.with.top" 20 $ vcat
-                    [ text "    with arguments" <+> do escapeContext (size delta2) $ prettyList (map prettyTCM vs)
-                    , text "             types" <+> do escapeContext (size delta2) $ prettyList (map prettyTCM as)
-                    , text "with function call" <+> prettyTCM v
-                    , text "           context" <+> (prettyTCM =<< getContextTelescope)
-                    , text "             delta" <+> do escapeContext (size delta) $ prettyTCM delta
-                    , text "                fv" <+> text (show fv)
-                    , text "              body" <+> (addCtxTel delta $ prettyTCM $ mkBody v)
-                    ]
--}
                   gamma <- maybe (typeError $ NotImplemented "with clauses for functions with unfolding arity") return mgamma
                   return (mkBody v, WithFunction x aux gamma delta1 delta2 vs as t' ps perm' perm finalPerm cs)
           in handleRHS rhs0
@@ -642,9 +544,7 @@ checkClause t c@(A.Clause (A.SpineLHS i x aps withPats) rhs0 wh) = do
                , clauseBody      = body
                , clauseType      = Just trhs
                }
-{-
-checkClause t (A.Clause (A.LHS _ _ ps@(_ : _)) _ _) = typeError $ UnexpectedWithPatterns ps
--}
+
 
 checkWithFunction :: WithFunctionProblem -> TCM ()
 checkWithFunction NoWithFunction = return ()
@@ -674,6 +574,10 @@ checkWithFunction (WithFunction f aux gamma delta1 delta2 vs as b qs perm' perm
   reportSLn "tc.with.top" 20 "created with display form"
 
   -- Generate the type of the with function
+  delta1 <- normalise delta1 -- Issue 1332: checkInternal is picky about argInfo
+                             -- but module application is sloppy.
+                             -- We normalise to get rid of Def's coming
+                             -- from module applications.
   candidateType <- withFunctionType delta1 vs as delta2 b
   reportSDoc "tc.with.type" 10 $ sep [ text "candidate type:", nest 2 $ prettyTCM candidateType ]
   reportSDoc "tc.with.type" 50 $ sep [ text "candidate type:", nest 2 $ text $ show candidateType ]
@@ -720,7 +624,8 @@ checkWithFunction (WithFunction f aux gamma delta1 delta2 vs as b qs perm' perm
       , prettyList $ map prettyTCM ts
       , prettyTCM dt
       ]
-  addConstant aux (Defn defaultArgInfo aux auxType [] [] [df] 0 noCompiledRep [] Nothing emptyFunction)
+  addConstant aux =<< do
+    useTerPragma $ Defn defaultArgInfo aux auxType [] [] [df] 0 noCompiledRep [] Nothing emptyFunction
   -- solveSizeConstraints -- Andreas, 2012-10-16 does not seem necessary
 
   reportSDoc "tc.with.top" 10 $ sep
@@ -773,21 +678,3 @@ containsAbsurdPattern p = case p of
     A.ConP _ _ ps -> any (containsAbsurdPattern . namedArg) ps
     A.DefP _ _ _  -> False  -- projection pattern
     A.PatternSynP _ _ _ -> __IMPOSSIBLE__ -- False
-
-{- UNUSED
-actualConstructor :: QName -> TCM QName
-actualConstructor c = do
---    v <- constructorForm =<< normalise (Con c [])
-    v <- constructorForm =<< getConTerm c
-    case ignoreSharing v of
-        Con c _ -> return $ conName c
-        _       -> actualConstructor =<< stripLambdas v
-    where
-        stripLambdas v = case ignoreSharing v of
-            Con c _ -> return c
-            Lam info b -> do
-                x <- freshName_ $ absName b
-                addCtx x (Dom info $ sort Prop) $
-                         stripLambdas (absBody b)
-            _       -> typeError $ GenericError $ "Not a constructor: " ++ show c
--}
diff --git a/src/full/Agda/TypeChecking/Rules/Def.hs-boot b/src/full/Agda/TypeChecking/Rules/Def.hs-boot
index 88dfe4a..3fe562f 100644
--- a/src/full/Agda/TypeChecking/Rules/Def.hs-boot
+++ b/src/full/Agda/TypeChecking/Rules/Def.hs-boot
@@ -7,5 +7,7 @@ import Agda.TypeChecking.Monad
 import qualified Agda.Syntax.Internal as I
 
 checkFunDef :: Delayed -> DefInfo -> QName -> [Clause] -> TCM ()
-checkFunDef' :: I.Type -> I.ArgInfo -> Delayed -> Maybe (Int,Int) -> Maybe QName -> DefInfo -> QName -> [Clause]
-                  -> TCM ()
+
+checkFunDef' :: I.Type -> I.ArgInfo -> Delayed -> Maybe (Int,Int) -> Maybe QName -> DefInfo -> QName -> [Clause] -> TCM ()
+
+useTerPragma :: Definition -> TCM Definition
diff --git a/src/full/Agda/TypeChecking/Rules/LHS.hs b/src/full/Agda/TypeChecking/Rules/LHS.hs
index 8fc1914..ed8d0a8 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS.hs
@@ -2,18 +2,20 @@
 
 module Agda.TypeChecking.Rules.LHS where
 
+import Prelude hiding (mapM)
+
 import Data.Maybe
 
 import Control.Applicative
-import Control.Monad
-import Control.Monad.State
+import Control.Monad hiding (mapM)
+import Control.Monad.State hiding (mapM)
 
 import Data.Traversable
 
 import Agda.Interaction.Options
 import Agda.Interaction.Options.Lenses
 
-import Agda.Syntax.Internal as I
+import Agda.Syntax.Internal as I hiding (Substitution)
 import Agda.Syntax.Internal.Pattern
 import Agda.Syntax.Abstract (IsProjP(..))
 import qualified Agda.Syntax.Abstract as A
@@ -51,7 +53,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Compute the set of flexible patterns in a list of patterns. The result is
@@ -103,28 +105,60 @@ dotPatternInsts ps s as = dpi (map namedArg ps) (reverse s) as
 
         _           -> __IMPOSSIBLE__
 
-instantiatePattern :: Substitution -> Permutation -> [I.NamedArg Pattern] -> [I.NamedArg Pattern]
+
+-- | In an internal pattern, replace some pattern variables
+--   by dot patterns, according to the given substitution.
+instantiatePattern
+  :: Substitution
+     -- ^ Partial substitution for the pattern variables,
+     --   given in order of the clause telescope,
+     --   (not in the order of occurrence in the patterns).
+  -> Permutation
+     -- ^ Map from the pattern variables to the telescope variables.
+  -> [I.NamedArg Pattern]
+     -- ^ Input patterns.
+  -> [I.NamedArg Pattern]
+     -- ^ Output patterns, with some @VarP@ replaced by @DotP@
+     --   according to the @Substitution at .
 instantiatePattern sub perm ps
-  | length sub /= length hps = error $ unlines [ "instantiatePattern:"
-                                               , "  sub  = " ++ show sub
-                                               , "  perm = " ++ show perm
-                                               , "  ps   = " ++ show ps
-                                               ]
+  | length sub /= length hps = error $ unlines
+      [ "instantiatePattern:"
+      , "  sub  = " ++ show sub
+      , "  perm = " ++ show perm
+      , "  ps   = " ++ show ps
+      ]
   | otherwise  = foldr merge ps $ zipWith inst (reverse sub) hps
   where
+    -- For each pattern variable get a copy of the patterns
+    -- focusing on this variable.
+    -- Order them in the dependency (telescope) order.
     hps = permute perm $ allHoles ps
+    -- If we do not want to substitute a variable, we
+    -- throw away the corresponding one-hole pattern.
     inst Nothing  hps = Nothing
+    -- If we want to substitute, we replace the variable
+    -- by the dot pattern.
     inst (Just t) hps = Just $ plugHole (DotP t) hps
 
+    -- If we did not instantiate a variable, we can keep the original
+    -- patterns in this iteration.
     merge Nothing   ps = ps
+    -- Otherwise, we merge the changes in @qs@ into @ps at .
+    -- This means we walk simultaneously through @qs@ and @ps@
+    -- and expect them to be the same everywhere except that
+    -- a @q@ can be a @DotP@ and the corresponding @p@ a @VarP at .
+    -- In this case, we take the @DotP at .
+    -- Apparently, the other way round can also happen (why?).
     merge (Just qs) ps = zipWith mergeA qs ps
       where
         mergeA a1 a2 = fmap (mergeP (namedArg a1) (namedArg a2) <$) a1
         mergeP (DotP s)  (DotP t)
           | s == t                    = DotP s
           | otherwise                 = __IMPOSSIBLE__
+        -- interesting cases:
         mergeP (DotP t)  (VarP _)     = DotP t
         mergeP (VarP _)  (DotP t)     = DotP t
+        -- the rest is homomorphical
         mergeP (DotP _)  _            = __IMPOSSIBLE__
         mergeP _         (DotP _)     = __IMPOSSIBLE__
         mergeP (ConP c1 mt1 ps) (ConP c2 mt2 qs)
@@ -148,6 +182,41 @@ instantiatePattern sub perm ps
         mergeP ProjP{} _              = __IMPOSSIBLE__
         mergeP _       ProjP{}        = __IMPOSSIBLE__
 
+
+-- | In an internal pattern, replace some pattern variables
+--   by dot patterns, according to the given substitution.
+instantiatePattern'
+  :: Substitution
+     -- ^ Partial substitution for the pattern variables,
+     --   given in order of the clause telescope,
+     --   (not in the order of occurrence in the patterns).
+  -> Permutation
+     -- ^ Map from the pattern variables to the telescope variables.
+  -> [I.NamedArg Pattern]
+     -- ^ Input patterns.
+  -> [I.NamedArg Pattern]
+     -- ^ Output patterns, with some @VarP@ replaced by @DotP@
+     --   according to the @Substitution at .
+instantiatePattern' sub perm ps = evalState (mapM goArg ps) 0
+  where
+    -- get a partial substitution from pattern variables to terms
+    sub'    = inversePermute perm sub
+    -- get next pattern variable
+    next    = do n <- get; put (n+1); return n
+    goArg   = traverse goNamed
+    goNamed = traverse goPat
+    goPat p = case p of
+      VarP x       -> replace p
+      DotP t       -> replace p
+      ConP c mt ps -> ConP c mt <$> mapM goArg ps
+      LitP{}       -> return p
+      ProjP{}      -> return p
+    replace p = do
+      i <- next
+      return $ fromMaybe p $ DotP <$> sub' !! i
+
+
+
 -- | Check if a problem is solved. That is, if the patterns are all variables.
 isSolvedProblem :: Problem -> Bool
 isSolvedProblem problem = null (restPats $ problemRest problem) &&
@@ -159,13 +228,6 @@ isSolvedProblem problem = null (restPats $ problemRest problem) &&
     isSolved (A.ImplicitP _) = True
     isSolved (A.AbsurdP _)   = True
     isSolved _               = False
-{-
-    isVar (A.VarP _)      = True
-    isVar (A.WildP _)     = True
-    isVar (A.ImplicitP _) = True
-    isVar (A.AbsurdP _)   = True
-    isVar _               = False
--}
 
 -- | For each user-defined pattern variable in the 'Problem', check
 -- that the corresponding data type (if any) does not contain a
@@ -314,6 +376,16 @@ data LHSResult = LHSResult
   , lhsPermutation :: Permutation       -- ^ The permutation from pattern vars to @Δ@.
   }
 
+instance InstantiateFull LHSResult where
+  instantiateFull' (LHSResult mtel tel sub xs ps t perm) = LHSResult
+    <$> instantiateFull' mtel
+    <*> instantiateFull' tel
+    <*> instantiateFull' sub
+    <*> return xs
+    <*> instantiateFull' ps
+    <*> instantiateFull' t
+    <*> return perm
+
 -- | Check a LHS. Main function.
 --
 --   @checkLeftHandSide a ps a ret@ checks that user patterns @ps@ eliminate
@@ -333,33 +405,35 @@ checkLeftHandSide
      -- ^ Continuation.
   -> TCM a
 checkLeftHandSide c f ps a ret = do
-  problem <- problemFromPats ps a
+  problem0 <- problemFromPats ps a
   -- Andreas, 2013-03-15 deactivating the following test allows
   -- flexible arity
   -- unless (noProblemRest problem) $ typeError $ TooManyArgumentsInLHS a
-  let mgamma = if noProblemRest problem then Just $ problemTel problem else Nothing
+  let mgamma = if noProblemRest problem0 then Just $ problemTel problem0 else Nothing
 
   -- doing the splits:
-  LHSState (Problem ps (perm, qs) delta rest) sigma dpi asb
-    <- checkLHS $ LHSState problem idS [] []
+  LHSState problem@(Problem ps (perm, qs) delta rest) sigma dpi asb
+    <- checkLHS f $ LHSState problem0 idS [] []
 
   unless (null $ restPats rest) $ typeError $ TooManyArgumentsInLHS a
 
-  let b' = restType rest
+  noShadowingOfConstructors c problem
 
   noPatternMatchingOnCodata qs
 
   reportSDoc "tc.lhs.top" 10 $
     vcat [ text "checked lhs:"
-	 , nest 2 $ vcat
-	   [ text "ps    = " <+> fsep (map prettyA ps)
-	   , text "perm  = " <+> text (show perm)
-	   , text "delta = " <+> prettyTCM delta
-	   , text "dpi   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi)
-	   , text "asb   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb)
+         , nest 2 $ vcat
+           [ text "ps    = " <+> fsep (map prettyA ps)
+           , text "perm  = " <+> text (show perm)
+           , text "delta = " <+> prettyTCM delta
+           , text "dpi   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi)
+           , text "asb   = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb)
            , text "qs    = " <+> text (show qs)
-	   ]
+           ]
          ]
+
+  let b' = restType rest
   bindLHSVars (filter (isNothing . isProjP) ps) delta $ bindAsPatterns asb $ do
     reportSDoc "tc.lhs.top" 10 $ text "bound pattern variables"
     reportSDoc "tc.lhs.top" 10 $ nest 2 $ text "type  = " <+> prettyTCM b'
@@ -368,338 +442,337 @@ checkLeftHandSide c f ps a ret = do
     mapM_ checkDotPattern dpi
 
     let rho = renamingR perm -- I'm not certain about this...
-        Perm n _ = perm
-        xs  = [ stringToArgName $ "h" ++ show n | n <- [0..n - 1] ]
-    applyRelevanceToContext (getRelevance b') $ do
-      ret $ LHSResult mgamma delta rho xs qs b' perm
-  where
-    -- the loop: split at a variable in the problem until problem is solved
-    checkLHS :: LHSState -> TCM LHSState
-    checkLHS st@(LHSState problem sigma dpi asb) = do
-      problem <- insertImplicitProblem problem  -- inserting implicits no longer preserve solvedness
-      if isSolvedProblem problem                -- since we might insert eta expanded record patterns
-        then do
-          noShadowingOfConstructors c problem
-          return $ st { lhsProblem = problem }
-        else do
-        unlessM (optPatternMatching <$> gets getPragmaOptions) $
-          typeError $ GenericError $ "Pattern matching is disabled"
-        sp <- splitProblem f problem
-        reportSDoc "tc.lhs.split" 20 $ text "splitting completed"
-        case sp of
-          Left NothingToSplit   -> do
-            reportSLn "tc.lhs.split" 50 $ "checkLHS: nothing to split in problem " ++ show problem
-            nothingToSplitError problem
-          Left (SplitPanic err) -> do
-            reportSLn "impossible" 10 $ "checkLHS: panic: " ++ err
-            __IMPOSSIBLE__
-
-          -- Split problem rest (projection pattern)
-          Right (SplitRest projPat projType) -> do
-
-            -- Compute the new problem
-            let Problem ps1 (iperm, ip) delta (ProblemRest (p:ps2) b) = problem
-                -- ps'      = ps1 ++ [p]
-                ps'      = ps1 -- drop the projection pattern (already splitted)
-                rest     = ProblemRest ps2 (projPat $> projType)
-                ip'      = ip ++ [fmap (Named Nothing . ProjP) projPat]
-                problem' = Problem ps' (iperm, ip') delta rest
-            -- Jump the trampolin
-            st' <- updateProblemRest (LHSState problem' sigma dpi asb)
-            -- If the field is irrelevant, we need to continue in irr. cxt.
-            -- (see Issue 939).
-            applyRelevanceToContext (getRelevance projPat) $ do
-              checkLHS st'
-
-
-          -- Split on literal pattern
-          Right (Split p0 xs (Arg _ (LitFocus lit iph hix a)) p1) -> do
-
-            -- plug the hole with a lit pattern
-            let ip    = plugHole (LitP lit) iph
-                iperm = expandP hix 0 $ fst (problemOutPat problem)
-
-            -- substitute the literal in p1 and sigma and dpi and asb
-            let delta1 = problemTel p0
-                delta2 = absApp (fmap problemTel p1) (Lit lit)
-                rho    = liftS (size delta2) $ singletonS (Lit lit)
-                -- rho    = [ var i | i <- [0..size delta2 - 1] ]
-                --       ++ [ raise (size delta2) $ Lit lit ]
-                --       ++ [ var i | i <- [size delta2 ..] ]
-                sigma'   = applySubst rho sigma
-                dpi'     = applySubst rho dpi
-                asb0     = applySubst rho asb
-                ip'      = applySubst rho ip
-                rest'    = applySubst rho (problemRest problem)
-
-            -- Compute the new problem
-            let ps'      = problemInPat p0 ++ problemInPat (absBody p1)
-                delta'   = abstract delta1 delta2
-                problem' = Problem ps' (iperm, ip') delta' rest'
-                asb'     = raise (size delta2) (map (\x -> AsB x (Lit lit) a) xs) ++ asb0
-            st' <- updateProblemRest (LHSState problem' sigma' dpi' asb')
-            checkLHS st'
-
-          -- Split on constructor pattern
-          Right (Split p0 xs (Arg info
-                  ( Focus { focusCon      = c
-                          , focusImplicit = impl
-                          , focusConArgs  = qs
-                          , focusRange    = r
-                          , focusOutPat   = iph
-                          , focusHoleIx   = hix
-                          , focusDatatype = d
-                          , focusParams   = vs
-                          , focusIndices  = ws
-                          , focusType     = a
-                          }
-                  )) p1
-                ) -> traceCall (CheckPattern (A.ConP (ConPatInfo impl $ PatRange r) (A.AmbQ [c]) qs)
-                                             (problemTel p0)
-                                             (El Prop $ Def d $ map Apply $ vs ++ ws)) $ do
-
-            let delta1 = problemTel p0
-            let typeOfSplitVar = Arg info a
-
-            reportSDoc "tc.lhs.split" 10 $ sep
-              [ text "checking lhs"
-              , nest 2 $ text "tel =" <+> prettyTCM (problemTel problem)
-              , nest 2 $ text "rel =" <+> (text $ show $ argInfoRelevance info)
-              ]
+        xs  = [ stringToArgName $ "h" ++ show n | n <- [0..permRange perm - 1] ]
+    lhsResult <- return $ LHSResult mgamma delta rho xs qs b' perm
+    applyRelevanceToContext (getRelevance b') $ ret lhsResult
+
+-- | The loop (tail-recursive): split at a variable in the problem until problem is solved
+checkLHS
+  :: Maybe QName       -- ^ The name of the definition we are checking.
+  -> LHSState          -- ^ The current state.
+  -> TCM LHSState      -- ^ The final state after all splitting is completed
+checkLHS f st@(LHSState problem sigma dpi asb) = do
+
+  problem <- insertImplicitProblem problem
+  -- Note: inserting implicits no longer preserve solvedness,
+  -- since we might insert eta expanded record patterns.
+  if isSolvedProblem problem then return $ st { lhsProblem = problem } else do
+
+  unlessM (optPatternMatching <$> gets getPragmaOptions) $
+    typeError $ GenericError $ "Pattern matching is disabled"
+
+  sp <- splitProblem f problem
+  reportSDoc "tc.lhs.split" 20 $ text "splitting completed"
+  case sp of
+    Left NothingToSplit   -> do
+      reportSLn "tc.lhs.split" 50 $ "checkLHS: nothing to split in problem " ++ show problem
+      nothingToSplitError problem
+    Left (SplitPanic err) -> do
+      reportSLn "impossible" 10 $ "checkLHS: panic: " ++ err
+      __IMPOSSIBLE__
+
+    -- Split problem rest (projection pattern)
+    Right (SplitRest projPat projType) -> do
+
+      -- Compute the new problem
+      let Problem ps1 (iperm, ip) delta (ProblemRest (p:ps2) b) = problem
+          -- ps'      = ps1 ++ [p]
+          ps'      = ps1 -- drop the projection pattern (already splitted)
+          rest     = ProblemRest ps2 (projPat $> projType)
+          ip'      = ip ++ [fmap (Named Nothing . ProjP) projPat]
+          problem' = Problem ps' (iperm, ip') delta rest
+      -- Jump the trampolin
+      st' <- updateProblemRest (LHSState problem' sigma dpi asb)
+      -- If the field is irrelevant, we need to continue in irr. cxt.
+      -- (see Issue 939).
+      applyRelevanceToContext (getRelevance projPat) $ do
+        checkLHS f st'
+
+    -- Split on literal pattern
+    Right (Split p0 xs (Arg _ (LitFocus lit iph hix a)) p1) -> do
+
+      -- plug the hole with a lit pattern
+      let ip    = plugHole (LitP lit) iph
+          iperm = expandP hix 0 $ fst (problemOutPat problem)
+
+      -- substitute the literal in p1 and sigma and dpi and asb
+      let delta1 = problemTel p0
+          delta2 = absApp (fmap problemTel p1) (Lit lit)
+          rho    = liftS (size delta2) $ singletonS (Lit lit)
+          -- rho    = [ var i | i <- [0..size delta2 - 1] ]
+          --       ++ [ raise (size delta2) $ Lit lit ]
+          --       ++ [ var i | i <- [size delta2 ..] ]
+          sigma'   = applySubst rho sigma
+          dpi'     = applySubst rho dpi
+          asb0     = applySubst rho asb
+          ip'      = applySubst rho ip
+          rest'    = applySubst rho (problemRest problem)
+
+      -- Compute the new problem
+      let ps'      = problemInPat p0 ++ problemInPat (absBody p1)
+          delta'   = abstract delta1 delta2
+          problem' = Problem ps' (iperm, ip') delta' rest'
+          asb'     = raise (size delta2) (map (\x -> AsB x (Lit lit) a) xs) ++ asb0
+      st' <- updateProblemRest (LHSState problem' sigma' dpi' asb')
+      checkLHS f st'
+
+    -- Split on constructor pattern
+    Right (Split p0 xs (Arg info
+            ( Focus { focusCon      = c
+                    , focusImplicit = impl
+                    , focusConArgs  = qs
+                    , focusRange    = r
+                    , focusOutPat   = iph
+                    , focusHoleIx   = hix
+                    , focusDatatype = d
+                    , focusParams   = vs
+                    , focusIndices  = ws
+                    , focusType     = a
+                    }
+            )) p1
+          ) -> traceCall (CheckPattern (A.ConP (ConPatInfo impl $ PatRange r) (A.AmbQ [c]) qs)
+                                       (problemTel p0)
+                                       (El Prop $ Def d $ map Apply $ vs ++ ws)) $ do
+
+      let delta1 = problemTel p0
+      let typeOfSplitVar = Arg info a
+
+      reportSDoc "tc.lhs.split" 10 $ sep
+        [ text "checking lhs"
+        , nest 2 $ text "tel =" <+> prettyTCM (problemTel problem)
+        , nest 2 $ text "rel =" <+> (text $ show $ argInfoRelevance info)
+        ]
 
-            reportSDoc "tc.lhs.split" 15 $ sep
-              [ text "split problem"
-              , nest 2 $ vcat
-                [ text "delta1 = " <+> prettyTCM delta1
-                , text "typeOfSplitVar =" <+> prettyTCM typeOfSplitVar
-                , text "focusOutPat =" <+> (text . show) iph
-                , text "delta2 = " <+> prettyTCM (problemTel $ absBody p1)
-                ]
-              ]
+      reportSDoc "tc.lhs.split" 15 $ sep
+        [ text "split problem"
+        , nest 2 $ vcat
+          [ text "delta1 = " <+> prettyTCM delta1
+          , text "typeOfSplitVar =" <+> prettyTCM typeOfSplitVar
+          , text "focusOutPat =" <+> (text . show) iph
+          , text "delta2 = " <+> prettyTCM (problemTel $ absBody p1)
+          ]
+        ]
 
 {-
-            c <- conSrcCon . theDef <$> getConstInfo c
-            Con c' [] <- ignoreSharing <$> (constructorForm =<< normalise (Con c []))
-            c  <- return $ c' `withRangeOf` c
+      c <- conSrcCon . theDef <$> getConstInfo c
+      Con c' [] <- ignoreSharing <$> (constructorForm =<< normalise (Con c []))
+      c  <- return $ c' `withRangeOf` c
 -}
-            c <- (`withRangeOf` c) <$> getConForm c
-            ca <- defType <$> getConInfo c
+      c <- (`withRangeOf` c) <$> getConForm c
+      ca <- defType <$> getConInfo c
 
-            reportSDoc "tc.lhs.split" 20 $ nest 2 $ vcat
-              [ text "ca =" <+> prettyTCM ca
-              , text "vs =" <+> prettyList (map prettyTCM vs)
-              ]
+      reportSDoc "tc.lhs.split" 20 $ nest 2 $ vcat
+        [ text "ca =" <+> prettyTCM ca
+        , text "vs =" <+> prettyList (map prettyTCM vs)
+        ]
 
-            -- Lookup the type of the constructor at the given parameters
-            let a = ca `piApply` vs
+      -- Lookup the type of the constructor at the given parameters
+      let a = ca `piApply` vs
 
-            -- It will end in an application of the datatype
-            (gamma', ca, d', us) <- do
-              TelV gamma' ca@(El _ def) <- telView a
-              let Def d' es = ignoreSharing def
-                  Just us   = allApplyElims es
-              return (gamma', ca, d', us)
+      -- It will end in an application of the datatype
+      (gamma', ca, d', us) <- do
+        TelV gamma' ca@(El _ def) <- telView a
+        let Def d' es = ignoreSharing def
+            Just us   = allApplyElims es
+        return (gamma', ca, d', us)
 
-            -- This should be the same datatype as we split on
-            unless (d == d') $ typeError $ ShouldBeApplicationOf ca d'
+      -- This should be the same datatype as we split on
+      unless (d == d') $ typeError $ ShouldBeApplicationOf ca d'
 
-{-
-            reportSDoc "tc.lhs.top" 20 $ nest 2 $ vcat
-              [ text "gamma' =" <+> text (show gamma')
-              ]
--}
+      -- reportSDoc "tc.lhs.top" 20 $ nest 2 $ vcat
+      --   [ text "gamma' =" <+> text (show gamma')
+      --   ]
 
-            -- Andreas 2010-09-07  propagate relevance info to new vars
-            gamma' <- return $ fmap (applyRelevance $ argInfoRelevance info) gamma'
-{-
-            reportSDoc "tc.lhs.top" 20 $ nest 2 $ vcat
-              [ text "gamma' =" <+> text (show gamma')
-              ]
--}
-            -- Insert implicit patterns
-            qs' <- insertImplicitPatterns ExpandLast qs gamma'
-
-            unless (size qs' == size gamma') $
-              typeError $ WrongNumberOfConstructorArguments (conName c) (size gamma') (size qs')
-
-            let gamma = useNamesFromPattern qs' gamma'
-
-            -- Get the type of the datatype.
-            da <- (`piApply` vs) . defType <$> getConstInfo d
-
-            -- Compute the flexible variables
-            flex <- flexiblePatterns (problemInPat p0 ++ qs')
-
-            -- Compute the constructor indices by dropping the parameters
-            let us' = drop (size vs) us
-
-	    reportSDoc "tc.lhs.top" 15 $ addCtxTel delta1 $
-	      sep [ text "preparing to unify"
-		  , nest 2 $ vcat
-		    [ text "c      =" <+> prettyTCM c <+> text ":" <+> prettyTCM a
-		    , text "d      =" <+> prettyTCM d <+> text ":" <+> prettyTCM da
-		    , text "gamma  =" <+> prettyTCM gamma
-		    , text "gamma' =" <+> prettyTCM gamma'
-		    , text "vs     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM vs)
-		    , text "us'    =" <+> brackets (fsep $ punctuate comma $ map prettyTCM us')
-		    , text "ws     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM ws)
-		    ]
-		  ]
-
-            -- Unify constructor target and given type (in Δ₁Γ)
-            sub0 <- addCtxTel (delta1 `abstract` gamma) $
-                    unifyIndices_ flex (raise (size gamma) da) us' (raise (size gamma) ws)
-
-            -- We should substitute c ys for x in Δ₂ and sigma
-            let ys     = teleArgs gamma
-                delta2 = absApp (raise (size gamma) $ fmap problemTel p1) (Con c ys)
-                rho0   = liftS (size delta2) $ Con c ys :# raiseS (size gamma)
-                -- rho0 = [ var i | i <- [0..size delta2 - 1] ]
-                --     ++ [ raise (size delta2) $ Con c ys ]
-                --     ++ [ var i | i <- [size delta2 + size gamma ..] ]
-                sigma0 = applySubst rho0 sigma
-                dpi0   = applySubst rho0 dpi
-                asb0   = applySubst rho0 asb
-                rest0  = applySubst rho0 (problemRest problem)
-
-            reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma) $ nest 2 $ vcat
-              [ text "delta2 =" <+> prettyTCM delta2
-              , text "sub0   =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub0)
-              ]
-            reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma `abstract` delta2) $
-              nest 2 $ vcat
-                [ text "dpi0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi0)
-                , text "asb0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb0)
-                ]
-
-            -- Andreas, 2010-09-09, save the type a of record pattern.
-            -- It is relative to delta1, but it should be relative to
-            -- all variables which will be bound by patterns.
-            -- Thus, it has to be raised by 1 (the "hole" variable)
-            -- plus the length of delta2 (the variables coming after the hole).
-            storedPatternType <- ifM (isJust <$> isRecord d)
-              (return $ Just (impl, raise (1 + size delta2) typeOfSplitVar))
-              (return $ Nothing)
-
-            -- Plug the hole in the out pattern with c ys
-            let ysp = map (argFromDom . fmap (namedVarP . fst)) $ telToList gamma
-                ip  = plugHole (ConP c storedPatternType ysp) iph
-                ip0 = applySubst rho0 ip
-
-            -- Δ₁Γ ⊢ sub0, we need something in Δ₁ΓΔ₂
-            -- Also needs to be padded with Nothing's to have the right length.
-            let pad n xs x = xs ++ replicate (max 0 $ n - size xs) x
-                newTel = problemTel p0 `abstract` (gamma `abstract` delta2)
-                sub    = replicate (size delta2) Nothing ++
-                         pad (size delta1 + size gamma) (raise (size delta2) sub0) Nothing
-
-            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
-              [ text "newTel =" <+> prettyTCM newTel
-              , addCtxTel newTel $ text "sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub)
-              , text "ip   =" <+> text (show ip)
-              , text "ip0  =" <+> text (show ip0)
-              ]
-            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
-              [ text "rho0 =" <+> text (show rho0)
+      -- Andreas 2010-09-07  propagate relevance info to new vars
+      -- Andreas 2014-11-25  clear 'Forced' and 'Unused'
+      let updRel = ignoreForced . composeRelevance (getRelevance info)
+      gamma' <- return $ mapRelevance updRel <$> gamma'
+
+      -- Insert implicit patterns
+      qs' <- insertImplicitPatterns ExpandLast qs gamma'
+
+      unless (size qs' == size gamma') $
+        typeError $ WrongNumberOfConstructorArguments (conName c) (size gamma') (size qs')
+
+      let gamma = useNamesFromPattern qs' gamma'
+
+      -- Get the type of the datatype.
+      da <- (`piApply` vs) . defType <$> getConstInfo d
+
+      -- Compute the flexible variables
+      flex <- flexiblePatterns (problemInPat p0 ++ qs')
+
+      -- Compute the constructor indices by dropping the parameters
+      let us' = drop (size vs) us
+
+      reportSDoc "tc.lhs.top" 15 $ addCtxTel delta1 $
+        sep [ text "preparing to unify"
+            , nest 2 $ vcat
+              [ text "c      =" <+> prettyTCM c <+> text ":" <+> prettyTCM a
+              , text "d      =" <+> prettyTCM d <+> text ":" <+> prettyTCM da
+              , text "gamma  =" <+> prettyTCM gamma
+              , text "gamma' =" <+> prettyTCM gamma'
+              , text "vs     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM vs)
+              , text "us'    =" <+> brackets (fsep $ punctuate comma $ map prettyTCM us')
+              , text "ws     =" <+> brackets (fsep $ punctuate comma $ map prettyTCM ws)
               ]
+            ]
+
+      -- Unify constructor target and given type (in Δ₁Γ)
+      sub0 <- addCtxTel (delta1 `abstract` gamma) $
+              unifyIndices_ flex (raise (size gamma) da) us' (raise (size gamma) ws)
+
+      -- We should substitute c ys for x in Δ₂ and sigma
+      let ys     = teleArgs gamma
+          delta2 = absApp (raise (size gamma) $ fmap problemTel p1) (Con c ys)
+          rho0   = liftS (size delta2) $ Con c ys :# raiseS (size gamma)
+          -- rho0 = [ var i | i <- [0..size delta2 - 1] ]
+          --     ++ [ raise (size delta2) $ Con c ys ]
+          --     ++ [ var i | i <- [size delta2 + size gamma ..] ]
+          sigma0 = applySubst rho0 sigma
+          dpi0   = applySubst rho0 dpi
+          asb0   = applySubst rho0 asb
+          rest0  = applySubst rho0 (problemRest problem)
+
+      reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma) $ nest 2 $ vcat
+        [ text "delta2 =" <+> prettyTCM delta2
+        , text "sub0   =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub0)
+        ]
+      reportSDoc "tc.lhs.top" 15 $ addCtxTel (delta1 `abstract` gamma `abstract` delta2) $
+        nest 2 $ vcat
+          [ text "dpi0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi0)
+          , text "asb0 = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb0)
+          ]
+
+      -- Andreas, 2010-09-09, save the type a of record pattern.
+      -- It is relative to delta1, but it should be relative to
+      -- all variables which will be bound by patterns.
+      -- Thus, it has to be raised by 1 (the "hole" variable)
+      -- plus the length of delta2 (the variables coming after the hole).
+      storedPatternType <- ifM (isJust <$> isRecord d)
+        (return $ Just (impl, raise (1 + size delta2) typeOfSplitVar))
+        (return $ Nothing)
+
+      -- Plug the hole in the out pattern with c ys
+      let ysp = map (argFromDom . fmap (namedVarP . fst)) $ telToList gamma
+          ip  = plugHole (ConP c storedPatternType ysp) iph
+          ip0 = applySubst rho0 ip
+
+      -- Δ₁Γ ⊢ sub0, we need something in Δ₁ΓΔ₂
+      -- Also needs to be padded with Nothing's to have the right length.
+      let pad n xs x = xs ++ replicate (max 0 $ n - size xs) x
+          newTel = problemTel p0 `abstract` (gamma `abstract` delta2)
+          sub    = replicate (size delta2) Nothing ++
+                   pad (size delta1 + size gamma) (raise (size delta2) sub0) Nothing
+
+      reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
+        [ text "newTel =" <+> prettyTCM newTel
+        , addCtxTel newTel $ text "sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub)
+        , text "ip   =" <+> text (show ip)
+        , text "ip0  =" <+> text (show ip0)
+        ]
+      reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
+        [ text "rho0 =" <+> text (show rho0)
+        ]
 
-            -- Instantiate the new telescope with the given substitution
-            (delta', perm, rho, instTypes) <- instantiateTel sub newTel
+      -- Instantiate the new telescope with the given substitution
+      (delta', perm, rho, instTypes) <- instantiateTel sub newTel
 
 
-            reportSDoc "tc.lhs.inst" 12 $
-              vcat [ sep [ text "instantiateTel"
-                         , nest 4 $ brackets $ fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub
-                         , nest 4 $ prettyTCM newTel
-                         ]
-                   , nest 2 $ text "delta' =" <+> prettyTCM delta'
-                   , nest 2 $ text "perm   =" <+> text (show perm)
-                   , nest 2 $ text "itypes =" <+> fsep (punctuate comma $ map prettyTCM instTypes)
+      reportSDoc "tc.lhs.inst" 12 $
+        vcat [ sep [ text "instantiateTel"
+                   , nest 4 $ brackets $ fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) sub
+                   , nest 4 $ prettyTCM newTel
                    ]
+             , nest 2 $ text "delta' =" <+> prettyTCM delta'
+             , nest 2 $ text "perm   =" <+> text (show perm)
+             , nest 2 $ text "itypes =" <+> fsep (punctuate comma $ map prettyTCM instTypes)
+             ]
 
 {-          -- Andreas, 2010-09-09
-            -- temporary error message to find non-id perms
-            let sorted (Perm _ xs) = xs == List.sort xs
-            unless (sorted (perm)) $ typeError $ GenericError $ "detected proper permutation " ++ show perm
+      -- temporary error message to find non-id perms
+      let sorted (Perm _ xs) = xs == List.sort xs
+      unless (sorted (perm)) $ typeError $ GenericError $ "detected proper permutation " ++ show perm
 -}
-            -- Compute the new dot pattern instantiations
-            let ps0'   = problemInPat p0 ++ qs' ++ problemInPat (absBody p1)
+      -- Compute the new dot pattern instantiations
+      let ps0'   = problemInPat p0 ++ qs' ++ problemInPat (absBody p1)
 
-            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
-              [ text "subst rho sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) (applySubst rho sub))
-              , text "ps0'  =" <+> brackets (fsep $ punctuate comma $ map prettyA ps0')
-              ]
+      reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
+        [ text "subst rho sub =" <+> brackets (fsep $ punctuate comma $ map (maybe (text "_") prettyTCM) (applySubst rho sub))
+        , text "ps0'  =" <+> brackets (fsep $ punctuate comma $ map prettyA ps0')
+        ]
 
-            newDpi <- dotPatternInsts ps0' (applySubst rho sub) instTypes
+      newDpi <- dotPatternInsts ps0' (applySubst rho sub) instTypes
 
-            -- The final dpis and asbs are the new ones plus the old ones substituted by ρ
-            let dpi' = applySubst rho dpi0 ++ newDpi
-                asb' = applySubst rho $ asb0 ++ raise (size delta2) (map (\x -> AsB x (Con c ys) ca) xs)
+      -- The final dpis and asbs are the new ones plus the old ones substituted by ρ
+      let dpi' = applySubst rho dpi0 ++ newDpi
+          asb' = applySubst rho $ asb0 ++ raise (size delta2) (map (\x -> AsB x (Con c ys) ca) xs)
 
-            reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
-              [ text "dpi' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi')
-              , text "asb' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb')
-              ]
+      reportSDoc "tc.lhs.top" 15 $ nest 2 $ vcat
+        [ text "dpi' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM dpi')
+        , text "asb' = " <+> brackets (fsep $ punctuate comma $ map prettyTCM asb')
+        ]
 
-            -- Apply the substitution to the type
-            let sigma'   = applySubst rho sigma0
-                rest'    = applySubst rho rest0
+      -- Apply the substitution to the type
+      let sigma'   = applySubst rho sigma0
+          rest'    = applySubst rho rest0
 
-            reportSDoc "tc.lhs.inst" 15 $
-              nest 2 $ text "ps0 = " <+> brackets (fsep $ punctuate comma $ map prettyA ps0')
+      reportSDoc "tc.lhs.inst" 15 $
+        nest 2 $ text "ps0 = " <+> brackets (fsep $ punctuate comma $ map prettyA ps0')
 
-            -- Permute the in patterns
-            let ps'  = permute perm ps0'
+      -- Permute the in patterns
+      let ps'  = permute perm ps0'
 
-           -- Compute the new permutation of the out patterns. This is the composition of
-            -- the new permutation with the expansion of the old permutation to
-            -- reflect the split.
-            let perm'  = expandP hix (size gamma) $ fst (problemOutPat problem)
-                iperm' = perm `composeP` perm'
+     -- Compute the new permutation of the out patterns. This is the composition of
+      -- the new permutation with the expansion of the old permutation to
+      -- reflect the split.
+      let perm'  = expandP hix (size gamma) $ fst (problemOutPat problem)
+          iperm' = perm `composeP` perm'
 
-            -- Instantiate the out patterns
-            let ip'    = instantiatePattern sub perm' ip0
-                newip  = applySubst rho ip'
+      -- Instantiate the out patterns
+      let ip'    = instantiatePattern sub perm' ip0
+          newip  = applySubst rho ip'
 
-            -- Construct the new problem
-            let problem' = Problem ps' (iperm', newip) delta' rest'
+      -- Construct the new problem
+      let problem' = Problem ps' (iperm', newip) delta' rest'
 
-            reportSDoc "tc.lhs.top" 12 $ sep
-              [ text "new problem"
-              , nest 2 $ vcat
-                [ text "ps'    = " <+> fsep (map prettyA ps')
-                , text "delta' = " <+> prettyTCM delta'
-                ]
-              ]
+      reportSDoc "tc.lhs.top" 12 $ sep
+        [ text "new problem"
+        , nest 2 $ vcat
+          [ text "ps'    = " <+> fsep (map prettyA ps')
+          , text "delta' = " <+> prettyTCM delta'
+          ]
+        ]
 
-            reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat
-              [ text "perm'  =" <+> text (show perm')
-              , text "iperm' =" <+> text (show iperm')
-              ]
-            reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat
-              [ text "ip'    =" <+> text (show ip')
-              , text "newip  =" <+> text (show newip)
-              ]
+      reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat
+        [ text "perm'  =" <+> text (show perm')
+        , text "iperm' =" <+> text (show iperm')
+        ]
+      reportSDoc "tc.lhs.top" 14 $ nest 2 $ vcat
+        [ text "ip'    =" <+> text (show ip')
+        , text "newip  =" <+> text (show newip)
+        ]
+
+      -- if rest type reduces,
+      -- extend the split problem by previously not considered patterns
+      st'@(LHSState problem'@(Problem ps' (iperm', ip') delta' rest')
+                    sigma' dpi' asb')
+        <- updateProblemRest $ LHSState problem' sigma' dpi' asb'
+
+      reportSDoc "tc.lhs.top" 12 $ sep
+        [ text "new problem from rest"
+        , nest 2 $ vcat
+          [ text "ps'    = " <+> fsep (map prettyA ps')
+          , text "delta' = " <+> prettyTCM delta'
+          , text "ip'    =" <+> text (show ip')
+          , text "iperm' =" <+> text (show iperm')
+          ]
+        ]
+      -- Continue splitting
+      checkLHS f st'
 
-            -- if rest type reduces,
-            -- extend the split problem by previously not considered patterns
-            st'@(LHSState problem'@(Problem ps' (iperm', ip') delta' rest')
-                          sigma' dpi' asb')
-              <- updateProblemRest $ LHSState problem' sigma' dpi' asb'
-
-            reportSDoc "tc.lhs.top" 12 $ sep
-              [ text "new problem from rest"
-              , nest 2 $ vcat
-                [ text "ps'    = " <+> fsep (map prettyA ps')
-                , text "delta' = " <+> prettyTCM delta'
-                , text "ip'    =" <+> text (show ip')
-                , text "iperm' =" <+> text (show iperm')
-                ]
-              ]
-            -- Continue splitting
-            checkLHS st'
 
--- Ensures that we are not performing pattern matching on codata.
+-- | Ensures that we are not performing pattern matching on codata.
 
 noPatternMatchingOnCodata :: [I.NamedArg Pattern] -> TCM ()
 noPatternMatchingOnCodata = mapM_ (check . namedArg)
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs b/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs
index 3fb4cb0..c8b73d4 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 module Agda.TypeChecking.Rules.LHS.Implicit where
@@ -25,7 +25,7 @@ import Agda.TypeChecking.Rules.LHS.Problem
 
 import Agda.Utils.Maybe
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Insert implicit patterns in a problem.
@@ -33,13 +33,13 @@ insertImplicitProblem :: Problem -> TCM Problem
 insertImplicitProblem (Problem ps qs tel pr) = do
   reportSDoc "tc.lhs.imp" 15 $
     sep [ text "insertImplicits"
-	, nest 2 $ text "ps  = " <+> do brackets $ fsep $ punctuate comma $ map prettyA ps
-	, nest 2 $ text "tel = " <+> prettyTCM tel
-	]
+        , nest 2 $ text "ps  = " <+> do brackets $ fsep $ punctuate comma $ map prettyA ps
+        , nest 2 $ text "tel = " <+> prettyTCM tel
+        ]
   ps' <- insertImplicitPatterns ExpandLast ps tel
   reportSDoc "tc.lhs.imp" 15 $
     sep [ text "insertImplicits finished"
-	, nest 2 $ text "ps'  = " <+> do brackets $ fsep $ punctuate comma $ map prettyA ps'
+        , nest 2 $ text "ps'  = " <+> do brackets $ fsep $ punctuate comma $ map prettyA ps'
         ]
   return $ Problem ps' qs tel pr
 
@@ -72,13 +72,17 @@ expandImplicitPattern' a p
          return $ Just p'
   | otherwise = return Nothing
 
+implicitP :: Named_ A.Pattern
 implicitP = unnamed $ A.ImplicitP $ PatRange $ noRange
 
 -- | Insert implicit patterns in a list of patterns.
-insertImplicitPatterns :: ExpandHidden -> [A.NamedArg A.Pattern] -> Telescope -> TCM [A.NamedArg A.Pattern]
-insertImplicitPatterns exh ps tel = insertImplicitPatternsT exh ps (telePi tel typeDontCare)
+insertImplicitPatterns :: ExpandHidden -> [A.NamedArg A.Pattern] ->
+                          Telescope -> TCM [A.NamedArg A.Pattern]
+insertImplicitPatterns exh ps tel =
+  insertImplicitPatternsT exh ps (telePi tel typeDontCare)
 
-insertImplicitPatternsT :: ExpandHidden -> [A.NamedArg A.Pattern] -> Type -> TCM [A.NamedArg A.Pattern]
+insertImplicitPatternsT :: ExpandHidden -> [A.NamedArg A.Pattern] -> Type ->
+                           TCM [A.NamedArg A.Pattern]
 insertImplicitPatternsT DontExpandLast [] a = return []
 insertImplicitPatternsT exh            ps a = do
   TelV tel b <- telViewUpTo' (-1) (not . visible) a
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs b/src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs
index 27b3f2b..cc05e25 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/Instantiate.hs
@@ -3,7 +3,7 @@
 module Agda.TypeChecking.Rules.LHS.Instantiate where
 
 import Agda.Syntax.Common
-import Agda.Syntax.Internal as I
+import Agda.Syntax.Internal as I hiding (Substitution)
 import qualified Agda.Syntax.Abstract as A
 import Agda.Syntax.Abstract.Views ( asView )
 
@@ -20,7 +20,7 @@ import Agda.Utils.List
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Instantiate a telescope with a substitution. Might reorder the telescope.
@@ -155,28 +155,28 @@ instantiateTel s tel = liftTCM $ do
     mkSubst :: [Maybe Term] -> S.Substitution
     mkSubst s = rho 0 s'
       where s'  = s
-	    rho i (Nothing : s) = var i :# rho (i + 1) s
-	    rho i (Just u  : s) = u :# rho i s
-	    rho i []		= raiseS i
+            rho i (Nothing : s) = var i :# rho (i + 1) s
+            rho i (Just u  : s) = u :# rho i s
+            rho i []            = raiseS i
 
 -- | Produce a nice error message when splitting failed
 nothingToSplitError :: Problem -> TCM a
 nothingToSplitError (Problem ps _ tel pr) = splitError ps tel
   where
-    splitError []	EmptyTel    = do
+    splitError []       EmptyTel    = do
       if null $ restPats pr then __IMPOSSIBLE__ else do
         typeError $ GenericError $ "Arguments left we cannot split on. TODO: better error message"
-    splitError (_:_)	EmptyTel    = __IMPOSSIBLE__
-    splitError []	ExtendTel{} = __IMPOSSIBLE__
+    splitError (_:_)    EmptyTel    = __IMPOSSIBLE__
+    splitError []       ExtendTel{} = __IMPOSSIBLE__
     splitError (p : ps) (ExtendTel a tel)
       | isBad p   = traceCall (CheckPattern (strip p) EmptyTel (unDom a)) $ case strip p of
-	  A.DotP _ e -> typeError $ UninstantiatedDotPattern e
-	  p	     -> typeError $ IlltypedPattern p (unDom a)
+          A.DotP _ e -> typeError $ UninstantiatedDotPattern e
+          p          -> typeError $ IlltypedPattern p (unDom a)
       | otherwise = underAbstraction a tel $ \tel -> splitError ps tel
       where
-	strip = snd . asView . namedArg
-	isBad p = case strip p of
-	  A.DotP _ _   -> True
-	  A.ConP _ _ _ -> True
-	  A.LitP _     -> True
-	  _	       -> False
+        strip = snd . asView . namedArg
+        isBad p = case strip p of
+          A.DotP _ _   -> True
+          A.ConP _ _ _ -> True
+          A.LitP _     -> True
+          _            -> False
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs b/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs
index 140c186..1232dbe 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs
@@ -1,13 +1,13 @@
 -- {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable    #-}
+{-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleInstances #-}
 
 module Agda.TypeChecking.Rules.LHS.Problem where
 
-import Control.Monad.Error
-import Data.Monoid ( Monoid(mappend,mempty) )
+import Prelude hiding (null)
+
 import Data.Foldable
 import Data.Traversable
 
@@ -19,8 +19,10 @@ import Agda.Syntax.Internal.Pattern
 import qualified Agda.Syntax.Abstract as A
 
 import Agda.TypeChecking.Substitute as S
-import Agda.TypeChecking.Pretty
+import Agda.TypeChecking.Pretty hiding (empty)
 
+import Agda.Utils.Except ( Error(noMsg, strMsg) )
+import Agda.Utils.Null
 import Agda.Utils.Permutation
 
 type Substitution   = [Maybe Term]
@@ -79,7 +81,7 @@ data Problem' p = Problem
 
 -- | The permutation should permute @allHoles@ of the patterns to correspond to
 --   the abstract patterns in the problem.
-type Problem	 = Problem' (Permutation, [I.NamedArg Pattern])
+type Problem     = Problem' (Permutation, [I.NamedArg Pattern])
 type ProblemPart = Problem' ()
 
 -- | User patterns that could not be given a type yet.
@@ -127,15 +129,41 @@ data Focus
     }
   | LitFocus Literal OneHolePatterns Int Type
 
+-- | Result of 'splitProblem':  Determines position for the next split.
 data SplitProblem
 
-  = Split ProblemPart [Name] (I.Arg Focus) (Abs ProblemPart)
-    -- ^ Split on constructor pattern.
-    --   The @[Name]@s give the as-bindings for the focus.
-
-  | SplitRest { splitProjection :: I.Arg QName, splitRestType :: Type }
-    -- ^ Split on projection pattern.
-    --   The projection could be belonging to an irrelevant record field.
+  = -- | Split on constructor pattern.
+    Split
+      { splitLPats   :: ProblemPart
+        -- ^ The typed user patterns left of the split position.
+        --   Invariant: @'problemRest' == empty at .
+      , splitAsNames :: [Name]
+        -- ^ The as-bindings for the focus.
+      , splitFocus   :: I.Arg Focus
+        -- ^ How to split the variable at the split position.
+      , splitRPats   :: Abs ProblemPart
+        -- ^ The typed user patterns right of the split position.
+      }
+
+  | -- | Split on projection pattern.
+    SplitRest
+      { splitProjection :: I.Arg QName
+        -- ^ The projection could be belonging to an irrelevant record field.
+      , splitRestType   :: Type
+      }
+
+-- | Put a typed pattern on the very left of a @SplitProblem at .
+consSplitProblem
+  :: A.NamedArg A.Pattern -- ^ @p@ A pattern.
+  -> ArgName              -- ^ @x@ The name of the argument (from its type).
+  -> I.Dom Type           -- ^ @t@ Its type.
+  -> SplitProblem         -- ^ The split problem, containing 'splitLPats' @ps;xs:ts at .
+  -> SplitProblem         -- ^ The result, now containing 'splitLPats' @(p,ps);(x,xs):(t,ts)@.
+consSplitProblem p x dom s at SplitRest{}              = s
+consSplitProblem p x dom s at Split{ splitLPats = ps } = s{ splitLPats = consProblem' ps }
+  where
+  consProblem' (Problem ps () tel pr) =
+    Problem (p:ps) () (ExtendTel dom $ Abs x tel) pr
 
 data SplitError
   = NothingToSplit
@@ -183,16 +211,11 @@ instance Error SplitError where
   noMsg  = NothingToSplit
   strMsg = SplitPanic
 
--- | 'ProblemRest' is a right dominant monoid.
---   @pr1 \`mappend\` pr2 = pr2@ unless @pr2 = mempty@, then it is @pr1 at .
---   Basically, this means that the left 'ProblemRest' is discarded, so
---   use it wisely!
-instance Monoid ProblemRest where
-  mempty = ProblemRest [] (defaultArg typeDontCare)
-  mappend pr (ProblemRest [] _) = pr
-  mappend _  pr                 = pr
-
-instance Monoid p => Monoid (Problem' p) where
-  mempty = Problem [] mempty EmptyTel mempty
-  Problem ps1 qs1 tel1 pr1 `mappend` Problem ps2 qs2 tel2 pr2 =
-    Problem (ps1 ++ ps2) (mappend qs1 qs2) (abstract tel1 tel2) (mappend pr1 pr2)
+instance Null ProblemRest where
+  null  = null . restPats
+  empty = ProblemRest { restPats = [], restType = defaultArg typeDontCare }
+
+instance Null a => Null (Problem' a) where
+  null p = null (problemInPat p) && null (problemRest p)
+  empty  = Problem empty empty empty empty
+
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs b/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
index 850cf48..272cff9 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE TupleSections #-}
 
 module Agda.TypeChecking.Rules.LHS.ProblemRest where
@@ -19,7 +19,7 @@ import Agda.Utils.Functor (($>))
 import Agda.Utils.Size
 import Agda.Utils.Permutation
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- MOVED from LHS:
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/Split.hs b/src/full/Agda/TypeChecking/Rules/LHS/Split.hs
index 8b077ea..054f434 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/Split.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/Split.hs
@@ -1,18 +1,22 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE PatternGuards       #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Agda.TypeChecking.Rules.LHS.Split where
+module Agda.TypeChecking.Rules.LHS.Split
+  ( splitProblem
+  ) where
 
-import Control.Applicative
-import Control.Monad.Error
+import Prelude hiding (null)
+
+import Control.Applicative hiding (empty)
+import Control.Monad.Trans ( lift )
 
 import Data.Maybe (fromMaybe)
-import Data.Monoid (mempty, mappend)
-import Data.List
+import Data.List hiding (null)
 import Data.Traversable hiding (mapM, sequence)
 
 import Agda.Interaction.Options
+import Agda.Interaction.Highlighting.Generate (storeDisambiguatedName)
 
 import Agda.Syntax.Common
 import Agda.Syntax.Literal
@@ -34,22 +38,29 @@ import Agda.TypeChecking.Free
 import Agda.TypeChecking.Irrelevance
 import Agda.TypeChecking.MetaVars
 import Agda.TypeChecking.Patterns.Abstract
-import Agda.TypeChecking.Pretty
+import Agda.TypeChecking.Pretty hiding (empty)
 import Agda.TypeChecking.Records
 import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Substitute
 
 import Agda.TypeChecking.Rules.LHS.Problem
 
+import Agda.Utils.Except
+  ( ExceptT
+  , MonadError(throwError)
+  , runExceptT
+  )
+
 import Agda.Utils.Functor ((<.>))
 import Agda.Utils.List
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
+import Agda.Utils.Null
 import Agda.Utils.Permutation
 import Agda.Utils.Tuple
 import qualified Agda.Utils.Pretty as P
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Split a problem at the first constructor pattern which is
@@ -74,11 +85,11 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
       , nest 2 $ text "perm =" <+> prettyTCM perm
       , nest 2 $ text "tel  =" <+> prettyTCM tel
       ]
-    runErrorT $
+    runExceptT $
       splitP ps (permute perm $ zip [0..] $ allHoles qs) tel
   where
     -- Result splitting
-    splitRest :: ProblemRest -> ErrorT SplitError TCM SplitProblem
+    splitRest :: ProblemRest -> ExceptT SplitError TCM SplitProblem
     splitRest (ProblemRest (p : ps) b) | Just f <- mf = do
       let failure   = lift $ typeError $ CannotEliminateWithPattern p $ unArg b
           notProjP  = lift $ typeError $ NotAProjectionPattern p
@@ -104,22 +115,6 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
             -- It could be a meta, but since we cannot postpone lhs checking, we crash here.
             caseMaybeM (lift $ isRecordType $ unArg b) notRecord $ \(r, vs, def) -> case def of
               Record{ recFields = fs } -> do
-                {- NO LONGER NEEDED, BUT KEEP
-                -- normalize projection name (could be from a module app)
-                d <- lift $ do
-                  v <- stripLambdas =<< normalise (Def d [])
-                  case v of
-                    Def d _ -> return d
-                    _       -> do
-                      reportSDoc "impossible" 10 $ sep
-                        [ text   "unexpected result " <+> prettyTCM v
-                        , text $ "when normalizing projection " ++ show d
-                        ]
-                      reportSDoc "impossible" 50 $ sep
-                        [ text $ "raw: " ++ show v
-                        ]
-                      __IMPOSSIBLE__
-                -}
                 lift $ reportSDoc "tc.lhs.split" 20 $ sep
                   [ text $ "we are of record type r  = " ++ show r
                   , text   "applied to parameters vs = " <+> prettyTCM vs
@@ -135,7 +130,7 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
                 let self = defaultArg $ Def f (map Apply fvs) `applyE` es
                 -- get the type of projection d applied to "self"
                 dType <- lift $ defType <$> getConstInfo d  -- full type!
-                -- dType <- lift $ typeOfConst d  -- WRONG: we apply to parameters ourselves!!
+
                 lift $ reportSDoc "tc.lhs.split" 20 $ sep
                   [ text "we are              self = " <+> prettyTCM (unArg self)
                   , text "being projected by dType = " <+> prettyTCM dType
@@ -145,66 +140,73 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
     -- if there are no more patterns left in the problem rest, there is nothing to split:
     splitRest _ = throwError $ NothingToSplit
 
-    -- Stripping initial lambdas from a normalized term
-    stripLambdas :: Term -> TCM Term
-    stripLambdas v = case ignoreSharing v of
-        Lam _ b -> addContext (absName b) $ stripLambdas (absBody b)
-        v       -> return v
-
     -- | In @splitP aps iqs tel@,
     --   @aps@ are the user patterns on which we are splitting (inPats),
     --   @ips@ are the one-hole patterns of the current split state (outPats)
     --   in one-to-one correspondence with the pattern variables
     --   recorded in @tel at .
-    splitP :: [A.NamedArg A.Pattern] -> [(Int, OneHolePatterns)] -> Telescope -> ErrorT SplitError TCM SplitProblem
+    splitP :: [A.NamedArg A.Pattern]
+           -> [(Int, OneHolePatterns)]
+           -> Telescope
+           -> ExceptT SplitError TCM SplitProblem
+
     -- the next two cases violate the one-to-one correspondence of qs and tel
-    splitP _	    []		 (ExtendTel _ _)	 = __IMPOSSIBLE__
-    splitP _	    (_:_)	  EmptyTel		 = __IMPOSSIBLE__
+    splitP _        []           (ExtendTel _ _)         = __IMPOSSIBLE__
+    splitP _        (_:_)         EmptyTel               = __IMPOSSIBLE__
     -- no more patterns?  pull them from the rest
-    splitP []	     _		  _			 = splitRest pr
+    splitP []        _            _                      = splitRest pr
     -- patterns but no types for them?  Impossible.
-    splitP ps	    []		  EmptyTel		 = __IMPOSSIBLE__
+    splitP ps       []            EmptyTel               = __IMPOSSIBLE__
+    -- (we can never have an ExtendTel without Abs)
+    splitP _        _            (ExtendTel _ NoAbs{})   = __IMPOSSIBLE__
+
     -- pattern with type?  Let's get to work:
-    splitP (p : ps) ((i, q) : qs) tel0@(ExtendTel a tel) = do
+    splitP ps0@(p : ps) qs0@((i, q) : qs) tel0@(ExtendTel dom@(Dom ai a) xtel@(Abs x tel)) = do
+
       liftTCM $ reportSDoc "tc.lhs.split" 30 $ sep
         [ text "splitP looking at pattern"
-        , nest 2 $ text "p =" <+> prettyA p
-        , nest 2 $ text "a =" <+> prettyTCM a
+        , nest 2 $ text "p   =" <+> prettyA p
+        , nest 2 $ text "dom =" <+> prettyTCM dom
         ]
-      let tryAgain = splitP (p : ps) ((i, q) : qs) tel0
+
+      -- Possible reinvokations:
+      let -- 1. Redo this argument (after meta instantiation).
+          tryAgain = splitP ps0 qs0 tel0
+          -- 2. Try to split on next argument.
+          keepGoing = consSplitProblem p x dom <$> do
+            underAbstraction dom xtel $ \ tel -> splitP ps qs tel
+
       p <- lift $ expandLitPattern p
       case asView $ namedArg p of
 
         -- Case: projection pattern.  That's an error.
-        --(_, p') | Just{} <- isProjP p' -> do
         (_, A.DefP _ d ps) -> typeError $
           if null ps
           then CannotEliminateWithPattern p (telePi tel0 $ unArg $ restType pr)
           else IllformedProjectionPattern $ namedArg p
-        -- Case: literal pattern
-	(xs, p@(A.LitP lit))  -> do
+
+        -- Case: literal pattern.
+        (xs, p@(A.LitP lit))  -> do
           -- Note that, in the presence of --without-K, this branch is
           -- based on the assumption that the types of literals are
           -- not indexed.
 
           -- Andreas, 2010-09-07 cannot split on irrelevant args
-          when (unusableRelevance $ getRelevance a) $
-            typeError $ SplitOnIrrelevant p a
-	  b <- lift $ litType lit
-	  ok <- lift $ do
-	      noConstraints (equalType (unDom a) b)
-	      return True
-	    `catchError` \_ -> return False
-	  if ok
-	    then return $
-	      Split mempty
-		    xs
-		    (argFromDom $ fmap (LitFocus lit q i) a)
-		    (fmap (\ tel -> Problem ps () tel __IMPOSSIBLE__) tel)
-	    else keepGoing
-
-        -- Case: constructor pattern
-	(xs, p@(A.ConP ci (A.AmbQ cs) args)) -> do
+          when (unusableRelevance $ getRelevance ai) $
+            typeError $ SplitOnIrrelevant p dom
+
+          -- Succeed if the split type is (already) equal to the type of the literal.
+          ifNotM (lift $ tryConversion $ equalType a =<< litType lit)
+            {- then -} keepGoing $
+            {- else -} return $ Split
+              { splitLPats   = empty
+              , splitAsNames = xs
+              , splitFocus   = Arg ai $ LitFocus lit q i a
+              , splitRPats   = Abs x  $ Problem ps () tel __IMPOSSIBLE__
+              }
+
+        -- Case: constructor pattern.
+        (xs, p@(A.ConP ci (A.AmbQ cs) args)) -> do
           let tryInstantiate a'
                 | [c] <- cs = do
                     -- Type is blocked by a meta and constructor is unambiguous,
@@ -214,24 +216,27 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
                     dt     <- defType <$> getConstInfo d
                     vs     <- newArgsMeta dt
                     Sort s <- ignoreSharing . unEl <$> reduce (apply dt vs)
-                    (True <$ noConstraints (equalType a' (El s $ Def d $ map Apply vs)))
-                      `catchError` \_ -> return False
+                    tryConversion $ equalType a' (El s $ Def d $ map Apply vs)
                   if ok then tryAgain else keepGoing
                 | otherwise = keepGoing
           -- ifBlockedType reduces the type
-          ifBlockedType (unDom a) (const tryInstantiate) $ \ a' -> do
-	  case ignoreSharing $ unEl a' of
+          ifBlockedType a (const tryInstantiate) $ \ a' -> do
+          case ignoreSharing $ unEl a' of
 
-            -- Subcase: split type is a Def
-	    Def d es	-> do
-	      def <- liftTCM $ theDef <$> getConstInfo d
+            -- Subcase: split type is a Def.
+            Def d es    -> do
+
+              def <- liftTCM $ theDef <$> getConstInfo d
+
+              -- We cannot split on (shape-)irrelevant non-records.
+              -- Andreas, 2011-10-04 unless allowed by option
               unless (defIsRecord def) $
-                -- cannot split on irrelevant or non-strict things
-                when (unusableRelevance $ getRelevance a) $ do
-                  -- Andreas, 2011-10-04 unless allowed by option
-                  allowed <- liftTCM $ optExperimentalIrrelevance <$> pragmaOptions
-                  unless allowed $ typeError $ SplitOnIrrelevant p a
+                when (unusableRelevance $ getRelevance ai) $
+                unlessM (liftTCM $ optExperimentalIrrelevance <$> pragmaOptions) $
+                typeError $ SplitOnIrrelevant p dom
 
+              -- Check that we are at record or data type and return
+              -- the number of parameters.
               let mp = case def of
                         Datatype{dataPars = np} -> Just np
                         Record{recPars = np}    -> Just np
@@ -240,7 +245,7 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
                 Nothing -> keepGoing
                 Just np -> do
                   let vs = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
-		  liftTCM $ traceCall (CheckPattern p EmptyTel (unDom a)) $ do  -- TODO: wrong telescope
+                  liftTCM $ traceCall (CheckPattern p EmptyTel a) $ do  -- TODO: wrong telescope
                   -- Check that we construct something in the right datatype
                   c <- do
                       cs' <- mapM canonicalName cs
@@ -251,23 +256,23 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
                             _                       -> __IMPOSSIBLE__
                       cs0 <- cons <$> getConstInfo d'
                       case [ c | (c, c') <- zip cs cs', elem c' cs0 ] of
-                        [c]   -> return c
+                        [c]   -> do
+                          -- If constructor pattern was ambiguous,
+                          -- remember our choice for highlighting info.
+                          when (length cs >= 2) $ storeDisambiguatedName c
+                          return c
                         []    -> typeError $ ConstructorPatternInWrongDatatype (head cs) d
                         cs    -> -- if there are more than one we give up (they might have different types)
                           typeError $ CantResolveOverloadedConstructorsTargetingSameDatatype d cs
-{-
-                          typeError $ GenericError $
-                            "Can't resolve overloaded constructors targeting the same datatype (" ++ show d ++ "):" ++
-                            unwords (map show cs)
--}
-		  let (pars, ixs) = genericSplitAt np vs
-		  reportSDoc "tc.lhs.split" 10 $
-		    vcat [ sep [ text "splitting on"
-			       , nest 2 $ fsep [ prettyA p, text ":", prettyTCM a ]
-			       ]
-			 , nest 2 $ text "pars =" <+> fsep (punctuate comma $ map prettyTCM pars)
-			 , nest 2 $ text "ixs  =" <+> fsep (punctuate comma $ map prettyTCM ixs)
-			 ]
+
+                  let (pars, ixs) = genericSplitAt np vs
+                  reportSDoc "tc.lhs.split" 10 $ vcat
+                    [ sep [ text "splitting on"
+                          , nest 2 $ fsep [ prettyA p, text ":", prettyTCM dom ]
+                          ]
+                    , nest 2 $ text "pars =" <+> fsep (punctuate comma $ map prettyTCM pars)
+                    , nest 2 $ text "ixs  =" <+> fsep (punctuate comma $ map prettyTCM ixs)
+                    ]
 
                   -- Andreas, 2013-03-22 fixing issue 279
                   -- To resolve ambiguous constructors, Agda always looks up
@@ -281,31 +286,18 @@ splitProblem mf (Problem ps (perm, qs) tel pr) = do
                   -- but the extra check here is non-invasive to the existing code.
                   checkParsIfUnambiguous cs d pars
 
-                  --whenM (optWithoutK <$> pragmaOptions) $
-                  --  wellFormedIndices a'
-
-		  return $ Split mempty
-				 xs
-				 (argFromDom $ fmap (Focus c (A.patImplicit ci) args (getRange p) q i d pars ixs) a)
-				 (fmap (\ tel -> Problem ps () tel __IMPOSSIBLE__) tel)
-            -- Subcase: split type is not a Def
-	    _	-> keepGoing
-        -- Case: neither literal nor constructor pattern
-	p -> keepGoing
-      where
-	keepGoing = do
-          r <- underAbstraction a tel $ \tel -> splitP ps qs tel
-          case r of
-            SplitRest{} -> return r
-	    Split p1 xs foc p2 -> do
-  	      let p0 = Problem [p] () (ExtendTel a (EmptyTel <$ tel)) mempty
-	      return $ Split (mappend p0 p1) xs foc p2
-{- OLD
-	keepGoing = do
-	  let p0 = Problem [p] () (ExtendTel a (EmptyTel <$ tel)) mempty
-	  Split p1 xs foc p2 <- underAbstraction a tel $ \tel -> splitP ps qs tel
-	  return $ Split (mappend p0 p1) xs foc p2
--}
+                  return $ Split
+                    { splitLPats   = empty
+                    , splitAsNames = xs
+                    , splitFocus   = Arg ai $ Focus c (A.patImplicit ci) args (getRange p) q i d pars ixs a
+                    , splitRPats   = Abs x  $ Problem ps () tel __IMPOSSIBLE__
+                    }
+            -- Subcase: split type is not a Def.
+            _   -> keepGoing
+
+        -- Case: neither literal nor constructor pattern.
+        _ -> keepGoing
+
 
 -- | @checkParsIfUnambiguous [c] d pars@ checks that the data/record type
 --   behind @c@ is has initial parameters (coming e.g. from a module instantiation)
@@ -327,150 +319,3 @@ checkParsIfUnambiguous [c] d pars = do
       compareArgs [] t (Def d []) vs (take (length vs) pars)
     _ -> __IMPOSSIBLE__
 checkParsIfUnambiguous _ _ _ = return ()
-
--- | Takes a type, which must be a data or record type application,
--- and checks that the indices are constructors (or literals) applied
--- to distinct variables which do not occur free in the parameters.
--- For the purposes of this check parameters count as constructor
--- arguments; parameters are reconstructed from the given type.
---
--- Precondition: The type must be a data or record type application.
-
-wellFormedIndices :: Type -> TCM ()
-wellFormedIndices t = do
-  t <- reduce t
-
-  reportSDoc "tc.lhs.split.well-formed" 10 $
-    fsep [ text "Checking if indices are well-formed:"
-         , nest 2 $ prettyTCM t
-         ]
-
-  (pars, ixs) <- normalise =<< case ignoreSharing $ unEl t of
-    Def d es -> do
-      let args = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
-      def       <- getConstInfo d
-      typedArgs <- args `withTypesFrom` defType def
-
-{- OLD
-      let noPars = case theDef def of
-            Datatype { dataPars = n } -> n
-            Record   { recPars  = n } -> n
-            _                         -> __IMPOSSIBLE__
-          (pars, ixs) = genericSplitAt noPars typedArgs
-      return (map fst pars, ixs)
--}
-      -- Andreas, 2013-05-30:
-      -- 1. treat non-linear parameters as indices
-      -- 2. ignore big parameters
-      let (noPars, smallPars, nonLinPars) = case theDef def of
-            Datatype { dataPars = n, dataSmallPars = Perm _ sps, dataNonLinPars = nl }
-                                      -> (n, sps, permPicks $ doDrop nl)
-            Record   { recPars  = n } -> (n, [0..n-1], []) -- TODO: smallness for record pars
-            _                         -> __IMPOSSIBLE__
-          (pars0, ixs0) = genericSplitAt noPars typedArgs
-          -- Andreas, 2013-05-30 take only the small parameters
-          pars = map (pars0 !!) (smallPars \\ nonLinPars)
-          -- add the non-linear parameters to the indices
-          ixs  = map (pars0 !!) nonLinPars ++ ixs0
-      return (map fst pars, ixs)
-
-    _ -> __IMPOSSIBLE__
-
-  mvs <- constructorApplications ixs
-  vs  <- case mvs of
-           Nothing -> typeError $
-                        IndicesNotConstructorApplications (map fst ixs)
-           Just vs -> return vs
-
-  unless (fastDistinct vs) $
-    typeError $ IndexVariablesNotDistinct vs (map fst ixs)
-
-  case map fst $ filter snd $ zip vs (map (`freeIn` pars) vs) of
-    [] -> return ()
-    vs ->
-      typeError $ IndicesFreeInParameters vs (map fst ixs) pars
-
-  where
-  -- | If the term consists solely of constructors (or literals)
-  -- applied to variables (after parameter reconstruction), then the
-  -- variables are returned, and otherwise nothing.
-  constructorApplication :: Term
-                         -> Type  -- ^ The term's type.
-                         -> TCM (Maybe [Nat])
-  constructorApplication (Var x [])      _ = return (Just [x])
-  constructorApplication (Lit {})        _ = return (Just [])
-  constructorApplication (Shared p)      t  = constructorApplication (derefPtr p) t
-  constructorApplication (Con c conArgs) (El _ (Def d es)) = do
-    let dataArgs = fromMaybe __IMPOSSIBLE__ $ allApplyElims es
-    conDef  <- getConInfo c
-    dataDef <- getConstInfo d
-
-{- OLD
-    let noPars = case theDef dataDef of
-          Datatype { dataPars = n } -> n
-          Record   { recPars  = n } -> n
-          _                         -> __IMPOSSIBLE__
-        pars    = genericTake noPars dataArgs
-        allArgs = pars ++ conArgs
-
-    reportSDoc "tc.lhs.split.well-formed" 20 $
-      fsep [ text "Reconstructed parameters:"
-           , nest 2 $
-               prettyTCM (Con c []) <+>
-               text "(:" <+> prettyTCM (defType conDef) <> text ")" <+>
-               text "<<" <+> prettyTCM pars <+> text ">>" <+>
-               prettyTCM conArgs
-           ]
-
-    constructorApplications =<< allArgs `withTypesFrom` defType conDef
--}
-
-    let (noPars, smallPars) = case theDef dataDef of
-          Datatype { dataPars = n, dataSmallPars = Perm _ is }
-                                    -> (n, is)
-          Record   { recPars  = n } -> (n, [0..n-1])
-          _                         -> __IMPOSSIBLE__
-
-        dataPars = take noPars dataArgs
-
-    allArgs <- (dataPars ++ conArgs) `withTypesFrom` defType conDef
-
-    -- skip big parameters during reconstruction
-    let ixs  = drop noPars allArgs
-        pars = map (allArgs !!) smallPars
-
-    reportSDoc "tc.lhs.split.well-formed" 20 $
-      fsep [ text "Reconstructed parameters:"
-           , nest 2 $
-               prettyTCM (Con c []) <+>
-               text "(:" <+> prettyTCM (defType conDef) <> text ")" <+>
-               text "<<" <+> prettyTCM (map fst pars) <+> text ">>" <+>
-               prettyTCM conArgs
-           ]
-
-    constructorApplications $ pars ++ ixs
-
-  constructorApplication _ _ = return Nothing
-
-  constructorApplications :: [(I.Arg Term, I.Dom Type)] -> TCM (Maybe [Nat])
-  constructorApplications args = do
-    xs <- mapM (\(e, t) -> do
-                   t <- reduce (unDom t)
-                   constructorApplication (unArg e) (ignoreSharingType t))
-               args
-    return (concat <$> sequence xs)
-
--- | @args \`withTypesFrom\` t@ returns the arguments @args@ paired up
--- with their types, taken from @t@, which is assumed to be a @length
--- args at -ary pi.
---
--- Precondition: @t@ has to start with @length args@ pis.
-
-withTypesFrom :: Args -> Type -> TCM [(I.Arg Term, I.Dom Type)]
-[]           `withTypesFrom` _ = return []
-(arg : args) `withTypesFrom` t = do
-  t <- reduce t
-  case ignoreSharing $ unEl t of
-    Pi a b -> ((arg, a) :) <$>
-              args `withTypesFrom` absApp b (unArg arg)
-    _      -> __IMPOSSIBLE__
diff --git a/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs b/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs
index afd9118..e2a9166 100644
--- a/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs
+++ b/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs
@@ -1,27 +1,30 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
 
 module Agda.TypeChecking.Rules.LHS.Unify where
 
+import Prelude hiding (null)
+
 import Control.Arrow ((***))
 import Control.Applicative hiding (empty)
 import Control.Monad.State
 import Control.Monad.Reader
-import Control.Monad.Error
 import Control.Monad.Writer (WriterT(..), MonadWriter(..), Monoid(..))
 
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.List hiding (sort)
+import Data.List hiding (null, sort)
 
 import Data.Typeable (Typeable)
 import Data.Foldable (Foldable)
@@ -30,7 +33,7 @@ import Data.Traversable (Traversable,traverse)
 import Agda.Interaction.Options (optInjectiveTypeConstructors)
 
 import Agda.Syntax.Common
-import Agda.Syntax.Internal as I
+import Agda.Syntax.Internal as I hiding (Substitution)
 import Agda.Syntax.Literal
 import Agda.Syntax.Position
 
@@ -42,7 +45,8 @@ import Agda.TypeChecking.Constraints
 import Agda.TypeChecking.DropArgs
 import Agda.TypeChecking.Level (reallyUnLevelView)
 import Agda.TypeChecking.Reduce
-import Agda.TypeChecking.Pretty
+import Agda.TypeChecking.Pretty hiding (empty)
+import qualified Agda.TypeChecking.Pretty as P
 import Agda.TypeChecking.Substitute hiding (Substitution)
 import qualified Agda.TypeChecking.Substitute as S
 import Agda.TypeChecking.Telescope
@@ -55,11 +59,17 @@ import Agda.Interaction.Options (optInjectiveTypeConstructors, optWithoutK)
 import Agda.TypeChecking.Rules.LHS.Problem
 -- import Agda.TypeChecking.SyntacticEquality
 
+import Agda.Utils.Except
+  ( Error(noMsg, strMsg)
+  , MonadError(catchError, throwError)
+  )
+
 import Agda.Utils.Maybe
-import Agda.Utils.Size
 import Agda.Utils.Monad
+import Agda.Utils.Null
+import Agda.Utils.Size
 
-#include "../../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 newtype Unify a = U { unUnify :: ReaderT UnifyEnv (WriterT UnifyOutput (ExceptionT UnifyException (StateT UnifyState TCM))) a }
@@ -79,23 +89,25 @@ instance MonadReader TCEnv Unify where
 instance HasConstInfo Unify where
   getConstInfo = U . lift . lift . lift . lift . getConstInfo
 
+-- UnifyEnv
+------------------------------------------------------------------------
+
 data UnifyMayPostpone = MayPostpone | MayNotPostpone
 
 type UnifyEnv = UnifyMayPostpone
-emptyUEnv   = MayPostpone
+
+emptyUEnv :: UnifyEnv
+emptyUEnv = MayPostpone
 
 noPostponing :: Unify a -> Unify a
-noPostponing (U (ReaderT f)) = U . ReaderT . const $ f MayNotPostpone
+noPostponing = U . local (const MayNotPostpone) . unUnify
 
 askPostpone :: Unify UnifyMayPostpone
-askPostpone = U . ReaderT $ return
+askPostpone = U $ ask
 
 -- | Output the result of unification (success or maybe).
 type UnifyOutput = Unifiable
 
-emptyUOutput :: UnifyOutput
-emptyUOutput = mempty
-
 -- | Were two terms unifiable or did we have to postpone some equation such that we are not sure?
 data Unifiable
   = Definitely  -- ^ Unification succeeded.
@@ -121,7 +133,7 @@ ifClean m t e = do
     Possibly ->   e
 
 data Equality = Equal TypeHH Term Term
-type Sub = Map Nat Term
+type Sub = IntMap Term
 
 data UnifyException
   = ConstructorMismatch Type Term Term
@@ -134,11 +146,13 @@ instance Error UnifyException where
   noMsg  = strMsg ""
   strMsg = GenericUnifyException
 
-data UnifyState = USt { uniSub	  :: Sub
-		      , uniConstr :: [Equality]
-		      }
+data UnifyState = USt
+  { uniSub    :: Sub
+  , uniConstr :: [Equality]
+  }
 
-emptyUState = USt Map.empty []
+emptyUState :: UnifyState
+emptyUState = USt IntMap.empty []
 
 -- | Throw-away error message.
 projectionMismatch :: QName -> QName -> Unify a
@@ -156,8 +170,8 @@ instance Subst Equality where
   applySubst rho (Equal a s t) =
     Equal (applySubst rho a) (applySubst rho s) (applySubst rho t)
 
-onSub :: (Sub -> a) -> Unify a
-onSub f = U $ gets $ f . uniSub
+getSub :: Unify Sub
+getSub = U $ gets uniSub
 
 modSub :: (Sub -> Sub) -> Unify ()
 modSub f = U $ modify $ \s -> s { uniSub = f $ uniSub s }
@@ -246,19 +260,19 @@ occursCheck i u a = do
 i |-> (u, a) = do
   occursCheck i u a
   liftTCM $ reportSDoc "tc.lhs.unify.assign" 15 $ prettyTCM (var i) <+> text ":=" <+> prettyTCM u
-  modSub $ Map.insert i (killRange u)
+  modSub $ IntMap.insert i (killRange u)
   -- Apply substitution to itself (issue 552)
-  rho  <- onSub id
+  rho  <- getSub
   rho' <- traverse ureduce rho
   modSub $ const rho'
 
 makeSubstitution :: Sub -> S.Substitution
 makeSubstitution sub
-  | Map.null sub = idS
-  | otherwise    = map val [0 .. highestIndex] ++# raiseS (highestIndex + 1)
+  | null sub  = idS
+  | otherwise = map val [0 .. highestIndex] ++# raiseS (highestIndex + 1)
   where
-    highestIndex = fst $ Map.findMax sub
-    val i = maybe (var i) id $ Map.lookup i sub
+    highestIndex = fst $ IntMap.findMax sub
+    val i = fromMaybe (var i) $ IntMap.lookup i sub
 
 -- | Apply the current substitution on a term and reduce to weak head normal form.
 class UReduce t where
@@ -266,7 +280,7 @@ class UReduce t where
 
 instance UReduce Term where
   ureduce u = doEtaContractImplicit $ do
-    rho <- onSub makeSubstitution
+    rho <- makeSubstitution <$> getSub
 -- Andreas, 2013-10-24 the following call to 'normalise' is problematic
 -- (see issue 924).  Instead, we only normalize if unifyAtomHH is undecided.
 --    liftTCM $ etaContract =<< normalise (applySubst rho u)
@@ -329,13 +343,17 @@ flattenSubstitution s = foldr instantiate s is
     instantiate :: Nat -> Substitution -> Substitution
     instantiate i s = map (fmap $ inst i u) s
       where
-	Just u = s !! i
+        Just u = s !! i
 
+    -- @inst i u v@ replaces index @i@ in @v@ by @u@, without removing the index.
     inst :: Nat -> Term -> Term -> Term
     inst i u v = applySubst us v
       where us = [var j | j <- [0..i - 1] ] ++# u :# raiseS (i + 1)
 
-data UnificationResult = Unifies Substitution | NoUnify Type Term Term | DontKnow TCErr
+data UnificationResult
+  = Unifies Substitution
+  | NoUnify Type Term Term
+  | DontKnow TCErr
 
 -- | Are we in a homogeneous (one type) or heterogeneous (two types) situation?
 data HomHet a
@@ -484,7 +502,7 @@ unifyIndices flex a us vs = liftTCM $ do
       Right _                               -> do
         checkEqualities $ applySubst (makeSubstitution s) eqs
         let n = maximum $ (-1) : flex'
-        return $ Unifies $ flattenSubstitution [ Map.lookup i s | i <- [0..n] ]
+        return $ Unifies $ flattenSubstitution [ IntMap.lookup i s | i <- [0..n] ]
   `catchError` \err -> case err of
      TypeError _ (Closure {clValue = WithoutKError{}}) -> throwError err
      _                                                 -> return $ DontKnow err
@@ -513,9 +531,9 @@ unifyIndices flex a us vs = liftTCM $ do
     unifyConstructorArgs a12 vs1 vs2 = do
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $ sep
         [ text "unifyConstructorArgs"
-	-- , nest 2 $ parens (prettyTCM tel0)
-	, nest 2 $ prettyList $ map prettyTCM vs1
-	, nest 2 $ prettyList $ map prettyTCM vs2
+        -- , nest 2 $ parens (prettyTCM tel0)
+        , nest 2 $ prettyList $ map prettyTCM vs1
+        , nest 2 $ prettyList $ map prettyTCM vs2
         , nest 2 $ text "constructor type:" <+> prettyTCM a12
         ]
       let n = genericLength vs1
@@ -540,10 +558,10 @@ unifyIndices flex a us vs = liftTCM $ do
     unifyConArgs tel0@(ExtendTel a@(Dom _ bHH) tel) us0@(arg@(Arg _ u) : us) vs0@(Arg _ v : vs) = do
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $ sep
         [ text "unifyConArgs"
-	-- , nest 2 $ parens (prettyTCM tel0)
-	, nest 2 $ prettyList $ map prettyTCM us0
-	, nest 2 $ prettyList $ map prettyTCM vs0
-	, nest 2 $ text "at telescope" <+> prettyTCM bHH <+> text "..."
+        -- , nest 2 $ parens (prettyTCM tel0)
+        , nest 2 $ prettyList $ map prettyTCM us0
+        , nest 2 $ prettyList $ map prettyTCM vs0
+        , nest 2 $ text "at telescope" <+> prettyTCM bHH <+> text "..."
         ]
       liftTCM $ reportSDoc "tc.lhs.unify" 25 $
         (text $ "tel0 = " ++ show tel0)
@@ -582,24 +600,24 @@ unifyIndices flex a us vs = liftTCM $ do
     unifyElims a us0@(Apply arg@(Arg _ u) : us) vs0@(Apply (Arg _ v) : vs) = do
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $ sep
         [ text "unifyElims"
-	, nest 2 $ parens (prettyTCM a)
-	, nest 2 $ prettyList $ map prettyTCM us0
-	, nest 2 $ prettyList $ map prettyTCM vs0
+        , nest 2 $ parens (prettyTCM a)
+        , nest 2 $ prettyList $ map prettyTCM us0
+        , nest 2 $ prettyList $ map prettyTCM vs0
         ]
       a <- ureduce a  -- Q: reduce sufficient?
       case ignoreSharing $ unEl a of
-	Pi b _  -> do
+        Pi b _  -> do
           -- Andreas, Ulf, 2011-09-08 (AIM XVI)
           -- in case of dependent function type, we cannot postpone
           -- unification of u and v, otherwise us or vs might be ill-typed
           let dep = dependent $ unEl a
           -- skip irrelevant parts
-	  unless (isIrrelevant b) $
+          unless (isIrrelevant b) $
             (if dep then noPostponing else id) $
               unify (unDom b) u v
           arg <- traverse ureduce arg
-	  unifyElims (a `piApply` [arg]) us vs
-	_	  -> __IMPOSSIBLE__
+          unifyElims (a `piApply` [arg]) us vs
+        _         -> __IMPOSSIBLE__
       where dependent (Pi _ NoAbs{}) = False
             dependent (Pi b c)       = 0 `relevantIn` absBody c
             dependent (Shared p)     = dependent (derefPtr p)
@@ -613,24 +631,24 @@ unifyIndices flex a us vs = liftTCM $ do
     unifyArgs a us0@(arg@(Arg _ u) : us) vs0@(Arg _ v : vs) = do
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $ sep
         [ text "unifyArgs"
-	, nest 2 $ parens (prettyTCM a)
-	, nest 2 $ prettyList $ map prettyTCM us0
-	, nest 2 $ prettyList $ map prettyTCM vs0
+        , nest 2 $ parens (prettyTCM a)
+        , nest 2 $ prettyList $ map prettyTCM us0
+        , nest 2 $ prettyList $ map prettyTCM vs0
         ]
       a <- ureduce a  -- Q: reduce sufficient?
       case ignoreSharing $ unEl a of
-	Pi b _  -> do
+        Pi b _  -> do
           -- Andreas, Ulf, 2011-09-08 (AIM XVI)
           -- in case of dependent function type, we cannot postpone
           -- unification of u and v, otherwise us or vs might be ill-typed
           let dep = dependent $ unEl a
           -- skip irrelevant parts
-	  unless (isIrrelevant b) $
+          unless (isIrrelevant b) $
             (if dep then noPostponing else id) $
               unify (unDom b) u v
           arg <- traverse ureduce arg
-	  unifyArgs (a `piApply` [arg]) us vs
-	_	  -> __IMPOSSIBLE__
+          unifyArgs (a `piApply` [arg]) us vs
+        _         -> __IMPOSSIBLE__
       where dependent (Pi _ NoAbs{}) = False
             dependent (Pi b c)       = 0 `relevantIn` absBody c
             dependent (Shared p)     = dependent (derefPtr p)
@@ -678,20 +696,20 @@ unifyIndices flex a us vs = liftTCM $ do
      -> Term -> Term -> Unify ()
     unifyHH aHH u v = do
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $
-	sep [ text "unifyHH"
-	    , nest 2 $ (parens $ prettyTCM u) <+> text "=?="
-	    , nest 2 $ parens $ prettyTCM v
-	    , nest 2 $ text ":" <+> prettyTCM aHH
-	    ]
+        sep [ text "unifyHH"
+            , nest 2 $ (parens $ prettyTCM u) <+> text "=?="
+            , nest 2 $ parens $ prettyTCM v
+            , nest 2 $ text ":" <+> prettyTCM aHH
+            ]
       u <- liftTCM . constructorForm =<< ureduce u
       v <- liftTCM . constructorForm =<< ureduce v
       aHH <- ureduce aHH
       liftTCM $ reportSDoc "tc.lhs.unify" 25 $
-	sep [ text "unifyHH (reduced)"
-	    , nest 2 $ (parens $ prettyTCM u) <+> text "=?="
-	    , nest 2 $ parens $ prettyTCM v
-	    , nest 2 $ text ":" <+> prettyTCM aHH
-	    ]
+        sep [ text "unifyHH (reduced)"
+            , nest 2 $ (parens $ prettyTCM u) <+> text "=?="
+            , nest 2 $ parens $ prettyTCM v
+            , nest 2 $ text ":" <+> prettyTCM aHH
+            ]
       -- obtain the (== Size) function
       isSizeName <- liftTCM isSizeNameTest
 
@@ -736,12 +754,12 @@ unifyIndices flex a us vs = liftTCM $ do
           (|->?) = maybeAssign fallback
 
       liftTCM $ reportSDoc "tc.lhs.unify" 15 $
-	sep [ text "unifyAtom"
-	    , nest 2 $ prettyTCM u <> if flexibleTerm u then text " (flexible)" else empty
+        sep [ text "unifyAtom"
+            , nest 2 $ prettyTCM u <> if flexibleTerm u then text " (flexible)" else P.empty
             , nest 2 $ text "=?="
-	    , nest 2 $ prettyTCM v <> if flexibleTerm v then text " (flexible)" else empty
-	    , nest 2 $ text ":" <+> prettyTCM aHH
-	    ]
+            , nest 2 $ prettyTCM v <> if flexibleTerm v then text " (flexible)" else P.empty
+            , nest 2 $ text ":" <+> prettyTCM aHH
+            ]
       liftTCM $ reportSDoc "tc.lhs.unify" 60 $
         text $ "aHH = " ++ show aHH
       case (ignoreSharing u, ignoreSharing v) of
@@ -753,7 +771,7 @@ unifyIndices flex a us vs = liftTCM $ do
         (_, Level l) -> do
             v <- liftTCM $ reallyUnLevelView l
             unifyAtomHH aHH u v tryAgain
-	(Var i us, Var j vs) | i == j  -> checkEqualityHH aHH u v
+        (Var i us, Var j vs) | i == j  -> checkEqualityHH aHH u v
 -- Andreas, 2013-03-05: the following flex/flex case is an attempt at
 -- better dotting (see Issue811).  Does not work perfectly, maybe the best choice
 -- which variable to assign cannot made locally, but would need a look at the full
@@ -769,9 +787,9 @@ unifyIndices flex a us vs = liftTCM $ do
             -- (in this order, see Problem.hs).
             -- The comparison is total.
             if fj >= fi then j |->? (u, a) else i |->? (v, a)
-	(Var i [], _) | homogeneous && flexible i -> i |->? (v, a)
-	(_, Var j []) | homogeneous && flexible j -> j |->? (u, a)
-	(Con c us, Con c' vs)
+        (Var i [], _) | homogeneous && flexible i -> i |->? (v, a)
+        (_, Var j []) | homogeneous && flexible j -> j |->? (u, a)
+        (Con c us, Con c' vs)
           | c == c' -> do
               r <- liftTCM (dataOrRecordTypeHH' c aHH)
               case r of
@@ -791,7 +809,7 @@ unifyIndices flex a us vs = liftTCM $ do
                 Nothing -> checkEqualityHH aHH u v
           | otherwise -> constructorMismatchHH aHH u v
         -- Definitions are ok as long as they can't reduce (i.e. datatypes/axioms)
-	(Def d us, Def d' vs)
+        (Def d us, Def d' vs)
           | d == d' -> do
               -- d must be a data, record or axiom
               def <- getConstInfo d
@@ -832,7 +850,7 @@ unifyIndices flex a us vs = liftTCM $ do
             if ok then unify a u v
                   else addEquality a u v
 
-	(Con c us, _) -> do
+        (Con c us, _) -> do
            md <- isEtaRecordTypeHH aHH
            case md of
              Just (d, parsHH) -> do
@@ -842,7 +860,7 @@ unifyIndices flex a us vs = liftTCM $ do
                unifyConstructorArgs bHH us vs
              Nothing -> fallback
 
-	(_, Con c vs) -> do
+        (_, Con c vs) -> do
            md <- isEtaRecordTypeHH aHH
            case md of
              Just (d, parsHH) -> do
@@ -854,7 +872,7 @@ unifyIndices flex a us vs = liftTCM $ do
 
         -- Andreas, 2011-05-30: If I put checkEquality below, then Issue81 fails
         -- because there are definitions blocked by flexibles that need postponement
-	_  -> fallback
+        _  -> fallback
 
 
     unify :: Type -> Term -> Term -> Unify ()
diff --git a/src/full/Agda/TypeChecking/Rules/Record.hs b/src/full/Agda/TypeChecking/Rules/Record.hs
index 49943a4..d9b23dd 100644
--- a/src/full/Agda/TypeChecking/Rules/Record.hs
+++ b/src/full/Agda/TypeChecking/Rules/Record.hs
@@ -31,7 +31,7 @@ import Agda.Utils.Monad
 import Agda.Interaction.Options
 
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -80,6 +80,8 @@ checkRecDef i name ind con ps contel fields =
       reportSDoc "tc.rec" 15 $ text "checking fields"
       -- WRONG: contype <- workOnTypes $ killRange <$> (instantiateFull =<< isType_ contel)
       contype <- killRange <$> (instantiateFull =<< isType_ contel)
+      reportSDoc "tc.rec" 20 $ vcat
+        [ text "contype = " <+> prettyTCM contype ]
 
       -- compute the field telescope (does not include record parameters)
       let TelV ftel _ = telView' contype
@@ -94,9 +96,12 @@ checkRecDef i name ind con ps contel fields =
       -- t = tel -> t0 where t0 must be a sort s
       t0' <- normalise t0
       s <- case ignoreSharing $ unEl t0' of
-	Sort s	-> return s
-	_	-> typeError $ ShouldBeASort t0
+        Sort s  -> return s
+        _       -> typeError $ ShouldBeASort t0
       gamma <- getContextTelescope  -- the record params (incl. module params)
+      reportSDoc "tc.rec" 20 $ vcat
+        [ text "gamma = " <+> inTopContext (prettyTCM gamma) ]
+
       -- record type (name applied to parameters)
       let rect = El s $ Def name $ map Apply $ teleArgs gamma
 
@@ -119,25 +124,30 @@ checkRecDef i name ind con ps contel fields =
 
       let getName :: A.Declaration -> [A.Arg QName]
           getName (A.Field _ x arg)    = [x <$ arg]
-	  getName (A.ScopedDecl _ [f]) = getName f
-	  getName _		       = []
+          getName (A.ScopedDecl _ [f]) = getName f
+          getName _                    = []
 
           fs = concatMap (convColor . getName) fields
-          con = ConHead conName $ map unArg fs
+          -- indCo is what the user wrote: inductive/coinductive/Nothing.
+          -- We drop the Range.
           indCo = rangedThing <$> ind
+          -- A constructor is inductive unless declared coinductive.
+          conInduction = fromMaybe Inductive indCo
+          haveEta      = conInduction == Inductive
+          con = ConHead conName conInduction $ map unArg fs
 
       reportSDoc "tc.rec" 30 $ text "record constructor is " <+> text (show con)
       addConstant name $ defaultDefn defaultArgInfo name t0
-		       $ Record { recPars           = 0
+                       $ Record { recPars           = 0
                                 , recClause         = Nothing
                                 , recConHead        = con
                                 , recNamedCon       = hasNamedCon
                                 , recConType        = contype  -- addConstant adds params!
-				, recFields         = fs
+                                , recFields         = fs
                                 , recTel            = ftel     -- addConstant adds params!
-				, recAbstr          = Info.defAbstract i
-                                , recEtaEquality    = indCo /= Just CoInductive
-                                , recInduction      = indCo
+                                , recAbstr          = Info.defAbstract i
+                                , recEtaEquality    = haveEta
+                                , recInduction      = indCo    -- we retain the original user declaration, in case the record turns out to be recursive
                                 -- determined by positivity checker:
                                 , recRecursive      = False
                                 , recMutual         = []
@@ -152,7 +162,7 @@ checkRecDef i name ind con ps contel fields =
                          , conSrcCon = con
                          , conData   = name
                          , conAbstr  = Info.defAbstract conInfo
-                         , conInd    = fromMaybe Inductive indCo
+                         , conInd    = conInduction
                          }
 
       -- Declare the constructor as eligible for instance search
@@ -199,9 +209,9 @@ checkRecDef i name ind con ps contel fields =
       let -- name of record module
           m    = qnameToMName name
           -- make record parameters hidden and non-stricts irrelevant
-	  htel = map hideAndRelParams $ telToList tel
+          htel = map hideAndRelParams $ telToList tel
           info = setRelevance recordRelevance defaultArgInfo
-	  tel' = telFromList $ htel ++ [Dom info ("r", rect)]
+          tel' = telFromList $ htel ++ [Dom info ("r", rect)]
           ext (Dom info (x, t)) = addCtx x (Dom info t)
 
       -- Add the record section
@@ -214,17 +224,17 @@ checkRecDef i name ind con ps contel fields =
       escapeContext (size tel) $ flip (foldr ext) ctx $
        -- the record variable has the empty name by intention, see issue 208
        underAbstraction (Dom info rect) (Abs "" ()) $ \_ -> do
-	reportSDoc "tc.rec.def" 10 $ sep
-	  [ text "record section:"
-	  , nest 2 $ sep
+        reportSDoc "tc.rec.def" 10 $ sep
+          [ text "record section:"
+          , nest 2 $ sep
             [ prettyTCM m <+> (inTopContext . prettyTCM =<< getContextTelescope)
             , fsep $ punctuate comma $ map (text . show . getName) fields
             ]
-	  ]
+          ]
         reportSDoc "tc.rec.def" 15 $ nest 2 $ vcat
           [ text "field tel =" <+> escapeContext 1 (prettyTCM ftel)
           ]
-	addSection m (size tel')
+        addSection m (size tel')
 
       -- Check the types of the fields
       -- Andreas, 2013-09-13 all module telescopes count as parameters to the record projections
@@ -276,15 +286,15 @@ checkRecordProjections m r con tel ftel fs = do
       -- because then meta variables are created again.
       -- Instead, we take the field type t from the field telescope.
       reportSDoc "tc.rec.proj" 5 $ sep
-	[ text "checking projection" <+> text (show x)
-	, nest 2 $ vcat
-	  [ text "top   =" <+> (inTopContext . prettyTCM =<< getContextTelescope)
+        [ text "checking projection" <+> text (show x)
+        , nest 2 $ vcat
+          [ text "top   =" <+> (inTopContext . prettyTCM =<< getContextTelescope)
           , text "tel   =" <+> (inTopContext . prettyTCM $ tel)
-	  , text "ftel1 =" <+> prettyTCM ftel1
-	  , text "t     =" <+> prettyTCM t
-	  , text "ftel2 =" <+> addCtxTel ftel1 (underAbstraction_ ftel2 prettyTCM)
-	  ]
-	]
+          , text "ftel1 =" <+> prettyTCM ftel1
+          , text "t     =" <+> prettyTCM t
+          , text "ftel2 =" <+> addCtxTel ftel1 (underAbstraction_ ftel2 prettyTCM)
+          ]
+        ]
 
       -- Andreas, 2010-09-09 The following comments are misleading, TODO: update
       -- in fact, tel includes the variable of record type as last one
@@ -297,16 +307,16 @@ checkRecordProjections m r con tel ftel fs = do
 
       {- what are the contexts?
 
-	  Γ, tel            ⊢ t
-	  Γ, tel, r         ⊢ vs
-	  Γ, tel, r, ftel₁  ⊢ raiseFrom (size ftel₁) 1 t
+          Γ, tel            ⊢ t
+          Γ, tel, r         ⊢ vs
+          Γ, tel, r, ftel₁  ⊢ raiseFrom (size ftel₁) 1 t
       -}
 
       -- The type of the projection function should be
       --  {tel} -> (r : R Δ) -> t
       -- where Δ = Γ, tel is the current context
       let finalt   = telePi (replaceEmptyName "r" tel) t
-	  projname = qualify m $ qnameName x
+          projname = qualify m $ qnameName x
           projcall = Var 0 [Proj projname]
 --          projcall = Def projname [defaultArg $ var 0]
           rel      = getRelevance ai
@@ -323,9 +333,9 @@ checkRecordProjections m r con tel ftel fs = do
       ifM (return (rel == Irrelevant) `and2M` do not . optIrrelevantProjections <$> pragmaOptions) recurse $ do
 
       reportSDoc "tc.rec.proj" 10 $ sep
-	[ text "adding projection"
-	, nest 2 $ prettyTCM projname <+> text ":" <+> inTopContext (prettyTCM finalt)
-	]
+        [ text "adding projection"
+        , nest 2 $ prettyTCM projname <+> text ":" <+> inTopContext (prettyTCM finalt)
+        ]
 
       -- The body should be
       --  P.xi {tel} (r _ .. x .. _) = x
@@ -359,17 +369,17 @@ checkRecordProjections m r con tel ftel fs = do
           -- (rt) which should be  R ptel
           (ptel,[rt]) = splitAt (size tel - 1) $ telToList tel
           projArgI    = domInfo rt
-	  conp	 = defaultArg
-		 $ ConP con (Just (False, argFromDom $ fmap snd rt))
+          conp   = defaultArg
+                 $ ConP con (Just (False, argFromDom $ fmap snd rt))
                    [ Arg info $ unnamed $ VarP "x" | Dom info _ <- telToList ftel ]
-	  nobind 0 = id
-	  nobind n = Bind . Abs "_" . nobind (n - 1)
-	  body	 = nobind (size ftel1)
-		 $ Bind . Abs "x"
-		 $ nobind (size ftel2)
-		 $ Body $ bodyMod $ var (size ftel2)
+          nobind 0 = id
+          nobind n = Bind . Abs "_" . nobind (n - 1)
+          body   = nobind (size ftel1)
+                 $ Bind . Abs "x"
+                 $ nobind (size ftel2)
+                 $ Body $ bodyMod $ var (size ftel2)
           cltel  = ftel
-	  clause                            = Clause { clauseRange = getRange info
+          clause                            = Clause { clauseRange = getRange info
                           , clauseTel       = killRange cltel
                           , clausePerm      = idP $ size ftel
                           , namedClausePats = [Named Nothing <$> conp]
@@ -395,18 +405,18 @@ checkRecordProjections m r con tel ftel fs = do
             }
 
       reportSDoc "tc.rec.proj" 80 $ sep
-	[ text "adding projection"
-	, nest 2 $ prettyTCM projname <+> text (show clause)
-	]
+        [ text "adding projection"
+        , nest 2 $ prettyTCM projname <+> text (show clause)
+        ]
       reportSDoc "tc.rec.proj" 70 $ sep
-	[ text "adding projection"
-	, nest 2 $ prettyTCM projname <+> text (show (clausePats clause)) <+> text "=" <+>
+        [ text "adding projection"
+        , nest 2 $ prettyTCM projname <+> text (show (clausePats clause)) <+> text "=" <+>
                      inTopContext (addCtxTel ftel (prettyTCM (clauseBody clause)))
-	]
+        ]
       reportSDoc "tc.rec.proj" 10 $ sep
-	[ text "adding projection"
-	, nest 2 $ prettyTCM (QNamed projname clause)
-	]
+        [ text "adding projection"
+        , nest 2 $ prettyTCM (QNamed projname clause)
+        ]
 
             -- Record patterns should /not/ be translated when the
             -- projection functions are defined. Record pattern
@@ -420,7 +430,7 @@ checkRecordProjections m r con tel ftel fs = do
             ]
 
       escapeContext (size tel) $ do
-	addConstant projname $
+        addConstant projname $
           (defaultDefn ai projname (killRange finalt)
             Function { funClauses        = [clause]
                      , funCompiled       = Just cc
@@ -434,6 +444,7 @@ checkRecordProjections m r con tel ftel fs = do
                      , funTerminates     = Just True
                      , funExtLam         = Nothing
                      , funWith           = Nothing
+                     , funCopatternLHS   = isCopatternLHS [clause]
                      })
             { defArgOccurrences = [StrictPos] }
         computePolarity projname
diff --git a/src/full/Agda/TypeChecking/Rules/Term.hs b/src/full/Agda/TypeChecking/Rules/Term.hs
index ce9eaf3..451e3c4 100644
--- a/src/full/Agda/TypeChecking/Rules/Term.hs
+++ b/src/full/Agda/TypeChecking/Rules/Term.hs
@@ -1,17 +1,16 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE PatternGuards         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE TupleSections         #-}
 
 module Agda.TypeChecking.Rules.Term where
 
 import Control.Applicative
 import Control.Monad.Trans
 import Control.Monad.Reader
-import Control.Monad.Error
 
 import Data.Maybe
 import Data.List hiding (sort)
@@ -19,6 +18,7 @@ import qualified Data.Map as Map
 import Data.Traversable (sequenceA)
 
 import Agda.Interaction.Options
+import Agda.Interaction.Highlighting.Generate (storeDisambiguatedName)
 
 import qualified Agda.Syntax.Abstract as A
 import Agda.Syntax.Abstract.Views as A
@@ -56,12 +56,19 @@ import Agda.TypeChecking.Reduce
 import Agda.TypeChecking.Substitute
 import Agda.TypeChecking.Telescope
 import Agda.TypeChecking.Rules.LHS (checkLeftHandSide, LHSResult(..))
+import Agda.TypeChecking.Unquote
 
 import {-# SOURCE #-} Agda.TypeChecking.Empty (isEmptyType)
 import {-# SOURCE #-} Agda.TypeChecking.Rules.Decl (checkSectionApplication)
-import {-# SOURCE #-} Agda.TypeChecking.Rules.Def (checkFunDef,checkFunDef')
+import {-# SOURCE #-} Agda.TypeChecking.Rules.Def (checkFunDef, checkFunDef', useTerPragma)
+
+import Agda.Utils.Except
+  ( Error(noMsg, strMsg)
+  , ExceptT
+  , MonadError(catchError, throwError)
+  , runExceptT
+  )
 
-import Agda.Utils.Fresh
 import Agda.Utils.Functor (($>))
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
@@ -69,7 +76,7 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -134,9 +141,9 @@ leqType_ t t' = workOnTypes $ leqType t t'
 
 forcePi :: Hiding -> String -> Type -> TCM (Type, Constraints)
 forcePi h name (El s t) =
-    do	t' <- reduce t
-	case t' of
-	    Pi _ _	-> return (El s t', [])
+    do  t' <- reduce t
+        case t' of
+            Pi _ _      -> return (El s t', [])
             _           -> do
                 sa <- newSortMeta
                 sb <- newSortMeta
@@ -144,7 +151,7 @@ forcePi h name (El s t) =
 
                 a <- newTypeMeta sa
                 x <- freshName_ name
-		let arg = Arg h Relevant a
+                let arg = Arg h Relevant a
                 b <- addCtx x arg $ newTypeMeta sb
                 let ty = El s' $ Pi arg (Abs (show x) b)
                 cs <- equalType (El s t') ty
@@ -162,7 +169,7 @@ checkTelescope_ [] ret = ret EmptyTel
 checkTelescope_ (b : tel) ret =
     checkTypedBindings_ b $ \tel1 ->
     checkTelescope_ tel   $ \tel2 ->
-	ret $ abstract tel1 tel2
+        ret $ abstract tel1 tel2
 
 -- | Check a typed binding and extends the context with the bound variables.
 --   The telescope passed to the continuation is valid in the original context.
@@ -250,7 +257,6 @@ checkLambda (Arg info (A.TBind _ xs typ)) body target = do
         let r  = getRelevance info
             r' = getRelevance arg -- relevance of function type
         when (r == Irrelevant && r' /= r) $ typeError $ WrongIrrelevanceInLambda target
---        unless (getRelevance arg == r) $ typeError $ WrongIrrelevanceInLambda target
         -- We only need to block the final term on the argument type
         -- comparison. The body will be blocked if necessary. We still want to
         -- compare the argument types first, so we spawn a new problem for that
@@ -278,7 +284,6 @@ checkAbsurdLambda i h e t = do
               null . allMetas <$> instantiateFull a
         | otherwise -> blockTerm t' $ do
           isEmptyType (getRange i) a
---          return $ Lam info' absurdBody
           -- Add helper function
           top <- currentModule
           aux <- qualify top <$> freshName_ (getRange i, absurdLambdaName)
@@ -315,6 +320,7 @@ checkAbsurdLambda i h e t = do
               , funTerminates     = Just True
               , funExtLam         = Nothing
               , funWith           = Nothing
+              , funCopatternLHS   = False
               }
           -- Andreas 2012-01-30: since aux is lifted to toplevel
           -- it needs to be applied to the current telescope (issue 557)
@@ -334,8 +340,9 @@ checkExtendedLambda i di qname cs e t = do
      let info = setRelevance rel defaultArgInfo
      -- Andreas, 2013-12-28: add extendedlambda as @Function@, not as @Axiom@;
      -- otherwise, @addClause@ in @checkFunDef'@ fails (see issue 1009).
-     addConstant qname $
-       (defaultDefn info qname t emptyFunction) { defMutual = j }
+     addConstant qname =<< do
+       useTerPragma $
+         (defaultDefn info qname t emptyFunction) { defMutual = j }
      reportSDoc "tc.term.exlam" 50 $
        text "extended lambda's implementation \"" <> prettyTCM qname <>
        text "\" has type: " $$ prettyTCM t -- <+> text " where clauses: " <+> text (show cs)
@@ -347,7 +354,7 @@ checkExtendedLambda i di qname cs e t = do
      let (hid, notHid) = partition isHidden argsNoParam
      abstract (A.defAbstract di) $ checkFunDef' t info NotDelayed
                                                 (Just (length hid, length notHid)) Nothing di qname cs
-     reduce $ (Def qname [] `apply` args)
+     return $ Def qname $ map Apply args
   where
     -- Concrete definitions cannot use information about abstract things.
     abstract ConcreteDef = inConcreteMode
@@ -370,15 +377,14 @@ checkRecordExpression fs e t = do
     Def r es  -> do
       let ~(Just vs) = allApplyElims es
       reportSDoc "tc.term.rec" 20 $ text $ "  r   = " ++ show r
-{-
-      axs    <- getRecordFieldNames r
-      let xs = map unArg axs
-      reportSDoc "tc.term.rec" 20 $ text $ "  xs  = " ++ show xs
-      ftel   <- getRecordFieldTypes r
-      reportSDoc "tc.term.rec" 20 $ text   "  ftel= " <> prettyTCM ftel
-      con    <- getRecordConstructor r
-      reportSDoc "tc.term.rec" 20 $ text $ "  con = " ++ show con
--}
+
+      reportSDoc "tc.term.rec" 30 $ text "  xs  = " <> do
+        text =<< show . map unArg <$> getRecordFieldNames r
+      reportSDoc "tc.term.rec" 30 $ text "  ftel= " <> do
+        prettyTCM =<< getRecordFieldTypes r
+      reportSDoc "tc.term.rec" 30 $ text "  con = " <> do
+        text =<< show <$> getRecordConstructor r
+
       def <- getRecordDef r
       let axs  = recordFieldNames def
           xs   = map unArg axs
@@ -493,21 +499,10 @@ checkLiteral lit t = do
   t' <- litType lit
   coerce (Lit lit) t' t
 
--- moved to TypeChecking.Monad.Builtin to avoid import cycles:
--- litType :: Literal -> TCM Type
-
 ---------------------------------------------------------------------------
 -- * Terms
 ---------------------------------------------------------------------------
 
-{- MOVED to TC.Datatypes.getConForm
--- TODO: move somewhere suitable
-reduceCon :: QName -> TCM ConHead
-reduceCon x = do
-  Con c [] <- ignoreSharing <$> (constructorForm =<< getConHead c)
-  return c
--}
-
 -- | @checkArguments' exph r args t0 t k@ tries @checkArguments exph args t0 t at .
 -- If it succeeds, it continues @k@ with the returned results.  If it fails,
 -- it registers a postponed typechecking problem and returns the resulting new
@@ -518,7 +513,7 @@ checkArguments' ::
   ExpandHidden -> ExpandInstances -> Range -> [I.NamedArg A.Expr] -> Type -> Type ->
   (Args -> Type -> TCM Term) -> TCM Term
 checkArguments' exph expIFS r args t0 t k = do
-  z <- runErrorT $ checkArguments exph expIFS r args t0 t
+  z <- runExceptT $ checkArguments exph expIFS r args t0 t
   case z of
     Right (vs, t1) -> k vs t1
       -- vs = evaluated args
@@ -543,9 +538,9 @@ checkExpr e t0 =
   traceCall (CheckExprCall e t0) $ localScope $ doExpandLast $ shared <$> do
     reportSDoc "tc.term.expr.top" 15 $
         text "Checking" <+> sep
-	  [ fsep [ prettyTCM e, text ":", prettyTCM t0 ]
-	  , nest 2 $ text "at " <+> (text . show =<< getCurrentRange)
-	  ]
+          [ fsep [ prettyTCM e, text ":", prettyTCM t0 ]
+          , nest 2 $ text "at " <+> (text . show =<< getCurrentRange)
+          ]
     reportSDoc "tc.term.expr.top.detailed" 80 $
       text "Checking" <+> fsep [ prettyTCM e, text ":", text (show t0) ]
     t <- reduce t0
@@ -553,44 +548,58 @@ checkExpr e t0 =
         text "    --> " <+> prettyTCM t
 
     let scopedExpr (A.ScopedExpr scope e) = setScope scope >> scopedExpr e
-	scopedExpr e			  = return e
+        scopedExpr e                      = return e
 
     e <- scopedExpr e
 
     case e of
 
-	A.ScopedExpr scope e -> __IMPOSSIBLE__ -- setScope scope >> checkExpr e t
-
-	-- Insert hidden lambda if appropriate
-	_   | Pi (Dom info _) _ <- ignoreSharing $ unEl t
-            , not (hiddenLambdaOrHole (getHiding info) e)
-            , getHiding info /= NotHidden -> do
-		x <- freshName r (argName t)
+        A.ScopedExpr scope e -> __IMPOSSIBLE__ -- setScope scope >> checkExpr e t
+
+        -- Insert hidden lambda if all of the following conditions are met:
+            -- type is a hidden function type, {x : A} -> B or {{x : A} -> B
+        _   | Pi (Dom info _) _ <- ignoreSharing $ unEl t
+            , let h = getHiding info
+            , notVisible h
+            -- expression is not a matching hidden lambda or question mark
+            , not (hiddenLambdaOrHole h e)
+            -> do
+                x <- freshName rx (argName t)
                 info <- reify info
                 reportSLn "tc.term.expr.impl" 15 $ "Inserting implicit lambda"
-		checkExpr (A.Lam (A.ExprRange $ getRange e) (domainFree info x) e) t
-	    where
-		r = case rStart $ getRange e of
-                      Nothing  -> noRange
-                      Just pos -> posToRange pos pos
-
-                hiddenLambdaOrHole h (A.AbsurdLam _ h') | h == h'                      = True
-                hiddenLambdaOrHole h (A.ExtendedLam _ _ _ [])                          = False
-                hiddenLambdaOrHole h (A.ExtendedLam _ _ _ cls)                         = any hiddenLHS cls
-		hiddenLambdaOrHole h (A.Lam _ (A.DomainFree info' _) _) | h == getHiding info'       = True
-		hiddenLambdaOrHole h (A.Lam _ (A.DomainFull (A.TypedBindings _ (Arg info' _))) _)
-                  | h == getHiding info'                                                            = True
-		hiddenLambdaOrHole _ A.QuestionMark{}				       = True
-		hiddenLambdaOrHole _ _						       = False
-
-                hiddenLHS (A.Clause (A.LHS _ (A.LHSHead _ (a : _)) _) _ _) = elem (getHiding a) [Hidden, Instance]
+                checkExpr (A.Lam (A.ExprRange re) (domainFree info x) e) t
+            where
+                re = getRange e
+                rx = caseMaybe (rStart re) noRange $ \ pos -> posToRange pos pos
+
+                hiddenLambdaOrHole h e = case e of
+                  A.AbsurdLam _ h'                 -> h == h'
+                  A.ExtendedLam _ _ _ cls          -> any hiddenLHS cls
+                  A.Lam _ (A.DomainFree info' _) _ -> h == getHiding info'
+                  A.Lam _ (A.DomainFull (A.TypedBindings _ (Arg info' _))) _
+                                                   -> h == getHiding info'
+                  A.QuestionMark{}                 -> True
+                  _                                -> False
+
+                hiddenLHS (A.Clause (A.LHS _ (A.LHSHead _ (a : _)) _) _ _) = notVisible a
                 hiddenLHS _ = False
 
         -- a meta variable without arguments: type check directly for efficiency
-	A.QuestionMark i ii -> checkMeta (newQuestionMark ii) t0 i -- Andreas, 2013-05-22 use unreduced type t0!
-	A.Underscore i   -> checkMeta (newValueMeta RunMetaOccursCheck) t0 i
+        A.QuestionMark i ii -> do
+          reportSDoc "tc.interaction" 20 $ sep
+            [ text "Found interaction point"
+            , text (show ii)
+            , text ":"
+            , prettyTCM t0
+            ]
+          reportSDoc "tc.interaction" 40 $ sep
+            [ text "Raw:"
+            , text (show t0)
+            ]
+          checkMeta (newQuestionMark ii) t0 i -- Andreas, 2013-05-22 use unreduced type t0!
+        A.Underscore i   -> checkMeta (newValueMeta RunMetaOccursCheck) t0 i
 
-	A.WithApp _ e es -> typeError $ NotImplemented "type checking of with application"
+        A.WithApp _ e es -> typeError $ NotImplemented "type checking of with application"
 
         -- check |- Set l : t  (requires universe polymorphism)
         A.App i s (Arg ai l)
@@ -613,6 +622,7 @@ checkExpr e t0 =
         A.App i q (Arg ai e)
           | A.Quote _ <- unScope q, visible ai -> do
           let quoted (A.Def x) = return x
+              quoted (A.Proj x) = return x
               quoted (A.Con (AmbQ [x])) = return x
               quoted (A.Con (AmbQ xs))  = typeError $ GenericError $ "quote: Ambigous name: " ++ show xs
               quoted (A.ScopedExpr _ e) = quoted e
@@ -622,10 +632,11 @@ checkExpr e t0 =
           coerce (quoteName x) ty t
 
           | A.QuoteTerm _ <- unScope q ->
-             do (et, _) <- inferExpr (namedThing e)
-                q <- quoteTerm =<< normalise et
-                ty <- el primAgdaTerm
+             do (et, _)   <- inferExpr (namedThing e)
+                q         <- quoteTerm =<< etaContract =<< normalise et
+                ty        <- el primAgdaTerm
                 coerce q ty t
+
         A.Quote _ -> typeError $ GenericError "quote must be applied to a defined name"
         A.QuoteTerm _ -> typeError $ GenericError "quoteTerm must be applied to a term"
         A.Unquote _ -> typeError $ GenericError "unquote must be applied to a term"
@@ -634,14 +645,14 @@ checkExpr e t0 =
 
         A.ExtendedLam i di qname cs -> checkExtendedLambda i di qname cs e t
 
-	A.Lam i (A.DomainFull (A.TypedBindings _ b)) e -> checkLambda (convColor b) e t
+        A.Lam i (A.DomainFull (A.TypedBindings _ b)) e -> checkLambda (convColor b) e t
 
-	A.Lam i (A.DomainFree info x) e0 -> checkExpr (A.Lam i (domainFree info x) e0) t
+        A.Lam i (A.DomainFree info x) e0 -> checkExpr (A.Lam i (domainFree info x) e0) t
 
-	A.Lit lit    -> checkLiteral lit t
-	A.Let i ds e -> checkLetBindings ds $ checkExpr e t
-	A.Pi _ tel e -> do
-	    t' <- checkTelescope_ tel $ \tel -> do
+        A.Lit lit    -> checkLiteral lit t
+        A.Let i ds e -> checkLetBindings ds $ checkExpr e t
+        A.Pi _ tel e -> do
+            t' <- checkTelescope_ tel $ \tel -> do
                     t   <- instantiateFull =<< isType_ e
                     tel <- instantiateFull tel
                     return $ telePi tel t
@@ -651,25 +662,25 @@ checkExpr e t0 =
                    , nest 2 $ text "t   =" <+> prettyTCM t'
                    , nest 2 $ text "cxt =" <+> (prettyTCM =<< getContextTelescope)
                    ]
-	    coerce (unEl t') (sort s) t
-	A.Fun _ (Arg info a) b -> do
-	    a' <- isType_ a
-	    b' <- isType_ b
-	    s <- reduce $ getSort a' `sLub` getSort b'
-	    coerce (Pi (convColor $ Dom info a') (NoAbs underscore b')) (sort s) t
-	A.Set _ n    -> do
+            coerce (unEl t') (sort s) t
+        A.Fun _ (Arg info a) b -> do
+            a' <- isType_ a
+            b' <- isType_ b
+            s <- reduce $ getSort a' `sLub` getSort b'
+            coerce (Pi (convColor $ Dom info a') (NoAbs underscore b')) (sort s) t
+        A.Set _ n    -> do
           n <- ifM typeInType (return 0) (return n)
-	  coerce (Sort $ mkType n) (sort $ mkType $ n + 1) t
-	A.Prop _     -> do
+          coerce (Sort $ mkType n) (sort $ mkType $ n + 1) t
+        A.Prop _     -> do
           typeError $ GenericError "Prop is no longer supported"
           -- s <- ifM typeInType (return $ mkType 0) (return Prop)
-	  -- coerce (Sort Prop) (sort $ mkType 1) t
+          -- coerce (Sort Prop) (sort $ mkType 1) t
 
-	A.Rec _ fs  -> checkRecordExpression fs e t
+        A.Rec _ fs  -> checkRecordExpression fs e t
 
         A.RecUpdate ei recexpr fs -> checkRecordUpdate ei recexpr fs e t
 
-	A.DontCare e -> -- resurrect vars
+        A.DontCare e -> -- resurrect vars
           ifM ((Irrelevant ==) <$> asks envRelevance)
             (dontCare <$> do applyRelevanceToContext Irrelevant $ checkExpr e t)
             (internalError "DontCare may only appear in irrelevant contexts")
@@ -699,7 +710,7 @@ checkExpr e t0 =
           blockTerm t $ coerce v ctxType t
         A.ETel _   -> __IMPOSSIBLE__
 
-	-- Application
+        -- Application
         _   | Application hd args <- appView e -> checkApplication hd args e t
 
 -- | @checkApplication hd args e t@ checks an application.
@@ -728,27 +739,21 @@ checkApplication hd args e t = do
       cons  <- mapM getConForm cs
       reportSLn "tc.check.term" 40 $ "  reduced: " ++ show cons
       dcs <- zipWithM (\ c con -> (, setConName c con) . getData . theDef <$> getConInfo con) cs cons
-{-
-      cs  <- zip cs . zipWith setRange (map getRange cs) <$> mapM reduceCon cs
-      reportSLn "tc.check.term" 40 $ "  ranges after: " ++ show (getRange cs)
-      reportSLn "tc.check.term" 40 $ "  reduced: " ++ show cs
-      dcs <- mapM (\(c0, c1) -> (getData /\ const c0) . theDef <$> getConstInfo c1) cs
--}
       -- Type error
       let badCon t = typeError $ DoesNotConstructAnElementOf (head cs) t
---      let badCon t = typeError $ DoesNotConstructAnElementOf (fst $ head cs) t
-
       -- Lets look at the target type at this point
-      let getCon = do
+      let getCon :: TCM (Maybe ConHead)
+          getCon = do
           TelV tel t1 <- telView t
           addCtxTel tel $ do
            reportSDoc "tc.check.term.con" 40 $ nest 2 $
              text "target type: " <+> prettyTCM t1
            ifBlockedType t1 (\ m t -> return Nothing) $ \ t' ->
-             (isDataOrRecord (unEl t') >>=) $ maybe (badCon t') $ \ d ->
+             caseMaybeM (isDataOrRecord $ unEl t') (badCon t') $ \ d ->
                case [ c | (d', c) <- dcs, d == d' ] of
                  [c] -> do
                    reportSLn "tc.check.term" 40 $ "  decided on: " ++ show c
+                   storeDisambiguatedName $ conName c
                    return $ Just c
                  []  -> badCon $ t' $> Def d []
                  cs  -> typeError $ CantResolveOverloadedConstructorsTargetingSameDatatype d $ map conName cs
@@ -762,7 +767,6 @@ checkApplication hd args e t = do
     A.Con (AmbQ [c]) -> do
       -- augment c with record fields, but do not revert to original name
       con <- getOrigConHead c
---      con <- setConName c . conSrcCon . theDef <$> getConstInfo c
       checkConstructorApplication e t con $ map convColor args
 
     -- Subcase: pattern synonym
@@ -774,7 +778,7 @@ checkApplication hd args e t = do
       -- over the ones we haven't.
       let meta r = A.Underscore $ A.emptyMetaInfo{ A.metaRange = r }   -- TODO: name suggestion
       case A.insertImplicitPatSynArgs meta (getRange n) ns args of
-        Nothing      -> typeError $ GenericError $ "Bad arguments to pattern synonym " ++ show n
+        Nothing      -> typeError $ BadArgumentsToPatternSynonym n
         Just (s, ns) -> do
           let p' = A.patternToExpr p
               e' = A.lambdaLiftExpr (map unArg ns) (A.substExpr s p')
@@ -790,12 +794,16 @@ checkApplication hd args e t = do
           checkHeadApplication e t e $ map convColor args
       where
         unquoteTerm qv = do
-          v <- unquote =<< checkExpr qv =<< el primAgdaTerm
-          e <- reifyUnquoted (v :: Term)
-          reportSDoc "tc.unquote.term" 10 $
-            vcat [ text "unquote" <+> prettyTCM qv
-                 , nest 2 $ text "-->" <+> prettyA e ]
-          return (killRange e)
+          qv <- checkExpr qv =<< el primAgdaTerm
+          mv <- runUnquoteM $ unquote qv
+          case mv of
+            Left err -> typeError $ UnquoteFailed err
+            Right v  -> do
+              e <- reifyUnquoted (v :: Term)
+              reportSDoc "tc.unquote.term" 10 $
+                vcat [ text "unquote" <+> prettyTCM qv
+                     , nest 2 $ text "-->" <+> prettyA e ]
+              return (killRange e)
 
     -- Subcase: defined symbol or variable.
     _ -> checkHeadApplication e t hd $ map convColor args
@@ -811,7 +819,7 @@ domainFree info x =
       { A.metaRange          = r
       , A.metaScope          = emptyScopeInfo
       , A.metaNumber         = Nothing
-      , A.metaNameSuggestion = show x
+      , A.metaNameSuggestion = show $ A.nameConcrete x
       }
 
 ---------------------------------------------------------------------------
@@ -820,37 +828,9 @@ domainFree info x =
 
 checkMeta :: (Type -> TCM Term) -> Type -> A.MetaInfo -> TCM Term
 checkMeta newMeta t i = fst <$> checkOrInferMeta newMeta (Just t) i
-{-
-checkMeta newMeta t i = do
-  case A.metaNumber i of
-    Nothing -> do
-      setScope (A.metaScope i)
-      v <- newMeta t
-      setValueMetaName v (A.metaNameSuggestion i)
-      return v
-    -- Rechecking an existing metavariable
-    Just n -> do
-      let v = MetaV (MetaId n) []
-      t' <- jMetaType . mvJudgement <$> lookupMeta (MetaId n)
-      coerce v t' t
--}
 
 inferMeta :: (Type -> TCM Term) -> A.MetaInfo -> TCM (Args -> Term, Type)
 inferMeta newMeta i = mapFst apply <$> checkOrInferMeta newMeta Nothing i
-{-
-inferMeta newMeta i =
-  case A.metaNumber i of
-    Nothing -> do
-      setScope (A.metaScope i)
-      t <- workOnTypes $ newTypeMeta_
-      v <- newMeta t
-      return (apply v, t)
-    -- Rechecking an existing metavariable
-    Just n -> do
-      let v = MetaV (MetaId n)
-      t' <- jMetaType . mvJudgement <$> lookupMeta (MetaId n)
-      return (v, t')
--}
 
 -- | Type check a meta variable.
 --   If its type is not given, we return its type, or a fresh one, if it is a new meta.
@@ -877,6 +857,15 @@ checkOrInferMeta newMeta mt i = do
 -- * Applications
 ---------------------------------------------------------------------------
 
+inferHeadDef :: QName -> TCM (Args -> Term, Type)
+inferHeadDef x = do
+  proj <- isProjection x
+  let app =
+        case proj of
+          Nothing -> \ f args -> return $ Def f $ map Apply args
+          Just p  -> \ f args -> return $ projDropPars p `apply` args
+  mapFst apply <$> inferDef app x
+
 -- | Infer the type of a head thing (variable, function symbol, or constructor).
 --   We return a function that applies the head to arguments.
 --   This is because in case of a constructor we want to drop the parameters.
@@ -888,34 +877,8 @@ inferHead e = do
       when (unusableRelevance $ getRelevance a) $
         typeError $ VariableIsIrrelevant x
       return (apply u, unDom a)
-    (A.Def x) -> do
-      proj <- isProjection x
-      case proj of
-        Nothing -> do
-          (u, a) <- inferDef (\ f args -> return $ Def f $ map Apply args) x
-          return (apply u, a)
-        Just Projection{ projDropPars = proj } -> do
-{- MOVED to Rules/Record.hs and ProjectionLike.hs
-        Just Projection{ projIndex = n, projProper, projDropPars = proj } -> do
-          reportSDoc "tc.term.proj" 10 $ sep
-            [ text "building projection" <+> prettyTCM x
-            , nest 2 $ parens (text "ctx =" <+> (text . show =<< do
-                size <$> freeVarsToApply x))
-            , nest 2 $ parens (text "n =" <+> text (show n))
-            , nest 2 $ parens (text "m =" <+> (text . show =<< getDefFreeVars x))
-            ]
-          let is | n == 0    = __IMPOSSIBLE__
-                 | otherwise = genericReplicate (n - 1) defaultArgInfo -- TODO: hiding
-              names = [ s ++ [c] | s <- "" : names, c <- ['a'..'z'] ]
-              -- Andreas, 2013-10-19
-              -- proper projections are postfix, projection-like defs are prefix
-              core | projProper = (Lam defaultArgInfo $ Abs "r" $ Var 0 [Proj x])
-                   | otherwise  = Def x []
-              -- leading lambdas are to ignore parameter applications
-              proj  = foldr (\ (i, s) -> Lam i . NoAbs s) core (zip is names)
--}
-          (u, a) <- inferDef (\ f vs -> return $ proj `apply` vs) x
-          return (apply u, a)
+    (A.Def x) -> inferHeadDef x
+    (A.Proj x) -> inferHeadDef x
     (A.Con (AmbQ [c])) -> do
 
       -- Constructors are polymorphic internally.
@@ -1132,7 +1095,7 @@ checkHeadApplication e t hd args = do
 
       -- The name of the fresh function.
       i <- fresh :: TCM Int
-      let name = filter (/= '_') (show $ A.qnameName c) ++ "-" ++ show i
+      let name = filter (/= '_') (show $ A.nameConcrete $ A.qnameName c) ++ "-" ++ show i
       c' <- setRange (getRange c) <$>
               liftM2 qualify (killRange <$> currentModule)
                              (freshName_ name)
@@ -1148,9 +1111,11 @@ checkHeadApplication e t hd args = do
       -- If we are in irrelevant position, add definition irrelevantly.
       -- TODO: is this sufficient?
       rel <- asks envRelevance
-      addConstant c' (Defn (setRelevance rel defaultArgInfo)
-                           c' t [] [] (defaultDisplayForm c')
-                  i noCompiledRep [] Nothing $ emptyFunction)
+      addConstant c' =<< do
+        let ai = setRelevance rel defaultArgInfo
+        useTerPragma $
+          Defn ai c' t [] [] (defaultDisplayForm c') i noCompiledRep [] Nothing $
+          emptyFunction
 
       -- Define and type check the fresh function.
       ctx <- getContext >>= mapM (\d -> flip Dom (unDom d) <$> reify (domInfo d))
@@ -1190,18 +1155,15 @@ checkHeadApplication e t hd args = do
     expandLast <- asks envExpandLast
     checkArguments' expandLast ExpandInstanceArguments (getRange hd) args t0 t $ \vs t1 -> do
       coerce (f vs) t1 t
-      -- -- try to remove projection redexes  -- fails succeed/Issue286
-      -- v <- onlyReduceProjections $ reduce $ f vs
-      -- coerce v t1 t
 
 -- Stupid ErrorT!
 instance Error (a, b, c) where
   strMsg _ = __IMPOSSIBLE__
   noMsg = __IMPOSSIBLE__
 
-traceCallE :: Error e => (Maybe r -> Call) -> ErrorT e TCM r -> ErrorT e TCM r
+traceCallE :: Error e => (Maybe r -> Call) -> ExceptT e TCM r -> ExceptT e TCM r
 traceCallE call m = do
-  z <- lift $ traceCall call' $ runErrorT m
+  z <- lift $ traceCall call' $ runExceptT m
   case z of
     Right e  -> return e
     Left err -> throwError err
@@ -1216,7 +1178,7 @@ traceCallE call m = do
 --   type @t0'@ (which should be a subtype of @t1@) and any constraints @cs@
 --   that have to be solved for everything to be well-formed.
 checkArguments :: ExpandHidden -> ExpandInstances -> Range -> [I.NamedArg A.Expr] -> Type -> Type ->
-                  ErrorT (Args, [I.NamedArg A.Expr], Type) TCM (Args, Type)
+                  ExceptT (Args, [I.NamedArg A.Expr], Type) TCM (Args, Type)
 
 -- Case: no arguments, do not insert trailing hidden arguments: We are done.
 checkArguments DontExpandLast DontExpandInstanceArguments _ [] t0 t1 = return ([], t0)
@@ -1314,7 +1276,7 @@ checkArguments exh expandIFS r args0@(arg@(Arg info e) : args) t0 t1 =
 -- | Check that a list of arguments fits a telescope.
 checkArguments_ :: ExpandHidden -> Range -> [I.NamedArg A.Expr] -> Telescope -> TCM Args
 checkArguments_ exh r args tel = do
-    z <- runErrorT $ checkArguments exh ExpandInstanceArguments r args (telePi tel $ sort Prop) (sort Prop)
+    z <- runExceptT $ checkArguments exh ExpandInstanceArguments r args (telePi tel $ sort Prop) (sort Prop)
     case z of
       Right (args, _) -> return args
       Left _          -> __IMPOSSIBLE__
@@ -1327,7 +1289,7 @@ inferExpr :: A.Expr -> TCM (Term, Type)
 inferExpr e = case e of
   _ | Application hd args <- appView e, defOrVar hd -> traceCall (InferExpr e) $ do
     (f, t0) <- inferHead hd
-    res <- runErrorT $ checkArguments DontExpandLast ExpandInstanceArguments (getRange hd) (map convColor args) t0 (sort Prop)
+    res <- runExceptT $ checkArguments DontExpandLast ExpandInstanceArguments (getRange hd) (map convColor args) t0 (sort Prop)
     case res of
       Right (vs, t1) -> return (f vs, t1)
       Left t1 -> fallback -- blocked on type t1
@@ -1341,6 +1303,7 @@ inferExpr e = case e of
 defOrVar :: A.Expr -> Bool
 defOrVar A.Var{} = True
 defOrVar A.Def{} = True
+defOrVar A.Proj{} = True
 defOrVar (A.ScopedExpr _ e) = defOrVar e
 defOrVar _     = False
 
@@ -1374,12 +1337,31 @@ inferOrCheck e mt = case e of
       return (v,t)
 -}
 
+-- | Check whether a de Bruijn index is bound by a module telescope.
+isModuleFreeVar :: Int -> TCM Bool
+isModuleFreeVar i = do
+  nfv <- getModuleFreeVars =<< currentModule
+  n   <- getContextSize
+  -- The first de Bruijn index that points to a module
+  -- free variable.
+  let firstModuleVar = n - nfv
+  when (firstModuleVar < 0) __IMPOSSIBLE__
+  return $ i >= firstModuleVar
+
 -- | Infer the type of an expression, and if it is of the form
 --   @{tel} -> D vs@ for some datatype @D@ then insert the hidden
 --   arguments.  Otherwise, leave the type polymorphic.
 inferExprForWith :: A.Expr -> TCM (Term, Type)
-inferExprForWith e = do
-  (v, t) <- inferExpr e
+inferExprForWith e = traceCall (InferExpr e) $ do
+  -- With wants type and term fully instantiated!
+  (v, t) <- instantiateFull =<< inferExpr e
+  v0 <- reduce v
+  -- Andreas 2014-11-06, issue 1342.
+  -- Check that we do not `with` on a module parameter!
+  case ignoreSharing v0 of
+    Var i [] -> whenM (isModuleFreeVar i) $ typeError $ WithOnFreeVariable e
+    _        -> return ()
+  -- Possibly insert hidden arguments.
   TelV tel t0 <- telViewUpTo' (-1) ((NotHidden /=) . getHiding) t
   case ignoreSharing $ unEl t0 of
     Def d vs -> do
@@ -1468,7 +1450,6 @@ checkLetBinding b@(A.LetPatBind i p e) ret =
 checkLetBinding (A.LetApply i x modapp rd rm) ret = do
   -- Any variables in the context that doesn't belong to the current
   -- module should go with the new module.
-  -- fv   <- getDefFreeVars =<< (qnameFromList . mnameToList) <$> currentModule
   fv   <- getModuleFreeVars =<< currentModule
   n    <- getContextSize
   let new = n - fv
diff --git a/src/full/Agda/TypeChecking/Rules/Term.hs-boot b/src/full/Agda/TypeChecking/Rules/Term.hs-boot
index d1d4ede..f166ac3 100644
--- a/src/full/Agda/TypeChecking/Rules/Term.hs-boot
+++ b/src/full/Agda/TypeChecking/Rules/Term.hs-boot
@@ -6,14 +6,14 @@ import Agda.Syntax.Internal
 -- import Agda.Syntax.Common hiding (Arg, Dom, NamedArg)
 import Agda.Syntax.Position
 import Agda.TypeChecking.Monad.Base
-import Control.Monad.Error (ErrorT)
+import Agda.Utils.Except ( ExceptT )
 
 isType_ :: A.Expr -> TCM Type
 
 checkExpr :: A.Expr -> Type -> TCM Term
 
 checkArguments :: ExpandHidden -> ExpandInstances -> Range -> [NamedArg A.Expr] -> Type -> Type ->
-                  ErrorT (Args, [NamedArg A.Expr], Type) TCM (Args, Type)
+                  ExceptT (Args, [NamedArg A.Expr], Type) TCM (Args, Type)
 
 checkArguments' :: ExpandHidden -> ExpandInstances -> Range -> [NamedArg A.Expr] -> Type -> Type ->
                    (Args -> Type -> TCM Term) -> TCM Term
diff --git a/src/full/Agda/TypeChecking/Serialise.hs b/src/full/Agda/TypeChecking/Serialise.hs
index e3b3f71..ed6cd48 100644
--- a/src/full/Agda/TypeChecking/Serialise.hs
+++ b/src/full/Agda/TypeChecking/Serialise.hs
@@ -1,11 +1,15 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE OverlappingInstances      #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeSynonymInstances      #-}
 
-{-# OPTIONS_GHC -O2 #-}
+-- Andreas, Makoto, Francesco 2014-10-15 AIM XX:
+-- -O2 does not have any noticable effect on runtime
+-- but sabotages cabal repl with -Werror
+-- (due to a conflict with --interactive warning)
+-- {-# OPTIONS_GHC -O2                      #-}
 
 -- | Structure-sharing serialisation of Agda interface files.
 
@@ -22,18 +26,19 @@ module Agda.TypeChecking.Serialise
   where
 
 import Control.Applicative
+import Control.Arrow (first, second)
+import Control.DeepSeq
 import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.State.Strict
-import Control.Monad.Error
 import Data.Array.IArray
 import Data.Word
 import qualified Data.ByteString.Lazy as L
 import Data.Hashable
 import qualified Data.HashTable.IO as H
 import Data.Int (Int32)
-import Data.IORef
+import Data.Maybe
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -65,7 +70,7 @@ import qualified Agda.Interaction.Highlighting.Precise as HP
 import Agda.Interaction.FindFile
 
 import qualified Agda.TypeChecking.Monad.Benchmark as Bench
-import Agda.TypeChecking.Monad.Benchmark (billTo)
+import Agda.TypeChecking.Monad.Benchmark (billSub, billTo)
 
 import Agda.TypeChecking.Monad
 import Agda.TypeChecking.CompiledClause
@@ -73,21 +78,39 @@ import Agda.TypeChecking.CompiledClause
 
 import Agda.Utils.BiMap (BiMap)
 import qualified Agda.Utils.BiMap as BiMap
-import Agda.Utils.FileName
-import Agda.Utils.Permutation
 import Agda.Utils.HashMap (HashMap)
 import Agda.Utils.Hash
 import qualified Agda.Utils.HashMap as HMap
+import Agda.Utils.FileName
+import Agda.Utils.IORef
+import Agda.Utils.Lens
+import Agda.Utils.Monad
+import Agda.Utils.Permutation
+
+import Agda.Utils.Except ( ExceptT, MonadError(throwError), runExceptT )
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
+-- | Compatibility with @bytestring < 0.10@ which does not implement
+--   @instance NFData@, to support @ghc <= 7.4 at .
+--
+--   Note that we only @deepSeq@ for the purpose of correct benchmarking.
+--   Thus, a simply non-forcing @return@ would be a possible implementation.
+
+returnForcedByteString :: Monad m => L.ByteString -> m L.ByteString
+#if MIN_VERSION_bytestring(0,10,0)
+returnForcedByteString bs = return $!! bs
+#else
+returnForcedByteString bs = return $! bs
+#endif
+
 -- Note that the Binary instance for Int writes 64 bits, but throws
 -- away the 32 high bits when reading (at the time of writing, on
 -- 32-bit machines). Word64 does not have these problems.
 
 currentInterfaceVersion :: Word64
-currentInterfaceVersion = 20140828 * 10 + 0
+currentInterfaceVersion = 20141018 * 10 + 0
 
 -- | Constructor tag (maybe omitted) and argument indices.
 
@@ -106,19 +129,63 @@ type HashTable k v = H.CuckooHashTable k v
 type HashTable k v = H.BasicHashTable k v
 #endif
 
+-- | Structure providing fresh identifiers for hash map
+--   and counting hash map hits (i.e. when no fresh identifier required).
+data FreshAndReuse = FreshAndReuse
+  { farFresh :: !Int32 -- ^ Number of hash map misses.
+  , farReuse :: !Int32 -- ^ Number of hash map hits.
+  }
+
+farEmpty :: FreshAndReuse
+farEmpty = FreshAndReuse 0 0
+
+lensFresh :: Lens' Int32 FreshAndReuse
+lensFresh f r = f (farFresh r) <&> \ i -> r { farFresh = i }
+
+lensReuse :: Lens' Int32 FreshAndReuse
+lensReuse f r = f (farReuse r) <&> \ i -> r { farReuse = i }
+
 -- | State of the the encoder.
-data Dict = Dict{ nodeD     :: !(HashTable Node    Int32)
-                , stringD   :: !(HashTable String  Int32)
-                , integerD  :: !(HashTable Integer Int32)
-                , doubleD   :: !(HashTable Double  Int32)
-                , termD     :: !(HashTable (Ptr Term) Int32)
-                , nodeC     :: !(IORef Int32)  -- counters for fresh indexes
-                , stringC   :: !(IORef Int32)
-                , integerC  :: !(IORef Int32)
-                , doubleC   :: !(IORef Int32)
-                , sharingStats :: !(IORef (Int32, Int32))
-                , fileMod   :: !SourceToModule
-                }
+data Dict = Dict
+  { nodeD        :: !(HashTable Node    Int32)
+  , stringD      :: !(HashTable String  Int32)
+  , integerD     :: !(HashTable Integer Int32)
+  , doubleD      :: !(HashTable Double  Int32)
+  , termD        :: !(HashTable (Ptr Term) Int32)
+  , nodeC        :: !(IORef FreshAndReuse)  -- counters for fresh indexes
+  , stringC      :: !(IORef FreshAndReuse)
+  , integerC     :: !(IORef FreshAndReuse)
+  , doubleC      :: !(IORef FreshAndReuse)
+  , termC        :: !(IORef FreshAndReuse)
+  , stats        :: !(HashTable String Int32)
+  , collectStats :: Bool
+    -- ^ If @True@ collect in @stats@ the quantities of
+    --   calls to @icode@ for each @Typeable a at .
+  , fileMod      :: !SourceToModule
+  }
+
+-- | Creates an empty dictionary.
+emptyDict
+  :: Bool
+     -- ^ Collect statistics for @icode@ calls?
+  -> SourceToModule
+     -- ^ Maps file names to the corresponding module names.
+     --   Must contain a mapping for every file name that is later encountered.
+  -> IO Dict
+emptyDict collectStats fileMod = Dict
+  <$> H.new
+  <*> H.new
+  <*> H.new
+  <*> H.new
+  <*> H.new
+  <*> newIORef farEmpty
+  <*> newIORef farEmpty
+  <*> newIORef farEmpty
+  <*> newIORef farEmpty
+  <*> newIORef farEmpty
+  <*> H.new
+  <*> pure collectStats
+  <*> pure fileMod
 
 -- | Universal type, wraps everything.
 data U    = forall a . Typeable a => U !a
@@ -149,7 +216,7 @@ type S a = ReaderT Dict IO a
 -- 'TCM' is not used because the associated overheads would make
 -- decoding slower.
 
-type R a = ErrorT TypeError (StateT St IO) a
+type R a = ExceptT TypeError (StateT St IO) a
 
 -- | Throws an error which is suitable when the data stream is
 -- malformed.
@@ -158,31 +225,69 @@ malformed :: R a
 malformed = throwError $ GenericError "Malformed input."
 
 class Typeable a => EmbPrj a where
-  icode :: a -> S Int32  -- ^ Serialization.
+  icode :: a -> S Int32  -- ^ Serialization (wrapper).
+  icod_ :: a -> S Int32  -- ^ Serialization (worker).
   value :: Int32 -> R a  -- ^ Deserialization.
 
+  icode a = do
+    tickICode a
+    icod_ a
+
+-- | Increase entry for @a@ in 'stats'.
+tickICode :: forall a. Typeable a => a -> S ()
+tickICode _ = whenM (asks collectStats) $ do
+    let key = "icode " ++ show (typeOf (undefined :: a))
+    hmap <- asks stats
+    liftIO $ do
+      n <- fromMaybe 0 <$> H.lookup hmap key
+      H.insert hmap key $! n + 1
+
 -- | Encodes something. To ensure relocatability file paths in
 -- positions are replaced with module names.
 
 encode :: EmbPrj a => a -> TCM L.ByteString
 encode a = do
+    collectStats <- hasVerbosity "profile.serialize" 20
     fileMod <- sourceToModule
-    newD@(Dict nD sD iD dD _ _ _ _ _ stats _) <- liftIO $ emptyDict fileMod
+    newD@(Dict nD sD iD dD _ nC sC iC dC tC stats _ _) <- liftIO $
+      emptyDict collectStats fileMod
     root <- liftIO $ runReaderT (icode a) newD
     nL <- benchSort $ l nD
     sL <- benchSort $ l sD
     iL <- benchSort $ l iD
     dL <- benchSort $ l dD
-    (shared, total) <- liftIO $ readIORef stats
-    let x = B.encode currentInterfaceVersion `L.append`
-            G.compress (B.encode (root, nL, sL, iL, dL))
+    -- Record reuse statistics.
     verboseS "profile.sharing" 10 $ do
-      tickN "pointers (reused)" $ fromIntegral shared
-      tickN "pointers" $ fromIntegral total
+      statistics "pointers" tC
+    verboseS "profile.serialize" 10 $ do
+      statistics "Integer"  iC
+      statistics "String"   sC
+      statistics "Double"   dC
+      statistics "Node"     nC
+    when collectStats $ do
+      stats <- Map.fromList . map (second toInteger) <$> do
+        liftIO $ H.toList stats
+      modifyStatistics $ Map.union stats
+    -- Encode hashmaps and root, and compress.
+    bits1 <- billSub [ Bench.Serialization, Bench.BinaryEncode ] $
+      returnForcedByteString $ B.encode (root, nL, sL, iL, dL)
+    let compressParams = G.defaultCompressParams
+          { G.compressLevel    = G.bestSpeed
+          , G.compressStrategy = G.huffmanOnlyStrategy
+          }
+    cbits <- billSub [ Bench.Serialization, Bench.Compress ] $
+      returnForcedByteString $ G.compressWith compressParams bits1
+    let x = B.encode currentInterfaceVersion `L.append` cbits
     return x
   where
     l h = List.map fst . List.sortBy (compare `on` snd) <$> H.toList h
     benchSort = billTo [Bench.Serialization, Bench.Sort] . liftIO
+    statistics :: String -> IORef FreshAndReuse -> TCM ()
+    statistics kind ioref = do
+      FreshAndReuse fresh reused <- liftIO $ readIORef ioref
+      tickN (kind ++ "  (fresh)") $ fromIntegral fresh
+      tickN (kind ++ " (reused)") $ fromIntegral reused
+
 
 -- encode :: EmbPrj a => a -> TCM L.ByteString
 -- encode a = do
@@ -220,7 +325,7 @@ runGetState g s n = feed (B.runGetIncremental g) (L.toChunks s)
 
 decode :: EmbPrj a => L.ByteString -> TCM (Maybe a)
 decode s = do
-  mf   <- stModuleToSource <$> get
+  mf   <- use stModuleToSource
   incs <- getIncludeDirs
 
   -- Note that B.runGetState and G.decompress can raise errors if the
@@ -245,12 +350,12 @@ decode s = do
         st <- St (ar nL) (ar sL) (ar iL) (ar dL)
                 <$> liftIO H.new
                 <*> return mf <*> return incs
-        (r, st) <- runStateT (runErrorT (value r)) st
+        (r, st) <- runStateT (runExceptT (value r)) st
         return (Just (modFile st), r)
 
   case mf of
     Nothing -> return ()
-    Just mf -> modify $ \s -> s { stModuleToSource = mf }
+    Just mf -> stModuleToSource .= mf
 
   case r of
     Right x   -> return (Just x)
@@ -298,15 +403,15 @@ decodeFile :: FilePath -> TCM (Maybe Interface)
 decodeFile f = decodeInterface =<< liftIO (L.readFile f)
 
 instance EmbPrj String where
-  icode   = icodeX stringD stringC
+  icod_   = icodeString
   value i = (! i) `fmap` gets stringE
 
 instance EmbPrj Integer where
-  icode   = icodeX integerD integerC
+  icod_   = icodeInteger
   value i = (! i) `fmap` gets integerE
 
 instance EmbPrj Word64 where
-  icode i = icode2' (int32 q) (int32 r)
+  icod_ i = icode2' (int32 q) (int32 r)
     where (q, r) = quotRem i (2^32)
           int32 :: Word64 -> Int32
           int32 = fromIntegral
@@ -315,52 +420,52 @@ instance EmbPrj Word64 where
                            n = 2^32
 
 instance EmbPrj Int32 where
-  icode i = return i
+  icod_ i = return i
   value i = return i
 
 instance EmbPrj Int where
-  icode i = return (fromIntegral i)
+  icod_ i = return (fromIntegral i)
   value i = return (fromIntegral i)
 
 instance EmbPrj Char where
-  icode c = return (fromIntegral $ fromEnum c)
+  icod_ c = return (fromIntegral $ fromEnum c)
   value i = return (toEnum $ fromInteger $ toInteger i)
 
 instance EmbPrj Double where
-  icode   = icodeX doubleD doubleC
+  icod_   = icodeDouble
   value i = (! i) `fmap` gets doubleE
 
 instance EmbPrj () where
-  icode () = icode0'
+  icod_ () = icode0'
   value = vcase valu where valu [] = valu0 ()
                            valu _  = malformed
 
 instance (EmbPrj a, EmbPrj b) => EmbPrj (a, b) where
-  icode (a, b) = icode2' a b
+  icod_ (a, b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 (,) a b
                            valu _      = malformed
 
 instance (EmbPrj a, EmbPrj b, EmbPrj c) => EmbPrj (a, b, c) where
-  icode (a, b, c) = icode3' a b c
+  icod_ (a, b, c) = icode3' a b c
   value = vcase valu where valu [a, b, c] = valu3 (,,) a b c
                            valu _         = malformed
 
 instance EmbPrj a => EmbPrj (Maybe a) where
-  icode Nothing  = icode0'
-  icode (Just x) = icode1' x
+  icod_ Nothing  = icode0'
+  icod_ (Just x) = icode1' x
   value = vcase valu where valu []  = valu0 Nothing
                            valu [x] = valu1 Just x
                            valu _   = malformed
 
 instance EmbPrj Bool where
-  icode True  = icode0'
-  icode False = icode0 0
+  icod_ True  = icode0'
+  icod_ False = icode0 0
   value = vcase valu where valu []  = valu0 True
                            valu [0] = valu0 False
                            valu _   = malformed
 
 instance EmbPrj AbsolutePath where
-  icode file = do
+  icod_ file = do
     mm <- Map.lookup file <$> asks fileMod
     case mm of
       Just m  -> icode m
@@ -377,19 +482,19 @@ instance EmbPrj AbsolutePath where
       Right f  -> return f
 
 instance EmbPrj Position where
-  icode (P.Pn file pos line col) = icode4' file pos line col
+  icod_ (P.Pn file pos line col) = icode4' file pos line col
   value = vcase valu
     where
     valu [f, p, l, c] = valu4 P.Pn f p l c
     valu _            = malformed
 
 instance EmbPrj TopLevelModuleName where
-  icode (TopLevelModuleName a) = icode1' a
+  icod_ (TopLevelModuleName a) = icode1' a
   value = vcase valu where valu [a] = valu1 TopLevelModuleName a
                            valu _   = malformed
 
 instance EmbPrj a => EmbPrj [a] where
-  icode xs = icodeN =<< mapM icode xs
+  icod_ xs = icodeN =<< mapM icode xs
   value = vcase (mapM value)
 --   icode []       = icode0'
 --   icode (x : xs) = icode2' x xs
@@ -398,63 +503,63 @@ instance EmbPrj a => EmbPrj [a] where
 --                            valu _       = malformed
 
 instance (Ord a, Ord b, EmbPrj a, EmbPrj b) => EmbPrj (BiMap a b) where
-  icode m = icode (BiMap.toList m)
+  icod_ m = icode (BiMap.toList m)
   value m = BiMap.fromList <$> value m
 
 instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Map a b) where
-  icode m = icode (Map.toList m)
+  icod_ m = icode (Map.toList m)
   value m = Map.fromList `fmap` value m
 
 instance (Ord a, EmbPrj a) => EmbPrj (Set a) where
-  icode s = icode (Set.toList s)
+  icod_ s = icode (Set.toList s)
   value s = Set.fromList `fmap` value s
 
 instance EmbPrj P.Interval where
-  icode (P.Interval p q) = icode2' p q
+  icod_ (P.Interval p q) = icode2' p q
   value = vcase valu where valu [p, q] = valu2 P.Interval p q
                            valu _      = malformed
 
 instance EmbPrj Range where
-  icode (P.Range is) = icode1' is
+  icod_ (P.Range is) = icode1' is
   value = vcase valu where valu [is] = valu1 P.Range is
                            valu _    = malformed
 
 instance EmbPrj HR.Range where
-  icode (HR.Range a b) = icode2' a b
+  icod_ (HR.Range a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 HR.Range a b
                            valu _      = malformed
 
 instance EmbPrj C.Name where
-  icode (C.NoName a b) = icode2 0 a b
-  icode (C.Name r xs)  = icode2' r xs
+  icod_ (C.NoName a b) = icode2 0 a b
+  icod_ (C.Name r xs)  = icode2' r xs
   value = vcase valu where valu [0, a, b] = valu2 C.NoName a b
                            valu [r, xs]   = valu2 C.Name   r xs
                            valu _         = malformed
 
 instance EmbPrj NamePart where
-  icode Hole   = icode0'
-  icode (Id a) = icode1' a
+  icod_ Hole   = icode0'
+  icod_ (Id a) = icode1' a
   value = vcase valu where valu []  = valu0 Hole
                            valu [a] = valu1 Id a
                            valu _   = malformed
 
 instance EmbPrj C.QName where
-  icode (Qual    a b) = icode2' a b
-  icode (C.QName a  ) = icode1' a
+  icod_ (Qual    a b) = icode2' a b
+  icod_ (C.QName a  ) = icode1' a
   value = vcase valu where valu [a, b] = valu2 Qual    a b
                            valu [a]    = valu1 C.QName a
                            valu _      = malformed
 
 instance EmbPrj Scope where
-  icode (Scope a b c d e) = icode5' a b c d e
+  icod_ (Scope a b c d e) = icode5' a b c d e
   value = vcase valu where valu [a, b, c, d, e] = valu5 Scope a b c d e
                            valu _               = malformed
 
 instance EmbPrj NameSpaceId where
-  icode PublicNS        = icode0'
-  icode PrivateNS       = icode0 1
-  icode ImportedNS      = icode0 2
-  icode OnlyQualifiedNS = icode0 3
+  icod_ PublicNS        = icode0'
+  icod_ PrivateNS       = icode0 1
+  icod_ ImportedNS      = icode0 2
+  icod_ OnlyQualifiedNS = icode0 3
   value = vcase valu where valu []  = valu0 PublicNS
                            valu [1] = valu0 PrivateNS
                            valu [2] = valu0 ImportedNS
@@ -462,44 +567,44 @@ instance EmbPrj NameSpaceId where
                            valu _   = malformed
 
 instance EmbPrj Access where
-  icode PrivateAccess = icode0 0
-  icode PublicAccess  = icode0'
-  icode OnlyQualified = icode0 2
+  icod_ PrivateAccess = icode0 0
+  icod_ PublicAccess  = icode0'
+  icod_ OnlyQualified = icode0 2
   value = vcase valu where valu [0] = valu0 PrivateAccess
                            valu []  = valu0 PublicAccess
                            valu [2] = valu0 OnlyQualified
                            valu _   = malformed
 
 instance EmbPrj NameSpace where
-  icode (NameSpace a b) = icode2' a b
+  icod_ (NameSpace a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 NameSpace a b
                            valu _      = malformed
 
 instance EmbPrj WhyInScope where
-  icode Defined       = icode0'
-  icode (Opened a b)  = icode2 0 a b
-  icode (Applied a b) = icode2 1 a b
+  icod_ Defined       = icode0'
+  icod_ (Opened a b)  = icode2 0 a b
+  icod_ (Applied a b) = icode2 1 a b
   value = vcase valu where valu []        = valu0 Defined
                            valu [0, a, b] = valu2 Opened a b
                            valu [1, a, b] = valu2 Applied a b
                            valu _         = malformed
 
 instance EmbPrj AbstractName where
-  icode (AbsName a b c) = icode3' a b c
+  icod_ (AbsName a b c) = icode3' a b c
   value = vcase valu where valu [a, b, c] = valu3 AbsName a b c
                            valu _         = malformed
 
 instance EmbPrj AbstractModule where
-  icode (AbsModule a b) = icode2' a b
+  icod_ (AbsModule a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 AbsModule a b
                            valu _      = malformed
 
 instance EmbPrj KindOfName where
-  icode DefName        = icode0'
-  icode ConName        = icode0 1
-  icode FldName        = icode0 2
-  icode PatternSynName = icode0 3
-  icode QuotableName   = icode0 4
+  icod_ DefName        = icode0'
+  icod_ ConName        = icode0 1
+  icod_ FldName        = icode0 2
+  icod_ PatternSynName = icode0 3
+  icod_ QuotableName   = icode0 4
   value = vcase valu where valu []  = valu0 DefName
                            valu [1] = valu0 ConName
                            valu [2] = valu0 FldName
@@ -508,85 +613,93 @@ instance EmbPrj KindOfName where
                            valu _   = malformed
 
 instance EmbPrj Agda.Syntax.Fixity.Fixity where
-  icode (LeftAssoc  a b) = icode2 0 a b
-  icode (RightAssoc a b) = icode2 1 a b
-  icode (NonAssoc   a b) = icode2' a b
+  icod_ (LeftAssoc  a b) = icode2 0 a b
+  icod_ (RightAssoc a b) = icode2 1 a b
+  icod_ (NonAssoc   a b) = icode2' a b
   value = vcase valu where valu [0, a, b] = valu2 LeftAssoc  a b
                            valu [1, a, b] = valu2 RightAssoc a b
                            valu [a, b]    = valu2 NonAssoc   a b
                            valu _         = malformed
 
 instance EmbPrj Agda.Syntax.Fixity.Fixity' where
-  icode (Fixity' a b) = icode2' a b
+  icod_ (Fixity' a b) = icode2' a b
   value = vcase valu where valu [a,b] = valu2 Fixity' a b
                            valu _ = malformed
 
 instance EmbPrj GenPart where
-    icode (BindHole a)   = icode1 0 a
-    icode (NormalHole a) = icode1 1 a
-    icode (IdPart a)     = icode1' a
-    value = vcase valu where valu [0, a] = valu1 BindHole a
-                             valu [1, a] = valu1 NormalHole a
-                             valu [a]    = valu1 IdPart a
-                             valu _      = malformed
+  icod_ (BindHole a)   = icode1 0 a
+  icod_ (NormalHole a) = icode1 1 a
+  icod_ (IdPart a)     = icode1' a
+  value = vcase valu where valu [0, a] = valu1 BindHole a
+                           valu [1, a] = valu1 NormalHole a
+                           valu [a]    = valu1 IdPart a
+                           valu _      = malformed
 
 instance EmbPrj A.QName where
-  icode (A.QName a b) = icode2' a b
+  icod_ (A.QName a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 A.QName a b
                            valu _      = malformed
 
 instance EmbPrj A.AmbiguousQName where
-  icode (A.AmbQ a) = icode a
+  icod_ (A.AmbQ a) = icode a
   value n = A.AmbQ `fmap` value n
 
 instance EmbPrj A.ModuleName where
-  icode (A.MName a) = icode a
+  icod_ (A.MName a) = icode a
   value n = A.MName `fmap` value n
 
 instance EmbPrj A.Name where
-  icode (A.Name a b c d) = icode4' a b c d
+  icod_ (A.Name a b c d) = icode4' a b c d
   value = vcase valu where valu [a, b, c, d] = valu4 A.Name a b c d
                            valu _            = malformed
 
 instance (EmbPrj s, EmbPrj t) => EmbPrj (Named s t) where
-  icode (Named a b) = icode2' a b
+  icod_ (Named a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 Named a b
                            valu _      = malformed
 
 instance EmbPrj a => EmbPrj (Ranged a) where
-  icode (Ranged r x) = icode2' r x
+  icod_ (Ranged r x) = icode2' r x
   value = vcase valu where valu [r, x] = valu2 Ranged r x
                            valu _      = malformed
 
+instance EmbPrj LocalVar where
+  icod_ (LocalVar a)      = icode1' a
+  icod_ (ShadowedVar a b) = icode2' a b
+  value = vcase valu where valu [a]    = valu1 LocalVar a
+                           valu [a, b] = valu2 ShadowedVar a b
+                           valu _      = malformed
+
 -- Only used for pattern synonyms
 instance EmbPrj A.Expr where
-  icode (A.Var n)               = icode1 0 n
-  icode (A.Def n)               = icode1 1 n
-  icode (A.Con ns)              = icode1 2 ns
-  icode (A.Lit l)               = icode1 3 l
-  icode (A.QuestionMark{})      = icode0 4
-  icode (A.Underscore _)        = icode0 5
-  icode (A.App _ a b)           = icode2 6 a b
-  icode (A.WithApp _ a b)       = icode2 7 a b
-  icode (A.Lam  _ a b)          = icode2 8 a b
-  icode (A.AbsurdLam _ a)       = icode1 9 a
-  icode (A.ExtendedLam _ _ _ _) = __IMPOSSIBLE__
-  icode (A.Pi   _ a b)          = icode2 11 a b
-  icode (A.Fun  _ a b)          = icode2 12 a b
-  icode (A.Set  _ a)            = icode1 13 a
-  icode (A.Prop _)              = icode0 14
-  icode (A.Let  _ _ _)          = __IMPOSSIBLE__
-  icode (A.ETel a)              = icode1 16 a
-  icode (A.Rec  _ a)            = icode1 17 a
-  icode (A.RecUpdate _ a b)     = icode2 18 a b
-  icode (A.ScopedExpr a b)      = icode2 19 a b
-  icode (A.QuoteGoal _ a b)     = icode2 20 a b
-  icode (A.QuoteContext _ a b)  = icode2 21 a b
-  icode (A.Quote _)             = icode0 22
-  icode (A.QuoteTerm _)         = icode0 23
-  icode (A.Unquote _)           = icode0 24
-  icode (A.DontCare a)          = icode1 25 a
-  icode (A.PatternSyn a)        = icode1 26 a
+  icod_ (A.Var n)               = icode1 0 n
+  icod_ (A.Def n)               = icode1 1 n
+  icod_ (A.Con ns)              = icode1 2 ns
+  icod_ (A.Lit l)               = icode1 3 l
+  icod_ (A.QuestionMark{})      = icode0 4
+  icod_ (A.Underscore _)        = icode0 5
+  icod_ (A.App _ a b)           = icode2 6 a b
+  icod_ (A.WithApp _ a b)       = icode2 7 a b
+  icod_ (A.Lam  _ a b)          = icode2 8 a b
+  icod_ (A.AbsurdLam _ a)       = icode1 9 a
+  icod_ (A.ExtendedLam _ _ _ _) = __IMPOSSIBLE__
+  icod_ (A.Pi   _ a b)          = icode2 11 a b
+  icod_ (A.Fun  _ a b)          = icode2 12 a b
+  icod_ (A.Set  _ a)            = icode1 13 a
+  icod_ (A.Prop _)              = icode0 14
+  icod_ (A.Let  _ _ _)          = __IMPOSSIBLE__
+  icod_ (A.ETel a)              = icode1 16 a
+  icod_ (A.Rec  _ a)            = icode1 17 a
+  icod_ (A.RecUpdate _ a b)     = icode2 18 a b
+  icod_ (A.ScopedExpr a b)      = icode2 19 a b
+  icod_ (A.QuoteGoal _ a b)     = icode2 20 a b
+  icod_ (A.QuoteContext _ a b)  = icode2 21 a b
+  icod_ (A.Quote _)             = icode0 22
+  icod_ (A.QuoteTerm _)         = icode0 23
+  icod_ (A.Unquote _)           = icode0 24
+  icod_ (A.DontCare a)          = icode1 25 a
+  icod_ (A.PatternSyn a)        = icode1 26 a
+  icod_ (A.Proj a)              = icode1 27 a
 
   value = vcase valu
     where
@@ -615,21 +728,22 @@ instance EmbPrj A.Expr where
       valu [24]       = valu0 (A.Unquote i)
       valu [25, a]    = valu1 A.DontCare a
       valu [26, a]    = valu1 A.PatternSyn a
+      valu [27, a]    = valu1 A.Proj a
       valu _          = malformed
 
       i = ExprRange noRange
 
 instance EmbPrj A.Pattern where
-  icode (A.VarP a)            = icode1 0 a
-  icode (A.ConP _ a b)        = icode2 1 a b
-  icode (A.DefP _ a b)        = icode2 2 a b
-  icode (A.WildP _)           = icode0 3
-  icode (A.AsP _ a b)         = icode2 4 a b
-  icode (A.DotP _ a)          = icode1 5 a
-  icode (A.AbsurdP _)         = icode0 6
-  icode (A.LitP a)            = icode1 7 a
-  icode (A.ImplicitP _)       = icode0 8
-  icode (A.PatternSynP _ a b) = icode2 9 a b
+  icod_ (A.VarP a)            = icode1 0 a
+  icod_ (A.ConP _ a b)        = icode2 1 a b
+  icod_ (A.DefP _ a b)        = icode2 2 a b
+  icod_ (A.WildP _)           = icode0 3
+  icod_ (A.AsP _ a b)         = icode2 4 a b
+  icod_ (A.DotP _ a)          = icode1 5 a
+  icod_ (A.AbsurdP _)         = icode0 6
+  icod_ (A.LitP a)            = icode1 7 a
+  icod_ (A.ImplicitP _)       = icode0 8
+  icod_ (A.PatternSynP _ a b) = icode2 9 a b
 
   value = vcase valu
     where
@@ -648,18 +762,18 @@ instance EmbPrj A.Pattern where
      i = patNoRange
 
 instance EmbPrj A.LamBinding where
-  icode (A.DomainFree i e) = icode2 0 i e
-  icode (A.DomainFull a)   = icode1 1 a
+  icod_ (A.DomainFree i e) = icode2 0 i e
+  icod_ (A.DomainFull a)   = icode1 1 a
 
   value = vcase valu where valu [0, i, e] = valu2 A.DomainFree i e
                            valu [1, a]    = valu1 A.DomainFull a
                            valu _         = malformed
 
 instance EmbPrj A.LetBinding where
-  icode (A.LetBind _ a b c d)  = icode4 0 a b c d
-  icode (A.LetPatBind _ a b )  = icode2 1 a b
-  icode (A.LetApply _ _ _ _ _) = icode0 2
-  icode (A.LetOpen _ _)        = icode0 2
+  icod_ (A.LetBind _ a b c d)  = icode4 0 a b c d
+  icod_ (A.LetPatBind _ a b )  = icode2 1 a b
+  icod_ (A.LetApply _ _ _ _ _) = icode0 2
+  icod_ (A.LetOpen _ _)        = icode0 2
 
   value = vcase valu
     where
@@ -670,100 +784,100 @@ instance EmbPrj A.LetBinding where
       valu _               = malformed
 
 instance EmbPrj A.TypedBindings where
-  icode (A.TypedBindings a b) = icode2' a b
+  icod_ (A.TypedBindings a b) = icode2' a b
 
   value = vcase valu where valu [a, b] = valu2 A.TypedBindings a b
                            valu _      = malformed
 
 instance EmbPrj A.TypedBinding where
-  icode (A.TBind a b c) = icode3 0 a b c
-  icode (A.TLet a b)    = icode2 1 a b
+  icod_ (A.TBind a b c) = icode3 0 a b c
+  icod_ (A.TLet a b)    = icode2 1 a b
 
   value = vcase valu where valu [0, a, b, c] = valu3 A.TBind a b c
                            valu [1, a, b]    = valu2 A.TLet a b
                            valu _            = malformed
 
 instance EmbPrj c => EmbPrj (Agda.Syntax.Common.ArgInfo c) where
-  icode (ArgInfo h r cs) = icode3' h r cs
+  icod_ (ArgInfo h r cs) = icode3' h r cs
 
   value = vcase valu where valu [h, r, cs] = valu3 ArgInfo h r cs
                            valu _          = malformed
 
 instance EmbPrj NameId where
-  icode (NameId a b) = icode2' a b
+  icod_ (NameId a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 NameId a b
                            valu _      = malformed
 
 instance EmbPrj Signature where
-  icode (Sig a b) = icode2' a b
+  icod_ (Sig a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 Sig a b
                            valu _      = malformed
 
 instance (Eq k, Hashable k, EmbPrj k, EmbPrj v) => EmbPrj (HashMap k v) where
-  icode m = icode (HMap.toList m)
+  icod_ m = icode (HMap.toList m)
   value m = HMap.fromList `fmap` value m
 
 instance EmbPrj Section where
-  icode (Section a b) = icode2' a b
+  icod_ (Section a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 Section a b
                            valu _      = malformed
 
 instance EmbPrj Telescope where
-  icode EmptyTel        = icode0'
-  icode (ExtendTel a b) = icode2' a b
+  icod_ EmptyTel        = icode0'
+  icod_ (ExtendTel a b) = icode2' a b
   value = vcase valu where valu []     = valu0 EmptyTel
                            valu [a, b] = valu2 ExtendTel a b
                            valu _      = malformed
 
 instance EmbPrj Permutation where
-  icode (Perm a b) = icode2' a b
+  icod_ (Perm a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 Perm a b
                            valu _      = malformed
 
 instance EmbPrj a => EmbPrj (Drop a) where
-  icode (Drop a b) = icode2' a b
+  icod_ (Drop a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 Drop a b
                            valu _      = malformed
 
 instance EmbPrj a => EmbPrj (Elim' a) where
-  icode (Apply a) = icode1' a
-  icode (Proj  a) = icode1 0 a
+  icod_ (Apply a) = icode1' a
+  icod_ (Proj  a) = icode1 0 a
   value = vcase valu where valu [a]    = valu1 Apply a
                            valu [0, a] = valu1 Proj a
                            valu _      = malformed
 
 instance (EmbPrj a, EmbPrj c) => EmbPrj (Agda.Syntax.Common.Arg c a) where
-  icode (Arg i e) = icode2' i e
+  icod_ (Arg i e) = icode2' i e
   value = vcase valu where valu [i, e] = valu2 Arg i e
                            valu _      = malformed
 
 instance (EmbPrj a, EmbPrj c) => EmbPrj (Agda.Syntax.Common.Dom c a) where
-  icode (Dom i e) = icode2' i e
+  icod_ (Dom i e) = icode2' i e
   value = vcase valu where valu [i, e] = valu2 Dom i e
                            valu _      = malformed
 
 instance EmbPrj Agda.Syntax.Common.Induction where
-  icode Inductive   = icode0'
-  icode CoInductive = icode0 1
+  icod_ Inductive   = icode0'
+  icod_ CoInductive = icode0 1
   value = vcase valu where valu []  = valu0 Inductive
                            valu [1] = valu0 CoInductive
                            valu _   = malformed
 
 instance EmbPrj Agda.Syntax.Common.Hiding where
-  icode Hidden    = icode0 0
-  icode NotHidden = icode0'
-  icode Instance  = icode0 2
+  icod_ Hidden    = icode0 0
+  icod_ NotHidden = icode0'
+  icod_ Instance  = icode0 2
   value = vcase valu where valu [0] = valu0 Hidden
                            valu []  = valu0 NotHidden
                            valu [2] = valu0 Instance
                            valu _   = malformed
 
 instance EmbPrj Agda.Syntax.Common.Relevance where
-  icode Relevant   = icode0'
-  icode Irrelevant = icode0 1
-  icode Forced     = icode0 2
-  icode NonStrict  = icode0 3
-  icode UnusedArg  = icode0 4
+  icod_ Relevant   = icode0'
+  icod_ Irrelevant = icode0 1
+  icod_ Forced     = icode0 2
+  icod_ NonStrict  = icode0 3
+  icod_ UnusedArg  = icode0 4
   value = vcase valu where valu []  = valu0 Relevant
                            valu [1] = valu0 Irrelevant
                            valu [2] = valu0 Forced
@@ -772,42 +886,44 @@ instance EmbPrj Agda.Syntax.Common.Relevance where
                            valu _   = malformed
 
 instance EmbPrj I.ConHead where
-  icode (ConHead a b) = icode2' a b
-  value = vcase valu where valu [a, b] = valu2 ConHead a b
-                           valu _      = malformed
+  icod_ (ConHead a b c) = icode3' a b c
+  value = vcase valu where valu [a, b, c] = valu3 ConHead a b c
+                           valu _         = malformed
 
 instance EmbPrj I.Type where
-  icode (El a b) = icode2' a b
+  icod_ (El a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 El a b
                            valu _      = malformed
 
 instance (EmbPrj a) => EmbPrj (I.Abs a) where
-  icode (NoAbs a b) = icode2 0 a b
-  icode (Abs a b)   = icode2' a b
+  icod_ (NoAbs a b) = icode2 0 a b
+  icod_ (Abs a b)   = icode2' a b
   value = vcase valu where valu [a, b]    = valu2 Abs a b
                            valu [0, a, b] = valu2 NoAbs a b
                            valu _         = malformed
 
 instance EmbPrj I.Term where
-  icode (Var      a b) = icode2 0 a b
-  icode (Lam      a b) = icode2 1 a b
-  icode (Lit      a  ) = icode1 2 a
-  icode (Def      a b) = icode2 3 a b
-  icode (Con      a b) = icode2 4 a b
-  icode (Pi       a b) = icode2 5 a b
-  icode (Sort     a  ) = icode1 7 a
-  icode (MetaV    a b) = __IMPOSSIBLE__
-  icode ExtLam{}       = __IMPOSSIBLE__
-  icode (DontCare a  ) = icode1 8 a
-  icode (Level    a  ) = icode1 9 a
-  icode (Shared p)     = do
+  icod_ (Var      a b) = icode2 0 a b
+  icod_ (Lam      a b) = icode2 1 a b
+  icod_ (Lit      a  ) = icode1 2 a
+  icod_ (Def      a b) = icode2 3 a b
+  icod_ (Con      a b) = icode2 4 a b
+  icod_ (Pi       a b) = icode2 5 a b
+  icod_ (Sort     a  ) = icode1 7 a
+  icod_ (MetaV    a b) = __IMPOSSIBLE__
+  icod_ ExtLam{}       = __IMPOSSIBLE__
+  icod_ (DontCare a  ) = icode1 8 a
+  icod_ (Level    a  ) = icode1 9 a
+  icod_ (Shared p)     = do
     h  <- asks termD
     mi <- liftIO $ H.lookup h p
-    st <- asks sharingStats
+    st <- asks termC
     case mi of
-      Just i  -> liftIO $ modifyIORef st (\(a, b) -> ((,) $! a + 1) b) >> return i
+      Just i  -> liftIO $ do
+        modifyIORef' st $ over lensReuse (+ 1)
+        return i
       Nothing -> do
-        liftIO $ modifyIORef st (\(a, b) -> (,) a $! b + 1)
+        liftIO $ modifyIORef' st $ over lensFresh (+1)
         n <- icode (derefPtr p)
         liftIO $ H.insert h p n
         return n
@@ -827,42 +943,42 @@ instance EmbPrj I.Term where
       valu _         = malformed
 
 instance EmbPrj Level where
-  icode (Max a) = icode1' a
+  icod_ (Max a) = icode1' a
   value = vcase valu where valu [a] = valu1 Max a
                            valu _   = malformed
 
 instance EmbPrj PlusLevel where
-  icode (ClosedLevel a) = icode1' a
-  icode (Plus a b)      = icode2' a b
+  icod_ (ClosedLevel a) = icode1' a
+  icod_ (Plus a b)      = icode2' a b
   value = vcase valu where valu [a]    = valu1 ClosedLevel a
                            valu [a, b] = valu2 Plus a b
                            valu _      = malformed
 
 instance EmbPrj LevelAtom where
-  icode (NeutralLevel a)   = icode1' a
-  icode (UnreducedLevel a) = icode1 1 a
-  icode MetaLevel{}        = __IMPOSSIBLE__
-  icode BlockedLevel{}     = __IMPOSSIBLE__
+  icod_ (NeutralLevel a)   = icode1' a
+  icod_ (UnreducedLevel a) = icode1 1 a
+  icod_ MetaLevel{}        = __IMPOSSIBLE__
+  icod_ BlockedLevel{}     = __IMPOSSIBLE__
   value = vcase valu where valu [a]    = valu1 NeutralLevel a
                            valu [1, a] = valu1 UnreducedLevel a
                            valu _      = malformed
 
 instance EmbPrj I.Sort where
-  icode (Type  a  ) = icode1' a
-  icode Prop        = icode1 1 ()
-  icode Inf         = icode1 4 ()
-  icode (DLub a b)  = __IMPOSSIBLE__
+  icod_ (Type  a  ) = icode1' a
+  icod_ Prop        = icode1 1 ()
+  icod_ Inf         = icode1 4 ()
+  icod_ (DLub a b)  = __IMPOSSIBLE__
   value = vcase valu where valu [a]    = valu1 Type  a
                            valu [1, _] = valu0 Prop
                            valu [4, _] = valu0 Inf
                            valu _      = malformed
 
 instance EmbPrj Agda.Syntax.Literal.Literal where
-  icode (LitInt    a b) = icode2' a b
-  icode (LitFloat  a b) = icode2 1 a b
-  icode (LitString a b) = icode2 2 a b
-  icode (LitChar   a b) = icode2 3 a b
-  icode (LitQName  a b) = icode2 5 a b
+  icod_ (LitInt    a b) = icode2' a b
+  icod_ (LitFloat  a b) = icode2 1 a b
+  icod_ (LitString a b) = icode2 2 a b
+  icod_ (LitChar   a b) = icode2 3 a b
+  icod_ (LitQName  a b) = icode2 5 a b
   value = vcase valu where valu [a, b]    = valu2 LitInt    a b
                            valu [1, a, b] = valu2 LitFloat  a b
                            valu [2, a, b] = valu2 LitString a b
@@ -871,25 +987,25 @@ instance EmbPrj Agda.Syntax.Literal.Literal where
                            valu _         = malformed
 
 instance EmbPrj DisplayForm where
-  icode (Display a b c) = icode3' a b c
+  icod_ (Display a b c) = icode3' a b c
   value = vcase valu where valu [a, b, c] = valu3 Display a b c
                            valu _         = malformed
 
 instance EmbPrj a => EmbPrj (Open a) where
-  icode (OpenThing a b) = icode2' a b
+  icod_ (OpenThing a b) = icode2' a b
   value = vcase valu where valu [a, b] = valu2 OpenThing a b
                            valu _      = malformed
 
 instance EmbPrj CtxId where
-  icode (CtxId a) = icode a
+  icod_ (CtxId a) = icode a
   value n = CtxId `fmap` value n
 
 instance EmbPrj DisplayTerm where
-  icode (DTerm    a  ) = icode1' a
-  icode (DDot     a  ) = icode1 1 a
-  icode (DCon     a b) = icode2 2 a b
-  icode (DDef     a b) = icode2 3 a b
-  icode (DWithApp a b c) = icode3 4 a b c
+  icod_ (DTerm    a  ) = icode1' a
+  icod_ (DDot     a  ) = icode1 1 a
+  icod_ (DCon     a b) = icode2 2 a b
+  icod_ (DDef     a b) = icode2 3 a b
+  icod_ (DWithApp a b c) = icode3 4 a b c
   value = vcase valu where valu [a]       = valu1 DTerm a
                            valu [1, a]    = valu1 DDot a
                            valu [2, a, b] = valu2 DCon a b
@@ -898,34 +1014,34 @@ instance EmbPrj DisplayTerm where
                            valu _         = malformed
 
 instance EmbPrj MutualId where
-  icode (MutId a) = icode a
+  icod_ (MutId a) = icode a
   value n = MutId `fmap` value n
 
 instance EmbPrj Definition where
-  icode (Defn rel a b c d e f g h i j) = icode11' rel a (P.killRange b) c d e f g h i j
+  icod_ (Defn rel a b c d e f g h i j) = icode11' rel a (P.killRange b) c d e f g h i j
   value = vcase valu where valu [rel, a, b, c, d, e, f, g, h, i, j] = valu11 Defn rel a b c d e f g h i j
                            valu _                             = malformed
 
 instance EmbPrj RewriteRule where
-  icode (RewriteRule a b c d e) = icode5' a b c d e
+  icod_ (RewriteRule a b c d e) = icode5' a b c d e
   value = vcase valu where valu [a, b, c, d, e] = valu5 RewriteRule a b c d e
                            valu _               = malformed
 
 
 instance EmbPrj Projection where
-  icode (Projection a b c d e) = icode5' a b c d e
+  icod_ (Projection a b c d e) = icode5' a b c d e
   value = vcase valu where valu [a, b, c, d, e] = valu5 Projection a b c d e
                            valu _               = malformed
 
 instance EmbPrj HaskellExport where
-  icode (HsExport a b) = icode2' a b
+  icod_ (HsExport a b) = icode2' a b
   value = vcase valu where
     valu [a,b] = valu2 HsExport a b
     valu _ = malformed
 
 instance EmbPrj HaskellRepresentation where
-  icode (HsType a)   = icode1' a
-  icode (HsDefn a b) = icode2' a b
+  icod_ (HsType a)   = icode1' a
+  icod_ (HsDefn a b) = icode2' a b
 
   value = vcase valu where
     valu [a]    = valu1 HsType a
@@ -933,22 +1049,22 @@ instance EmbPrj HaskellRepresentation where
     valu _      = malformed
 
 instance EmbPrj JS.Exp where
-  icode (JS.Self)         = icode0 0
-  icode (JS.Local i)      = icode1 1 i
-  icode (JS.Global i)     = icode1 2 i
-  icode (JS.Undefined)    = icode0 3
-  icode (JS.String s)     = icode1 4 s
-  icode (JS.Char c)       = icode1 5 c
-  icode (JS.Integer n)    = icode1 6 n
-  icode (JS.Double d)     = icode1 7 d
-  icode (JS.Lambda n e)   = icode2 8 n e
-  icode (JS.Object o)     = icode1 9 o
-  icode (JS.Apply e es)   = icode2 10 e es
-  icode (JS.Lookup e l)   = icode2 11 e l
-  icode (JS.If e f g)     = icode3 12 e f g
-  icode (JS.BinOp e op f) = icode3 13 e op f
-  icode (JS.PreOp op e)   = icode2 14 op e
-  icode (JS.Const i)      = icode1 15 i
+  icod_ (JS.Self)         = icode0 0
+  icod_ (JS.Local i)      = icode1 1 i
+  icod_ (JS.Global i)     = icode1 2 i
+  icod_ (JS.Undefined)    = icode0 3
+  icod_ (JS.String s)     = icode1 4 s
+  icod_ (JS.Char c)       = icode1 5 c
+  icod_ (JS.Integer n)    = icode1 6 n
+  icod_ (JS.Double d)     = icode1 7 d
+  icod_ (JS.Lambda n e)   = icode2 8 n e
+  icod_ (JS.Object o)     = icode1 9 o
+  icod_ (JS.Apply e es)   = icode2 10 e es
+  icod_ (JS.Lookup e l)   = icode2 11 e l
+  icod_ (JS.If e f g)     = icode3 12 e f g
+  icod_ (JS.BinOp e op f) = icode3 13 e op f
+  icod_ (JS.PreOp op e)   = icode2 14 op e
+  icod_ (JS.Const i)      = icode1 15 i
   value = vcase valu where valu [0]           = valu0 JS.Self
                            valu [1,  a]       = valu1 JS.Local a
                            valu [2,  a]       = valu1 JS.Global a
@@ -968,22 +1084,22 @@ instance EmbPrj JS.Exp where
                            valu _             = malformed
 
 instance EmbPrj JS.LocalId where
-  icode (JS.LocalId l) = icode l
+  icod_ (JS.LocalId l) = icode l
   value n = JS.LocalId `fmap` value n
 
 instance EmbPrj JS.GlobalId where
-  icode (JS.GlobalId l) = icode l
+  icod_ (JS.GlobalId l) = icode l
   value n = JS.GlobalId `fmap` value n
 
 instance EmbPrj JS.MemberId where
-  icode (JS.MemberId l) = icode l
+  icod_ (JS.MemberId l) = icode l
   value n = JS.MemberId `fmap` value n
 
 instance EmbPrj Polarity where
-  icode Covariant     = icode0'
-  icode Contravariant = icode0 1
-  icode Invariant     = icode0 2
-  icode Nonvariant    = icode0 3
+  icod_ Covariant     = icode0'
+  icod_ Contravariant = icode0 1
+  icod_ Invariant     = icode0 2
+  icod_ Nonvariant    = icode0 3
 
   value = vcase valu where
     valu []  = valu0 Covariant
@@ -993,12 +1109,12 @@ instance EmbPrj Polarity where
     valu _   = malformed
 
 instance EmbPrj Occurrence where
-  icode StrictPos = icode0'
-  icode Mixed     = icode0 1
-  icode Unused    = icode0 2
-  icode GuardPos  = icode0 3
-  icode JustPos   = icode0 4
-  icode JustNeg   = icode0 5
+  icod_ StrictPos = icode0'
+  icod_ Mixed     = icode0 1
+  icod_ Unused    = icode0 2
+  icod_ GuardPos  = icode0 3
+  icod_ JustPos   = icode0 4
+  icod_ JustNeg   = icode0 5
 
   value = vcase valu where
     valu []  = valu0 StrictPos
@@ -1010,20 +1126,20 @@ instance EmbPrj Occurrence where
     valu _   = malformed
 
 instance EmbPrj CompiledRepresentation where
-  icode (CompiledRep a b c d) = icode4' a b c d
+  icod_ (CompiledRep a b c d) = icode4' a b c d
   value = vcase valu where valu [a, b, c, d] = valu4 CompiledRep a b c d
                            valu _         = malformed
 
 instance EmbPrj Defn where
-  icode Axiom                                   = icode0 0
-  icode (Function    a b c d e f g h i j k l)   = icode12 1 a b c d e f g h i j k l
-  icode (Datatype    a b c d e f g h i j)       = icode10 2 a b c d e f g h i j
-  icode (Record      a b c d e f g h i j k l)   = icode12 3 a b c d e f g h i j k l
-  icode (Constructor a b c d e)                 = icode5 4 a b c d e
-  icode (Primitive   a b c d)                   = icode4 5 a b c d
+  icod_ Axiom                                   = icode0 0
+  icod_ (Function    a b c d e f g h i j k l m) = icode13 1 a b c d e f g h i j k l m
+  icod_ (Datatype    a b c d e f g h i j)       = icode10 2 a b c d e f g h i j
+  icod_ (Record      a b c d e f g h i j k l)   = icode12 3 a b c d e f g h i j k l
+  icod_ (Constructor a b c d e)                 = icode5 4 a b c d e
+  icod_ (Primitive   a b c d)                   = icode4 5 a b c d
   value = vcase valu where
     valu [0]                                     = valu0 Axiom
-    valu [1, a, b, c, d, e, f, g, h, i, j, k, l] = valu12 Function a b c d e f g h i j k l
+    valu [1, a, b, c, d, e, f, g, h, i, j, k, l, m] = valu13 Function a b c d e f g h i j k l m
     valu [2, a, b, c, d, e, f, g, h, i, j]       = valu10 Datatype a b c d e f g h i j
     valu [3, a, b, c, d, e, f, g, h, i, j, k, l] = valu12 Record  a b c d e f g h i j k l
     valu [4, a, b, c, d, e]                      = valu5 Constructor a b c d e
@@ -1031,23 +1147,23 @@ instance EmbPrj Defn where
     valu _                                       = malformed
 
 instance EmbPrj a => EmbPrj (WithArity a) where
-  icode (WithArity a b) = icode2' a b
+  icod_ (WithArity a b) = icode2' a b
 
   value = vcase valu where
     valu [a, b] = valu2 WithArity a b
     valu _      = malformed
 
 instance EmbPrj a => EmbPrj (Case a) where
-  icode (Branches a b c) = icode3' a b c
+  icod_ (Branches a b c) = icode3' a b c
 
   value = vcase valu where
     valu [a, b, c] = valu3 Branches a b c
     valu _         = malformed
 
 instance EmbPrj CompiledClauses where
-  icode Fail       = icode0'
-  icode (Done a b) = icode2' a (P.killRange b)
-  icode (Case a b) = icode2 2 a b
+  icod_ Fail       = icode0'
+  icod_ (Done a b) = icode2' a (P.killRange b)
+  icod_ (Case a b) = icode2 2 a b
 
   value = vcase valu where
     valu []        = valu0 Fail
@@ -1056,55 +1172,55 @@ instance EmbPrj CompiledClauses where
     valu _         = malformed
 
 instance EmbPrj FunctionInverse where
-  icode NotInjective = icode0'
-  icode (Inverse a)  = icode1' a
+  icod_ NotInjective = icode0'
+  icod_ (Inverse a)  = icode1' a
   value = vcase valu where valu []  = valu0 NotInjective
                            valu [a] = valu1 Inverse a
                            valu _   = malformed
 
 instance EmbPrj TermHead where
-  icode SortHead     = icode0'
-  icode PiHead       = icode0 1
-  icode (ConsHead a) = icode1 2 a
+  icod_ SortHead     = icode0'
+  icod_ PiHead       = icode0 1
+  icod_ (ConsHead a) = icode1 2 a
   value = vcase valu where valu []     = valu0 SortHead
                            valu [1]    = valu0 PiHead
                            valu [2, a] = valu1 ConsHead a
                            valu _      = malformed
 
 instance EmbPrj Agda.Syntax.Common.IsAbstract where
-  icode AbstractDef = icode0 0
-  icode ConcreteDef = icode0'
+  icod_ AbstractDef = icode0 0
+  icod_ ConcreteDef = icode0'
   value = vcase valu where valu [0] = valu0 AbstractDef
                            valu []  = valu0 ConcreteDef
                            valu _   = malformed
 
 instance EmbPrj I.Clause where
-  icode (Clause a b c d e f) = icode6' a b c d e f
+  icod_ (Clause a b c d e f) = icode6' a b c d e f
   value = vcase valu where valu [a, b, c, d, e, f] = valu6 Clause a b c d e f
                            valu _                  = malformed
 
 instance EmbPrj I.ClauseBody where
-  icode (Body   a) = icode1 0 a
-  icode (Bind   a) = icode1' a
-  icode NoBody     = icode0'
+  icod_ (Body   a) = icode1 0 a
+  icod_ (Bind   a) = icode1' a
+  icod_ NoBody     = icode0'
   value = vcase valu where valu [0, a] = valu1 Body   a
                            valu [a]    = valu1 Bind   a
                            valu []     = valu0 NoBody
                            valu _      = malformed
 
 instance EmbPrj Delayed where
-  icode Delayed    = icode0 0
-  icode NotDelayed = icode0'
+  icod_ Delayed    = icode0 0
+  icod_ NotDelayed = icode0'
   value = vcase valu where valu [0] = valu0 Delayed
                            valu []  = valu0 NotDelayed
                            valu _   = malformed
 
 instance EmbPrj I.Pattern where
-  icode (VarP a    ) = icode1' a
-  icode (ConP a b c) = icode3' a b c
-  icode (LitP a    ) = icode1 2 a
-  icode (DotP a    ) = icode1 3 a
-  icode (ProjP a   ) = icode1 4 a
+  icod_ (VarP a    ) = icode1' a
+  icod_ (ConP a b c) = icode3' a b c
+  icod_ (LitP a    ) = icode1 2 a
+  icod_ (DotP a    ) = icode1 3 a
+  icod_ (ProjP a   ) = icode1 4 a
   value = vcase valu where valu [a]       = valu1 VarP a
                            valu [a, b, c] = valu3 ConP a b c
                            valu [2, a]    = valu1 LitP a
@@ -1113,23 +1229,23 @@ instance EmbPrj I.Pattern where
                            valu _         = malformed
 
 instance EmbPrj a => EmbPrj (Builtin a) where
-  icode (Prim    a) = icode1' a
-  icode (Builtin a) = icode1 1 a
+  icod_ (Prim    a) = icode1' a
+  icod_ (Builtin a) = icode1 1 a
   value = vcase valu where valu [a]    = valu1 Prim    a
                            valu [1, a] = valu1 Builtin a
                            valu _      = malformed
 
 instance EmbPrj HP.NameKind where
-  icode HP.Bound           = icode0'
-  icode (HP.Constructor a) = icode1 1 a
-  icode HP.Datatype        = icode0 2
-  icode HP.Field           = icode0 3
-  icode HP.Function        = icode0 4
-  icode HP.Module          = icode0 5
-  icode HP.Postulate       = icode0 6
-  icode HP.Primitive       = icode0 7
-  icode HP.Record          = icode0 8
-  icode HP.Argument        = icode0 9
+  icod_ HP.Bound           = icode0'
+  icod_ (HP.Constructor a) = icode1 1 a
+  icod_ HP.Datatype        = icode0 2
+  icod_ HP.Field           = icode0 3
+  icod_ HP.Function        = icode0 4
+  icod_ HP.Module          = icode0 5
+  icod_ HP.Postulate       = icode0 6
+  icod_ HP.Primitive       = icode0 7
+  icod_ HP.Record          = icode0 8
+  icod_ HP.Argument        = icode0 9
 
   value = vcase valu where
     valu []      = valu0 HP.Bound
@@ -1145,13 +1261,13 @@ instance EmbPrj HP.NameKind where
     valu _       = malformed
 
 instance EmbPrj HP.Aspect where
-  icode HP.Comment       = icode0 0
-  icode HP.Keyword       = icode0 1
-  icode HP.String        = icode0 2
-  icode HP.Number        = icode0 3
-  icode HP.Symbol        = icode0'
-  icode HP.PrimitiveType = icode0 5
-  icode (HP.Name mk b)   = icode2 6 mk b
+  icod_ HP.Comment       = icode0 0
+  icod_ HP.Keyword       = icode0 1
+  icod_ HP.String        = icode0 2
+  icod_ HP.Number        = icode0 3
+  icod_ HP.Symbol        = icode0'
+  icod_ HP.PrimitiveType = icode0 5
+  icod_ (HP.Name mk b)   = icode2 6 mk b
 
   value = vcase valu where
     valu [0]        = valu0 HP.Comment
@@ -1164,13 +1280,13 @@ instance EmbPrj HP.Aspect where
     valu _          = malformed
 
 instance EmbPrj HP.OtherAspect where
-  icode HP.Error              = icode0 0
-  icode HP.DottedPattern      = icode0'
-  icode HP.UnsolvedMeta       = icode0 2
-  icode HP.TerminationProblem = icode0 3
-  icode HP.IncompletePattern  = icode0 4
-  icode HP.TypeChecks         = icode0 5
-  icode HP.UnsolvedConstraint = icode0 6
+  icod_ HP.Error              = icode0 0
+  icod_ HP.DottedPattern      = icode0'
+  icod_ HP.UnsolvedMeta       = icode0 2
+  icod_ HP.TerminationProblem = icode0 3
+  icod_ HP.IncompletePattern  = icode0 4
+  icod_ HP.TypeChecks         = icode0 5
+  icod_ HP.UnsolvedConstraint = icode0 6
 
   value = vcase valu where
     valu [0] = valu0 HP.Error
@@ -1182,24 +1298,24 @@ instance EmbPrj HP.OtherAspect where
     valu [6] = valu0 HP.UnsolvedConstraint
     valu _   = malformed
 
-instance EmbPrj HP.MetaInfo where
-  icode (HP.MetaInfo a b c d) = icode4' a b c d
+instance EmbPrj HP.Aspects where
+  icod_ (HP.Aspects a b c d) = icode4' a b c d
 
   value = vcase valu where
-    valu [a, b, c, d] = valu4 HP.MetaInfo a b c d
+    valu [a, b, c, d] = valu4 HP.Aspects a b c d
     valu _            = malformed
 
 instance EmbPrj Precedence where
-  icode TopCtx                 = icode0'
-  icode FunctionSpaceDomainCtx = icode0 1
-  icode (LeftOperandCtx a)     = icode1 2 a
-  icode (RightOperandCtx a)    = icode1 3 a
-  icode FunctionCtx            = icode0 4
-  icode ArgumentCtx            = icode0 5
-  icode InsideOperandCtx       = icode0 6
-  icode WithFunCtx             = icode0 7
-  icode WithArgCtx             = icode0 8
-  icode DotPatternCtx          = icode0 9
+  icod_ TopCtx                 = icode0'
+  icod_ FunctionSpaceDomainCtx = icode0 1
+  icod_ (LeftOperandCtx a)     = icode1 2 a
+  icod_ (RightOperandCtx a)    = icode1 3 a
+  icod_ FunctionCtx            = icode0 4
+  icod_ ArgumentCtx            = icode0 5
+  icod_ InsideOperandCtx       = icode0 6
+  icod_ WithFunCtx             = icode0 7
+  icod_ WithArgCtx             = icode0 8
+  icod_ DotPatternCtx          = icode0 9
   value = vcase valu
     where
     valu []     = valu0 TopCtx
@@ -1215,19 +1331,19 @@ instance EmbPrj Precedence where
     valu _      = malformed
 
 instance EmbPrj ScopeInfo where
-  icode (ScopeInfo a b c d) = icode4' a b c d
+  icod_ (ScopeInfo a b c d) = icode4' a b c d
   value = vcase valu where valu [a, b, c, d] = valu4 ScopeInfo a b c d
                            valu _            = malformed
 
 instance EmbPrj HP.CompressedFile where
-  icode (HP.CompressedFile f) = icode1' f
+  icod_ (HP.CompressedFile f) = icode1' f
   value = vcase valu
     where
     valu [f] = valu1 HP.CompressedFile f
     valu _   = malformed
 
 instance EmbPrj Interface where
-  icode (Interface a b c d e f g h i j k) = icode11' a b c d e f g h i j k
+  icod_ (Interface a b c d e f g h i j k) = icode11' a b c d e f g h i j k
   value = vcase valu
     where
       valu [a, b, c, d, e, f, g, h, i, j, k] = valu11 Interface a b c d e f g h i j k
@@ -1235,58 +1351,145 @@ instance EmbPrj Interface where
 
 -- This is used for the Epic compiler backend
 instance EmbPrj Epic.EInterface where
-  icode (Epic.EInterface a b c d e f g h) = icode8' a b c d e f g h
+  icod_ (Epic.EInterface a b c d e f g h) = icode8' a b c d e f g h
   value = vcase valu where
     valu [a, b, c, d, e, f, g, h] = valu8 Epic.EInterface a b c d e f g h
     valu _                        = malformed
 
 instance EmbPrj Epic.InjectiveFun where
-  icode (Epic.InjectiveFun a b) = icode2' a b
+  icod_ (Epic.InjectiveFun a b) = icode2' a b
   value = vcase valu where
      valu [a,b] = valu2 Epic.InjectiveFun a b
      valu _     = malformed
 
 instance EmbPrj Epic.Relevance where
-  icode Epic.Irr      = icode0 0
-  icode Epic.Rel      = icode0 1
+  icod_ Epic.Irr      = icode0 0
+  icod_ Epic.Rel      = icode0 1
   value = vcase valu where valu [0] = valu0 Epic.Irr
                            valu [1] = valu0 Epic.Rel
                            valu _   = malformed
 
 instance EmbPrj Epic.Forced where
-  icode Epic.Forced    = icode0 0
-  icode Epic.NotForced = icode0 1
+  icod_ Epic.Forced    = icode0 0
+  icod_ Epic.NotForced = icode0 1
   value = vcase valu where valu [0] = valu0 Epic.Forced
                            valu [1] = valu0 Epic.NotForced
                            valu _   = malformed
 
 instance EmbPrj Epic.Tag where
-  icode (Epic.Tag a)     = icode1 0 a
-  icode (Epic.PrimTag a) = icode1 1 a
+  icod_ (Epic.Tag a)     = icode1 0 a
+  icod_ (Epic.PrimTag a) = icode1 1 a
   value = vcase valu
     where
     valu [0, a] = valu1 Epic.Tag a
     valu [1, a] = valu1 Epic.PrimTag a
     valu _      = malformed
 
-icodeX :: (Eq k, Hashable k) =>
-          (Dict -> HashTable k Int32) -> (Dict -> IORef Int32) ->
-          k -> S Int32
+-- Specializing icodeX leads to Warning like
+-- src/full/Agda/TypeChecking/Serialise.hs:1297:1: Warning:
+--     RULE left-hand side too complicated to desugar
+--       case cobox_aQY5 of _ [Occ=Dead] { ghc-prim:GHC.Types.Eq# cobox ->
+--       icodeX @ String $dEq_aQY3 $dHashable_aQY4
+--       }
+--
+-- type ICodeX k
+--   =  (Dict -> HashTable k Int32)
+--   -> (Dict -> IORef Int32)
+--   -> k -> S Int32
+-- {-# SPECIALIZE icodeX :: ICodeX String  #-}
+-- {-# SPECIALIZE icodeX :: ICodeX Integer #-}
+-- {-# SPECIALIZE icodeX :: ICodeX Double  #-}
+-- {-# SPECIALIZE icodeX :: ICodeX Node    #-}
+
+-- Andreas, 2014-10-16 AIM XX:
+-- Inlining this increases Serialization time by 10%
+-- Makoto's theory: code size increase might lead to
+-- instruction cache misses.
+-- {-# INLINE icodeX #-}
+icodeX :: (Eq k, Hashable k)
+  =>  (Dict -> HashTable k Int32)
+  -> (Dict -> IORef FreshAndReuse)
+  -> k -> S Int32
 icodeX dict counter key = do
   d <- asks dict
   c <- asks counter
   liftIO $ do
   mi    <- H.lookup d key
   case mi of
-    Just i  -> return i
+    Just i  -> do
+      modifyIORef' c $ over lensReuse (+1)
+      return i
+    Nothing -> do
+      fresh <- (^.lensFresh) <$> do readModifyIORef' c $ over lensFresh (+1)
+      H.insert d key fresh
+      return fresh
+
+-- Instead of inlining icodeX, we manually specialize it to
+-- its four uses: Integer, String, Double, Node.
+-- Not a great gain (hardly noticeable), but not harmful.
+
+icodeInteger :: Integer -> S Int32
+icodeInteger key = do
+  d <- asks integerD
+  c <- asks integerC
+  liftIO $ do
+  mi <- H.lookup d key
+  case mi of
+    Just i  -> do
+      modifyIORef' c $ over lensReuse (+1)
+      return i
+    Nothing -> do
+      fresh <- (^.lensFresh) <$> do readModifyIORef' c $ over lensFresh (+1)
+      H.insert d key fresh
+      return fresh
+
+icodeDouble :: Double -> S Int32
+icodeDouble key = do
+  d <- asks doubleD
+  c <- asks doubleC
+  liftIO $ do
+  mi <- H.lookup d key
+  case mi of
+    Just i  -> do
+      modifyIORef' c $ over lensReuse (+1)
+      return i
+    Nothing -> do
+      fresh <- (^.lensFresh) <$> do readModifyIORef' c $ over lensFresh (+1)
+      H.insert d key fresh
+      return fresh
+
+icodeString :: String -> S Int32
+icodeString key = do
+  d <- asks stringD
+  c <- asks stringC
+  liftIO $ do
+  mi <- H.lookup d key
+  case mi of
+    Just i  -> do
+      modifyIORef' c $ over lensReuse (+1)
+      return i
+    Nothing -> do
+      fresh <- (^.lensFresh) <$> do readModifyIORef' c $ over lensFresh (+1)
+      H.insert d key fresh
+      return fresh
+
+icodeN :: Node -> S Int32
+icodeN key = do
+  d <- asks nodeD
+  c <- asks nodeC
+  liftIO $ do
+  mi <- H.lookup d key
+  case mi of
+    Just i  -> do
+      modifyIORef' c $ over lensReuse (+1)
+      return i
     Nothing -> do
-      fresh <- readIORef c
+      fresh <- (^.lensFresh) <$> do readModifyIORef' c $ over lensFresh (+1)
       H.insert d key fresh
-      writeIORef c $! fresh + 1
       return fresh
 
-icodeN :: [Int32] -> S Int32
-icodeN = icodeX nodeD nodeC
+-- icodeN :: [Int32] -> S Int32
+-- icodeN = icodeX nodeD nodeC
 
 {-# INLINE vcase #-}
 -- | @vcase value ix@ decodes thing represented by @ix :: Int32@
@@ -1310,6 +1513,91 @@ vcase valu = \ix -> do
           liftIO $ H.insert memo (ix, aTyp) (U v)
           return v
 
+-- Andreas, Makoto, AIM XX (2014-10-15):
+-- No performance gain for INLINE here (neutral / slighly negative).
+--
+-- {-# INLINE icode0 #-}
+-- {-# INLINE icode1 #-}
+-- {-# INLINE icode2 #-}
+-- {-# INLINE icode3 #-}
+-- {-# INLINE icode4 #-}
+-- {-# INLINE icode5 #-}
+-- {-# INLINE icode6 #-}
+-- {-# INLINE icode7 #-}
+-- {-# INLINE icode8 #-}
+-- {-# INLINE icode9 #-}
+-- {-# INLINE icode10 #-}
+-- {-# INLINE icode11 #-}
+-- {-# INLINE icode12 #-}
+-- {-# INLINE icode13 #-}
+-- {-# INLINE icode14 #-}
+
+icode0 :: Int32 -> S Int32
+
+icode1 :: EmbPrj a => Int32 -> a -> S Int32
+
+icode2 :: (EmbPrj a, EmbPrj b) =>
+          Int32 -> a -> b ->
+          S Int32
+
+icode3 :: (EmbPrj a, EmbPrj b, EmbPrj c) =>
+          Int32 -> a -> b -> c ->
+          S Int32
+
+icode4 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) =>
+          Int32 -> a -> b -> c -> d ->
+          S Int32
+
+icode5 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) =>
+          Int32 -> a -> b -> c -> d -> e ->
+          S Int32
+
+icode6 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) =>
+          Int32 -> a -> b -> c -> d -> e -> f ->
+          S Int32
+
+icode7 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g ) =>
+          Int32 -> a -> b -> c -> d -> e -> f -> g ->
+          S Int32
+
+icode8 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h ) =>
+          Int32 -> a -> b -> c -> d -> e -> f -> g -> h ->
+          S Int32
+
+icode9 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i ) =>
+          Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i ->
+          S Int32
+
+icode10 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j ) =>
+           Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j ->
+           S Int32
+
+icode11 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k ) =>
+           Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k ->
+           S Int32
+
+icode12 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l ) =>
+           Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l ->
+           S Int32
+
+icode13 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+           , EmbPrj m ) =>
+           Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m ->
+           S Int32
+
+icode14 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+           , EmbPrj m, EmbPrj n ) =>
+           Int32 -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n ->
+           S Int32
+
 icode0  tag                       = icodeN [tag]
 icode1  tag a                     = icodeN . (tag :) =<< sequence [icode a]
 icode2  tag a b                   = icodeN . (tag :) =<< sequence [icode a, icode b]
@@ -1326,6 +1614,92 @@ icode12 tag a b c d e f g h i j k l = icodeN . (tag :) =<< sequence [icode a, ic
 icode13 tag a b c d e f g h i j k l m = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j, icode k, icode l, icode m]
 icode14 tag a b c d e f g h i j k l m n = icodeN . (tag :) =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j, icode k, icode l, icode m, icode n]
 
+
+-- Andreas, Makoto, AIM XX (2014-10-15):
+-- No performance gain for INLINE here (neutral / slighly negative).
+--
+-- {-# INLINE icode0' #-}
+-- {-# INLINE icode1' #-}
+-- {-# INLINE icode2' #-}
+-- {-# INLINE icode3' #-}
+-- {-# INLINE icode4' #-}
+-- {-# INLINE icode5' #-}
+-- {-# INLINE icode6' #-}
+-- {-# INLINE icode7' #-}
+-- {-# INLINE icode8' #-}
+-- {-# INLINE icode9' #-}
+-- {-# INLINE icode10' #-}
+-- {-# INLINE icode11' #-}
+-- {-# INLINE icode12' #-}
+-- {-# INLINE icode13' #-}
+-- {-# INLINE icode14' #-}
+
+icode0' :: S Int32
+
+icode1' :: EmbPrj a => a -> S Int32
+
+icode2' :: (EmbPrj a, EmbPrj b) =>
+           a -> b ->
+           S Int32
+
+icode3' :: (EmbPrj a, EmbPrj b, EmbPrj c) =>
+           a -> b -> c ->
+           S Int32
+
+icode4' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) =>
+           a -> b -> c -> d ->
+           S Int32
+
+icode5' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) =>
+           a -> b -> c -> d -> e ->
+           S Int32
+
+icode6' :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) =>
+           a -> b -> c -> d -> e -> f ->
+           S Int32
+
+icode7' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g ) =>
+           a -> b -> c -> d -> e -> f -> g ->
+           S Int32
+
+icode8' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h ) =>
+           a -> b -> c -> d -> e -> f -> g -> h ->
+           S Int32
+
+icode9' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+           , EmbPrj g, EmbPrj h, EmbPrj i ) =>
+           a -> b -> c -> d -> e -> f -> g -> h -> i ->
+           S Int32
+
+icode10' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+            , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j ) =>
+            a -> b -> c -> d -> e -> f -> g -> h -> i -> j ->
+            S Int32
+
+icode11' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+            , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k ) =>
+            a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k ->
+            S Int32
+
+icode12' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+            , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l ) =>
+            a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l ->
+            S Int32
+
+icode13' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+            , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+            , EmbPrj m ) =>
+            a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m ->
+            S Int32
+
+icode14' :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+            , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+            , EmbPrj m, EmbPrj n ) =>
+            a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n ->
+            S Int32
+
 icode0'                        = icodeN []
 icode1'  a                     = icodeN =<< sequence [icode a]
 icode2'  a b                   = icodeN =<< sequence [icode a, icode b]
@@ -1342,6 +1716,85 @@ icode12' a b c d e f g h i j k l = icodeN =<< sequence [icode a, icode b, icode
 icode13' a b c d e f g h i j k l m = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j, icode k, icode l, icode m]
 icode14' a b c d e f g h i j k l m n = icodeN =<< sequence [icode a, icode b, icode c, icode d, icode e, icode f, icode g, icode h, icode i, icode j, icode k, icode l, icode m, icode n]
 
+valu0 :: a -> R a
+
+valu1 :: EmbPrj a => (a -> b) -> Int32 -> R b
+
+valu2 :: (EmbPrj a, EmbPrj b) =>
+         (a -> b -> c) ->
+         Int32 -> Int32 ->
+         R c
+
+valu3 :: (EmbPrj a, EmbPrj b, EmbPrj c) =>
+         (a -> b -> c -> d) ->
+         Int32 -> Int32 -> Int32 ->
+         R d
+
+valu4 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d) =>
+         (a -> b -> c -> d -> e) ->
+         Int32 -> Int32 -> Int32 -> Int32 ->
+         R e
+
+valu5 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e) =>
+         (a -> b -> c -> d -> e -> f) ->
+         Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R f
+
+valu6 :: (EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f) =>
+         (a -> b -> c -> d -> e -> f -> g) ->
+         Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R g
+
+valu7 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+         , EmbPrj g ) =>
+         (a -> b -> c -> d -> e -> f -> g -> h) ->
+         Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R h
+
+valu8 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+         , EmbPrj g, EmbPrj h ) =>
+         (a -> b -> c -> d -> e -> f -> g -> h -> i) ->
+         Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R i
+
+valu9 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+         , EmbPrj g, EmbPrj h, EmbPrj i ) =>
+         (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) ->
+         Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R j
+
+valu10 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j ) =>
+          (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) ->
+          Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+          R k
+
+valu11 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k ) =>
+          (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l) ->
+          Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+         R l
+
+valu12 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l ) =>
+          (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m) ->
+          Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+          R m
+
+valu13 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+          , EmbPrj m ) =>
+          (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n) ->
+          Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+          R n
+
+valu14 :: ( EmbPrj a, EmbPrj b, EmbPrj c, EmbPrj d, EmbPrj e, EmbPrj f
+          , EmbPrj g, EmbPrj h, EmbPrj i, EmbPrj j, EmbPrj k, EmbPrj l
+          , EmbPrj m, EmbPrj n ) =>
+          (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> n -> o) ->
+          Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 ->
+          R o
+
 valu0  z                           = return z
 valu1  z a                         = valu0 z                        `ap` value a
 valu2  z a b                       = valu1 z a                      `ap` value b
@@ -1357,23 +1810,3 @@ valu11 z a b c d e f g h i j k     = valu10 z a b c d e f g h i j   `ap` value k
 valu12 z a b c d e f g h i j k l   = valu11 z a b c d e f g h i j k `ap` value l
 valu13 z a b c d e f g h i j k l m = valu12 z a b c d e f g h i j k l `ap` value m
 valu14 z a b c d e f g h i j k l m n = valu13 z a b c d e f g h i j k l m `ap` value n
-
--- | Creates an empty dictionary.
-
-emptyDict :: SourceToModule
-             -- ^ Maps file names to the corresponding module names.
-             -- Must contain a mapping for every file name that is
-             -- later encountered.
-          -> IO Dict
-emptyDict fileMod = Dict
-  <$> H.new
-  <*> H.new
-  <*> H.new
-  <*> H.new
-  <*> H.new
-  <*> newIORef 0
-  <*> newIORef 0
-  <*> newIORef 0
-  <*> newIORef 0
-  <*> newIORef (0, 0)
-  <*> return fileMod
diff --git a/src/full/Agda/TypeChecking/SizedTypes.hs b/src/full/Agda/TypeChecking/SizedTypes.hs
index 8400367..a1be345 100644
--- a/src/full/Agda/TypeChecking/SizedTypes.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes.hs
@@ -1,10 +1,8 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 module Agda.TypeChecking.SizedTypes where
 
-import Control.Monad.Error
-
 import Data.Function
 import Data.List
 import qualified Data.Map as Map
@@ -24,14 +22,16 @@ import Agda.TypeChecking.Telescope
 import {-# SOURCE #-} Agda.TypeChecking.Conversion
 import {-# SOURCE #-} Agda.TypeChecking.Constraints
 
-import qualified Agda.Utils.Warshall as W
+import Agda.Utils.Except ( MonadError(catchError, throwError) )
 import Agda.Utils.List
 import Agda.Utils.Maybe
 import Agda.Utils.Monad
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+import qualified Agda.Utils.Warshall as W
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -358,7 +358,7 @@ computeSizeConstraint c =
         (b, m) <- sizeExpr v
         return $ Just $ Leq a (m - n) b
       `catchError` \ err -> case err of
-        PatternErr _ -> return Nothing
+        PatternErr{} -> return Nothing
         _            -> throwError err
     _ -> __IMPOSSIBLE__
 
@@ -506,10 +506,9 @@ oldSolver metas cs = do
                 term (W.SizeVar j n) | j < ar = plus (var $ ar - j - 1) n
                 term _                        = __IMPOSSIBLE__
 
-                lam _ v = Lam defaultArgInfo $ Abs "s" v -- hiding does not matter
-
-                -- convert size expression to term and abstract
-                v = flip (foldr lam) [0..ar-1] $ term e
+                tel = replicate ar $ defaultArg "s"
+                -- convert size expression to term
+                v = term e
 
             reportSDoc "tc.size.solve" 20 $ sep
               [ text (show m) <+> text ":="
@@ -520,7 +519,7 @@ oldSolver metas cs = do
             let isInf (W.SizeConst W.Infinite) = True
                 isInf _                        = False
             unlessM ((isJust <$> isInteractionMeta m) `and2M` return (isInf e)) $
-              assignTerm m v
+              assignTerm m tel v
 
       mapM_ inst $ Map.toList sol
       return True
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Solve.hs b/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
index a622848..1db4933 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Solve.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE PatternGuards         #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
 
 -- | Solving size constraints under hypotheses.
 --
@@ -56,8 +56,7 @@
 
 module Agda.TypeChecking.SizedTypes.Solve where
 
-import Control.Monad.Error
-
+import Control.Monad ( forM )
 import Data.Foldable (Foldable, foldMap)
 import Data.Function
 import Data.List
@@ -90,6 +89,7 @@ import Agda.TypeChecking.SizedTypes.Utils
 import Agda.TypeChecking.SizedTypes.WarshallSolver as Size
 
 import Agda.Utils.Cluster
+import Agda.Utils.Except ( MonadError(catchError) )
 import Agda.Utils.Function
 import Agda.Utils.Functor
 import Agda.Utils.List
@@ -98,7 +98,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Solve size constraints involving hypotheses.
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs b/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
index a5e3b9e..37ca8a7 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveFoldable            #-}
+{-# LANGUAGE DeriveFunctor             #-}
+{-# LANGUAGE DeriveTraversable         #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE FunctionalDependencies    #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeSynonymInstances      #-}
+{-# LANGUAGE UndecidableInstances      #-}
 
 -- | Syntax of size expressions and constraints.
 
@@ -106,7 +106,7 @@ getPolarity pols x = Map.findWithDefault Least x pols
 -- | Partial substitution from flexible variables to size expression.
 type Solution rigid flex = Map flex (SizeExpr' rigid flex)
 
-emptySolution = Map.empty
+-- emptySolution = Map.empty
 
 -- | Executing a substitution.
 class Substitute r f a where
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Tests.hs b/src/full/Agda/TypeChecking/SizedTypes/Tests.hs
index b44deed..3c171c7 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Tests.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Tests.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Agda.TypeChecking.SizedTypes.Tests where
@@ -45,16 +43,20 @@ instance AsWeightRelation Label where
   eval (Label cmp w) x y = eval cmp x (y `plus` w)
   eval LInf          _ _ = True
 
-prop_MeetSound (l :: Label) l' x y =
+prop_MeetSound :: Label -> Label -> Weight -> Weight -> Property
+prop_MeetSound l l' x y =
   eval l x y && eval l' x y ==> eval (meet l l') x y
 
-prop_MeetComplete (l :: Label) l' x y =
+prop_MeetComplete :: Label -> Label -> Weight -> Weight -> Property
+prop_MeetComplete l l' x y =
   eval (meet l l') x y ==> eval l x y && eval l' x y
 
-prop_ComposeSound (l1 :: Label) l2 x y z =
+prop_ComposeSound :: Label -> Label -> Weight -> Weight -> Weight -> Property
+prop_ComposeSound l1 l2 x y z =
   eval l1 x y && eval l2 y z ==> eval (compose l1 l2) x z
 
-prop_ComposeComplete (l1 :: Label) l2 k z = let x = Offset k in
+prop_ComposeComplete :: Label -> Label -> Int -> Weight -> Property
+prop_ComposeComplete l1 l2 k z = let x = Offset k in
   eval (compose l1 l2) x z ==>
     let y = z + toWeight l2
     in  eval l1 x y -- && eval l2 y z -- does not hold for l2 = \infty
@@ -70,39 +72,83 @@ prop_ComposeComplete (l1 :: Label) l2 k z = let x = Offset k in
 
 -- * Generic properties
 
-propCommutative o x y   = x `o` y == y `o` x
+propCommutative :: Eq b => (a -> a -> b) -> a -> a -> Bool
+propCommutative o x y = x `o` y == y `o` x
+
+propAssociative :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool
 propAssociative o x y z = x `o` (y `o` z) == (x `o` y) `o` z
-propIdempotent  o x     = (x `o` x) == x
-propUnit        o u x   = u `o` x == x && x `o` u == x
-propZero        o z x   = z `o` x == z && x `o` z == z
-propDistL       o p x y z = x `o` (y `p` z) == (x `o` y) `p` (x `o` z)
-propDistR       o p x y z = (x `p` y) `o` z == (x `o` z) `p` (y `o` z)
+
+propIdempotent :: Eq a => (a -> a -> a) -> a -> Bool
+propIdempotent o x = (x `o` x) == x
+
+propUnit :: Eq a => (a -> a -> a) -> a -> a -> Bool
+propUnit o u x = u `o` x == x && x `o` u == x
+
+propZero :: Eq a => (a -> a -> a) -> a -> a -> Bool
+propZero o z x = z `o` x == z && x `o` z == z
+
+propDistL :: Eq b => (a -> b -> b) -> (b -> b -> b) -> a -> b -> b -> Bool
+propDistL o p x y z = x `o` (y `p` z) == (x `o` y) `p` (x `o` z)
+
+propDistR :: Eq a => (a -> b -> a) -> (a -> a -> a) -> a -> a -> b -> Bool
+propDistR o p x y z = (x `p` y) `o` z == (x `o` z) `p` (y `o` z)
+
+propDistributive :: Eq a =>
+                    (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool
 propDistributive o p x y z = propDistL o p x y z && propDistR o p x y z
 
-propSemiLattice o x y z = propCommutative o x y && propAssociative o x y z && propIdempotent o x
+propSemiLattice :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool
+propSemiLattice o x y z =
+  propCommutative o x y && propAssociative o x y z && propIdempotent o x
+
+propBoundedSemiLattice :: Eq a => (a -> a -> a) -> a -> a -> a -> a -> Bool
 propBoundedSemiLattice o u x y z = propSemiLattice o x y z && propUnit o u x
-propMonoid o u x y z    = propAssociative o x y z && propUnit o u x
+
+propMonoid :: Eq a => (a -> a -> a) -> a -> a -> a -> a -> Bool
+propMonoid o u x y z = propAssociative o x y z && propUnit o u x
+
+propDioid :: Eq a =>
+             (a -> a -> a) -> a -> (a -> a -> a) -> a -> a -> a -> a -> Bool
 propDioid p n o u x y z = propBoundedSemiLattice p n x y z
                        && propMonoid o u x y z
                        && propDistributive o p x y z
                        && propZero o n x
 
 -- | Properties of 'Dioid' class.
+propDioid_Gen :: Dioid a => a -> a -> a -> Bool
 propDioid_Gen = propDioid meet top compose unitCompose
 
 -- | @Weight@ instance.
-prop_Dioid_Weight x y z = propDioid_Gen (x :: Weight) y z
+prop_Dioid_Weight :: Weight -> Weight -> Weight -> Bool
+prop_Dioid_Weight x y z = propDioid_Gen x y z
 
 -- | @Label@ instance.
-prop_SemiLattice_Label x y z = propSemiLattice meet (x :: Label) y z
-prop_Unit_Label x  = propUnit meet top (x :: Label)
-prop_BoundedSemiLattice_Label x y z = propBoundedSemiLattice meet top (x :: Label) y z
-prop_Monoid_Label x y z = propMonoid compose unitCompose (x :: Label) y z
-prop_DistL_Label x y z = propDistL compose meet (x :: Label) y z
-prop_DistR_Label x y z = propDistR compose meet (x :: Label) y z
-prop_Dist_Label x y z = propDistributive compose meet (x :: Label) y z
-prop_Zero_Label x     = propZero compose top (x :: Label)
-prop_Dioid_Label x y z = propDioid_Gen (x :: Label) y z
+prop_SemiLattice_Label :: Label -> Label -> Label -> Bool
+prop_SemiLattice_Label x y z = propSemiLattice meet x y z
+
+prop_Unit_Label :: Label -> Bool
+prop_Unit_Label x = propUnit meet top x
+
+prop_BoundedSemiLattice_Label :: Label -> Label -> Label -> Bool
+prop_BoundedSemiLattice_Label x y z = propBoundedSemiLattice meet top x y z
+
+prop_Monoid_Label :: Label -> Label -> Label -> Bool
+prop_Monoid_Label x y z = propMonoid compose unitCompose x y z
+
+prop_DistL_Label :: Label -> Label -> Label -> Bool
+prop_DistL_Label x y z = propDistL compose meet x y z
+
+prop_DistR_Label :: Label -> Label -> Label -> Bool
+prop_DistR_Label x y z = propDistR compose meet x y z
+
+prop_Dist_Label :: Label -> Label -> Label -> Bool
+prop_Dist_Label x y z = propDistributive compose meet x y z
+
+prop_Zero_Label :: Label -> Bool
+prop_Zero_Label x = propZero compose top x
+
+prop_Dioid_Label :: Label -> Label -> Label -> Bool
+prop_Dioid_Label x y z = propDioid_Gen x y z
 
 ------------------------------------------------------------------------
 -- * All tests
diff --git a/src/full/Agda/TypeChecking/SizedTypes/Utils.hs b/src/full/Agda/TypeChecking/SizedTypes/Utils.hs
index ed188da..e030d3e 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/Utils.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/Utils.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE NoMonomorphismRestriction,
-   MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Agda.TypeChecking.SizedTypes.Utils where
 
@@ -8,11 +7,14 @@ import Data.Functor
 import qualified Debug.Trace as Debug
 import Agda.Utils.Function
 
+debug :: Bool
 debug = False
+
+trace :: String -> a -> a
 trace  s = applyWhen debug $ Debug.trace s
-traceM s = trace s $ pure ()
 
-($>) = flip (<$)
+traceM :: Applicative f => String -> f ()
+traceM s = trace s $ pure ()
 
 class Eq a => Top a where
   top   :: a
diff --git a/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs b/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
index 3f1f09e..5934a83 100644
--- a/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
+++ b/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE PatternGuards             #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TupleSections             #-}
+{-# LANGUAGE TypeSynonymInstances      #-}
 
 module Agda.TypeChecking.SizedTypes.WarshallSolver where
 
@@ -32,7 +32,7 @@ import Agda.Utils.Graph.AdjacencyMap.Unidirectional
 -- (Edge'(..), allNodes, emptyGraph, insertEdge, graphToList, graphFromList, nodes, lookupEdge, outgoing, incoming, diagonal, transClos)
 import qualified Agda.Utils.Graph.AdjacencyMap.Unidirectional as Graph
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 type Graph r f a = Graph.Graph (Node r f) (Node r f) a
@@ -41,13 +41,23 @@ type Key r f = Edge' r f ()
 type Nodes r f = Graph.Nodes (Node r f)
 type LabelledEdge r f = Edge' r f Label
 
-src  = Graph.source
+src :: Edge s t e -> s
+src = Graph.source
+
+dest :: Edge s t e -> t
 dest = Graph.target
 
+lookupEdge :: (Ord s, Ord t) => Graph.Graph s t e -> s -> t -> Maybe e
 lookupEdge g s t = Graph.lookup s t g
+
+graphToList :: (Ord s, Ord t) => Graph.Graph s t e -> [Edge s t e]
 graphToList = Graph.toList
+
+graphFromList :: (Ord s, Ord t) => [Edge s t e] -> Graph.Graph s t e
 graphFromList = Graph.fromList
 
+insertEdge :: (Ord s, Ord t, MeetSemiLattice e, Top e) =>
+              Edge s t e -> Graph.Graph s t e -> Graph.Graph s t e
 insertEdge e g
   | isTop (label e) = g
   | otherwise       = Graph.insertEdgeWith meet e g
@@ -291,6 +301,7 @@ instance (Show r, Show f, Show a, Ord r, Ord f, Dioid a) => Dioid (Edge' r f a)
 -- | A graph forest.
 type Graphs r f a = [Graph r f a]
 
+emptyGraphs :: Graphs r f a
 emptyGraphs = []
 
 -- | Split a list of graphs @gs@ into those that mention node @n@ and those that do not.
@@ -547,6 +558,7 @@ instance Plus (SizeExpr' r f) Label (SizeExpr' r f) where
 -- | Lower or upper bound for a flexible variable
 type Bound r f = Map f (Set (SizeExpr' r f))
 
+emptyBound :: Bound r f
 emptyBound = Map.empty
 
 data Bounds r f = Bounds
@@ -636,10 +648,11 @@ largest hg ns
      Return these edges as a map from target notes to a list of edges.
      We assume the graph is reflexive-transitive.
  -}
-commonSuccs :: (Ord r, Ord f, Dioid a) => Graph r f a -> [Node r f] -> Map (Node r f) [Edge' r f a]
-commonSuccs hg srcs = intersectAll $  map (buildmap . outgoing hg) srcs
+commonSuccs :: (Ord r, Ord f, Dioid a) =>
+               Graph r f a -> [Node r f] -> Map (Node r f) [Edge' r f a]
+commonSuccs hg srcs = intersectAll $ map (buildmap . outgoing hg) srcs
   where
-   buildmap = Map.fromList . map (\ e -> (dest e, [e]))
+   buildmap            = Map.fromList . map (\ e -> (dest e, [e]))
    intersectAll []     = Map.empty
    intersectAll (m:ms) = foldl (Map.intersectionWith (++)) m ms
 
@@ -656,7 +669,8 @@ commonPreds hg tgts = intersectAll $  map (buildmap . incoming hg) tgts
    intersectAll (m:ms) = foldl (Map.intersectionWith (++)) m ms
 
 -- | Compute the sup of two different rigids or a rigid and a constant.
-lub' :: forall r f . (Ord r, Ord f, Show r, Show f) => HypGraph r f -> (Node r f, Offset) -> (Node r f, Offset) -> Maybe (SizeExpr' r f)
+lub' :: forall r f . (Ord r, Ord f, Show r, Show f) =>
+        HypGraph r f -> (Node r f, Offset) -> (Node r f, Offset) -> Maybe (SizeExpr' r f)
 lub' hg (node1, n) (node2, m) = do
   let sucs     = commonSuccs hg [node1, node2]
       sucNodes = smallest hg $ Map.keys sucs
@@ -884,6 +898,7 @@ verifySolution hg cs sol = do
 
 -- * Tests
 
+testSuccs :: Ord f => Map (Node [Char] f) [Edge' [Char] f Label]
 testSuccs = commonSuccs hg [n1,n2]
   where
     n1 = NodeRigid "i"
@@ -899,7 +914,9 @@ testSuccs = commonSuccs hg [n1,n2]
          , Graph.Edge n2 n4 $ Label Le 5
          , Graph.Edge n2 n5 $ Label Le 6
          ]
+
 -- testLub = smallest hg $ Map.keys $ commonSuccs hg [n1,n2] --
+testLub :: (Show f, Ord f) => Maybe (SizeExpr' [Char] f)
 testLub = lub hg (Rigid "i" 0) (Rigid "j" 2)
   where
     n1 = NodeRigid "i"
diff --git a/src/full/Agda/TypeChecking/Substitute.hs b/src/full/Agda/TypeChecking/Substitute.hs
index a199ec3..4ac769a 100644
--- a/src/full/Agda/TypeChecking/Substitute.hs
+++ b/src/full/Agda/TypeChecking/Substitute.hs
@@ -1,16 +1,19 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE DeriveDataTypeable   #-}
+{-# LANGUAGE DeriveFunctor        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
 {-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE StandaloneDeriving   #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module Agda.TypeChecking.Substitute where
+module Agda.TypeChecking.Substitute
+  ( module Agda.TypeChecking.Substitute
+  , Substitution(..)
+  ) where
 
-import Control.Arrow ((***))
+import Control.Arrow ((***), first, second)
 
 import Data.Function
 import Data.Functor
@@ -30,13 +33,15 @@ import Agda.TypeChecking.Monad.Base as Base
 import Agda.TypeChecking.Free as Free
 import Agda.TypeChecking.CompiledClause
 
+import Agda.Utils.Empty
+import Agda.Utils.Functor
 import Agda.Utils.List
 import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ---------------------------------------------------------------------------
@@ -62,7 +67,7 @@ instance Apply Term where
       Con c args  -> conApp c args es
       Lam _ b     ->
         case es of
-          Apply a : es0 -> absApp b (unArg a) `applyE` es0
+          Apply a : es0 -> lazyAbsApp b (unArg a) `applyE` es0
           _             -> __IMPOSSIBLE__
       MetaV x es' -> MetaV x (es' ++ es)
       Shared p    -> Shared $ applyE p es
@@ -79,29 +84,29 @@ instance Apply Term where
 canProject :: QName -> Term -> Maybe (Arg Term)
 canProject f v =
   case ignoreSharing v of
-    (Con (ConHead _ fs) vs) -> do
+    (Con (ConHead _ _ fs) vs) -> do
       i <- elemIndex f fs
-      mhead (drop i vs)
+      headMaybe (drop i vs)
     _ -> Nothing
 
 -- | Eliminate a constructed term.
 conApp :: ConHead -> Args -> Elims -> Term
-conApp ch                args []             = Con ch args
-conApp ch                args (Apply a : es) = conApp ch (args ++ [a]) es
-conApp ch@(ConHead c fs) args (Proj f  : es) =
+conApp ch                  args []             = Con ch args
+conApp ch                  args (Apply a : es) = conApp ch (args ++ [a]) es
+conApp ch@(ConHead c _ fs) args (Proj f  : es) =
   let failure = flip trace __IMPOSSIBLE__ $
         "conApp: constructor " ++ show c ++
         " with fields " ++ show fs ++
         " projected by " ++ show f
       i = maybe failure id            $ elemIndex f fs
-      v = maybe failure argToDontCare $ mhead $ drop i args
+      v = maybe failure argToDontCare $ headMaybe $ drop i args
   in  applyE v es
 {-
       i = maybe failure id    $ elemIndex f $ map unArg fs
-      v = maybe failure unArg $ mhead $ drop i args
+      v = maybe failure unArg $ headMaybe $ drop i args
       -- Andreas, 2013-10-20 see Issue543a:
       -- protect result of irrelevant projection.
-      r = maybe __IMPOSSIBLE__ getRelevance $ mhead $ drop i fs
+      r = maybe __IMPOSSIBLE__ getRelevance $ headMaybe $ drop i fs
       u | Irrelevant <- r = DontCare v
         | otherwise       = v
   in  applyE v es
@@ -142,7 +147,7 @@ instance Apply a => Apply (Ptr a) where
 instance Subst a => Apply (Tele a) where
   apply tel               []       = tel
   apply EmptyTel          _        = __IMPOSSIBLE__
-  apply (ExtendTel _ tel) (t : ts) = absApp tel (unArg t) `apply` ts
+  apply (ExtendTel _ tel) (t : ts) = lazyAbsApp tel (unArg t) `apply` ts
 
 instance Apply Definition where
   apply (Defn info x t pol occ df m c rew inst d) args =
@@ -268,12 +273,12 @@ instance Apply FunctionInverse where
 
 instance Apply ClauseBody where
   apply  b       []       = b
-  apply (Bind b) (a:args) = absApp b (unArg a) `apply` args
+  apply (Bind b) (a:args) = lazyAbsApp b (unArg a) `apply` args
   apply (Body v) args     = Body $ v `apply` args
   apply  NoBody   _       = NoBody
   applyE  b       []             = b
 
-  applyE (Bind b) (Apply a : es) = absApp b (unArg a) `applyE` es
+  applyE (Bind b) (Apply a : es) = lazyAbsApp b (unArg a) `applyE` es
   applyE (Bind b) (Proj{}  : es) = __IMPOSSIBLE__
   applyE (Body v) es             = Body $ v `applyE` es
   applyE  NoBody   _             = NoBody
@@ -331,7 +336,7 @@ instance Abstract Permutation where
 -- reduction.
 piApply :: Type -> Args -> Type
 piApply t []                      = t
-piApply (El _ (Pi  _ b)) (a:args) = absApp b (unArg a) `piApply` args
+piApply (El _ (Pi  _ b)) (a:args) = lazyAbsApp b (unArg a) `piApply` args
 piApply (El s (Shared p)) args    = piApply (El s $ derefPtr p) args
 piApply t args                    =
   trace ("piApply t = " ++ show t ++ "\n  args = " ++ show args) __IMPOSSIBLE__
@@ -342,21 +347,21 @@ piApply t args                    =
 
 -- | @(abstract args v) `apply` args --> v[args]@.
 class Abstract t where
-    abstract :: Telescope -> t -> t
+  abstract :: Telescope -> t -> t
 
 instance Abstract Term where
-    abstract = teleLam
+  abstract = teleLam
 
 instance Abstract Type where
-    abstract = telePi_
+  abstract = telePi_
 
 instance Abstract Sort where
-    abstract EmptyTel s = s
-    abstract _        s = __IMPOSSIBLE__
+  abstract EmptyTel s = s
+  abstract _        s = __IMPOSSIBLE__
 
 instance Abstract Telescope where
-  abstract  EmptyTel            tel = tel
-  abstract (ExtendTel arg tel') tel = ExtendTel arg $ fmap (`abstract` tel) tel'
+  EmptyTel           `abstract` tel = tel
+  ExtendTel arg xtel `abstract` tel = ExtendTel arg $ xtel <&> (`abstract` tel)
 
 instance Abstract Definition where
   abstract tel (Defn info x t pol occ df m c rews inst d) =
@@ -472,27 +477,7 @@ abstractArgs args x = abstract tel x
 -- * Explicit substitutions
 ---------------------------------------------------------------------------
 
--- | Substitutions.
-
-infixr 4 :#
-data Substitution
-
-  = IdS                     -- Γ ⊢ IdS : Γ
-
-  | EmptyS                  -- Γ ⊢ EmptyS : ()
-
-                            --      Γ ⊢ ρ : Δ
-  | Wk !Int Substitution    -- -------------------
-                            -- Γ, Ψ ⊢ Wk |Ψ| ρ : Δ
-
-                            -- Γ ⊢ u : Aρ  Γ ⊢ ρ : Δ
-  | Term :# Substitution    -- ---------------------
-                            --   Γ ⊢ u :# ρ : Δ, A
-
-                            --        Γ ⊢ ρ : Δ
-  | Lift !Int Substitution  -- -------------------------
-                            -- Γ, Ψρ ⊢ Lift |Ψ| ρ : Δ, Ψ
-  deriving (Eq, Ord, Show)
+-- See Syntax.Internal for the definition.
 
 idS :: Substitution
 idS = IdS
@@ -506,8 +491,13 @@ wkS n rho        = Wk n rho
 raiseS :: Int -> Substitution
 raiseS n = wkS n idS
 
+consS :: Term -> Substitution -> Substitution
+consS (Var n []) (Wk m rho)
+  | n + 1 == m = wkS (m - 1) (liftS 1 rho)
+consS u rho = seq u (u :# rho)
+
 singletonS :: Term -> Substitution
-singletonS u = u :# idS
+singletonS u = consS u idS
 
 liftS :: Int -> Substitution -> Substitution
 liftS 0 rho          = rho
@@ -516,13 +506,14 @@ liftS k (Lift n rho) = Lift (n + k) rho
 liftS k rho          = Lift k rho
 
 dropS :: Int -> Substitution -> Substitution
-dropS 0 rho          = rho
-dropS n IdS          = raiseS n
-dropS n (Wk m rho)   = wkS m (dropS n rho)
-dropS n (u :# rho)   = dropS (n - 1) rho
-dropS n (Lift 0 rho) = __IMPOSSIBLE__
-dropS n (Lift m rho) = wkS 1 $ dropS (n - 1) $ liftS (m - 1) rho
-dropS n EmptyS       = __IMPOSSIBLE__
+dropS 0 rho                = rho
+dropS n IdS                = raiseS n
+dropS n (Wk m rho)         = wkS m (dropS n rho)
+dropS n (u :# rho)         = dropS (n - 1) rho
+dropS n (Strengthen _ rho) = dropS (n - 1) rho
+dropS n (Lift 0 rho)       = __IMPOSSIBLE__
+dropS n (Lift m rho)       = wkS 1 $ dropS (n - 1) $ liftS (m - 1) rho
+dropS n EmptyS             = __IMPOSSIBLE__
 
 -- | @applySubst (ρ `composeS` σ) v == applySubst ρ (applySubst σ v)@
 composeS :: Substitution -> Substitution -> Substitution
@@ -531,6 +522,7 @@ composeS IdS sgm = sgm
 composeS rho EmptyS = EmptyS
 composeS rho (Wk n sgm) = composeS (dropS n rho) sgm
 composeS rho (u :# sgm) = applySubst rho u :# composeS rho sgm
+composeS rho (Strengthen err sgm) = Strengthen err (composeS rho sgm)
 composeS rho (Lift 0 sgm) = __IMPOSSIBLE__
 composeS (u :# rho) (Lift n sgm) = u :# composeS rho (liftS (n - 1) sgm)
 composeS rho (Lift n sgm) = lookupS rho 0 :# composeS rho (wkS 1 (liftS (n - 1) sgm))
@@ -539,22 +531,32 @@ composeS rho (Lift n sgm) = lookupS rho 0 :# composeS rho (wkS 1 (liftS (n - 1)
 --   Γ ⊢ σ : Δ
 --   Γ ⊢ δ : Θσ
 splitS :: Int -> Substitution -> (Substitution, Substitution)
-splitS 0 rho          = (rho, EmptyS)
-splitS n (u :# rho)   = id *** (u :#) $ splitS (n - 1) rho
-splitS n (Lift 0 _)   = __IMPOSSIBLE__
-splitS n (Wk m rho)   = wkS m *** wkS m $ splitS n rho
-splitS n IdS          = (raiseS n, liftS n EmptyS)
-splitS n (Lift m rho) = wkS 1 *** liftS 1 $ splitS (n - 1) (liftS (m - 1) rho)
-splitS n EmptyS       = __IMPOSSIBLE__
+splitS 0 rho                  = (rho, EmptyS)
+splitS n (u :# rho)           = second (u :#) $ splitS (n - 1) rho
+splitS n (Strengthen err rho) = second (Strengthen err) $ splitS (n - 1) rho
+splitS n (Lift 0 _)           = __IMPOSSIBLE__
+splitS n (Wk m rho)           = wkS m *** wkS m $ splitS n rho
+splitS n IdS                  = (raiseS n, liftS n EmptyS)
+splitS n (Lift m rho)         = wkS 1 *** liftS 1 $ splitS (n - 1) (liftS (m - 1) rho)
+splitS n EmptyS               = __IMPOSSIBLE__
 
 infixr 4 ++#
 
 (++#) :: [Term] -> Substitution -> Substitution
-us ++# rho = foldr (:#) rho us
+us ++# rho = foldr consS rho us
+
+prependS :: Empty -> [Maybe Term] -> Substitution -> Substitution
+prependS err us rho = foldr f rho us
+  where
+    f Nothing  rho = Strengthen err rho
+    f (Just u) rho = consS u rho
 
 parallelS :: [Term] -> Substitution
 parallelS us = us ++# idS
 
+compactS :: Empty -> [Maybe Term] -> Substitution
+compactS err us = prependS err us idS
+
 lookupS :: Substitution -> Nat -> Term
 lookupS rho i = case rho of
   IdS                    -> var i
@@ -564,6 +566,10 @@ lookupS rho i = case rho of
   u :# rho   | i == 0    -> u
              | i < 0     -> __IMPOSSIBLE__
              | otherwise -> lookupS rho (i - 1)
+  Strengthen err rho
+             | i == 0    -> absurd err
+             | i < 0     -> __IMPOSSIBLE__
+             | otherwise -> lookupS rho (i - 1)
   Lift n rho | i < n     -> var i
              | otherwise -> raise n $ lookupS rho (i - n)
   EmptyS                 -> __IMPOSSIBLE__
@@ -593,6 +599,9 @@ raiseFrom n k = applySubst (liftS n $ raiseS k)
 subst :: Subst t => Term -> t -> t
 subst u t = substUnder 0 u t
 
+strengthen :: Subst t => Empty -> t -> t
+strengthen err = applySubst (compactS err [Nothing])
+
 substUnder :: Subst t => Nat -> Term -> t -> t
 substUnder n u = applySubst (liftS n (singletonS u))
 
@@ -761,6 +770,9 @@ telToList (ExtendTel arg tel) = fmap (absName tel,) arg : telToList (absBody tel
   -- Andreas, 2013-12-14: This would work also for 'NoAbs',
   -- since 'absBody' raises.
 
+telToArgs :: Telescope -> [Arg ArgName]
+telToArgs tel = [ Common.Arg (domInfo d) (fst $ unDom d) | d <- telToList tel ]
+
 -- | Turn a typed binding @(x1 .. xn : A)@ into a telescope.
 bindsToTel' :: (Name -> a) -> [Name] -> Dom Type -> ListTel' a
 bindsToTel' f []     t = []
@@ -782,6 +794,9 @@ mkPi (Common.Dom info (x, a)) b = el $ Pi (Common.Dom info a) (mkAbs x b)
   where
     el = El $ dLub (getSort a) (Abs x (getSort b)) -- dLub checks x freeIn
 
+mkLam :: Arg ArgName -> Term -> Term
+mkLam a v = Lam (argInfo a) (Abs (unArg a) v)
+
 telePi' :: (Abs Type -> Abs Type) -> Telescope -> Type -> Type
 telePi' reAbs = telePi where
   telePi EmptyTel          t = t
@@ -812,7 +827,7 @@ telePi_ (ExtendTel u tel) t = el $ Pi u b
 -}
 
 teleLam :: Telescope -> Term -> Term
-teleLam  EmptyTel	  t = t
+teleLam  EmptyTel         t = t
 teleLam (ExtendTel u tel) t = Lam (domInfo u) $ flip teleLam t <$> tel
 
 -- | Performs void ('noAbs') abstraction over telescope.
@@ -834,10 +849,11 @@ dLub s1 (NoAbs _ s2) = sLub s1 s2
 dLub s1 b@(Abs _ s2) = case occurrence 0 $ freeVars s2 of
   Flexible      -> DLub s1 b
   Irrelevantly  -> DLub s1 b
-  NoOccurrence  -> sLub s1 (absApp b __IMPOSSIBLE__)
+  NoOccurrence  -> sLub s1 (noabsApp __IMPOSSIBLE__ b)
 --  Free.Unused   -> sLub s1 (absApp b __IMPOSSIBLE__) -- triggers Issue784
   Free.Unused   -> DLub s1 b
   StronglyRigid -> Inf
+  Unguarded     -> Inf
   WeaklyRigid   -> Inf
 
 ---------------------------------------------------------------------------
@@ -845,11 +861,23 @@ dLub s1 b@(Abs _ s2) = case occurrence 0 $ freeVars s2 of
 --   and things we couldn't do before we could define 'absBody'
 ---------------------------------------------------------------------------
 
--- | Instantiate an abstraction
+-- | Instantiate an abstraction. Strict in the term.
 absApp :: Subst t => Abs t -> Term -> t
 absApp (Abs   _ v) u = subst u v
 absApp (NoAbs _ v) _ = v
 
+-- | Instantiate an abstraction. Lazy in the term, which allow it to be
+--   __IMPOSSIBLE__ in the case where the variable shouldn't be used but we
+--   cannot use 'noabsApp'. Used in Apply.
+lazyAbsApp :: Subst t => Abs t -> Term -> t
+lazyAbsApp (Abs   _ v) u = applySubst (u :# IdS) v
+lazyAbsApp (NoAbs _ v) _ = v
+
+-- | Instantiate an abstraction that doesn't use its argument.
+noabsApp :: Subst t => Empty -> Abs t -> t
+noabsApp err (Abs   _ v) = strengthen err v
+noabsApp _   (NoAbs _ v) = v
+
 absBody :: Subst t => Abs t -> t
 absBody (Abs   _ v) = v
 absBody (NoAbs _ v) = raise 1 v
@@ -926,6 +954,9 @@ instance GetBody Clause where
 deriving instance (Subst a, Eq a) => Eq (Tele a)
 deriving instance (Subst a, Ord a) => Ord (Tele a)
 
+deriving instance Eq Substitution
+deriving instance Ord Substitution
+
 deriving instance Eq Sort
 deriving instance Ord Sort
 deriving instance Eq Type
@@ -1098,6 +1129,7 @@ levelTm l =
     Max [Plus 0 l] -> unLevelAtom l
     _              -> Level l
 
+unLevelAtom :: LevelAtom -> Term
 unLevelAtom (MetaLevel x es)   = MetaV x es
 unLevelAtom (NeutralLevel v)   = v
 unLevelAtom (UnreducedLevel v) = v
@@ -1108,15 +1140,17 @@ unLevelAtom (BlockedLevel _ v) = v
 ---------------------------------------------------------------------------
 
 instance Sized Substitution where
-  size IdS          = 1
-  size EmptyS       = 1
-  size (Wk _ rho)   = 1 + size rho
-  size (t :# rho)   = 1 + size t + size rho
-  size (Lift _ rho) = 1 + size rho
+  size IdS                = 1
+  size EmptyS             = 1
+  size (Wk _ rho)         = 1 + size rho
+  size (t :# rho)         = 1 + size t + size rho
+  size (Strengthen _ rho) = 1 + size rho
+  size (Lift _ rho)       = 1 + size rho
 
 instance KillRange Substitution where
-  killRange IdS          = IdS
-  killRange EmptyS       = EmptyS
-  killRange (Wk n rho)   = killRange1 (Wk n) rho
-  killRange (t :# rho)   = killRange2 (:#) t rho
-  killRange (Lift n rho) = killRange1 (Lift n) rho
+  killRange IdS                  = IdS
+  killRange EmptyS               = EmptyS
+  killRange (Wk n rho)           = killRange1 (Wk n) rho
+  killRange (t :# rho)           = killRange2 (:#) t rho
+  killRange (Strengthen err rho) = killRange1 (Strengthen err) rho
+  killRange (Lift n rho)         = killRange1 (Lift n) rho
diff --git a/src/full/Agda/TypeChecking/SyntacticEquality.hs b/src/full/Agda/TypeChecking/SyntacticEquality.hs
index ccefa6c..7e0f152 100644
--- a/src/full/Agda/TypeChecking/SyntacticEquality.hs
+++ b/src/full/Agda/TypeChecking/SyntacticEquality.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | A syntactic equality check that takes meta instantiations into account,
@@ -31,7 +31,7 @@ import Agda.TypeChecking.Substitute
 
 import Agda.Utils.Monad (ifM)
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Syntactic equality check for terms.
diff --git a/src/full/Agda/TypeChecking/Telescope.hs b/src/full/Agda/TypeChecking/Telescope.hs
index d4cb8dc..7c746c4 100644
--- a/src/full/Agda/TypeChecking/Telescope.hs
+++ b/src/full/Agda/TypeChecking/Telescope.hs
@@ -20,9 +20,9 @@ import Agda.Utils.Permutation
 import Agda.Utils.Size
 import Agda.Utils.Tuple
 import Agda.Utils.VarSet (VarSet)
-import qualified Agda.Utils.VarSet as Set
+import qualified Agda.Utils.VarSet as VarSet
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data OutputTypeName
@@ -59,9 +59,9 @@ renameP p = applySubst (renaming p)
 renaming :: Permutation -> Substitution
 renaming p = gamma'
   where
-    n	   = size p
-    gamma  = permute (reverseP $ invertP $ reverseP p) $ map var [0..]
-    gamma' = gamma ++# raiseS n
+    n      = size p
+    gamma  = safePermute (reverseP $ invertP (-1) $ reverseP p) $ map var [0..]
+    gamma' = prependS __IMPOSSIBLE__ gamma (raiseS n)
 
 -- | If @permute π : [a]Γ -> [a]Δ@, then @substs (renamingR π) : Term Δ -> Term Γ@
 renamingR :: Permutation -> Substitution
@@ -69,7 +69,7 @@ renamingR p@(Perm n _) = permute (reverseP p) (map var [0..]) ++# raiseS n
 
 -- | Flatten telescope: (Γ : Tel) -> [Type Γ]
 flattenTel :: Telescope -> [Dom Type]
-flattenTel EmptyTel	     = []
+flattenTel EmptyTel          = []
 flattenTel (ExtendTel a tel) = raise (size tel + 1) a : flattenTel (absBody tel)
 
 -- | Order a flattened telescope in the correct dependeny order: Γ ->
@@ -91,7 +91,7 @@ reorderTel_ tel = case reorderTel tel of
 -- | Unflatten: turns a flattened telescope into a proper telescope. Must be
 --   properly ordered.
 unflattenTel :: [ArgName] -> [Dom Type] -> Telescope
-unflattenTel []	  []	        = EmptyTel
+unflattenTel []   []            = EmptyTel
 unflattenTel (x : xs) (a : tel) = ExtendTel a' (Abs x tel')
   where
     tel' = unflattenTel xs tel
@@ -113,24 +113,33 @@ teleArgs tel = [ Common.Arg info (var i) | (i, Common.Dom info _) <- zip (downFr
 
 -- | A telescope split in two.
 data SplitTel = SplitTel
-      { firstPart  :: Telescope
-      , secondPart :: Telescope
-      , splitPerm  :: Permutation
-      }
+  { firstPart  :: Telescope
+  , secondPart :: Telescope
+  , splitPerm  :: Permutation
+    -- ^ The permutation takes us from the original telescope to
+    --   @firstPart ++ secondPart at .
+  }
 
 -- | Split a telescope into the part that defines the given variables and the
 --   part that doesn't.
-splitTelescope :: VarSet -> Telescope -> SplitTel
+--
+--   See 'Agda.TypeChecking.Tests.prop_splitTelescope'.
+splitTelescope
+  :: VarSet     -- ^ A set of de Bruijn indices.
+  -> Telescope  -- ^ Original telescope.
+  -> SplitTel   -- ^ @firstPart@ mentions the given variables, @secondPart@ not.
 splitTelescope fv tel = SplitTel tel1 tel2 perm
   where
     names = teleNames tel
     ts0   = flattenTel tel
-
     n     = size tel
 
     -- We start with a rough split into fv and the rest. This will most likely
     -- not be correct so we patch it up later with reorderTel.
-    is    = map (n - 1 -) $ filter (< n) $ reverse $ Set.toList fv
+
+    -- Convert given de Bruijn indices into ascending list of de Bruijn levels.
+    is    = map (n - 1 -) $ dropWhile (>= n) $ VarSet.toDescList fv
+    -- Compute the complement (de Bruijn levels not mentioned in @fv@).
     isC   = [0..n - 1] \\ is
     perm0 = Perm n $ is ++ isC
 
@@ -146,9 +155,8 @@ splitTelescope fv tel = SplitTel tel1 tel2 perm
 
     tel'  = unflattenTel (permute perm names) ts2
 
-    Perm _ js = perm
-    m         = genericLength $ takeWhile (`notElem` is) (reverse js)
-    (tel1, tel2) = telFromList -*- telFromList $ genericSplitAt (n - m) $ telToList tel'
+    m            = length $ takeWhile (`notElem` is) $ reverse $ permPicks perm
+    (tel1, tel2) = telFromList -*- telFromList $ splitAt (n - m) $ telToList tel'
 
 telView :: Type -> TCM TelView
 telView = telViewUpTo (-1)
diff --git a/src/full/Agda/TypeChecking/Test/Generators.hs b/src/full/Agda/TypeChecking/Test/Generators.hs
index 7ab10de..dbd1ddc 100644
--- a/src/full/Agda/TypeChecking/Test/Generators.hs
+++ b/src/full/Agda/TypeChecking/Test/Generators.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE UndecidableInstances   #-}
 
 module Agda.TypeChecking.Test.Generators where
 
@@ -25,22 +25,22 @@ import Agda.Utils.QuickCheck hiding (Args)
 import Agda.Utils.TestHelpers
 import qualified Agda.Utils.VarSet as Set
 
-#include "../../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 data TermConfiguration = TermConf
-      { tcDefinedNames	   :: [QName]
+      { tcDefinedNames     :: [QName]
       , tcConstructorNames :: [QName]
       , tcProjectionNames  :: [QName]
-      , tcFreeVariables	   :: [Nat]
-      , tcLiterals	   :: UseLiterals
-      , tcFrequencies	   :: Frequencies
-      , tcFixSize	   :: Maybe Int
-	-- ^ Maximum size of the generated element. When @Nothing@ this value
-	--   is initialized from the 'Test.QuickCheck.size' parameter.
-      , tcIsType	   :: Bool
-	-- ^ When this is true no lambdas, literals, or constructors are
-	--   generated
+      , tcFreeVariables    :: [Nat]
+      , tcLiterals         :: UseLiterals
+      , tcFrequencies      :: Frequencies
+      , tcFixSize          :: Maybe Int
+        -- ^ Maximum size of the generated element. When @Nothing@ this value
+        --   is initialized from the 'Test.QuickCheck.size' parameter.
+      , tcIsType           :: Bool
+        -- ^ When this is true no lambdas, literals, or constructors are
+        --   generated
       }
   deriving Show
 
@@ -56,11 +56,11 @@ data TermFreqs = TermFreqs
       { varFreq :: Int
       , defFreq :: Int
       , conFreq :: Int
-      , litFreq	 :: Int
+      , litFreq  :: Int
       , sortFreq :: Int
-      , lamFreq	 :: Int
-      , piFreq	 :: Int
-      , funFreq	 :: Int
+      , lamFreq  :: Int
+      , piFreq   :: Int
+      , funFreq  :: Int
       }
   deriving Show
 
@@ -84,17 +84,17 @@ data SortFreqs = SortFreqs
 
 defaultFrequencies :: Frequencies
 defaultFrequencies = Freqs
-      { termFreqs   = TermFreqs	  { varFreq = 24, defFreq = 8, conFreq = 8, litFreq = 1, sortFreq = 2, lamFreq = 10, piFreq = 5, funFreq = 5 }
+      { termFreqs   = TermFreqs   { varFreq = 24, defFreq = 8, conFreq = 8, litFreq = 1, sortFreq = 2, lamFreq = 10, piFreq = 5, funFreq = 5 }
       , elimFreqs   = ElimFreqs   { applyFreq = 9, projFreq = 1 }
       , hiddenFreqs = HiddenFreqs { hiddenFreq = 1, notHiddenFreq = 5 }
-      , sortFreqs   = SortFreqs	  { setFreqs = [3, 1], propFreq = 1 }
+      , sortFreqs   = SortFreqs   { setFreqs = [3, 1], propFreq = 1 }
       }
 
 noProp :: TermConfiguration -> TermConfiguration
 noProp conf = conf { tcFrequencies = fq { sortFreqs = sfq { propFreq = 0 } } }
   where
-    fq	= tcFrequencies conf
-    sfq	= sortFreqs fq
+    fq  = tcFrequencies conf
+    sfq = sortFreqs fq
 
 data UseLiterals = UseLit
       { useLitInt    :: Bool
@@ -138,9 +138,9 @@ makeConfiguration ds cs ps vs = TermConf
   , tcProjectionNames  = projs
   , tcFreeVariables    = List.sort $ List.nub vs
   , tcFrequencies      = defaultFrequencies
-  , tcLiterals	       = noLiterals
-  , tcFixSize	       = Nothing
-  , tcIsType	       = False
+  , tcLiterals         = noLiterals
+  , tcFixSize          = Nothing
+  , tcIsType           = False
   }
   where
     (defs, cons, projs) = flip evalState 0 $ do
@@ -150,22 +150,22 @@ makeConfiguration ds cs ps vs = TermConf
     mkName s = do
       n <- tick
       return $ QName { qnameModule = MName []
-		     , qnameName   = Name
-			{ nameId	  = NameId n 1
-			, nameConcrete	  = C.Name noRange [C.Id s]
-			, nameBindingSite = noRange
-			, nameFixity	  = defaultFixity'
-			}
-		      }
+                     , qnameName   = Name
+                        { nameId          = NameId n 1
+                        , nameConcrete    = C.Name noRange [C.Id s]
+                        , nameBindingSite = noRange
+                        , nameFixity      = defaultFixity'
+                        }
+                      }
 
 class GenC a where
   genC :: TermConfiguration -> Gen a
 
-newtype YesType a   = YesType	{ unYesType :: a     }
-newtype NoType  a   = NoType	{ unNoType  :: a     }
-newtype VarName	    = VarName	{ unVarName :: Nat   }
-newtype DefName	    = DefName	{ unDefName :: QName }
-newtype ConName	    = ConName	{ unConName :: ConHead }
+newtype YesType a   = YesType   { unYesType :: a     }
+newtype NoType  a   = NoType    { unNoType  :: a     }
+newtype VarName     = VarName   { unVarName :: Nat   }
+newtype DefName     = DefName   { unDefName :: QName }
+newtype ConName     = ConName   { unConName :: ConHead }
 newtype ProjName    = ProjName  { unProjName :: QName }
 newtype SizedList a = SizedList { unSizedList :: [a] }
 
@@ -194,7 +194,7 @@ instance GenC Hiding where
   genC conf = frequency [ (hideF, return Hidden), (nohideF, return NotHidden) ]
     where
       HiddenFreqs {hiddenFreq = hideF, notHiddenFreq = nohideF } =
-	hiddenFreqs $ tcFrequencies conf
+        hiddenFreqs $ tcFrequencies conf
 
 instance (GenC c, GenC a) => GenC (Common.Arg c a) where
   genC conf = (\ (h, a) -> Arg (setHiding h defaultArgInfo) a) <$> genC conf
@@ -211,7 +211,7 @@ instance GenC a => GenC (Elim' a) where
                         , (projF, Proj . unProjName <$> genC conf) ]
     where
       ElimFreqs {applyFreq = applyF, projFreq = projF } =
-	elimFreqs $ tcFrequencies conf
+        elimFreqs $ tcFrequencies conf
 
 instance GenC DefName where
   genC conf = DefName  <$> do elements $ tcDefinedNames conf
@@ -245,12 +245,12 @@ instance GenC Integer where
 
 instance GenC Literal where
   genC conf = oneof (concat $ zipWith gen useLits
-	      [ uncurry LitInt	  <$> genC conf
-	      , uncurry LitFloat  <$> genC conf
-	      , uncurry LitString <$> genC conf
-	      , uncurry LitChar   <$> genC conf
-	      ]
-	   )
+              [ uncurry LitInt    <$> genC conf
+              , uncurry LitFloat  <$> genC conf
+              , uncurry LitString <$> genC conf
+              , uncurry LitChar   <$> genC conf
+              ]
+           )
     where
       useLits = map ($ tcLiterals conf) [ useLitInt, useLitFloat, useLitString, useLitChar ]
 
@@ -270,15 +270,15 @@ instance GenC Term where
   genC conf = case tcFixSize conf of
       Nothing -> sized $ \n -> genC $ fixSizeConf n conf
       Just n | n <= 0    -> genLeaf
-	     | otherwise -> frequency
-	[ (varF, genVar $ genElims conf)
-	, (defF, genDef $ genElims conf)
-	, (conF, genCon $ genArgs conf)
-	, (litF,  Lit <$> genC conf)
-	, (sortF, Sort <$> genC conf)
-	, (lamF,  genLam)
-	, (piF,	  genPi)
-	]
+             | otherwise -> frequency
+        [ (varF, genVar $ genElims conf)
+        , (defF, genDef $ genElims conf)
+        , (conF, genCon $ genArgs conf)
+        , (litF,  Lit <$> genC conf)
+        , (sortF, Sort <$> genC conf)
+        , (lamF,  genLam)
+        , (piF,   genPi)
+        ]
     where
       defs    = tcDefinedNames conf
       cons    = tcConstructorNames conf
@@ -288,15 +288,15 @@ instance GenC Term where
       useLits = map ($ tcLiterals conf) [ useLitInt, useLitFloat, useLitString, useLitChar ]
 
       varF  | null vars = 0
-	    | otherwise = freq (varFreq . termFreqs)
+            | otherwise = freq (varFreq . termFreqs)
       defF  | null defs = 0
-	    | otherwise = freq (defFreq . termFreqs)
+            | otherwise = freq (defFreq . termFreqs)
       conF  | null cons || isType = 0
-	    | otherwise	          = freq (conFreq . termFreqs)
+            | otherwise           = freq (conFreq . termFreqs)
       litF  | or useLits && not isType = freq (litFreq . termFreqs)
-	    | otherwise		    = 0
+            | otherwise             = 0
       lamF  | isType    = 0
-	    | otherwise = freq (lamFreq  . termFreqs)
+            | otherwise = freq (lamFreq  . termFreqs)
       sortF = freq (sortFreq . termFreqs)
       piF   = freq (piFreq   . termFreqs)
 
@@ -311,16 +311,16 @@ instance GenC Term where
       genDef args = Def <$> elements defs <*> args
 
       genCon :: Gen Args -> Gen Term
-      genCon args = Con <$> (flip ConHead [] <$> elements cons) <*> args
+      genCon args = Con <$> ((\ c -> ConHead c Inductive []) <$> elements cons) <*> args
 
       genLeaf :: Gen Term
       genLeaf = frequency
-	[ (varF, genVar $ return [])
-	, (defF, genDef $ return [])
-	, (conF, genCon $ return [])
-	, (litF,  Lit  <$> genC conf)
-	, (sortF, Sort <$> genC conf)
-	]
+        [ (varF, genVar $ return [])
+        , (defF, genDef $ return [])
+        , (conF, genCon $ return [])
+        , (litF,  Lit  <$> genC conf)
+        , (sortF, Sort <$> genC conf)
+        ]
 
 -- | Only generates default configurations. Names and free variables varies.
 genConf :: Gen TermConfiguration
@@ -353,7 +353,7 @@ instance ShrinkC a b => ShrinkC (NoType a) b where
   noShrink (NoType x) = noShrink x
 
 instance ShrinkC a b => ShrinkC [a] [b] where
-  noShrink	  = map noShrink
+  noShrink        = map noShrink
   shrinkC conf xs = noShrink (removeChunks xs) ++ shrinkOne xs
    where
     -- Code stolen from Test.QuickCheck.Arbitrary
@@ -395,12 +395,12 @@ instance ShrinkC DefName QName where
   noShrink = unDefName
 
 instance ShrinkC ConName ConHead where
-  shrinkC conf (ConName (ConHead{conName = c})) = map (flip ConHead []) $ takeWhile (/= c) $ tcConstructorNames conf
+  shrinkC conf (ConName (ConHead{conName = c})) = map (\ c -> ConHead c Inductive []) $ takeWhile (/= c) $ tcConstructorNames conf
   noShrink = unConName
 
 instance ShrinkC Literal Literal where
   shrinkC _ (LitInt _ 0) = []
-  shrinkC conf l	 = LitInt noRange 0 : case l of
+  shrinkC conf l         = LitInt noRange 0 : case l of
       LitInt    r n -> LitInt    r <$> shrink n
       LitString r s -> LitString r <$> shrinkC conf s
       LitChar   r c -> LitChar   r <$> shrinkC conf c
@@ -410,7 +410,7 @@ instance ShrinkC Literal Literal where
 
 instance ShrinkC Char Char where
   shrinkC _ 'a' = []
-  shrinkC _ _	= ['a']
+  shrinkC _ _   = ['a']
   noShrink = id
 
 instance ShrinkC Hiding Hiding where
@@ -453,7 +453,7 @@ instance ShrinkC Sort Sort where
   noShrink = id
 
 instance ShrinkC Telescope Telescope where
-  shrinkC conf EmptyTel		 = []
+  shrinkC conf EmptyTel          = []
   shrinkC conf (ExtendTel a tel) =
     killAbs tel : (uncurry ExtendTel <$> shrinkC conf (a, tel))
   noShrink = id
@@ -465,19 +465,19 @@ instance ShrinkC Type Type where
 instance ShrinkC Term Term where
   shrinkC conf (DontCare _)  = []
   shrinkC conf (Sort Prop) = []
-  shrinkC conf t	   = filter validType $ case ignoreSharing t of
+  shrinkC conf t           = filter validType $ case ignoreSharing t of
     Var i es     -> map unArg (argsFromElims es) ++
-		    (uncurry Var <$> shrinkC conf (VarName i, NoType es))
+                    (uncurry Var <$> shrinkC conf (VarName i, NoType es))
     Def d es     -> map unArg (argsFromElims es) ++
-		    (uncurry Def <$> shrinkC conf (DefName d, NoType es))
+                    (uncurry Def <$> shrinkC conf (DefName d, NoType es))
     Con c args   -> map unArg args ++
-		    (uncurry Con <$> shrinkC conf (ConName c, NoType args))
-    Lit l	 -> Lit <$> shrinkC conf l
+                    (uncurry Con <$> shrinkC conf (ConName c, NoType args))
+    Lit l        -> Lit <$> shrinkC conf l
     Level l      -> [] -- TODO
     Lam info b   -> killAbs b : ((\(h,x) -> Lam (setHiding h defaultArgInfo) x)
                                  <$> shrinkC conf (argInfoHiding info, b))
     Pi a b       -> unEl (unDom a) : unEl (killAbs b) :
-		    (uncurry Pi <$> shrinkC conf (a, b))
+                    (uncurry Pi <$> shrinkC conf (a, b))
     Sort s       -> Sort <$> shrinkC conf s
     MetaV m es   -> map unArg (argsFromElims es) ++
                     (MetaV m <$> shrinkC conf (NoType es))
@@ -486,12 +486,12 @@ instance ShrinkC Term Term where
     ExtLam _ _   -> __IMPOSSIBLE__
     where
       validType t
-	| not (tcIsType conf) = True
-	| otherwise	    = case t of
-	    Con _ _ -> False
-	    Lam _ _ -> False
-	    Lit _	  -> False
-	    _	  -> True
+        | not (tcIsType conf) = True
+        | otherwise         = case t of
+            Con _ _ -> False
+            Lam _ _ -> False
+            Lit _         -> False
+            _     -> True
   noShrink = id
 
 killAbs :: KillVar a => Abs a -> a
@@ -503,17 +503,17 @@ class KillVar a where
 
 instance KillVar Term where
   killVar i t = case ignoreSharing t of
-    Var j args | j == i	   -> DontCare (Var j [])
-	       | j >  i	   -> Var (j - 1) $ killVar i args
-	       | otherwise -> Var j	  $ killVar i args
-    Def c args		   -> Def c	  $ killVar i args
-    Con c args		   -> Con c	  $ killVar i args
-    Lit l		   -> Lit l
+    Var j args | j == i    -> DontCare (Var j [])
+               | j >  i    -> Var (j - 1) $ killVar i args
+               | otherwise -> Var j       $ killVar i args
+    Def c args             -> Def c       $ killVar i args
+    Con c args             -> Con c       $ killVar i args
+    Lit l                  -> Lit l
     Level l                -> Level l -- TODO
-    Sort s		   -> Sort s
-    Lam h b		   -> Lam h	  $ killVar i b
-    Pi a b		   -> uncurry Pi  $ killVar i (a, b)
-    MetaV m args	   -> MetaV m	  $ killVar i args
+    Sort s                 -> Sort s
+    Lam h b                -> Lam h       $ killVar i b
+    Pi a b                 -> uncurry Pi  $ killVar i (a, b)
+    MetaV m args           -> MetaV m     $ killVar i args
     DontCare mv            -> DontCare    $ killVar i mv
     Shared{}               -> __IMPOSSIBLE__
     ExtLam _ _             -> __IMPOSSIBLE__
@@ -522,7 +522,7 @@ instance KillVar Type where
   killVar i (El s t) = El s $ killVar i t
 
 instance KillVar Telescope where
-  killVar i EmptyTel	      = EmptyTel
+  killVar i EmptyTel          = EmptyTel
   killVar i (ExtendTel a tel) = uncurry ExtendTel $ killVar i (a, tel)
 
 instance KillVar a => KillVar (Elim' a) where
diff --git a/src/full/Agda/TypeChecking/Tests.hs b/src/full/Agda/TypeChecking/Tests.hs
index 99c93cb..da0c511 100644
--- a/src/full/Agda/TypeChecking/Tests.hs
+++ b/src/full/Agda/TypeChecking/Tests.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Agda.TypeChecking.Tests where
 
 import qualified Agda.Utils.VarSet as Set
@@ -11,6 +13,9 @@ import Agda.Utils.Size
 import Agda.Utils.Permutation
 import Agda.Utils.TestHelpers
 
+#include "undefined.h"
+import Agda.Utils.Impossible
+
 ---------------------------------------------------------------------------
 -- * Tests for "Agda.Utils.Permutation"
 ---------------------------------------------------------------------------
@@ -46,7 +51,7 @@ prop_reorderTelStable conf =
 -- | The result of splitting a telescope is well-scoped.
 prop_splitTelescopeScope :: TermConfiguration -> Property
 prop_splitTelescopeScope conf =
-  forAll (genC conf)			    $ \tel ->
+  forAll (genC conf)                        $ \tel ->
   forAll (listOfElements [0..size tel - 1]) $ \vs ->
   let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel
       tel' = telFromList (telToList tel1 ++ telToList tel2)
@@ -55,21 +60,21 @@ prop_splitTelescopeScope conf =
 -- | The permutation generated when splitting a telescope preserves scoping.
 prop_splitTelescopePermScope :: TermConfiguration -> Property
 prop_splitTelescopePermScope conf =
-      forAllShrink (genC conf) (shrinkC conf)		     $ \tel ->
+      forAllShrink (genC conf) (shrinkC conf)                $ \tel ->
       forAllShrink (listOfElements [0..size tel - 1]) shrink $ \vs ->
   let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel
       conf1 = extendWithTelConf tel1 conf
       conf2 = conf1 { tcFreeVariables = map (size tel2 +) (tcFreeVariables conf1) }
       conf' = conf  { tcFreeVariables = map (size tel +) (tcFreeVariables conf) ++ vs }
   in  forAllShrink (genC conf') (shrinkC conf') $ \t ->
-      isWellScoped conf2 (applySubst (renamingR $ invertP perm) (t :: Term))
+      isWellScoped conf2 (applySubst (renamingR $ invertP __IMPOSSIBLE__ perm) (t :: Term))
 
 {-
 -- | The permutation generated when splitting a telescope correctly translates
 --   between the old and the new telescope.
 prop_splitTelescopePermInv :: TermConfiguration -> Property
 prop_splitTelescopePermInv conf =
-      forAll (wellScopedTel conf)		$ \tel ->
+      forAll (wellScopedTel conf)               $ \tel ->
       forAll (listOfElements [0..size tel - 1]) $ \vs ->
   let SplitTel tel1 tel2 perm = splitTelescope (Set.fromList vs) tel
       tel' = telFromList (telToList tel1 ++ telToList tel2)
@@ -77,8 +82,8 @@ prop_splitTelescopePermInv conf =
       conf2 = extendWithTelConf tel' conf
   in  forAll (wellScopedTerm conf1) $ \t1 ->
       forAll (wellScopedTerm conf2) $ \t2 ->
-  let t1' = rename (invertP perm) $ rename perm t1
-      t2' = rename perm $ rename (invertP perm) t2
+  let t1' = rename (invertP __IMPOSSIBLE__ perm) $ rename perm t1
+      t2' = rename perm $ rename (invertP __IMPOSSIBLE__ perm) t2
   in  t1 == t1' && t2 == t2'
 -}
 
diff --git a/src/full/Agda/TypeChecking/Unquote.hs b/src/full/Agda/TypeChecking/Unquote.hs
new file mode 100644
index 0000000..aacc343
--- /dev/null
+++ b/src/full/Agda/TypeChecking/Unquote.hs
@@ -0,0 +1,403 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE PatternGuards        #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Agda.TypeChecking.Unquote where
+
+import Control.Applicative
+import Control.Monad.State (evalState, get, put)
+import Control.Monad.Writer (execWriterT, tell)
+import Control.Monad.Trans (lift)
+
+import Data.Char
+import Data.Maybe (fromMaybe)
+import Data.Traversable (traverse)
+
+import Agda.Syntax.Common
+import Agda.Syntax.Internal as I
+import Agda.Syntax.Literal
+import Agda.Syntax.Position
+import Agda.Syntax.Translation.InternalToAbstract
+
+import Agda.TypeChecking.CompiledClause
+import Agda.TypeChecking.Datatypes ( getConHead )
+import Agda.TypeChecking.DropArgs
+import Agda.TypeChecking.Free
+import Agda.TypeChecking.Level
+import Agda.TypeChecking.Monad
+import Agda.TypeChecking.Monad.Builtin
+import Agda.TypeChecking.Monad.Exception
+import Agda.TypeChecking.Pretty
+import Agda.TypeChecking.Reduce
+import Agda.TypeChecking.Reduce.Monad
+import Agda.TypeChecking.Substitute
+
+import Agda.Utils.Except
+import Agda.Utils.Impossible
+import Agda.Utils.Monad ( ifM )
+import Agda.Utils.Permutation ( Permutation(Perm) )
+import Agda.Utils.String ( Str(Str), unStr )
+import Agda.Utils.VarSet (VarSet)
+import qualified Agda.Utils.VarSet as Set
+
+#include "undefined.h"
+
+agdaTermType :: TCM Type
+agdaTermType = El (mkType 0) <$> primAgdaTerm
+
+qNameType :: TCM Type
+qNameType = El (mkType 0) <$> primQName
+
+type UnquoteM = ExceptionT UnquoteError TCM
+
+runUnquoteM :: UnquoteM a -> TCM (Either UnquoteError a)
+runUnquoteM = runExceptionT
+
+isCon :: ConHead -> TCM Term -> UnquoteM Bool
+isCon con tm = do t <- lift tm
+                  case ignoreSharing t of
+                    Con con' _ -> return (con == con')
+                    _ -> return False
+
+{-unquoteFailedGeneric :: String -> UnquoteM a
+unquoteFailedGeneric msg = typeError . GenericError $ "Unable to unquote the " ++ msg
+
+unquoteFailed :: String -> String -> Term -> TCM a
+unquoteFailed kind msg t = do doc <- prettyTCM t
+                              unquoteFailedGeneric $ "term (" ++ show doc ++ ") of type " ++ kind ++ ".\nReason: " ++ msg ++ "."
+-}
+class Unquote a where
+  unquote :: Term -> UnquoteM a
+
+unquoteH :: Unquote a => I.Arg Term -> UnquoteM a
+unquoteH a | isHidden a && isRelevant a =
+    unquote $ unArg a
+unquoteH a = throwException $ BadVisibility "hidden"  a
+
+unquoteN :: Unquote a => I.Arg Term -> UnquoteM a
+unquoteN a | notHidden a && isRelevant a =
+    unquote $ unArg a
+unquoteN a = throwException $ BadVisibility "visible" a
+
+choice :: Monad m => [(m Bool, m a)] -> m a -> m a
+choice [] dflt = dflt
+choice ((mb, mx) : mxs) dflt = ifM mb mx $ choice mxs dflt
+
+ensureDef :: QName -> UnquoteM QName
+ensureDef x = do
+  i <- (theDef <$> getConstInfo x) `catchError` \_ -> return Axiom  -- for recursive unquoteDecl
+  case i of
+    Constructor{} -> do
+      def <- lift $ prettyTCM =<< primAgdaTermDef
+      con <- lift $ prettyTCM =<< primAgdaTermCon
+      throwException $ ConInsteadOfDef x (show def) (show con)
+    _ -> return x
+
+ensureCon :: QName -> UnquoteM QName
+ensureCon x = do
+  i <- (theDef <$> getConstInfo x) `catchError` \_ -> return Axiom  -- for recursive unquoteDecl
+  case i of
+    Constructor{} -> return x
+    _ -> do
+      def <- lift $ prettyTCM =<< primAgdaTermDef
+      con <- lift $ prettyTCM =<< primAgdaTermCon
+      throwException $ DefInsteadOfCon x (show def) (show con)
+
+pickName :: Type -> String
+pickName a =
+  case unEl a of
+    Pi{}   -> "f"
+    Sort{} -> "A"
+    Def d _ | c:_ <- show (qnameName d),
+              isAlpha c -> [toLower c]
+    _    -> "_"
+
+instance Unquote I.ArgInfo where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [h,r] -> do
+        choice
+          [(c `isCon` primArgArgInfo, ArgInfo <$> unquoteN h <*> unquoteN r <*> return [])]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "ArgInfo" t
+
+instance Unquote a => Unquote (I.Arg a) where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [info,x] -> do
+        choice
+          [(c `isCon` primArgArg, Arg <$> unquoteN info <*> unquoteN x)]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Arg" t
+
+-- Andreas, 2013-10-20: currently, post-fix projections are not part of the
+-- quoted syntax.
+instance Unquote a => Unquote (Elim' a) where
+  unquote t = Apply <$> unquote t
+
+instance Unquote Integer where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Lit (LitInt _ n) -> return n
+      _ -> throwException $ NotALiteral "Integer" t
+
+instance Unquote Double where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Lit (LitFloat _ x) -> return x
+      _ -> throwException $ NotALiteral "Float" t
+
+instance Unquote Char where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Lit (LitChar _ x) -> return x
+      _ -> throwException $ NotALiteral "Char" t
+
+instance Unquote Str where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Lit (LitString _ x) -> return (Str x)
+      _ -> throwException $ NotALiteral "String" t
+
+instance Unquote a => Unquote [a] where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [x,xs] -> do
+        choice
+          [(c `isCon` primCons, (:) <$> unquoteN x <*> unquoteN xs)]
+          __IMPOSSIBLE__
+      Con c [] -> do
+        choice
+          [(c `isCon` primNil, return [])]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "List" t
+
+instance Unquote Hiding where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [] -> do
+        choice
+          [(c `isCon` primHidden,  return Hidden)
+          ,(c `isCon` primInstance, return Instance)
+          ,(c `isCon` primVisible, return NotHidden)]
+          __IMPOSSIBLE__
+      Con c vs -> __IMPOSSIBLE__
+      _        -> throwException $ NotAConstructor "Hiding" t
+
+instance Unquote Relevance where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [] -> do
+        choice
+          [(c `isCon` primRelevant,   return Relevant)
+          ,(c `isCon` primIrrelevant, return Irrelevant)]
+          __IMPOSSIBLE__
+      Con c vs -> __IMPOSSIBLE__
+      _        -> throwException $ NotAConstructor "Relevance" t
+
+instance Unquote QName where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Lit (LitQName _ x) -> return x
+      _                  -> throwException $ NotALiteral "QName" t
+
+instance Unquote ConHead where
+  unquote t = lift . getConHead =<< ensureCon =<< unquote t
+
+instance Unquote a => Unquote (Abs a) where
+  unquote t = Abs "_" <$> unquote t
+
+instance Unquote Sort where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [] -> do
+        choice
+          [(c `isCon` primAgdaSortUnsupported, pure $ Type $ Max [Plus 0 $ UnreducedLevel $ hackReifyToMeta])]
+          __IMPOSSIBLE__
+      Con c [u] -> do
+        choice
+          [(c `isCon` primAgdaSortSet, Type <$> unquoteN u)
+          ,(c `isCon` primAgdaSortLit, Type . levelMax . (:[]) . ClosedLevel <$> unquoteN u)]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Sort" t
+
+instance Unquote Level where
+  unquote l = Max . (:[]) . Plus 0 . UnreducedLevel <$> unquote l
+
+instance Unquote Type where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [s, u] -> do
+        choice
+          [(c `isCon` primAgdaTypeEl, El <$> unquoteN s <*> unquoteN u)]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Type" t
+
+instance Unquote Literal where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [x] ->
+        choice
+          [ (c `isCon` primAgdaLitNat,    LitInt    noRange <$> unquoteN x)
+          , (c `isCon` primAgdaLitFloat,  LitFloat  noRange <$> unquoteN x)
+          , (c `isCon` primAgdaLitChar,   LitChar   noRange <$> unquoteN x)
+          , (c `isCon` primAgdaLitString, LitString noRange . unStr <$> unquoteN x)
+          , (c `isCon` primAgdaLitQName,  LitQName  noRange <$> unquoteN x) ]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Literal" t
+
+instance Unquote Term where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [] ->
+        choice
+          [(c `isCon` primAgdaTermUnsupported, pure hackReifyToMeta)]
+          __IMPOSSIBLE__
+
+      Con c [x] -> do
+        choice
+          [ (c `isCon` primAgdaTermSort,   Sort <$> unquoteN x)
+          , (c `isCon` primAgdaTermLit,    Lit <$> unquoteN x) ]
+          __IMPOSSIBLE__
+
+      Con c [x, y] ->
+        choice
+          [ (c `isCon` primAgdaTermVar, Var <$> (fromInteger <$> unquoteN x) <*> unquoteN y)
+          , (c `isCon` primAgdaTermCon, Con <$> unquoteN x <*> unquoteN y)
+          , (c `isCon` primAgdaTermDef, Def <$> (ensureDef =<< unquoteN x) <*> unquoteN y)
+          , (c `isCon` primAgdaTermLam, Lam <$> (flip setHiding defaultArgInfo <$> unquoteN x) <*> unquoteN y)
+          , (c `isCon` primAgdaTermPi,  mkPi <$> (domFromArg <$> unquoteN x) <*> unquoteN y)
+          , (c `isCon` primAgdaTermExtLam, mkExtLam <$> unquoteN x <*> unquoteN y) ]
+          __IMPOSSIBLE__
+        where
+          mkExtLam = ExtLam
+          mkPi a (Abs _ b) = Pi a (Abs x b)
+            where x | 0 `freeIn` b = pickName (unDom a)
+                    | otherwise    = "_"
+          mkPi _ NoAbs{} = __IMPOSSIBLE__
+
+      Con{} -> __IMPOSSIBLE__
+      Lit{} -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Term" t
+
+instance Unquote Pattern where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [] -> do
+        choice
+          [ (c `isCon` primAgdaPatVar,    pure (VarP "x"))
+          , (c `isCon` primAgdaPatAbsurd, pure (VarP "()"))
+          , (c `isCon` primAgdaPatDot,    pure (DotP hackReifyToMeta))
+          ] __IMPOSSIBLE__
+      Con c [x] -> do
+        choice
+          [ (c `isCon` primAgdaPatProj, ProjP <$> unquoteN x)
+          , (c `isCon` primAgdaPatLit,  LitP  <$> unquoteN x) ]
+          __IMPOSSIBLE__
+      Con c [x, y] -> do
+        choice
+          [ (c `isCon` primAgdaPatCon, flip ConP Nothing <$> unquoteN x <*> (map (fmap unnamed) <$> unquoteN y)) ]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Pattern" t
+
+data UnquotedFunDef = UnQFun Type [Clause]
+
+instance Unquote Clause where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [x] -> do
+        choice
+          [ (c `isCon` primAgdaClauseAbsurd, mkClause Nothing <$> unquoteN x) ]
+          __IMPOSSIBLE__
+      Con c [x, y] -> do
+        choice
+          [ (c `isCon` primAgdaClauseClause, checkClause =<< mkClause . Just <$> unquoteN y <*> unquoteN x) ]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Clause" t
+    where
+      mkClause :: Maybe Term -> [I.Arg Pattern] -> I.Clause
+      mkClause b ps0 =
+        Clause { clauseRange     = noRange
+               , clauseTel       = dummyTel n'
+               , clausePerm      = Perm n vs
+               , namedClausePats = ps
+               , clauseBody      = mkBody n b
+               , clauseType      = Nothing }
+        where
+          ps = map (fmap unnamed) ps0
+          n  = vars True ps  -- with dot patterns
+          n' = vars False ps -- without dot patterns
+          dummyTel 0 = EmptyTel
+          dummyTel n = ExtendTel (defaultDom typeDontCare) (Abs "x" $ dummyTel (n - 1))
+          mkBody 0 b = maybe NoBody Body b
+          mkBody n b = Bind $ Abs "x" $ mkBody (n - 1) b
+          vars d ps = sum $ map (vars' d . namedArg) ps
+          vars' d (ConP _ _ ps) = vars d ps
+          vars' d VarP{}      = 1
+          vars' d DotP{}      = if d then 1 else 0
+          vars' d LitP{}      = 0
+          vars' d ProjP{}     = 0
+
+          vs = evalState (execWriterT $ mapM_ (computePerm . namedArg) ps) 0
+          next = do n <- get; put (n + 1); return n
+
+          computePerm (ConP _ _ ps) = mapM_ (computePerm . namedArg) ps
+          computePerm VarP{}        = tell . (:[]) =<< next
+          computePerm DotP{}        = () <$ next
+          computePerm LitP{}        = return ()
+          computePerm ProjP{}       = return ()
+
+      checkClause :: I.Clause -> UnquoteM I.Clause
+      checkClause cl at Clause{ clausePerm = Perm n vs , clauseBody = body } = do
+        let freevs    = allVars $ freeVars $ fromMaybe __IMPOSSIBLE__ $ getBody body
+            propervs  = Set.fromList $ map ((n-1)-) vs
+            dottedvs  = Set.difference (Set.fromList [0..n-1]) propervs
+            offending = Set.intersection freevs dottedvs
+        Agda.TypeChecking.Monad.reportSDoc "tc.unquote.clause.dotvars" 30 $ vcat
+          [ text $ "checkClause "
+          , nest 2 $ text $ "free vars:      " ++ show freevs
+          , nest 2 $ text $ "dotted vars:    " ++ show dottedvs
+          , nest 2 $ text $ "offending vars: " ++ show offending
+          ]
+        if Set.null offending
+          then return cl
+          else throwException $ RhsUsesDottedVar (Set.toList offending) t
+
+instance Unquote UnquotedFunDef where
+  unquote t = do
+    t <- lift $ reduce t
+    case ignoreSharing t of
+      Con c [x, y] -> do
+        choice
+          [ (c `isCon` primAgdaFunDefCon, UnQFun <$> unquoteN x <*> unquoteN y) ]
+          __IMPOSSIBLE__
+      Con c _ -> __IMPOSSIBLE__
+      _ -> throwException $ NotAConstructor "Pattern" t
+
+reifyUnquoted :: Reify a e => a -> TCM e
+reifyUnquoted = nowReifyingUnquoted . disableDisplayForms . withShowAllArguments . reify
diff --git a/src/full/Agda/TypeChecking/With.hs b/src/full/Agda/TypeChecking/With.hs
index 7bb4c74..67485bf 100644
--- a/src/full/Agda/TypeChecking/With.hs
+++ b/src/full/Agda/TypeChecking/With.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 module Agda.TypeChecking.With where
@@ -35,7 +35,7 @@ import Agda.Utils.Monad
 import Agda.Utils.Permutation
 import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- showPat moved to TypeChecking.Pretty as prettyTCM instance
@@ -377,7 +377,7 @@ withDisplayForm f aux delta1 delta2 n qs perm@(Perm m _) lhsPerm = do
 patsToTerms :: Permutation -> [I.NamedArg Pattern] -> [I.Arg DisplayTerm]
 patsToTerms perm ps = evalState (toTerms ps) xs
   where
-    xs   = permute (invertP perm) $ downFrom (size perm)
+    xs   = permute (invertP __IMPOSSIBLE__ perm) $ downFrom (size perm)
     tick = do x : xs <- get; put xs; return x
 
     toTerms :: [I.NamedArg Pattern] -> State [Nat] [I.Arg DisplayTerm]
@@ -388,7 +388,7 @@ patsToTerms perm ps = evalState (toTerms ps) xs
       ProjP d     -> __IMPOSSIBLE__ -- TODO: convert spine to non-spine ... DDef d . defaultArg
       VarP _      -> DTerm . var <$> tick
       DotP t      -> DDot t <$ tick
-      ConP c _ ps -> DCon (conName c) <$> toTerms ps
+      ConP c _ ps -> DCon c <$> toTerms ps
       LitP l      -> return $ DTerm (Lit l)
 
 {- OLD
diff --git a/src/full/Agda/Utils/AssocList.hs b/src/full/Agda/Utils/AssocList.hs
new file mode 100644
index 0000000..962c213
--- /dev/null
+++ b/src/full/Agda/Utils/AssocList.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE CPP           #-}
+{-# LANGUAGE TupleSections #-}
+
+-- | Additional functions for association lists.
+
+module Agda.Utils.AssocList where
+
+import Prelude hiding (lookup)
+
+import Control.Applicative
+
+import Data.Functor
+import qualified Data.List as List
+
+import Agda.Utils.Tuple
+
+#include "undefined.h"
+import Agda.Utils.Impossible
+
+-- | A finite map, represented as a set of pairs.
+--
+--   Invariant: at most one value per key.
+type AssocList k v = [(k,v)]
+
+-- | O(n).
+--   Reexport 'List.lookup'.
+lookup :: Eq k => k -> AssocList k v -> Maybe v
+lookup = List.lookup
+
+-- | O(n).
+--   Get the domain (list of keys) of the finite map.
+keys :: AssocList k v -> [k]
+keys = map fst
+
+-- | O(1).
+--   Add a new binding.
+--   Assumes the binding is not yet in the list.
+insert :: k -> v -> AssocList k v -> AssocList k v
+insert k v = ((k,v) :)
+
+-- | O(n).
+--   Update the value at a key.
+--   The key must be in the domain of the finite map.
+--   Otherwise, an internal error is raised.
+update :: Eq k => k -> v -> AssocList k v -> AssocList k v
+update k v = updateAt k $ const v
+
+-- | O(n).
+--   Update the value at a key with a certain function.
+--   The key must be in the domain of the finite map.
+--   Otherwise, an internal error is raised.
+updateAt :: Eq k => k -> (v -> v) -> AssocList k v -> AssocList k v
+updateAt k f = loop where
+  loop []       = __IMPOSSIBLE__
+  loop (p@(k',v) : ps)
+    | k == k'   = (k, f v) : ps
+    | otherwise = p : loop ps
+
+-- | O(n).
+--   Map over an association list, preserving the order.
+mapWithKey :: (k -> v -> v) -> AssocList k v -> AssocList k v
+mapWithKey f = map $ \ (k,v) -> (k, f k v)
+
+-- | O(n).
+--   If called with a effect-producing function, violation of the invariant
+--   could matter here (duplicating effects).
+mapWithKeyM :: (Functor m, Applicative m) => (k -> v -> m v) -> AssocList k v -> m (AssocList k v)
+mapWithKeyM f = mapM $ \ (k,v) -> (k,) <$> f k v
+  where
+    -- mapM is applicative!
+    mapM g [] = pure []
+    mapM g (x : xs) = (:) <$> g x <*> mapM g xs
+
+-- | O(n).
+--   Named in analogy to 'Data.Map.mapKeysMonotonic'.
+--   To preserve the invariant, it is sufficient that the key
+--   transformation is injective (rather than monotonic).
+mapKeysMonotonic :: (k -> k') -> AssocList k v -> AssocList k' v
+mapKeysMonotonic f = map $ mapFst f
diff --git a/src/full/Agda/Utils/Bag.hs b/src/full/Agda/Utils/Bag.hs
new file mode 100644
index 0000000..8e38cc8
--- /dev/null
+++ b/src/full/Agda/Utils/Bag.hs
@@ -0,0 +1,217 @@
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+
+-- | A simple overlay over Data.Map to manage unordered sets with duplicates.
+
+module Agda.Utils.Bag where
+
+import Prelude hiding (null, map)
+
+import Control.Applicative hiding (empty)
+import Text.Show.Functions ()
+
+import Data.Foldable (Foldable(foldMap))
+import Data.Functor.Identity
+import qualified Data.List as List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Monoid
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Traversable as Trav
+
+import Agda.Utils.Functor
+import Agda.Utils.QuickCheck
+
+#include "undefined.h"
+import Agda.Utils.Impossible
+
+-- | A set with duplicates.
+--   Faithfully stores elements which are equal with regard to (==).
+newtype Bag a = Bag { bag :: Map a [a] }
+  deriving (Eq, Ord)
+  -- The list contains all occurrences of @a@ (not just the duplicates!).
+  -- Hence the invariant: the list is never empty!
+  --
+  -- This is slightly wasteful, but much easier to implement
+  -- in terms of Map as the alternative, which is to store
+  -- only the duplicates in the list.
+  -- See, e.g., implementation of 'union' which would be impossible
+  -- to do in the other representation.  We would need a
+  -- 'Map.unionWithKey' that passes us *both* keys.
+  -- But Map works under the assumption that Eq for keys is identity,
+  -- it does not honor information in keys that goes beyond Ord.
+
+------------------------------------------------------------------------
+-- * Query
+------------------------------------------------------------------------
+
+null :: Bag a -> Bool
+null = Map.null . bag
+
+size :: Bag a -> Int
+size = getSum . foldMap (Sum . length) . bag
+
+-- | @bag ! a@ finds all elements equal to @a at .
+(!) :: Ord a => Bag a -> a -> [a]
+Bag b ! a = Map.findWithDefault [] a b
+
+member :: Ord a => a -> Bag a -> Bool
+member a = not . notMember a
+
+notMember :: Ord a => a -> Bag a -> Bool
+notMember a b = List.null (b ! a)
+
+-- | Return the multiplicity of the given element.
+count :: Ord a => a -> Bag a -> Int
+count a b = length (b ! a)
+
+------------------------------------------------------------------------
+-- * Construction
+------------------------------------------------------------------------
+
+empty :: Bag a
+empty = Bag $ Map.empty
+
+singleton :: a -> Bag a
+singleton a = Bag $ Map.singleton a [a]
+
+union :: Ord a => Bag a -> Bag a -> Bag a
+union (Bag b) (Bag c) = Bag $ Map.unionWith (++) b c
+
+unions :: Ord a => [Bag a] -> Bag a
+unions = Bag . Map.unionsWith (++)  . List.map bag
+
+-- | @insert a b = union b (singleton a)@
+insert :: Ord a => a -> Bag a -> Bag a
+insert a = Bag . Map.insertWith (++) a [a] . bag
+
+-- | @fromList = unions . map singleton@
+fromList :: Ord a => [a] -> Bag a
+fromList = Bag . Map.fromListWith (++) . List.map (\ a -> (a,[a]))
+
+------------------------------------------------------------------------
+-- * Destruction
+------------------------------------------------------------------------
+
+-- | Returns the elements of the bag, grouped by equality (==).
+groups :: Bag a -> [[a]]
+groups = Map.elems . bag
+
+-- | Returns the bag, with duplicates.
+toList :: Bag a -> [a]
+toList = concat . groups
+
+-- | Returns the bag without duplicates.
+keys :: Bag a -> [a]
+keys = Map.keys . bag
+-- Works because of the invariant!
+-- keys = catMaybes . map headMaybe . Map.elems . bag
+--   -- Map.keys does not work, as zero copies @(a,[])@
+--   -- should count as not present in the bag.
+
+-- | Returns the bag, with duplicates.
+elems :: Bag a -> [a]
+elems = toList
+
+toAscList :: Bag a -> [a]
+toAscList = toList
+
+------------------------------------------------------------------------
+-- * Traversal
+------------------------------------------------------------------------
+
+map :: (Ord a, Ord b) => (a -> b) -> Bag a -> Bag b
+map f = Bag . Map.fromListWith (++) . List.map ff . Map.elems . bag
+  where
+    ff (a : as) = (b, b : List.map f as) where b = f a
+    ff []       = __IMPOSSIBLE__
+
+traverse :: forall a b m . (Applicative m, Ord b) => (a -> m b) -> Bag a -> m (Bag b)
+traverse f = (Bag . Map.fromListWith (++)) <.> Trav.traverse trav . Map.elems . bag
+  where
+    trav :: [a] -> m (b, [b])
+    trav (a : as) = (\ b bs -> (b, b:bs)) <$> f a <*> Trav.traverse f as
+    trav []       = __IMPOSSIBLE__
+
+------------------------------------------------------------------------
+-- * Instances
+------------------------------------------------------------------------
+
+instance Show a => Show (Bag a) where
+  showsPrec _ (Bag b) = ("Agda.Utils.Bag.Bag (" ++) . showsPrec 0 b . (')':)
+
+instance Ord a => Monoid (Bag a) where
+  mempty  = empty
+  mappend = union
+  mconcat = unions
+
+instance Foldable Bag where
+  foldMap f = foldMap f . toList
+
+-- not a Functor (only works for 'Ord'ered types)
+-- not Traversable (only works for 'Ord'ered types)
+
+------------------------------------------------------------------------
+-- * Properties
+------------------------------------------------------------------------
+
+instance (Ord a, Arbitrary a) => Arbitrary (Bag a) where
+  arbitrary = fromList <$> arbitrary
+
+prop_count_empty :: Ord a => a -> Bool
+prop_count_empty a = count a empty == 0
+
+prop_count_singleton :: Ord a => a -> Bool
+prop_count_singleton a = count a (singleton a) == 1
+
+prop_count_insert :: Ord a => a -> Bag a -> Bool
+prop_count_insert a b = count a (insert a b) == 1 + count a b
+
+prop_size_union :: Ord a => Bag a -> Bag a -> Bool
+prop_size_union b c = size (b `union` c) == size b + size c
+
+prop_size_fromList :: Ord a => [a] -> Bool
+prop_size_fromList l = size (fromList l) == length l
+
+prop_fromList_toList :: Ord a => Bag a -> Bool
+prop_fromList_toList b = fromList (toList b) == b
+
+prop_toList_fromList :: Ord a => [a] -> Bool
+prop_toList_fromList l = toList (fromList l) == List.sort l
+
+prop_keys_fromList :: Ord a => [a] -> Bool
+prop_keys_fromList l = keys (fromList l) == Set.toList (Set.fromList l)
+
+prop_nonempty_groups :: Bag a -> Bool
+prop_nonempty_groups b = all (not . List.null) $ groups b
+
+prop_map_id :: Ord a => Bag a -> Bool
+prop_map_id b = map id b == b
+
+prop_map_compose :: (Ord a, Ord b, Ord c) =>
+                    (b -> c) -> (a -> b) -> Bag a -> Bool
+prop_map_compose f g b = map f (map g b) == map (f . g) b
+
+prop_traverse_id :: Ord a => Bag a -> Bool
+prop_traverse_id b = traverse Identity b == Identity b
+
+------------------------------------------------------------------------
+-- * All tests
+------------------------------------------------------------------------
+
+-- Template Haskell hack to make the following $quickCheckAll work
+-- under ghc-7.8.
+return [] -- KEEP!
+
+-- | All tests as collected by 'quickCheckAll'.
+--
+--   Using 'quickCheckAll' is convenient and superior to the manual
+--   enumeration of tests, since the name of the property is
+--   added automatically.
+
+tests :: IO Bool
+tests = do
+  putStrLn "Agda.Utils.Favorites"
+  $quickCheckAll
diff --git a/src/full/Agda/Utils/BiMap.hs b/src/full/Agda/Utils/BiMap.hs
index 12824f1..4a70302 100644
--- a/src/full/Agda/Utils/BiMap.hs
+++ b/src/full/Agda/Utils/BiMap.hs
@@ -1,11 +1,11 @@
--- | Finite bijections (implemented as a pair of maps).
-
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TupleSections              #-}
+
+-- | Finite bijections (implemented as a pair of maps).
 
 module Agda.Utils.BiMap where
 
@@ -89,6 +89,7 @@ instance (Ord a, Ord b, Arbitrary a, Arbitrary b) => Arbitrary (BiMap a b) where
 -- * Properties
 ------------------------------------------------------------------------
 
+prop_BiMap_invariant :: (Ord a, Ord b) => BiMap a b -> Bool
 prop_BiMap_invariant (BiMap t u) =
   Map.toAscList t == List.sort (List.map swap (Map.toList u))
 
diff --git a/src/full/Agda/Utils/Char.hs b/src/full/Agda/Utils/Char.hs
index 56985a6..ae181b4 100644
--- a/src/full/Agda/Utils/Char.hs
+++ b/src/full/Agda/Utils/Char.hs
@@ -1,14 +1,54 @@
-
 module Agda.Utils.Char where
 
 import Data.Char
 
+-- | Convert a character in @'0'..'9'@ into the corresponding digit @0..9 at .
+
 decDigit :: Char -> Int
 decDigit c = ord c - ord '0'
 
+-- | Convert a character in @'0'..'9','A'..'F','a'..'f'@
+--   into the corresponding digit @0..15 at .
+
 hexDigit :: Char -> Int
-hexDigit c | isDigit c	= decDigit c
-           | otherwise	= ord (toLower c) - ord 'a' + 10
+hexDigit c | isDigit c  = decDigit c
+           | otherwise  = ord (toLower c) - ord 'a' + 10
+
+-- | Convert a character in @'0'..'7'@ into the corresponding digit @0..7 at .
 
 octDigit :: Char -> Int
 octDigit = decDigit
+
+------------------------------------------------------------------------
+-- * Unicode exploration
+------------------------------------------------------------------------
+
+-- | Unicode characters are divided into letters, numbers, marks,
+-- punctuation, symbols, separators (including spaces) and others
+-- (including control characters).
+--
+-- These are the tests that 'Data.Char' offers
+data UnicodeTest
+  = IsControl | IsSpace
+  | IsLower | IsUpper | IsAlpha | IsAlphaNum | IsPrint
+  | IsDigit | IsOctDigit | IsHexDigit
+  | IsLetter | IsMark | IsNumber | IsPunctuation | IsSymbol | IsSeparator
+  deriving (Eq, Ord, Show)
+
+-- | Test names paired with their implementation.
+unicodeTests :: [(UnicodeTest, Char -> Bool)]
+unicodeTests =
+  [ (IsControl, isControl), (IsSpace, isSpace)
+  , (IsLower, isLower), (IsUpper, isUpper), (IsAlpha, isAlpha)
+  , (IsAlphaNum, isAlphaNum)
+  , (IsPrint, isPrint)
+  , (IsDigit, isDigit), (IsOctDigit, isOctDigit), (IsHexDigit, isHexDigit)
+  , (IsLetter, isLetter), (IsMark, isMark)
+  , (IsNumber, isNumber), (IsPunctuation, isPunctuation), (IsSymbol, isSymbol)
+  , (IsSeparator, isSeparator)
+  ]
+
+-- | Find out which tests a character satisfies.
+testChar :: Char -> [UnicodeTest]
+testChar c = map fst $ filter (($ c) . snd) unicodeTests
+
diff --git a/src/full/Agda/Utils/Cluster.hs b/src/full/Agda/Utils/Cluster.hs
index 0167e52..f72229f 100644
--- a/src/full/Agda/Utils/Cluster.hs
+++ b/src/full/Agda/Utils/Cluster.hs
@@ -1,7 +1,6 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
+-- {-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE TemplateHaskell     #-}
+-- {-# LANGUAGE TupleSections       #-}
 
 -- | Create clusters of non-overlapping things.
 
@@ -18,11 +17,12 @@ import Data.Equivalence.Monad
 
 import Data.Char
 import Data.Functor
-import qualified Data.IntMap as Map
+import qualified Data.IntMap as IntMap
 import Data.List
 
 import Test.QuickCheck
 import Test.QuickCheck.All
+import Test.QuickCheck.Function
 import Text.Show.Functions
 
 -- | Characteristic identifiers.
@@ -30,23 +30,25 @@ type C = Int
 
 -- | Given a function @f :: a -> (C,[C])@ which returns a non-empty list of
 --   characteristics @C@ of @a@, partition a list of @a at s into groups
---   that share at least one characteristics.
-cluster :: forall a. (a -> (C,[C])) -> [a] -> [[a]]
+--   such that each element in a group shares at least one characteristic
+--   with at least one other element of the group.
+cluster :: (a -> (C,[C])) -> [a] -> [[a]]
 cluster f as = cluster' $ map (\ a -> (a, f a)) as
 
 -- | Partition a list of @a at s paired with a non-empty list of
--- characteristics $C$ into groups that share at least one
--- characteristics.
-cluster' :: forall a. [(a,(C,[C]))] -> [[a]]
+--   characteristics $C$ into groups
+--   such that each element in a group shares at least one characteristic
+--   with at least one other element of the group.
+cluster' :: [(a,(C,[C]))] -> [[a]]
 cluster' acs = runEquivM id const $ do
   -- Construct the equivalence classes of characteristics.
-  forM acs $ \ (_,(c,cs)) -> equateAll $ c:cs
+  forM_ acs $ \ (_,(c,cs)) -> equateAll $ c:cs
   -- Pair each element with its class.
-  cas <- forM acs $ \ (a,(c,_)) -> (`Map.singleton` [a]) <$> classDesc c
+  cas <- forM acs $ \ (a,(c,_)) -> (`IntMap.singleton` [a]) <$> classDesc c
   -- Create a map from class to elements.
-  let m = Map.unionsWith (++) cas
+  let m = IntMap.unionsWith (++) cas
   -- Return the values of the map
-  return $ Map.elems m
+  return $ IntMap.elems m
 
 ------------------------------------------------------------------------
 -- * Properties
@@ -55,29 +57,80 @@ cluster' acs = runEquivM id const $ do
 -- instance Show (Int -> (C, [C])) where
 --   show f = "function " ++ show (map (\ x -> (x, f x)) [-10..10])
 
+-- Fundamental properties: soundness and completeness
+
+-- | Not too many clusters.  (Algorithm equated all it could.)
+--
+--   Each element in a cluster shares a characteristic with at least one
+--   other element in the same cluster.
+prop_cluster_complete :: Fun Int (C, [C]) -> [Int] -> Bool
+prop_cluster_complete (Fun _ f) as =
+  (`all` cluster f as) $ \ cl ->
+  (`all` cl) $ \ a ->
+  let csa = uncurry (:) $ f a in
+  let cl' = delete a cl       in
+  -- Either a is the single element of the cluster, or it shares a characteristic c
+  -- with some other element b of the same cluster.
+  null cl' || not (null [ (b,c) | b <- cl', c <- uncurry (:) (f b), c `elem` csa ])
+
+-- | Not too few clusters.  (Algorithm did not equate too much.)
+--
+--   Elements of different clusters share no characteristics.
+prop_cluster_sound :: Fun Int (C, [C]) -> [Int] -> Bool
+prop_cluster_sound (Fun _ f) as =
+  (`all` [ (c, d) | let cs = cluster f as, c <- cs, d <- cs, c /= d]) $ \ (c, d) ->
+  (`all` c) $ \ a ->
+  (`all` d) $ \ b ->
+  null $ (uncurry (:) $ f a) `intersect` (uncurry (:) $ f b)
+
+neToList :: (a, [a]) -> [a]
+neToList = uncurry (:)
+
+isSingleton, exactlyTwo, atLeastTwo :: [a] -> Bool
 isSingleton x = length x == 1
 exactlyTwo  x = length x == 2
 atLeastTwo  x = length x >= 2
 
+prop_cluster_empty :: Bool
 prop_cluster_empty =
   null (cluster (const (0,[])) [])
 
-prop_cluster_permutation f (as :: [Int]) =
+prop_cluster_permutation :: Fun Int (C, [C]) -> [Int] -> Bool
+prop_cluster_permutation (Fun _ f) as =
   sort as == sort (concat (cluster f as))
 
+prop_cluster_single :: a -> [a] -> Bool
 prop_cluster_single a as =
   isSingleton $ cluster (const (0,[])) $ (a:as)
 
-prop_cluster_idem f a as =
+prop_cluster_idem :: Fun a (C, [C]) -> a -> [a] -> Bool
+prop_cluster_idem (Fun _ f) a as =
   isSingleton $ cluster f $ head $ cluster f (a:as)
 
-prop_two_clusters (as :: [Int]) =
+prop_two_clusters :: [Int] -> Bool
+prop_two_clusters as =
   atLeastTwo $ cluster (\ x -> (x, [x])) (-1:1:as)
 
+-- | An example.
+--
+--   "anabel" is related to "babel" (common letter 'a' in 2-letter prefix)
+--   which is related to "bond" (common letter 'b').
+--
+--   "hurz", "furz", and "kurz" are all related (common letter 'u').
+test :: [[String]]
 test = cluster (\ (x:y:_) -> (ord x,[ord y]))
          ["anabel","bond","babel","hurz","furz","kurz"]
-test1 = cluster (\ (x:y:_) -> (ord x,[]))
-         ["anabel","bond","babel","hurz","furz","kurz"]
+
+prop_test :: Bool
+prop_test = test == [["anabel","bond","babel"],["hurz","furz","kurz"]]
+
+-- | Modified example (considering only the first letter).
+test1 :: [[String]]
+test1 = cluster (\ (x:_:_) -> (ord x,[]))
+          ["anabel","bond","babel","hurz","furz","kurz"]
+
+prop_test1 :: Bool
+prop_test1 = test1 == [["anabel"],["bond","babel"],["furz"],["hurz"],["kurz"]]
 
 ------------------------------------------------------------------------
 -- * All tests
diff --git a/src/full/Agda/Utils/Either.hs b/src/full/Agda/Utils/Either.hs
index 3037d73..d7075a2 100644
--- a/src/full/Agda/Utils/Either.hs
+++ b/src/full/Agda/Utils/Either.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 ------------------------------------------------------------------------
 -- | Utilities for the 'Either' type
 ------------------------------------------------------------------------
@@ -8,6 +6,7 @@ module Agda.Utils.Either
   ( whileLeft, caseEitherM
   , mapEither, mapLeft, mapRight
   , isLeft, isRight
+  , fromLeft, fromRight
   , allRight
   , tests
   ) where
@@ -17,9 +16,6 @@ import Control.Applicative
 import Agda.Utils.QuickCheck
 import Agda.Utils.TestHelpers
 
-#include "../undefined.h"
-import Agda.Utils.Impossible
-
 -- | Loop while we have an exception.
 
 whileLeft :: Monad m => (a -> Either b c) -> (a -> b -> m a) -> (a -> c -> m d) -> a -> m d
@@ -30,10 +26,10 @@ whileLeft test left right = loop where
       Right c -> right a c
 
 -- | Monadic version of 'either' with a different argument ordering.
+
 caseEitherM :: Monad m => m (Either a b) -> (a -> m c) -> (b -> m c) -> m c
 caseEitherM mm f g = either f g =<< mm
 
-
 -- | 'Either' is a bifunctor.
 
 mapEither :: (a -> c) -> (b -> d) -> Either a b -> Either c d
@@ -50,17 +46,25 @@ mapRight :: (b -> d) -> Either a b -> Either a d
 mapRight = mapEither id
 
 -- | Returns 'True' iff the argument is @'Right' x@ for some @x at .
-
+--   Note: from @base >= 4.7.0.0@ already present in @Data.Either at .
 isRight :: Either a b -> Bool
 isRight (Right _) = True
 isRight (Left  _) = False
 
 -- | Returns 'True' iff the argument is @'Left' x@ for some @x at .
-
+--   Note: from @base >= 4.7.0.0@ already present in @Data.Either at .
 isLeft :: Either a b -> Bool
 isLeft (Right _) = False
 isLeft (Left _)  = True
 
+-- | Analogue of 'Data.Maybe.fromMaybe'.
+fromLeft :: (b -> a) -> Either a b -> a
+fromLeft = either id
+
+-- | Analogue of 'Data.Maybe.fromMaybe'.
+fromRight :: (a -> b) -> Either a b -> b
+fromRight f = either f id
+
 -- | Returns @'Just' <input with tags stripped>@ if all elements are
 -- to the right, and otherwise 'Nothing'.
 --
@@ -77,48 +81,13 @@ allRight []             = Just []
 allRight (Left  _ : _ ) = Nothing
 allRight (Right b : xs) = (b:) <$> allRight xs
 
+prop_allRight :: Eq b => [Either t b] -> Bool
 prop_allRight xs =
   allRight xs ==
     if all isRight xs then
-      Just (map fromRight xs)
+      Just $ map (\ (Right x) -> x) xs
      else
       Nothing
-  where
-  fromRight (Right x) = x
-  fromRight (Left _)  = __IMPOSSIBLE__
-
-{- Andreas, 2012-12-01 I do not know why it makes sense to copy
-   the input (only extra work for the garbage collector...
-   So I disable the code below...
-
--- | Returns @'Right' <input with tags stripped>@ if all elements are
--- to the right, and otherwise @Left <input>@:
---
--- @
---  allRight xs ==
---    if all isRight xs then
---      Right (map (\(Right x) -> x) xs)
---     else
---      Left xs
--- @
-
-allRight :: [Either a b] -> Either [Either a b] [b]
-allRight []              = Right []
-allRight xs@(Left _ : _) = Left xs
-allRight (Right b : xs)  = case allRight xs of
-  Left  xs -> Left (Right b : xs)
-  Right bs -> Right (b : bs)
-
-prop_allRight xs =
-  allRight xs ==
-    if all isRight xs then
-      Right (map fromRight xs)
-     else
-      Left xs
-  where
-  fromRight (Right x) = x
-  fromRight (Left _)  = __IMPOSSIBLE__
--}
 
 ------------------------------------------------------------------------
 -- All tests
diff --git a/src/full/Agda/Utils/Empty.hs b/src/full/Agda/Utils/Empty.hs
new file mode 100644
index 0000000..2ae574a
--- /dev/null
+++ b/src/full/Agda/Utils/Empty.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP            #-}
+{-# LANGUAGE EmptyDataDecls #-}
+
+-- | An empty type with some useful instances.
+module Agda.Utils.Empty where
+
+import Agda.Utils.Impossible
+
+#include "undefined.h"
+
+data Empty
+
+instance Eq Empty where
+  _ == _ = True
+
+instance Ord Empty where
+  compare _ _ = EQ
+
+instance Show Empty where
+  showsPrec p _ = showParen (p > 9) $ showString "error \"Agda.Utils.Empty.Empty\""
+
+absurd :: Empty -> a
+absurd e = seq e __IMPOSSIBLE__
+
diff --git a/src/full/Agda/Utils/Except.hs b/src/full/Agda/Utils/Except.hs
new file mode 100644
index 0000000..f2c3107
--- /dev/null
+++ b/src/full/Agda/Utils/Except.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+------------------------------------------------------------------------------
+-- | Wrapper for Control.Monad.Except from the mtl package
+------------------------------------------------------------------------------
+
+module Agda.Utils.Except
+  ( Error(noMsg, strMsg)
+  , ExceptT
+  , mkExceptT
+  , MonadError(catchError, throwError)
+  , runExceptT
+  ) where
+
+------------------------------------------------------------------------
+#if MIN_VERSION_mtl(2,2,1)
+-- New mtl, reexport ExceptT, define class Error for backward compat.
+------------------------------------------------------------------------
+
+import Control.Monad.Except
+
+-- | We cannot define data constructors synonymous, so we define the
+-- @mkExceptT@ function to be used instead of the data constructor
+-- @ExceptT at .
+mkExceptT :: m (Either e a) -> ExceptT e m a
+mkExceptT = ExceptT
+
+-- From Control.Monad.Trans.Error of transformers 0.3.0.0.
+
+class Error a where
+  noMsg  :: a
+  strMsg :: String -> a
+
+  noMsg    = strMsg ""
+  strMsg _ = noMsg
+
+-- | A string can be thrown as an error.
+instance Error String where
+    strMsg = id
+
+------------------------------------------------------------------------
+#else
+-- Old mtl, need to define ExceptT from ErrorT
+------------------------------------------------------------------------
+
+import Control.Monad.Error
+
+type ExceptT = ErrorT
+
+-- | We cannot define data constructors synonymous, so we define the
+-- @mkExceptT@ function to be used instead of the data constructor
+-- @ErrorT at .
+mkExceptT :: m (Either e a) -> ExceptT e m a
+mkExceptT = ErrorT
+
+-- | 'runExcept' function using mtl 2.1.*.
+runExceptT ::  ExceptT e m a -> m (Either e a)
+runExceptT = runErrorT
+
+#endif
diff --git a/src/full/Agda/Utils/Favorites.hs b/src/full/Agda/Utils/Favorites.hs
index 2a290b1..317e262 100644
--- a/src/full/Agda/Utils/Favorites.hs
+++ b/src/full/Agda/Utils/Favorites.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveFoldable             #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 -- | Maintaining a list of favorites of some partially ordered type.
 --   Only the best elements are kept.
@@ -39,7 +39,7 @@ import Agda.Utils.QuickCheck
 import Agda.Utils.TestHelpers
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | A list of incomparable favorites.
@@ -151,12 +151,15 @@ instance PartialOrd a => Monoid (Favorites a) where
 instance (PartialOrd a, Arbitrary a) => Arbitrary (Favorites a) where
   arbitrary = fromList <$> arbitrary
 
+property_null_empty :: Bool
 property_null_empty = null empty
 
+property_not_null_singleton :: a -> Bool
 property_not_null_singleton = not . null . singleton
 
 -- Remember: less is better!
 
+prop_compareWithFavorites :: ISet -> Favorites ISet -> Bool
 prop_compareWithFavorites a at ISet{} as =
   case compareWithFavorites a as of
     Dominates dominated notDominated ->
diff --git a/src/full/Agda/Utils/FileName.hs b/src/full/Agda/Utils/FileName.hs
index 94a7d6f..626a573 100644
--- a/src/full/Agda/Utils/FileName.hs
+++ b/src/full/Agda/Utils/FileName.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 {-| Operations on file names. -}
@@ -30,7 +30,7 @@ import Data.Typeable (Typeable)
 import Agda.Utils.TestHelpers
 import Agda.Utils.QuickCheck
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Paths which are known to be absolute.
@@ -75,6 +75,11 @@ mkAbsolute f
       AbsolutePath $ ByteString.pack $ dropTrailingPathSeparator $ normalise f
   | otherwise    = __IMPOSSIBLE__
 
+#if mingw32_HOST_OS
+prop_mkAbsolute :: FilePath -> Property
+#else
+prop_mkAbsolute :: FilePath -> Bool
+#endif
 prop_mkAbsolute f =
   let path = rootPath ++ f
   in
@@ -83,6 +88,7 @@ prop_mkAbsolute f =
 #endif
       absolutePathInvariant $ mkAbsolute $ path
 
+rootPath :: FilePath
 #if mingw32_HOST_OS
 rootPath = joinDrive "C:" [pathSeparator]
 #else
@@ -148,6 +154,7 @@ instance Arbitrary AbsolutePath where
 ------------------------------------------------------------------------
 -- All tests
 
+tests :: IO Bool
 tests = runTests "Agda.Utils.FileName"
   [ quickCheck' absolutePathInvariant
   , quickCheck' prop_mkAbsolute
diff --git a/src/full/Agda/Utils/Fresh.hs b/src/full/Agda/Utils/Fresh.hs
deleted file mode 100644
index 95d8740..0000000
--- a/src/full/Agda/Utils/Fresh.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-{-| A common interface for monads which allow some kind of fresh name
-    generation.
--}
-module Agda.Utils.Fresh where
-
-import Control.Monad.State
-import Control.Monad.Reader
-
-class HasFresh i a where
-    nextFresh :: a -> (i,a)
-
-fresh :: (HasFresh i s, MonadState s m) => m i
-fresh =
-    do	(i,s) <- gets nextFresh
-	put s
-	return i
-
-withFresh :: (HasFresh i e, MonadReader e m) => (i -> m a) -> m a
-withFresh ret =
-    do	(i,e) <- asks nextFresh
-	local (const e) $ ret i
diff --git a/src/full/Agda/Utils/Function.hs b/src/full/Agda/Utils/Function.hs
index b27997d..1f0bcdf 100644
--- a/src/full/Agda/Utils/Function.hs
+++ b/src/full/Agda/Utils/Function.hs
@@ -1,24 +1,55 @@
+{-# LANGUAGE TupleSections #-}
 
 module Agda.Utils.Function where
 
+-- | Repeat something while a condition on some state is true.
+--   Return the last state (including the changes of the last
+--   transition, even if the condition became false then).
+
+repeatWhile :: (a -> (Bool, a)) -> a -> a
+repeatWhile f = loop where
+  loop a = if again then loop a' else a'
+    where (again, a') = f a
+
+-- | Monadic version of 'repeatWhile'.
+repeatWhileM :: (Monad m) => (a -> m (Bool, a)) -> a -> m a
+repeatWhileM f = loop where
+  loop a = do
+    (again, a') <- f a
+    if again then loop a' else return a'
+
 -- | A version of the trampoline function.
 --
 --   The usual function iterates @f :: a -> Maybe a@ as long
 --   as @Just{}@ is returned, and returns the last value of @a@
 --   upon @Nothing at .
 --
---   @usualTrampoline f = trampoline $ \ a -> maybe (False,a) (True,) (f a)@.
-trampoline :: (a -> (Bool, a)) -> a -> a
+--   @usualTrampoline f = trampolineWhile $ \ a -> maybe (False,a) (True,) (f a)@.
+--
+--   @trampolineWhile@ is very similar to @repeatWhile@, only that
+--   it discards the state on which the condition went @False@,
+--   and returns the last state on which the condition was @True at .
+trampolineWhile :: (a -> (Bool, a)) -> a -> a
+trampolineWhile f = repeatWhile $ \ a ->
+  let (again, a') = f a
+  in (again,) $ if again then a' else a
+
+-- | Monadic version of 'trampolineWhile'.
+trampolineWhileM :: (Monad m) => (a -> m (Bool, a)) -> a -> m a
+trampolineWhileM f = repeatWhileM $ \ a -> do
+  (again, a') <- f a
+  return $ (again,) $ if again then a' else a
+
+-- | More general trampoline, which allows some final computation
+--   from iteration state @a@ into result type @b at .
+trampoline :: (a -> Either b a) -> a -> b
 trampoline f = loop where
-  loop a = if again then loop a' else a'
-    where (again, a') = f a
+  loop a = either id loop $ f a
 
 -- | Monadic version of 'trampoline'.
-trampolineM :: (Monad m) => (a -> m (Bool, a)) -> a -> m a
+trampolineM :: Monad m => (a -> m (Either b a)) -> a -> m b
 trampolineM f = loop where
-  loop a = do
-    (again, a') <- f a
-    if again then loop a' else return a'
+  loop a = either return loop =<< f a
 
 -- | Iteration to fixed-point.
 --
diff --git a/src/full/Agda/Utils/Functor.hs b/src/full/Agda/Utils/Functor.hs
index 724a04e..621e970 100644
--- a/src/full/Agda/Utils/Functor.hs
+++ b/src/full/Agda/Utils/Functor.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE TupleSections #-}
 
 -- | Utilities for functors.
@@ -13,6 +14,12 @@ import Data.Functor.Identity
 import Data.Functor.Compose
 import Data.Functor.Constant
 
+-- ASR (15 October 2014): See issue 1304.
+#if !MIN_VERSION_transformers(0,4,1)
+instance Eq a => Eq (Identity a) where
+  Identity x == Identity x' = x == x'
+#endif
+
 infixr 4 $>
 
 ($>) :: Functor f => f a -> b -> f b
@@ -29,6 +36,12 @@ infixr 9 <.>
 for :: Functor m => m a -> (a -> b) -> m b
 for = flip fmap
 
+infix 4 <&>
+
+-- | Infix version of 'for'.
+(<&>) :: Functor m => m a -> (a -> b) -> m b
+(<&>) = for
+
 -- | A decoration is a functor that is traversable into any functor.
 --
 --   The 'Functor' superclass is given because of the limitations
diff --git a/src/full/Agda/Utils/Geniplate.hs b/src/full/Agda/Utils/Geniplate.hs
index d8c88f6..ecac3fe 100644
--- a/src/full/Agda/Utils/Geniplate.hs
+++ b/src/full/Agda/Utils/Geniplate.hs
@@ -11,12 +11,15 @@ module Agda.Utils.Geniplate
 import Data.Generics.Geniplate
 import Data.Map (Map)
 
+import qualified Language.Haskell.TH as TH
+
 import qualified Agda.Syntax.Abstract.Name as A
 import qualified Agda.Syntax.Concrete.Name as C
 import qualified Agda.Syntax.Scope.Base as S
 
 -- | Types which Geniplate should not descend into.
 
+dontDescendInto :: [TH.TypeQ]
 dontDescendInto =
   [ [t| String |]
   , [t| A.QName |]
@@ -32,6 +35,7 @@ dontDescendInto =
 -- 'universeBi' functions neither descend into the types in
 -- 'dontDescendInto', nor into the types in the list argument.
 
+instanceUniverseBiT' :: [TH.TypeQ] -> TH.TypeQ -> TH.Q [TH.Dec]
 instanceUniverseBiT' ts p =
   instanceUniverseBiT (ts ++ dontDescendInto) p
 
@@ -39,5 +43,6 @@ instanceUniverseBiT' ts p =
 -- 'transformBiM' functions neither descend into the types in
 -- 'dontDescendInto', nor into the types in the list argument.
 
+instanceTransformBiMT' :: [TH.TypeQ] -> TH.TypeQ -> TH.TypeQ -> TH.Q [TH.Dec]
 instanceTransformBiMT' ts p =
   instanceTransformBiMT (ts ++ dontDescendInto) p
diff --git a/src/full/Agda/Utils/Graph/AdjacencyMap.hs b/src/full/Agda/Utils/Graph/AdjacencyMap.hs
index 3e914e9..444fb02 100644
--- a/src/full/Agda/Utils/Graph/AdjacencyMap.hs
+++ b/src/full/Agda/Utils/Graph/AdjacencyMap.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE TupleSections, DeriveFunctor, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections              #-}
 
 -- | Directed graphs (can of course simulate undirected graphs).
 --
@@ -128,6 +130,7 @@ nodes g = Map.keysSet (unGraph g)
 fromNodes :: Ord n => [n] -> Graph n e
 fromNodes = Graph . Map.fromList . map (, Map.empty)
 
+prop_nodes_fromNodes :: Ord n => [n] -> Bool
 prop_nodes_fromNodes ns = nodes (fromNodes ns) == Set.fromList ns
 
 -- | Constructs a graph from a list of edges.  O(e)
@@ -278,6 +281,7 @@ transitiveClosure g = List.foldl' extend g $ sccs' g
       Just es -> Graph $ Map.singleton a $ Map.map (otimes w) es
       Nothing -> empty
 
+prop_transitiveClosure :: (Eq e, SemiRing e, Ord n) => Graph n e -> Property
 prop_transitiveClosure g = label sccInfo $
   transitiveClosure g == transitiveClosure1 g
   where
diff --git a/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs b/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs
index 8db1060..ed73e66 100644
--- a/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs
+++ b/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs
@@ -1,5 +1,8 @@
-{-# LANGUAGE TupleSections, DoAndIfThenElse,
-  DeriveFunctor, GeneralizedNewtypeDeriving, FlexibleInstances #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DoAndIfThenElse            #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections              #-}
 
 -- | Directed graphs (can of course simulate undirected graphs).
 --
@@ -67,7 +70,7 @@ import Data.Set (Set)
 
 import Agda.Utils.Function (iterateUntil)
 import Agda.Utils.Functor (for)
-import Agda.Utils.List (mhead)
+import Agda.Utils.List (headMaybe)
 import Agda.Utils.QuickCheck as QuickCheck
 import Agda.Utils.SemiRing
 import Agda.Utils.TestHelpers
@@ -157,6 +160,7 @@ lookup s t (Graph g) = Map.lookup t =<< Map.lookup s g
 neighbours :: (Ord s, Ord t) => s -> Graph s t e -> [(t, e)]
 neighbours s (Graph g) = maybe [] Map.assocs $ Map.lookup s g
 
+prop_neighbours :: (Ord s, Ord t, Eq e) => s -> Graph s t e -> Bool
 prop_neighbours s g =
   neighbours s g == map (\ (Edge s t e) -> (t, e)) (edgesFrom g [s])
 
@@ -204,6 +208,7 @@ nodes = allNodes . computeNodes
 fromNodes :: Ord n => [n] -> Graph n n e
 fromNodes ns = Graph $ Map.fromList $ map (, Map.empty) ns
 
+prop_nodes_fromNodes :: Ord n => [n] -> Bool
 prop_nodes_fromNodes ns = sourceNodes (fromNodes ns) == Set.fromList ns
 
 -- | Constructs a graph from a list of edges.  O(e log n)
@@ -222,7 +227,7 @@ fromListWith f = List.foldl' (flip (insertEdgeWith f)) empty
 
 -- | Convert a graph into a list of edges. O(e)
 
-toList ::  (Ord s, Ord t) => Graph s t e -> [Edge s t e]
+toList :: (Ord s, Ord t) => Graph s t e -> [Edge s t e]
 toList (Graph g) = [ Edge s t a | (s,m) <- Map.assocs g, (t,a) <- Map.assocs m ]
 
 -- | Empty graph (no nodes, no edges).
@@ -246,12 +251,14 @@ insertEdge (Edge s t e) = insert s t e
 -- | Insert an edge, possibly combining @old@ edge weight with @new@ weight by
 --   given function @f@ into @f new old at .
 
-insertWith :: (Ord s, Ord t) => (e -> e -> e) -> s -> t -> e -> Graph s t e -> Graph s t e
+insertWith :: (Ord s, Ord t) =>
+              (e -> e -> e) -> s -> t -> e -> Graph s t e -> Graph s t e
 insertWith f s t e (Graph g) = Graph (Map.alter (Just . ins) s g)
   where ins Nothing  = Map.singleton t e
         ins (Just m) = Map.insertWith f t e m
 
-insertEdgeWith :: (Ord s, Ord t) => (e -> e -> e) -> Edge s t e -> Graph s t e -> Graph s t e
+insertEdgeWith :: (Ord s, Ord t) =>
+                  (e -> e -> e) -> Edge s t e -> Graph s t e -> Graph s t e
 insertEdgeWith f (Edge s t e) = insertWith f s t e
 
 -- | Left-biased union.
@@ -259,7 +266,8 @@ insertEdgeWith f (Edge s t e) = insertWith f s t e
 union :: (Ord s, Ord t) => Graph s t e -> Graph s t e -> Graph s t e
 union = unionWith $ \ left right -> left
 
-unionWith :: (Ord s, Ord t) => (e -> e -> e) -> Graph s t e -> Graph s t e -> Graph s t e
+unionWith :: (Ord s, Ord t) =>
+             (e -> e -> e) -> Graph s t e -> Graph s t e -> Graph s t e
 unionWith f (Graph g) (Graph g') = Graph $ Map.unionWith (Map.unionWith f) g g'
 
 unions ::(Ord s, Ord t) => [Graph s t e] -> Graph s t e
@@ -268,7 +276,8 @@ unions = unionsWith $ \ left right -> left
 unionsWith :: (Ord s, Ord t) => (e -> e -> e) -> [Graph s t e] -> Graph s t e
 unionsWith f = List.foldl' (unionWith f) empty
 
-prop_insertWith :: (Eq e, Ord s, Ord t) => (e -> e -> e) -> s -> t -> e -> Graph s t e -> Bool
+prop_insertWith :: (Eq e, Ord s, Ord t) =>
+                   (e -> e -> e) -> s -> t -> e -> Graph s t e -> Bool
 prop_insertWith f s t e g =
   insertWith f s t e g == unionWith (flip f) g (singleton s t e)
 
@@ -448,6 +457,7 @@ transitiveClosure g = List.foldl' extend g $ sccs' g
 
 -- | Correctness of the optimized algorithm that proceeds by SCC.
 
+prop_transitiveClosure :: (Eq e, SemiRing e, Ord n) => Graph n n e -> Property
 prop_transitiveClosure g = QuickCheck.label sccInfo $
   transitiveClosure g == transitiveClosure1 g
   where
@@ -461,7 +471,7 @@ prop_transitiveClosure g = QuickCheck.label sccInfo $
 --
 --   The path must satisfy the given predicate @good :: e -> Bool at .
 findPath :: (SemiRing e, Ord n) => (e -> Bool) -> n -> n -> Graph n n e -> Maybe e
-findPath good a b g = mhead $ filter good $ allPaths good a b g
+findPath good a b g = headMaybe $ filter good $ allPaths good a b g
 
 -- | @allPaths classify a b g@ returns a list of pathes (accumulated edge weights)
 --   from node @a@ to node @b@ in @g at .
@@ -524,6 +534,7 @@ type G = Graph N N E
 newtype N = N (Positive Int)
   deriving (Arbitrary, Eq, Ord)
 
+n :: Int -> N
 n = N . Positive
 
 instance Show N where
diff --git a/src/full/Agda/Utils/HashMap.hs b/src/full/Agda/Utils/HashMap.hs
index c901f24..35bce49 100644
--- a/src/full/Agda/Utils/HashMap.hs
+++ b/src/full/Agda/Utils/HashMap.hs
@@ -1,4 +1,3 @@
-
 module Agda.Utils.HashMap
   ( module HashMap ) where
 
diff --git a/src/full/Agda/Utils/IO/UTF8.hs b/src/full/Agda/Utils/IO/UTF8.hs
index 7ab15d0..f782fac 100644
--- a/src/full/Agda/Utils/IO/UTF8.hs
+++ b/src/full/Agda/Utils/IO/UTF8.hs
@@ -9,7 +9,22 @@ module Agda.Utils.IO.UTF8
 import qualified System.IO as IO
 import Control.Applicative
 
-import Agda.Utils.Unicode
+-- | Converts many character sequences which may be interpreted as
+-- line or paragraph separators into '\n'.
+
+convertLineEndings :: String -> String
+-- ASCII:
+convertLineEndings ('\x000D' : '\x000A' : s) = '\n' : convertLineEndings s  -- CR LF
+convertLineEndings ('\x000A'            : s) = '\n' : convertLineEndings s  -- LF  (Line feed)
+convertLineEndings ('\x000D'            : s) = '\n' : convertLineEndings s  -- CR  (Carriage return)
+convertLineEndings ('\x000C'            : s) = '\n' : convertLineEndings s  -- FF  (Form feed)
+-- Unicode:
+convertLineEndings ('\x0085'            : s) = '\n' : convertLineEndings s  -- NEXT LINE
+convertLineEndings ('\x2028'            : s) = '\n' : convertLineEndings s  -- LINE SEPARATOR
+convertLineEndings ('\x2029'            : s) = '\n' : convertLineEndings s  -- PARAGRAPH SEPARATOR
+-- Not a line ending:
+convertLineEndings (c                   : s) = c    : convertLineEndings s
+convertLineEndings ""                        = ""
 
 -- | Reads a UTF8-encoded text file and converts all Unicode line
 -- endings into '\n'.
diff --git a/src/full/Agda/Utils/IORef.hs b/src/full/Agda/Utils/IORef.hs
new file mode 100644
index 0000000..6877e1a
--- /dev/null
+++ b/src/full/Agda/Utils/IORef.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE CPP #-}
+
+-- | Provides @Data.IORef.modifyIORef'@ for @base < 4.6 at .
+
+module Agda.Utils.IORef
+  ( module Data.IORef
+  , module Agda.Utils.IORef
+  ) where
+
+import Data.IORef
+
+#if !MIN_VERSION_base(4,6,0)
+
+-- | Strict version of 'modifyIORef'.
+--
+-- /Since: 4.6.0.0/
+modifyIORef' :: IORef a -> (a -> a) -> IO ()
+modifyIORef' ref f = do
+    x <- readIORef ref
+    writeIORef ref $! f x
+
+#endif
+
+-- | Read 'IORef', modify it strictly, and return old value.
+readModifyIORef' :: IORef a -> (a -> a) -> IO a
+readModifyIORef' ref f = do
+    x <- readIORef ref
+    writeIORef ref $! f x
+    return x
diff --git a/src/full/Agda/Utils/Lens.hs b/src/full/Agda/Utils/Lens.hs
new file mode 100644
index 0000000..75820af
--- /dev/null
+++ b/src/full/Agda/Utils/Lens.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE RankNTypes #-}
+
+-- | A cut-down implementation of lenses, with names taken from
+--   Edward Kmett's lens package.
+
+module Agda.Utils.Lens
+  ( module Agda.Utils.Lens
+  , (<&>) -- reexported from Agda.Utils.Functor
+  ) where
+
+import Control.Monad.State
+import Control.Monad.Reader
+
+import Data.Functor.Constant
+import Data.Functor.Identity
+
+import Agda.Utils.Functor ((<&>))
+
+-- * Type-preserving lenses.
+
+-- | Van Laarhoven style homogeneous lenses.
+--   Mnemoic: "Lens inner outer".
+type Lens' i o = forall f. Functor f => (i -> f i) -> o -> f o
+
+
+-- * Elementary lens operations.
+
+infixl 8 ^.
+-- | Get inner part @i@ of structure @o@ as designated by @Lens' i o at .
+(^.) :: o -> Lens' i o -> i
+o ^. l = getConstant $ l Constant o
+
+-- | Set inner part @i@ of structure @o@ as designated by @Lens' i o at .
+set :: Lens' i o -> i -> o -> o
+set l = over l . const
+
+-- | Modify inner part @i@ of structure @o@ using a function @i -> i at .
+over :: Lens' i o -> (i -> i) -> o -> o
+over l f o = runIdentity $ l (Identity . f) o
+
+
+-- * State accessors and modifiers.
+
+-- | Read a part of the state.
+use :: MonadState o m => Lens' i o -> m i
+use l = gets (^. l)
+
+infix  4 .=
+-- | Write a part of the state.
+(.=) :: MonadState o m => Lens' i o -> i -> m ()
+l .= i = modify $ set l i
+
+infix  4 %=
+-- | Modify a part of the state.
+(%=) :: MonadState o m => Lens' i o -> (i -> i) -> m ()
+l %= f = modify $ over l f
+
+
+-- * Read-only state accessors and modifiers.
+
+-- | Ask for part of read-only state.
+view :: MonadReader o m => Lens' i o -> m i
+view l = asks (^. l)
+
+-- | Modify a part of the state in a subcomputation.
+locally :: MonadReader o m => Lens' i o -> (i -> i) -> m a -> m a
+locally l = local . over l
+
diff --git a/src/full/Agda/Utils/Lens/Examples.hs b/src/full/Agda/Utils/Lens/Examples.hs
new file mode 100644
index 0000000..ccae1b0
--- /dev/null
+++ b/src/full/Agda/Utils/Lens/Examples.hs
@@ -0,0 +1,18 @@
+-- | Examples how to use 'Agda.Utils.Lens'.
+
+module Agda.Utils.Lens.Examples where
+
+import Agda.Utils.Functor
+import Agda.Utils.Lens
+
+data Record a b = Record
+  { field1 :: a
+  , field2 :: b
+  }
+
+-- | (View source:) This is how you implement a lens for a record field.
+lensField1 :: Lens' a (Record a b)
+lensField1 f r = f (field1 r) <&> \ a -> r { field1 = a }
+
+lensField2 :: Lens' b (Record a b)
+lensField2 f r = f (field2 r) <&> \ b -> r { field2 = b }
diff --git a/src/full/Agda/Utils/List.hs b/src/full/Agda/Utils/List.hs
index 28e9d21..4910e09 100644
--- a/src/full/Agda/Utils/List.hs
+++ b/src/full/Agda/Utils/List.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP             #-}
+{-# LANGUAGE PatternGuards   #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 {-| Utitlity functions on lists.
@@ -10,24 +10,50 @@ import Data.Functor ((<$>))
 import Data.Function
 import Data.List
 import Data.Maybe
+import Data.Map (Map)
+import qualified Data.Map as Map
 import qualified Data.Set as Set
 
 import Text.Show.Functions ()
 import Test.QuickCheck
 import Test.QuickCheck.All
 
+import Agda.Utils.Bag (Bag)
+import qualified Agda.Utils.Bag as Bag
 import Agda.Utils.TestHelpers
 -- import Agda.Utils.QuickCheck -- Andreas, 2014-04-27 Inconvenient
 -- because cabal-only CPP directive
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
+-- | Case distinction for lists, with list first.
+--   Cf. 'Agda.Utils.Null.ifNull'.
+caseList :: [a] -> b -> (a -> [a] -> b) -> b
+caseList []     n c = n
+caseList (x:xs) n c = c x xs
+
+-- | Case distinction for lists, with list last.
+listCase :: b -> (a -> [a] -> b) -> [a] -> b
+listCase n c []     = n
+listCase n c (x:xs) = c x xs
+
 -- | Head function (safe).
-mhead :: [a] -> Maybe a
-mhead []    = Nothing
-mhead (x:_) = Just x
+headMaybe :: [a] -> Maybe a
+headMaybe = listToMaybe
+
+-- | Head function (safe). Returns a value on empty lists.
+--
+-- > headWithDefault 42 []      = 42
+-- > headWithDefault 42 [1,2,3] = 1
+headWithDefault :: a -> [a] -> a
+headWithDefault def = fromMaybe def . headMaybe
+
+-- | Last element (safe).
+lastMaybe :: [a] -> Maybe a
+lastMaybe [] = Nothing
+lastMaybe xs = Just $ last xs
 
 -- | Opposite of cons @(:)@, safe.
 uncons :: [a] -> Maybe (a, [a])
@@ -143,12 +169,12 @@ preOrSuffix (a:as) (b:bs)
 wordsBy :: (a -> Bool) -> [a] -> [[a]]
 wordsBy p xs = yesP xs
     where
-	yesP xs = noP (dropWhile p xs)
+        yesP xs = noP (dropWhile p xs)
 
-	noP []	= []
-	noP xs	= ys : yesP zs
-	    where
-		(ys,zs) = break p xs
+        noP []  = []
+        noP xs  = ys : yesP zs
+            where
+                (ys,zs) = break p xs
 
 -- | Chop up a list in chunks of a given length.
 chop :: Int -> [a] -> [[a]]
@@ -167,13 +193,13 @@ holes (x:xs) = (x, xs) : map (id -*- (x:)) (holes xs)
 
 sorted :: Ord a => [a] -> Bool
 sorted [] = True
-sorted xs = and $ zipWith (<=) (init xs) (tail xs)
+sorted xs = and $ zipWith (<=) xs (tail xs)
 
 -- | Check whether all elements in a list are distinct from each
 -- other. Assumes that the 'Eq' instance stands for an equivalence
 -- relation.
 distinct :: Eq a => [a] -> Bool
-distinct []	= True
+distinct []     = True
 distinct (x:xs) = x `notElem` xs && distinct xs
 
 -- | An optimised version of 'distinct'.
@@ -192,6 +218,14 @@ allEqual :: Eq a => [a] -> Bool
 allEqual []       = True
 allEqual (x : xs) = all (== x) xs
 
+-- | Returns an (arbitrary) representative for each list element
+--   that occurs more than once.
+duplicates :: Ord a => [a] -> [a]
+duplicates = mapMaybe dup . Bag.groups . Bag.fromList
+  where
+    dup (a : _ : _) = Just a
+    dup _           = Nothing
+
 -- | A variant of 'groupBy' which applies the predicate to consecutive
 -- pairs.
 
@@ -289,17 +323,23 @@ zipWithTails f (x : xs) (y : ys) = (f x y : zs , as , bs)
   where (zs , as , bs) = zipWithTails f xs ys
 -}
 
--- | Efficient version of nub that sorts the list first. The tag function is
---   assumed to be cheap. If it isn't pair up the elements with their tags and
---   call uniqBy fst (or snd).
-uniqBy :: Ord b => (a -> b) -> [a] -> [a]
-uniqBy tag =
-  map head
-  . groupBy ((==) `on` tag)
-  . sortBy (compare `on` tag)
+-- | Efficient version of nub that sorts the list via a search tree ('Data.Map').
+uniqOn :: Ord b => (a -> b) -> [a] -> [a]
+uniqOn key = Map.elems . Map.fromList . map (\ a -> (key a, a))
+
+-- Andreas, 2014-10-09 RETIRED, the Map version is simpler,
+-- and possibly more efficient (discards duplicates early).
+-- -- | Efficient version of nub that sorts the list first. The tag function is
+-- --   assumed to be cheap. If it isn't pair up the elements with their tags and
+-- --   call uniqOn fst (or snd).
+-- uniqOn :: Ord b => (a -> b) -> [a] -> [a]
+-- uniqOn tag =
+--   map head
+--   . groupBy ((==) `on` tag)
+--   . sortBy (compare `on` tag)
 
-prop_uniqBy :: [Integer] -> Bool
-prop_uniqBy xs = sort (nub xs) == uniqBy id xs
+prop_uniqOn :: [Integer] -> Bool
+prop_uniqOn xs = sort (nub xs) == uniqOn id xs
 
 -- | Compute the common suffix of two lists.
 commonSuffix :: Eq a => [a] -> [a] -> [a]
@@ -346,5 +386,5 @@ tests = do
 --   , quickCheck' prop_extractNthElement
 --   , quickCheck' prop_genericElemIndex
 --   , quickCheck' prop_zipWith'
---   , quickCheck' prop_uniqBy
+--   , quickCheck' prop_uniqOn
 --   ]
diff --git a/src/full/Agda/Utils/Map.hs b/src/full/Agda/Utils/Map.hs
index 411b5db..f82a009 100644
--- a/src/full/Agda/Utils/Map.hs
+++ b/src/full/Agda/Utils/Map.hs
@@ -9,7 +9,7 @@ import Data.Traversable
 
 import Agda.Utils.Tuple
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- * Monadic map operations
@@ -21,22 +21,22 @@ data EitherOrBoth a b = L a | B a b | R b
 unionWithM :: (Ord k, Functor m, Monad m) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
 unionWithM f m1 m2 = fromList <$> mapM combine (toList m)
     where
-	m = unionWith both (map L m1) (map R m2)
+        m = unionWith both (map L m1) (map R m2)
 
-	both (L a) (R b) = B a b
-	both _     _	 = __IMPOSSIBLE__
+        both (L a) (R b) = B a b
+        both _     _     = __IMPOSSIBLE__
 
-	combine (k, B a b) = (,) k <$> f a b
-	combine (k, L a)   = return (k, a)
-	combine (k, R b)   = return (k, b)
+        combine (k, B a b) = (,) k <$> f a b
+        combine (k, L a)   = return (k, a)
+        combine (k, R b)   = return (k, b)
 
 insertWithKeyM :: (Ord k, Monad m) => (k -> a -> a -> m a) -> k -> a -> Map k a -> m (Map k a)
 insertWithKeyM clash k x m =
     case lookup k m of
-	Just y	-> do
-	    z <- clash k x y
-	    return $ insert k z m
-	Nothing	-> return $ insert k x m
+        Just y  -> do
+            z <- clash k x y
+            return $ insert k z m
+        Nothing -> return $ insert k x m
 
 -- * Non-monadic map operations
 ---------------------------------------------------------------------------
diff --git a/src/full/Agda/Utils/Maybe.hs b/src/full/Agda/Utils/Maybe.hs
index 027335f..7c586f1 100644
--- a/src/full/Agda/Utils/Maybe.hs
+++ b/src/full/Agda/Utils/Maybe.hs
@@ -73,7 +73,7 @@ caseMaybeM mm err f = maybeM  err f mm
 ifJustM :: Monad m => m (Maybe a) -> (a -> m b) -> m b -> m b
 ifJustM mm = flip (caseMaybeM mm)
 
--- | A more telling name for 'Traversable.forM' for the 'Maybe' collection type.
+-- | A more telling name for 'Traversable.forM_' for the 'Maybe' collection type.
 --   Or: 'caseMaybe' without the 'Nothing' case.
 whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenJust m k = caseMaybe m (return ()) k
diff --git a/src/full/Agda/Utils/Maybe/Strict.hs b/src/full/Agda/Utils/Maybe/Strict.hs
index aaa2629..75d8213 100644
--- a/src/full/Agda/Utils/Maybe/Strict.hs
+++ b/src/full/Agda/Utils/Maybe/Strict.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 #if __GLASGOW_HASKELL__ >= 706
@@ -6,7 +6,7 @@
 #endif
 
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StandaloneDeriving    #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
diff --git a/src/full/Agda/Utils/Monad.hs b/src/full/Agda/Utils/Monad.hs
index 7d174ed..69808c7 100644
--- a/src/full/Agda/Utils/Monad.hs
+++ b/src/full/Agda/Utils/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
 
 module Agda.Utils.Monad
@@ -9,9 +9,8 @@ module Agda.Utils.Monad
     )
     where
 
-import Prelude		   hiding (concat)
+import Prelude             hiding (concat)
 import Control.Monad       hiding (mapM, forM)
-import Control.Monad.Error
 import Control.Monad.State
 import Control.Monad.Writer
 import Control.Applicative
@@ -19,20 +18,25 @@ import Data.Traversable as Trav hiding (for, sequence)
 import Data.Foldable as Fold
 import Data.Maybe
 
+import Agda.Utils.Except
+  ( Error(noMsg, strMsg)
+  , MonadError(catchError, throwError)
+  )
+
 import Agda.Utils.List
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- Conditionals and monads ------------------------------------------------
 
 -- | @when_@ is just @Control.Monad.when@ with a more general type.
 when_ :: Monad m => Bool -> m a -> m ()
-when_ b m = when b $ do m >> return ()
+when_ b m = when b $ m >> return ()
 
 -- | @unless_@ is just @Control.Monad.unless@ with a more general type.
 unless_ :: Monad m => Bool -> m a -> m ()
-unless_ b m = unless b $ do m >> return ()
+unless_ b m = unless b $ m >> return ()
 
 whenM :: Monad m => m Bool -> m a -> m ()
 whenM c m = c >>= (`when_` m)
@@ -45,8 +49,8 @@ unlessM c m = c >>= (`unless_` m)
 -- | Monadic if-then-else.
 ifM :: Monad m => m Bool -> m a -> m a -> m a
 ifM c m m' =
-    do	b <- c
-	if b then m else m'
+    do  b <- c
+        if b then m else m'
 
 -- | @ifNotM mc = ifM (not <$> mc)@
 ifNotM :: Monad m => m Bool -> m a -> m a -> m a
@@ -113,13 +117,13 @@ mapMaybeM :: (Monad m, Functor m) => (a -> m (Maybe b)) -> [a] -> m [b]
 mapMaybeM f xs = catMaybes <$> Trav.mapM f xs
 
 -- | A monadic version of @'dropWhile' :: (a -> Bool) -> [a] -> [a]@.
-dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+dropWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]
 dropWhileM p []       = return []
 dropWhileM p (x : xs) = ifM (p x) (dropWhileM p xs) (return (x : xs))
 
 -- Error monad ------------------------------------------------------------
 
--- | To simulate @MaybeT@ by @'ErrorT'@.
+-- | To simulate @MaybeT@ by @ExceptT at .
 instance Error () where
   noMsg = ()
 
@@ -134,21 +138,10 @@ first `finally` after = do
     Left e  -> throwError e
     Right r -> return r
 
--- | Bracket for the 'Error' class.
-
-bracket :: (Error e, MonadError e m)
-        => m a         -- ^ Acquires resource. Run first.
-        -> (a -> m c)  -- ^ Releases resource. Run last.
-        -> (a -> m b)  -- ^ Computes result. Run in-between.
-        -> m b
-bracket acquire release compute = do
-  resource <- acquire
-  compute resource `finally` release resource
-
 -- State monad ------------------------------------------------------------
 
 -- | Bracket without failure.  Typically used to preserve state.
-bracket_ :: (Monad m)
+bracket_ :: Monad m
          => m a         -- ^ Acquires resource. Run first.
          -> (a -> m c)  -- ^ Releases resource. Run last.
          -> m b         -- ^ Computes result. Run in-between.
@@ -160,21 +153,32 @@ bracket_ acquire release compute = do
   return result
 
 -- | Restore state after computation.
-localState :: (MonadState s m) => m a -> m a
+localState :: MonadState s m => m a -> m a
 localState = bracket_ get put
 
 -- Read -------------------------------------------------------------------
 
 readM :: (Error e, MonadError e m, Read a) => String -> m a
 readM s = case reads s of
-	    [(x,"")]	-> return x
-	    _		->
+            [(x,"")]    -> return x
+            _           ->
               throwError $ strMsg $ "readM: parse error string " ++ s
 
 
+-- RETIRED STUFF ----------------------------------------------------------
 
+{- RETIRED, ASR, 09 September 2014. Not used.
+-- | Bracket for the 'Error' class.
 
--- RETIRED STUFF ----------------------------------------------------------
+-- bracket :: (Error e, MonadError e m)
+--         => m a         -- ^ Acquires resource. Run first.
+--         -> (a -> m c)  -- ^ Releases resource. Run last.
+--         -> (a -> m b)  -- ^ Computes result. Run in-between.
+--         -> m b
+-- bracket acquire release compute = do
+--   resource <- acquire
+--   compute resource `finally` release resource
+-}
 
 {- RETIRED, Andreas, 2012-04-30. Not used.
 concatMapM :: Applicative m => (a -> m [b]) -> [a] -> m [b]
@@ -184,7 +188,7 @@ concatMapM f xs = concat <$> traverse f xs
 --   the force to be effective. For the 'IO' monad you do.
 forceM :: Monad m => [a] -> m ()
 forceM xs = do () <- length xs `seq` return ()
-	       return ()
+               return ()
 
 commuteM :: (Traversable f, Applicative m) => f (m a) -> m (f a)
 commuteM = traverse id
diff --git a/src/full/Agda/Utils/Null.hs b/src/full/Agda/Utils/Null.hs
index a501e83..89959fa 100644
--- a/src/full/Agda/Utils/Null.hs
+++ b/src/full/Agda/Utils/Null.hs
@@ -8,6 +8,8 @@ import Control.Monad
 
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as ByteString
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import qualified Data.List as List
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -16,6 +18,8 @@ import qualified Data.Sequence as Seq
 import Data.Set (Set)
 import qualified Data.Set as Set
 
+import Agda.Utils.Bag (Bag)
+import qualified Agda.Utils.Bag as Bag
 import Agda.Utils.Functor
 import Agda.Utils.Monad
 
@@ -24,6 +28,14 @@ class Null a where
   null  :: a -> Bool
   -- ^ Satisfying @null empty == True at .
 
+instance Null () where
+  empty  = ()
+  null _ = True
+
+instance (Null a, Null b) => Null (a,b) where
+  empty      = (empty, empty)
+  null (a,b) = null a && null b
+
 instance Null ByteString where
   empty = ByteString.empty
   null  = ByteString.null
@@ -32,6 +44,14 @@ instance Null [a] where
   empty = []
   null  = List.null
 
+instance Null (Bag a) where
+  empty = Bag.empty
+  null  = Bag.null
+
+instance Null (IntMap a) where
+  empty = IntMap.empty
+  null  = IntMap.null
+
 instance Null (Map k a) where
   empty = Map.empty
   null  = Map.null
diff --git a/src/full/Agda/Utils/PartialOrd.hs b/src/full/Agda/Utils/PartialOrd.hs
index 426aba2..0c7826a 100644
--- a/src/full/Agda/Utils/PartialOrd.hs
+++ b/src/full/Agda/Utils/PartialOrd.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 module Agda.Utils.PartialOrd where
 
@@ -105,6 +105,8 @@ orPO _    _    = POAny
 --   @seqPO@ is associative, commutative, and idempotent.
 --   @seqPO@ has dominant element @POAny@ and neutral element (unit) @POEQ at .
 
+seqPO :: PartialOrdering -> PartialOrdering -> PartialOrdering
+
 seqPO POAny _   = POAny  -- Shortcut if no information on first.
 seqPO POEQ p    = p      -- No need to look at second if first is neutral.
 
@@ -204,8 +206,8 @@ instance PartialOrd a => PartialOrd (Maybe a) where
 instance (PartialOrd a, PartialOrd b) => PartialOrd (Either a b) where
   comparable mx my = case (mx, my) of
     (Left  x, Left  y) -> comparable x y
-    (Left  x, Right y) -> POAny
-    (Right x, Left  y) -> POAny
+    (Left  _, Right _) -> POAny
+    (Right _, Left  _) -> POAny
     (Right x, Right y) -> comparable x y
 
 -- | Pointwise partial ordering for tuples.
@@ -311,91 +313,118 @@ instance Arbitrary ISet where
   arbitrary = ISet . Inclusion . Set.fromList <$> listOf (choose (0, 8))
 
 -- | Any two elements are 'related' in the way 'comparable' computes.
+prop_comparable_related :: ISet -> ISet -> Bool
 prop_comparable_related (ISet a) (ISet b) =
   related a o b where o = comparable a b
 
 -- | @flip comparable a b == oppPO (comparable a b)@
+prop_oppPO :: ISet -> ISet -> Bool
 prop_oppPO (ISet a) (ISet b) =
   comparable a b == oppPO (comparable b a)
 
 -- | Auxiliary function: lists to sets = sorted duplicate-free lists.
+sortUniq :: [Ordering] -> [Ordering]
 sortUniq = Set.toAscList . Set.fromList
 
 -- | 'leqPO' is inclusion of the associated 'Ordering' sets.
+prop_leqPO_sound :: PartialOrdering -> PartialOrdering -> Bool
 prop_leqPO_sound p q =
   (p `leqPO` q) == null (toOrderings p \\ toOrderings q)
 
 -- | 'orPO' amounts to the union of the associated 'Ordering' sets.
 --   Except that 'orPO POLT POGT == POAny' which should also include 'POEQ'.
+prop_orPO_sound :: PartialOrdering -> PartialOrdering -> Bool
 prop_orPO_sound p q =
   (p `orPO` q) == fromOrderings (toOrderings p ++ toOrderings q)
 
 -- | 'orPO' is associative.
+prop_associative_orPO :: PartialOrdering -> PartialOrdering ->
+                         PartialOrdering -> Bool
 prop_associative_orPO = associative orPO
 
 -- | 'orPO' is commutative.
+prop_commutative_orPO :: PartialOrdering -> PartialOrdering -> Bool
 prop_commutative_orPO = commutative orPO
 
 -- | 'orPO' is idempotent.
+prop_idempotent_orPO :: PartialOrdering -> Bool
 prop_idempotent_orPO = idempotent orPO
 
 -- | The dominant element wrt. 'orPO' is 'POAny'.
+prop_zero_orPO :: PartialOrdering -> Bool
 prop_zero_orPO = isZero POAny orPO
 
 -- | Soundness of 'seqPO'.
 --
 --   As QuickCheck test, this property is inefficient, see 'prop_seqPO'.
+property_seqPO :: ISet -> PartialOrdering -> ISet -> PartialOrdering ->
+                  ISet -> Property
 property_seqPO (ISet a) o (ISet b) p (ISet c) =
   related a o b && related b p c ==> related a (seqPO o p) c
 
 -- | A more efficient way of stating soundness of 'seqPO'.
+prop_seqPO :: ISet -> ISet -> ISet -> Bool
 prop_seqPO (ISet a) (ISet b) (ISet c) = related a o c
   where o = comparable a b `seqPO` comparable b c
 
 -- | The unit of 'seqPO' is 'POEQ'.
+prop_identity_seqPO :: PartialOrdering -> Bool
 prop_identity_seqPO = identity POEQ seqPO
 
 -- | The zero of 'seqPO' is 'POAny'.
+prop_zero_seqPO :: PartialOrdering -> Bool
 prop_zero_seqPO = isZero POAny seqPO
 
 -- | 'seqPO' is associative.
+prop_associative_seqPO :: PartialOrdering -> PartialOrdering ->
+                          PartialOrdering -> Bool
 prop_associative_seqPO = associative seqPO
 
 -- | 'seqPO' is also commutative.
+prop_commutative_seqPO :: PartialOrdering -> PartialOrdering -> Bool
 prop_commutative_seqPO = commutative seqPO
 
 -- | 'seqPO' is idempotent.
+prop_idempotent_seqPO :: PartialOrdering -> Bool
 prop_idempotent_seqPO = idempotent seqPO
 
 -- | 'seqPO' distributes over 'orPO'.
+prop_distributive_seqPO_orPO :: PartialOrdering -> PartialOrdering ->
+                                PartialOrdering -> Bool
 prop_distributive_seqPO_orPO = distributive seqPO orPO
 
 -- | The result of 'toOrderings' is a sorted list without duplicates.
+prop_sorted_toOrderings :: PartialOrdering -> Bool
 prop_sorted_toOrderings p =
   sortUniq os == os where os = toOrderings p
 
 -- | From 'Ordering' to 'PartialOrdering' and back is the identity.
+prop_toOrderings_after_fromOrdering :: Ordering -> Bool
 prop_toOrderings_after_fromOrdering o =
   toOrderings (fromOrdering o) == [o]
 
 -- | From 'PartialOrdering' to 'Orderings' and back is the identity.
+prop_fromOrderings_after_toOrderings :: PartialOrdering -> Bool
 prop_fromOrderings_after_toOrderings p =
   fromOrderings (toOrderings p) == p
 
 -- | From 'Orderings' to 'PartialOrdering' and back is the identity.
 --   Except for @[LT,GT]@ which is a non-canonical representative of 'POAny'.
+prop_toOrderings_after_fromOrderings :: NonEmptyList Ordering -> Bool
 prop_toOrderings_after_fromOrderings (NonEmpty os) =
   Set.fromList os  `Set.isSubsetOf`
   Set.fromList (toOrderings (fromOrderings os))
 
 -- | Pairs are related iff both components are related.
-
+prop_related_pair :: ISet -> ISet -> ISet -> ISet -> PartialOrdering -> Bool
 prop_related_pair (ISet x1) (ISet x2) (ISet y1) (ISet y2) o =
   related (x1,x2) o (y1,y2) == (related x1 o y1 && related x2 o y2)
 
 -- | Comparing 'PartialOrdering's amounts to compare their representation as
 --   'Ordering' sets.
 
+prop_comparable_PartialOrdering :: PartialOrdering -> PartialOrdering -> Bool
+
 prop_comparable_PartialOrdering p q =
   comparable p q == comparable (to p) (to q)
     where to = Inclusion . toOrderings
diff --git a/src/full/Agda/Utils/Permutation.hs b/src/full/Agda/Utils/Permutation.hs
index b19f89a..0237cdc 100644
--- a/src/full/Agda/Utils/Permutation.hs
+++ b/src/full/Agda/Utils/Permutation.hs
@@ -1,13 +1,18 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections      #-}
 
 module Agda.Utils.Permutation where
 
 import Prelude hiding (drop)
 
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
 import Data.List hiding (drop)
 import qualified Data.List as List
 import Data.Maybe
@@ -16,10 +21,11 @@ import Data.Foldable (Foldable)
 import Data.Traversable (Traversable)
 import Data.Typeable (Typeable)
 
-import Agda.Utils.Size
+import Agda.Utils.Functor
 import Agda.Utils.List ((!!!))
+import Agda.Utils.Size
 
-#include "../undefined.h"
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 -- | Partial permutations. Examples:
@@ -55,9 +61,40 @@ instance Sized Permutation where
 --   Agda typing:
 --   @permute (Perm {m} n is) : Vec A m -> Vec A n@
 permute :: Permutation -> [a] -> [a]
-permute (Perm _ is) xs = map (xs !!!!) is
+permute p xs = map (fromMaybe __IMPOSSIBLE__) (safePermute p xs)
+
+safePermute :: Permutation -> [a] -> [Maybe a]
+safePermute (Perm _ is) xs = map (xs !!!!) is
   where
-    xs !!!! n = fromMaybe __IMPOSSIBLE__ (xs !!! n)
+    xs !!!! n | n < 0     = Nothing
+              | otherwise = xs !!! n
+
+-- |  Invert a Permutation on a partial finite int map.
+-- @inversePermute perm f = f'@
+-- such that @permute perm f' = f@
+--
+-- Example, with map represented as @[Maybe a]@:
+-- @
+--   f    = [Nothing, Just a, Just b ]
+--   perm = Perm 4 [3,0,2]
+--   f'   = [ Just a , Nothing , Just b , Nothing ]
+-- @
+-- Zipping @perm@ with @f@ gives @[(0,a),(2,b)]@, after compression
+-- with @catMaybes at .  This is an @IntMap@ which can easily
+-- written out into a substitution again.
+
+class InversePermute a b where
+  inversePermute :: Permutation -> a -> b
+
+instance InversePermute [Maybe a] [(Int,a)] where
+  inversePermute (Perm n is) = catMaybes . zipWith (\ i ma -> (i,) <$> ma) is
+
+instance InversePermute [Maybe a] (IntMap a) where
+  inversePermute p = IntMap.fromList . inversePermute p
+
+instance InversePermute [Maybe a] [Maybe a] where
+  inversePermute p@(Perm n _) = tabulate . inversePermute p
+    where tabulate m = for [0..n-1] $ \ i -> IntMap.lookup i m
 
 -- | Identity permutation.
 idP :: Int -> Permutation
@@ -93,12 +130,13 @@ composeP p1 (Perm n xs) = Perm n $ permute p1 xs
       == permute (Perm xs) (permute (Perm ys) zs)
   -}
 
-invertP :: Permutation -> Permutation
-invertP p@(Perm n xs) = Perm (size xs) $ map inv [0..n - 1]
+-- | @invertP err p@ is the inverse of @p@ where defined,
+--   otherwise defaults to @err at .
+--   @composeP p (invertP err p) == p@
+invertP :: Int -> Permutation -> Permutation
+invertP err p@(Perm n xs) = Perm (size xs) $ map inv [0..n - 1]
   where
-    inv x = case findIndex (x ==) xs of
-	      Just y  -> fromIntegral y
-	      Nothing -> error $ "invertP: non-surjective permutation " ++ show p
+    inv x = fromMaybe err (findIndex (x ==) xs)
 
 -- | Turn a possible non-surjective permutation into a surjective permutation.
 compactP :: Permutation -> Permutation
@@ -130,8 +168,8 @@ expandP :: Int -> Int -> Permutation -> Permutation
 expandP i n (Perm m xs) = Perm (m + n - 1) $ concatMap expand xs
   where
     expand j
-      | j == i	  = [i..i + n - 1]
-      | j < i	  = [j]
+      | j == i    = [i..i + n - 1]
+      | j < i     = [j]
       | otherwise = [j + n - 1]
 
 -- | Stable topologic sort. The first argument decides whether its first
@@ -140,7 +178,7 @@ topoSort :: (a -> a -> Bool) -> [a] -> Maybe Permutation
 topoSort parent xs = fmap (Perm (size xs)) $ topo g
   where
     nodes     = zip [0..] xs
-    g	      = [ (n, parents x) | (n, x) <- nodes ]
+    g         = [ (n, parents x) | (n, x) <- nodes ]
     parents x = [ n | (n, y) <- nodes, parent y x ]
 
     topo :: Eq node => [(node, [node])] -> Maybe [node]
@@ -148,13 +186,15 @@ topoSort parent xs = fmap (Perm (size xs)) $ topo g
     topo g  = case xs of
       []    -> fail "cycle detected"
       x : _ -> do
-	ys <- topo $ remove x g
-	return $ x : ys
+        ys <- topo $ remove x g
+        return $ x : ys
       where
-	xs = [ x | (x, []) <- g ]
-	remove x g = [ (y, filter (/= x) ys) | (y, ys) <- g, x /= y ]
+        xs = [ x | (x, []) <- g ]
+        remove x g = [ (y, filter (/= x) ys) | (y, ys) <- g, x /= y ]
 
+------------------------------------------------------------------------
 -- * Drop (apply) and undrop (abstract)
+------------------------------------------------------------------------
 
 -- | Delayed dropping which allows undropping.
 data Drop a = Drop
@@ -184,3 +224,7 @@ instance DoDrop Permutation where
     Perm (n + m) $ [0..m-1] ++ map (+ m) (List.drop k xs)
     where m = -k
   unDrop m = dropMore (-m) -- allow picking up more than dropped
+
+------------------------------------------------------------------------
+-- * Properties, see 'Agda.Utils.Permutation.Tests'
+------------------------------------------------------------------------
diff --git a/src/full/Agda/Utils/Permutation/Tests.hs b/src/full/Agda/Utils/Permutation/Tests.hs
new file mode 100644
index 0000000..eaf80c6
--- /dev/null
+++ b/src/full/Agda/Utils/Permutation/Tests.hs
@@ -0,0 +1,117 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+{-# LANGUAGE CPP                #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE TemplateHaskell    #-}
+
+module Agda.Utils.Permutation.Tests (tests) where
+
+import Data.Functor
+import Data.List as List
+import Data.Maybe
+
+import Test.QuickCheck
+import Test.QuickCheck.All
+
+import Agda.Utils.Permutation
+
+------------------------------------------------------------------------
+-- * Properties
+------------------------------------------------------------------------
+
+instance Arbitrary Permutation where
+  arbitrary = do
+    is <- nub . map getNonNegative <$> arbitrary
+    NonNegative n <- arbitrary
+    return $ Perm (if null is then n else maximum is + n + 1) is
+
+data ComposablePermutations = ComposablePermutations Permutation Permutation
+  deriving (Eq, Show)
+
+instance Arbitrary ComposablePermutations where
+  arbitrary = do
+    p2@(Perm n is) <- arbitrary
+    let m = length is
+    p1 <- Perm m . filter (< m) . map getNonNegative <$> arbitrary
+    return $ ComposablePermutations p1 p2
+
+type A = Int
+
+-- | Extend a list by indefinitely many elements.
+withStream :: Testable b
+  => ([a] -> b)  -- ^ Stream function.
+  -> [a]         -- ^ Initial segment.
+  -> a           -- ^ Default element, appended ad infinitum.
+  -> b
+withStream k as a = k $ as ++ repeat a
+
+-- | Apply a permutation to a list which might be too short.
+--   Silently discard picks that go beyond the list's boundaries.
+permutePartial :: Permutation -> [a] -> [a]
+permutePartial perm xs =
+  catMaybes $ permute perm $ map Just xs ++ repeat Nothing
+  -- Note: we have to add @Nothing at s to make @permute@ total.
+
+-- | @perm([0..n-1]) == perm@
+prop_permute_id_r :: Permutation -> Bool
+prop_permute_id_r perm@(Perm n picks) =
+  permute perm [0..] == picks
+
+-- | @idP(xs) == xs@
+prop_permute_id_l :: Int -> [A] -> A -> Bool
+prop_permute_id_l n = withStream $ \ xs ->
+  permute (idP n) xs == take n xs
+
+-- | @takeP n perm = perm . take n@
+prop_takeP :: Int -> Permutation -> [A] -> A -> Bool
+prop_takeP n perm = withStream $ \ xs ->
+  permute (takeP n perm) xs == permutePartial perm (take n xs)
+  -- Note: we have to add @Nothing at s to make @permute@ total.
+
+-- | @(droppedP perm)(xs) = xs \\ perm(xs)@
+prop_droppedP :: Permutation -> [A] -> A -> Bool
+prop_droppedP perm@(Perm n _) = withStream $ \ xs -> let xs' = take n xs in
+  sort (permute (droppedP perm) xs') == sort (xs' \\ permute perm xs')
+
+-- | @(p1 ∘ p2)(xs) = p1(p2(xs))@
+prop_composeP :: ComposablePermutations -> [A] -> A -> Bool
+prop_composeP (ComposablePermutations p1 p2) = withStream $ \ xs ->
+  permute (composeP p1 p2) xs == permutePartial p1 (permute p2 xs)
+
+-- | @p ∘ p⁻¹ ∘ p = p@
+prop_invertP_left :: Permutation -> Int -> [A] -> A -> Bool
+prop_invertP_left p err = withStream $ \ xs -> let ys = permute p xs in
+  permute p (permute (invertP err p) ys) == ys
+
+-- NOT QUITE RIGHT YET:
+-- -- | @p⁻1 ∘ p ∘ p⁻¹ = p⁻¹@
+-- prop_invertP_right :: Permutation -> Int -> [A] -> A -> Bool
+-- prop_invertP_right p err = withStream $ \ xs ->
+--   let pinv = invertP err p
+--       ys   = permute pinv xs
+--   in  permute pinv (permute p ys) == ys
+
+-- | @reverseP p = reverse . p . reverse@
+prop_reverseP :: Permutation -> [A] -> A -> Bool
+prop_reverseP p@(Perm n _) = withStream $ \ xs0 -> let xs = take n xs0 in
+  permute (reverseP p) xs == reverse (permute p (reverse xs))
+
+-- | @permute p . inversePermute p = id@
+prop_inversePermute :: Permutation -> [Maybe A] -> Maybe A -> Bool
+prop_inversePermute p@(Perm _ is) = withStream $ \ xs0 ->
+  let xs = take (length is) xs0
+      ys = inversePermute p xs
+  in  permute p ys == xs
+
+-- Template Haskell hack to make the following $quickCheckAll work
+-- under ghc-7.8.
+return [] -- KEEP!
+
+-- | All tests as collected by 'quickCheckAll'.
+tests :: IO Bool
+tests = do
+  putStrLn "Agda.Utils.Permutation"
+  $quickCheckAll
diff --git a/src/full/Agda/Utils/Pointer.hs b/src/full/Agda/Utils/Pointer.hs
index 6168bbf..0fe4fbb 100644
--- a/src/full/Agda/Utils/Pointer.hs
+++ b/src/full/Agda/Utils/Pointer.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+
 module Agda.Utils.Pointer
   ( Ptr, newPtr, derefPtr, setPtr
   , updatePtr, updatePtrM
diff --git a/src/full/Agda/Utils/Pretty.hs b/src/full/Agda/Utils/Pretty.hs
index 8618e5b..c06b1ef 100644
--- a/src/full/Agda/Utils/Pretty.hs
+++ b/src/full/Agda/Utils/Pretty.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 {-| Pretty printing functions.
 -}
 module Agda.Utils.Pretty
@@ -6,21 +9,55 @@ module Agda.Utils.Pretty
     ) where
 
 import Data.Function
+import Data.Int ( Int32 )
 import Text.PrettyPrint hiding (TextDetails(Str))
 
-instance Eq Doc where
-  (==) = (==) `on` render
+-- * Pretty class
+
+-- | While 'Show' is for rendering data in Haskell syntax,
+--   'Pretty' is for displaying data to the world, i.e., the
+--   user and the environment.
+--
+--   Atomic data has no inner document structure, so just
+--   implement 'pretty' as @pretty a = text $ ... a ... at .
 
 class Pretty a where
-    pretty	:: a -> Doc
-    prettyPrec	:: Int -> a -> Doc
+    pretty      :: a -> Doc
+    prettyPrec  :: Int -> a -> Doc
+
+    pretty      = prettyPrec 0
+    prettyPrec  = const pretty
+
+-- | Use instead of 'show' when printing to world.
+
+prettyShow :: Pretty a => a -> String
+prettyShow = render . pretty
+
+-- * Pretty instances
 
-    pretty	= prettyPrec 0
-    prettyPrec	= const pretty
+instance Pretty Int where
+    pretty = text . show
+
+instance Pretty Int32 where
+    pretty = text . show
+
+instance Pretty Integer where
+    pretty = text . show
+
+instance Pretty Char where
+    pretty c = text [c]
+
+instance Pretty String where
+    pretty = text
 
 instance Pretty Doc where
     pretty = id
 
+-- * 'Doc' utilities
+
+instance Eq Doc where
+  (==) = (==) `on` render
+
 pwords :: String -> [Doc]
 pwords = map text . words
 
diff --git a/src/full/Agda/Utils/ReadP.hs b/src/full/Agda/Utils/ReadP.hs
index eab570e..ca34f9f 100644
--- a/src/full/Agda/Utils/ReadP.hs
+++ b/src/full/Agda/Utils/ReadP.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE MagicHash, Rank2Types, DeriveFunctor #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE MagicHash     #-}
+{-# LANGUAGE Rank2Types    #-}
+
 -----------------------------------------------------------------------------
 -- |
 
@@ -190,7 +193,7 @@ run _            _     = []
 -- | Run a parser on a list of tokens. Returns the list of complete matches.
 parse :: ReadP t a -> [t] -> [a]
 parse p ts = case complete p of
-    R f	-> map fst $ run (f return) ts
+    R f -> map fst $ run (f return) ts
 
 get :: ReadP t t
 -- ^ Consumes and returns the next character.
@@ -426,7 +429,7 @@ run' _                 s     = Right s
 
 parse' :: ReadP t a -> [t] -> Either a [t]
 parse' p ts = case complete p of
-    R f	-> run' (f return) ts
+    R f -> run' (f return) ts
 
 -- ---------------------------------------------------------------------------
 -- QuickCheck properties that hold for the combinators
@@ -489,10 +492,10 @@ Here follow the properties:
 >  prop_Gather s =
 >    forAll readPWithoutReadS $ \p ->
 >      readP_to_S (gather p) s =~
->	 [ ((pre,x::Int),s')
->	 | (x,s') <- readP_to_S p s
->	 , let pre = take (length s - length s') s
->	 ]
+>        [ ((pre,x::Int),s')
+>        | (x,s') <- readP_to_S p s
+>        , let pre = take (length s - length s') s
+>        ]
 >
 >  prop_String_Yes this s =
 >    readP_to_S (string this) (this ++ s) =~
diff --git a/src/full/Agda/Utils/SemiRing.hs b/src/full/Agda/Utils/SemiRing.hs
index 554308f..8c730f1 100644
--- a/src/full/Agda/Utils/SemiRing.hs
+++ b/src/full/Agda/Utils/SemiRing.hs
@@ -1,4 +1,3 @@
-
 module Agda.Utils.SemiRing where
 
 class SemiRing a where
diff --git a/src/full/Agda/Utils/Size.hs b/src/full/Agda/Utils/Size.hs
index da8bdca..9e09576 100644
--- a/src/full/Agda/Utils/Size.hs
+++ b/src/full/Agda/Utils/Size.hs
@@ -1,17 +1,41 @@
+module Agda.Utils.Size
+  ( Sized(..)
+  , SizedThing(..)
+  , sizeThing
+  ) where
 
-module Agda.Utils.Size ( Sized(..) ) where
+import Prelude hiding (null)
 
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.List
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import qualified Data.List as List
+
+import Agda.Utils.Null
+
+-- | The size of an object.
+--
+--   For collections, it returns the length of the collection,
+--   not the overall size including the elements.
 
 class Sized a where
   size :: Integral n => a -> n
 
 instance Sized [a] where
-  size = genericLength
+  size = List.genericLength
+
+instance Sized (IntMap a) where
+  size = fromIntegral . IntMap.size
+
+instance Sized IntSet where
+  size = fromIntegral . IntSet.size
 
 instance Sized (Map k a) where
   size = fromIntegral . Map.size
@@ -19,6 +43,26 @@ instance Sized (Map k a) where
 instance Sized (Set a) where
   size = fromIntegral . Set.size
 
-instance Sized a => Sized (Maybe a) where
-  size Nothing  = 1
-  size (Just a) = size a
+instance Sized (Seq a) where
+  size = fromIntegral . Seq.length
+
+
+-- | Thing decorated with its size.
+--   The thing should fit into main memory, thus, the size is an @Int at .
+
+data SizedThing a = SizedThing
+  { theSize    :: !Int
+  , sizedThing :: a
+  }
+
+-- | Cache the size of an object.
+sizeThing :: Sized a => a -> SizedThing a
+sizeThing a = SizedThing (size a) a
+
+-- | Return the cached size.
+instance Sized (SizedThing a) where
+  size = fromIntegral . theSize
+
+instance Null a => Null (SizedThing a) where
+  empty = SizedThing 0 empty
+  null  = null . sizedThing
diff --git a/src/full/Agda/Utils/String.hs b/src/full/Agda/Utils/String.hs
index 587a5f7..ec17ce9 100644
--- a/src/full/Agda/Utils/String.hs
+++ b/src/full/Agda/Utils/String.hs
@@ -53,10 +53,11 @@ addFinalNewLine s | last s == '\n' = s
 indent :: Integral i => i -> String -> String
 indent i = unlines . map (genericReplicate i ' ' ++) . lines
 
-newtype Str = Str { getStr :: String }
+newtype Str = Str { unStr :: String }
+  deriving Eq
 
 instance Show Str where
-  show = getStr
+  show = unStr
 
 -- | Show a number using comma to separate powers of 1,000.
 
diff --git a/src/full/Agda/Utils/Suffix.hs b/src/full/Agda/Utils/Suffix.hs
index 6ca3266..9206152 100644
--- a/src/full/Agda/Utils/Suffix.hs
+++ b/src/full/Agda/Utils/Suffix.hs
@@ -1,11 +1,13 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP           #-}
 {-# LANGUAGE PatternGuards #-}
 
 module Agda.Utils.Suffix where
 
 import Data.Char
 
-#include "../undefined.h"
+import Agda.Utils.Function
+
+#include "undefined.h"
 import Agda.Utils.Impossible
 
 ------------------------------------------------------------------------
@@ -38,13 +40,24 @@ fromSubscriptDigit d
 ------------------------------------------------------------------------
 -- Suffices
 
-data Suffix = NoSuffix | Prime Int | Index Int | Subscript Int
+-- | Classification of identifier variants.
+
+data Suffix
+  = NoSuffix
+  | Prime     Int  -- ^ Identifier ends in @Int@ many primes.
+  | Index     Int  -- ^ Identifier ends in number @Int@ (ordinary digits).
+  | Subscript Int  -- ^ Identifier ends in number @Int@ (subscript digits).
 
+-- | Increase the suffix by one.  If no suffix yet, put a subscript @1 at .
+
+nextSuffix :: Suffix -> Suffix
 nextSuffix NoSuffix      = Subscript 1
 nextSuffix (Prime i)     = Prime $ i + 1
 nextSuffix (Index i)     = Index $ i + 1
 nextSuffix (Subscript i) = Subscript $ i + 1
 
+-- | Parse suffix.
+
 suffixView :: String -> (String, Suffix)
 suffixView s
     | (ps@(_:_), s') <- span (=='\'') rs         = (reverse s', Prime $ length ps)
@@ -55,8 +68,21 @@ suffixView s
     | otherwise                                  = (s, NoSuffix)
     where rs = reverse s
 
+-- | Print suffix.
+
 addSuffix :: String -> Suffix -> String
 addSuffix s NoSuffix      = s
 addSuffix s (Prime n)     = s ++ replicate n '\''
 addSuffix s (Index i)     = s ++ show i
 addSuffix s (Subscript i) = s ++ map toSubscriptDigit (show i)
+
+-- | Add first available @Suffix@ to a name.
+
+nameVariant
+  :: (String -> Bool) -- ^ Is the given name already taken?
+  -> String           -- ^ Name of which we want an available variant.
+  -> String           -- ^ Name extended by suffix that is not taken already.
+nameVariant taken x = addSuffix x $ trampoline step $ Prime 0
+  where
+    -- if the current suffix is taken, repeat with next suffix, else done
+    step s = if taken (addSuffix x s) then Right (nextSuffix s) else Left s
diff --git a/src/full/Agda/Utils/Time.hs b/src/full/Agda/Utils/Time.hs
index 7d9145f..76dc9d7 100644
--- a/src/full/Agda/Utils/Time.hs
+++ b/src/full/Agda/Utils/Time.hs
@@ -1,11 +1,19 @@
 {-# LANGUAGE CPP #-}
 
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# OPTIONS_GHC -fno-warn-identities #-}
+#endif
+-- To avoid warning on derived Integral instance for CPUTime
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 -- | Time-related utilities.
 
 module Agda.Utils.Time
   ( ClockTime
   , getClockTime
   , measureTime
+  , CPUTime(..)
   ) where
 
 import Control.Monad.Trans
@@ -17,6 +25,9 @@ import qualified Data.Time
 import qualified System.Time
 #endif
 
+import Agda.Utils.Pretty
+import Agda.Utils.String
+
 -- | Timestamps.
 
 type ClockTime =
@@ -36,13 +47,22 @@ getClockTime =
   System.Time.getClockTime
 #endif
 
-type Picoseconds = Integer
+-- | CPU time in pico (10^-12) seconds.
+
+newtype CPUTime = CPUTime Integer
+  deriving (Eq, Show, Ord, Num, Real, Enum, Integral)
+
+-- | Print CPU time in milli (10^-3) seconds.
+
+instance Pretty CPUTime where
+  pretty (CPUTime ps) =
+    text $ showThousandSep (div ps 1000000000) ++ "ms"
 
 -- | Measure the time of a computation. Returns the
-measureTime :: MonadIO m => m a -> m (a, Picoseconds)
+measureTime :: MonadIO m => m a -> m (a, CPUTime)
 measureTime m = do
   start <- liftIO $ getCPUTime
   x     <- m
   stop  <- liftIO $ getCPUTime
-  return (x, stop - start)
+  return (x, CPUTime $ stop - start)
 
diff --git a/src/full/Agda/Utils/Trie.hs b/src/full/Agda/Utils/Trie.hs
index 59232ac..80506f6 100644
--- a/src/full/Agda/Utils/Trie.hs
+++ b/src/full/Agda/Utils/Trie.hs
@@ -1,10 +1,10 @@
--- | Strict tries (based on 'Data.Map.Strict' and 'Agda.Utils.Maybe.Strict').
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE BangPatterns               #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE TupleSections              #-}
+
+-- | Strict tries (based on 'Data.Map.Strict' and 'Agda.Utils.Maybe.Strict').
 
 module Agda.Utils.Trie
   ( Trie
@@ -140,6 +140,7 @@ modelPath ks (Model xs) =
   $ nubBy ((==) `on` fst)
   $ filter (flip isPrefixOf ks . fst) xs
 
+prop_path :: [Key] -> Model -> Property
 prop_path ks m =
   collect (length $ modelPath ks m) $
   lookupPath ks (modelToTrie m) == modelPath ks m
diff --git a/src/full/Agda/Utils/Tuple.hs b/src/full/Agda/Utils/Tuple.hs
index bfe7fcf..d829354 100644
--- a/src/full/Agda/Utils/Tuple.hs
+++ b/src/full/Agda/Utils/Tuple.hs
@@ -1,4 +1,8 @@
-{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections              #-}
 
 module Agda.Utils.Tuple where
 
diff --git a/src/full/Agda/Utils/Unicode.hs b/src/full/Agda/Utils/Unicode.hs
deleted file mode 100644
index f15642c..0000000
--- a/src/full/Agda/Utils/Unicode.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-
-module Agda.Utils.Unicode
-    ( isUnicodeId
-    , convertLineEndings
-    ) where
-
-import Data.Char
-
--- Unicode ----------------------------------------------------------------
-
-isUnicodeId :: Char -> Bool
-isUnicodeId c = isPrint c && not (isAscii c)
-
--- | Converts many character sequences which may be interpreted as
--- line or paragraph separators into '\n'.
-
-convertLineEndings :: String -> String
-convertLineEndings ('\x000D' : '\x000A' : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x000A'            : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x000D'            : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x0085'            : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x000C'            : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x2028'            : s) = '\n' : convertLineEndings s
-convertLineEndings ('\x2029'            : s) = '\n' : convertLineEndings s
-convertLineEndings (c                   : s) = c    : convertLineEndings s
-convertLineEndings ""                        = ""
diff --git a/src/full/Agda/Utils/Update.hs b/src/full/Agda/Utils/Update.hs
index d7fce1f..c1962da 100644
--- a/src/full/Agda/Utils/Update.hs
+++ b/src/full/Agda/Utils/Update.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Agda.Utils.Update
   ( Change
   , MonadChange(..)
diff --git a/src/full/Agda/Utils/VarSet.hs b/src/full/Agda/Utils/VarSet.hs
index 36afb74..1e063a4 100644
--- a/src/full/Agda/Utils/VarSet.hs
+++ b/src/full/Agda/Utils/VarSet.hs
@@ -1,18 +1,29 @@
+{-# LANGUAGE CPP #-}
 
 -- | Var field implementation of sets of (small) natural numbers.
+
 module Agda.Utils.VarSet
   ( VarSet
-  , union, unions, member, empty, delete, singleton, fromList, toList, isSubsetOf, Set.null
+  , union, unions, member, empty, delete, singleton
+  , fromList, toList, toDescList
+  , isSubsetOf, IntSet.null
+  , intersection, difference
   , Agda.Utils.VarSet.subtract
   )
   where
 
-import Data.IntSet as Set
+import Data.IntSet (IntSet)
+import Data.IntSet as IntSet
 
-type VarSet = Set.IntSet
+type VarSet = IntSet
 
 subtract :: Int -> VarSet -> VarSet
-subtract n s = Set.map (Prelude.subtract n) s
+subtract n = IntSet.map (Prelude.subtract n)
+
+#if !MIN_VERSION_containers(0,5,0)
+toDescList :: VarSet -> [Int]
+toDescList = reverse . toList
+#endif
 
 {-
 import Data.Bits
diff --git a/src/full/Agda/Utils/Warshall.hs b/src/full/Agda/Utils/Warshall.hs
index 1634ef6..97b69c3 100644
--- a/src/full/Agda/Utils/Warshall.hs
+++ b/src/full/Agda/Utils/Warshall.hs
@@ -115,8 +115,9 @@ instance Show Node where
   show (Rigid (RConst Infinite))   = "#"
   show (Rigid (RConst (Finite n))) = show n
 
+infinite :: Rigid -> Bool
 infinite (RConst Infinite) = True
-infinite _ = False
+infinite _                 = False
 
 -- | @isBelow r w r'@
 --   checks, if @r@ and @r'@ are connected by @w@ (meaning @w@ not infinite),
@@ -145,6 +146,7 @@ instance Show Constraint where
 
 type Constraints = [Constraint]
 
+emptyConstraints :: Constraints
 emptyConstraints = []
 
 -- graph (matrix) ------------------------------------------------
@@ -158,6 +160,7 @@ data Graph = Graph
   }
 
 -- | The empty graph: no nodes, edges are all undefined (infinity weight).
+initGraph :: Graph
 initGraph = Graph Map.empty Map.empty Map.empty 0 (\ x y -> Infinite)
 
 -- | The Graph Monad, for constructing a graph iteratively.
@@ -236,7 +239,10 @@ instance (Show a, Show b, Show c) => Show (LegendMatrix a b c) where
 --   which is either a constant or a @v + n@ for a rigid variable @v at .
 type Solution = Map Int SizeExpr
 
+emptySolution :: Solution
 emptySolution = Map.empty
+
+extendSolution :: Solution -> Int -> SizeExpr -> Solution
 extendSolution subst k v = Map.insert k v subst
 
 data SizeExpr = SizeVar RigidId Int   -- ^ e.g. x + 5
@@ -455,6 +461,7 @@ edges g = do
   return (i, j, e)
 
 -- | Check that no edges get longer when completing a graph.
+prop_smaller :: Nat -> Property
 prop_smaller n' =
   forAll (genGraph_ n) $ \g ->
   let g' = warshallG g in
@@ -466,21 +473,30 @@ prop_smaller n' =
     Nothing =< _ = False
     Just x  =< y = x <= y
 
+newEdge :: Nat -> Nat -> Distance -> AdjList Nat Distance ->
+           AdjList Nat Distance
 newEdge i j e = Map.insertWith (++) i [(j, e)]
 
-genPath :: Nat -> Nat -> Nat -> AdjList Nat Distance -> Gen (AdjList Nat Distance)
+genPath :: Nat -> Nat -> Nat -> AdjList Nat Distance ->
+           Gen (AdjList Nat Distance)
 genPath n i j g = do
   es <- listOf $ (,) <$> node <*> edge
   v  <- edge
   return $ addPath i (es ++ [(j, v)]) g
   where
+    edge :: Gen Distance
     edge = Dist <$> natural
+
+    node :: Gen Nat
     node = choose (0, n - 1)
-    addPath _ [] g = g
-    addPath i ((j, v):es) g =
-      newEdge i j v $ addPath j es g
+
+    addPath :: Nat -> [(Nat, Distance)] -> AdjList Nat Distance ->
+               AdjList Nat Distance
+    addPath _ []          g = g
+    addPath i ((j, v):es) g = newEdge i j v $ addPath j es g
 
 -- | Check that all transitive edges are added.
+prop_path :: Nat -> Property
 prop_path n' =
   forAll (genGraph_ n) $ \g ->
   forAll (two $ choose (0, n - 1)) $ \(i, j) ->
@@ -495,6 +511,7 @@ mapNodes f = Map.map f' . Map.mapKeys f
     f' es = [ (f n, e) | (n,e) <- es ]
 
 -- | Check that no edges are added between components.
+prop_disjoint :: Nat -> Property
 prop_disjoint n' =
   forAll (two $ genGraph_ n) $ \(g1, g2) ->
   let g  = Map.union (mapNodes Left g1) (mapNodes Right g2)
@@ -507,6 +524,7 @@ prop_disjoint n' =
     isLeft = either (const True) (const False)
     isRight = not . isLeft
 
+prop_stable :: Nat -> Property
 prop_stable n' =
   forAll (genGraph_ n) $ \g ->
   let g' = warshallG g in
diff --git a/src/full/Agda/Version.hs b/src/full/Agda/Version.hs
index 2965ad7..28413df 100644
--- a/src/full/Agda/Version.hs
+++ b/src/full/Agda/Version.hs
@@ -1,4 +1,3 @@
-
 module Agda.Version where
 
 import Data.Version
diff --git a/src/full/Agda/undefined.h b/src/full/undefined.h
similarity index 100%
rename from src/full/Agda/undefined.h
rename to src/full/undefined.h

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/agda.git



More information about the Pkg-haskell-commits mailing list